From: Erik B. <eb...@us...> - 2006-08-09 06:07:58
|
Update of /cvsroot/gexperts/gexperts/unstable In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv6394 Modified Files: DbugIntf.pas Log Message: Synchronize the two versions of this file (internal, external) Index: DbugIntf.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/DbugIntf.pas,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- DbugIntf.pas 5 Jul 2004 04:54:11 -0000 1.8 +++ DbugIntf.pas 9 Aug 2006 06:07:55 -0000 1.9 @@ -18,10 +18,14 @@ procedure SendDateTime(const Identifier: string; const Value: TDateTime); procedure SendDebugEx(const Msg: string; MType: TMsgDlgType); procedure SendDebug(const Msg: string); +procedure SendDebugError(const Msg: string); +procedure SendDebugWarning(const Msg: string); procedure SendDebugClear; procedure SendInteger(const Identifier: string; const Value: Integer); procedure SendMethodEnter(const MethodName: string); procedure SendMethodExit(const MethodName: string); +procedure SendIndent; +procedure SendUnIndent; procedure SendSeparator; procedure SendDebugFmt(const Msg: string; const Args: array of const); procedure SendDebugFmtEx(const Msg: string; const Args: array of const; MType: TMsgDlgType); @@ -35,6 +39,9 @@ Messages, SysUtils, Registry, +{$IFDEF GX_DEBUGLOG} + GX_Debug, +{$ENDIF GX_DEBUGLOG} Forms; // We need "Forms" for the Application object threadvar @@ -60,9 +67,9 @@ if PastFailedAttemptToStartDebugWin then Exit; - with TRegIniFile.Create('\Software\GExperts') do + with TRegIniFile.Create('\Software\GExperts') do // Do not localize. try - DebugFileName := ReadString('Debug', 'FilePath', ''); + DebugFileName := ReadString('Debug', 'FilePath', ''); // Do not localize. finally Free; end; @@ -70,7 +77,7 @@ if Trim(DebugFileName) = '' then begin GetModuleFileName(HINSTANCE, Buf, SizeOf(Buf)-1); - DebugFileName := ExtractFilePath(StrPas(Buf))+'GDebug.exe'; + DebugFileName := ExtractFilePath(StrPas(Buf)) + 'GDebug.exe'; // Do not localize. end; if (Trim(DebugFileName) = '') or not FileExists(DebugFileName) then @@ -83,10 +90,8 @@ si.cb := SizeOf(si); si.dwFlags := STARTF_USESHOWWINDOW; si.wShowWindow := SW_SHOW; - if not CreateProcess(PChar(DebugFileName), nil, - nil, nil, - False, 0, nil, nil, - si, pi) then + if not CreateProcess(PChar(DebugFileName), nil, nil, nil, + False, 0, nil, nil, si, pi) then begin PastFailedAttemptToStartDebugWin := True; Exit; @@ -103,15 +108,24 @@ end; procedure SendDebugEx(const Msg: string; MType: TMsgDlgType); +{$IFDEF MSWINDOWS} var CDS: TCopyDataStruct; DebugWin: hWnd; MessageString: string; +{$ENDIF MSWINDOWS} {$IFDEF LINUX} + {$DEFINE NEEDMTYPESTR} +{$ENDIF LINUX} +{$IFDEF GX_DEBUGLOG} + {$DEFINE NEEDMTYPESTR} +{$ENDIF GX_DEBUGLOG} + +{$IFDEF NEEDMTYPESTR} const MTypeStr: array[TMsgDlgType] of string = ('Warning: ', 'Error: ', 'Information: ', 'Confirmation: ', 'Custom: '); -{$ENDIF LINUX} +{$ENDIF NEEDMTYPESTR} begin if SendPaused then Exit; @@ -119,8 +133,10 @@ {$IFDEF LINUX} Writeln('GX: ' + MTypeStr[MType] + Msg); {$ENDIF LINUX} - -{$IFNDEF LINUX} +{$IFDEF GX_DEBUGLOG} + GxAddToDebugLog(MTypeStr[MType] + Msg); +{$ENDIF GX_DEBUGLOG} +{$IFDEF MSWINDOWS} DebugWin := FindWindow('TfmDebug', nil); if DebugWin = 0 then @@ -137,7 +153,7 @@ CDS.lpData := PChar(#1+Char(Ord(MType) + 1)+ MessageString +#0); SendMessage(DebugWin, WM_COPYDATA, WPARAM(Application.Handle), LPARAM(@CDS)); end; -{$ENDIF not LINUX} +{$ENDIF MSWINDOWS} end; procedure SendDebug(const Msg: string); @@ -145,6 +161,16 @@ SendDebugEx(Msg, mtInformation); end; +procedure SendDebugError(const Msg: string); +begin + SendDebugEx(Msg, mtError); +end; + +procedure SendDebugWarning(const Msg: string); +begin + SendDebugEx(Msg, mtWarning); +end; + procedure SendDebugFmt(const Msg: string; const Args: array of const); begin SendDebugEx(Format(Msg, Args), mtInformation); @@ -165,17 +191,26 @@ procedure SendMethodEnter(const MethodName: string); begin - MsgPrefix := MsgPrefix + Indentation; SendDebugEx('Entering ' + MethodName, mtInformation); + SendIndent; end; -procedure SendMethodExit(const MethodName: string); +procedure SendIndent; begin - SendDebugEx('Exiting ' + MethodName, mtInformation); + MsgPrefix := MsgPrefix + Indentation; +end; +procedure SendUnIndent; +begin Delete(MsgPrefix, 1, Length(Indentation)); end; +procedure SendMethodExit(const MethodName: string); +begin + SendUnindent; + SendDebugEx('Exiting ' + MethodName, mtInformation); +end; + procedure SendSeparator; const SeparatorString = '------------------------------'; |