改进了一下
改成自动注册热键，不用在主窗体创建时注册热键。
增加窗体透明拖动条，这样就不会挡住被调试的界面。 以下是代码
==========
Unit PMyBaseDebug;
{
单元名：PMyBaseDebug
创建者：马敏钊
创建日期：20050407
类：TBaseDebug
功能描述：
提供基本的Debug方法 和日志显示记录的功能
本单元自己维护一个全局变量Gob_Debug
20050412
添加了TBaseDebug 的自动注册热键的能力
将公开的 方法 InitDebugSystem(ImainForm: TForm)改为私有
添加了窗体透明的拖动条
添加了一个方法
Function AddLogShower(IStrings:TStringList): Variant; Overload;
将 FShower: TMemo;改为私有
将 AutoSaveLog: boolean; 改名为 WantAutoSaveLog: boolean;
}
Interface
Uses Windows,SysUtils,Classes, Controls, Forms, StdCtrls,ExtCtrls,ComCtrls;
Const
{分割符号}
CSplitStr = '==========';
ClogFileName = 'Log.log';
Type
TMyInterfaceObject = Class(TObject, IInterface)
Protected
Function QueryInterface(Const IID: TGUID; Out Obj): HResult; Stdcall;
Function _AddRef: Integer; Stdcall;
Function _Release: Integer; Stdcall;
Public
End;
TDebugLogFile = Class
Private
FFileParth: String; //路径
FText: Text;
FIsCreateToNew: boolean; //是否是每次启动程序都创建新的记录文件 否则就是当天只会有1个文件
Public
{带入日志文件存放的目录位置}
Constructor Create(Iparth: String);
Destructor Destroy; Override;
{写入内容即可自动记录}
Procedure AddLog(Icon: String);
Property IsCreateToNew: boolean Read FIsCreateToNew Write FIsCreateToNew;
End;
{
显示接口
}
IShower = Interface
['{DFDA0AC0-0534-4FD6-A216-E278E93668B3}']
{
函数 AddShow
参数 Icon:string 要显示或者记录的内容
返回 记录组件Item的当前条数
}
Function AddShow(ICon: String): Integer;
End;
TEventShowed = Procedure(ILogCon: String) Of Object;
TDebuglog = Class(TMyInterfaceObject, IShower)
Private
FShower: TComponent; //容器
FClearTager: Word; //显示多少条后清空一下
FIsAddTime: boolean; //是否在每条显示前加时间
FAfterShowed: TEventShowed; //显示后触发的事件 可以用来做日志
FIsNeedSplt: boolean; //是否需要分割字符
FSplitChar: String; //分割的字符
FShow: IShower;
FLog: TDebugLogFile;
Protected
Function DoAdd(Icon: String): Integer; Virtual;
Function AddShow(ICon: String): Integer;
Published
Property AfterShowed: TEventShowed Read FAfterShowed Write FAfterShowed;
Public
{如果带入记录文件存放路径的话就自动生成记录类}
Constructor Create(IShower: TComponent; IlogFIleDir: String = ');
Destructor Destroy; Override;
Property ClearTager: Word Read FClearTager Write FClearTager;
Property IsAddTime: boolean Read FIsAddTime Write FIsAddTime;
Property IsNeedSplitChar: boolean Read FIsNeedSplt Write FIsNeedSplt;
Property SplitChar: String Read FSplitChar Write FSplitChar;
Property Shower: IShower Read FShow Write FShow;
End;
Type
TBaseDebug = Class
Private
FStartTime,
FEndTime: Cardinal;
FBugShowForm: TForm;
FLoger: TDebugLog;
FTimer:TTimer;
FtrackBar: TTrackBar;
FGroupBox:TGroupBox;
FShower: TMemo;
Procedure FormKeyDown(Sender: TObject; Var Key: Word;
Shift: TShiftState);
Procedure TimerOnTimer(Iobj:TObject);//自动设置快捷键的Timer事件
{加载热键系统 Alt+Shift+ctrl+o 是打开debug窗体 +p是打开/关闭自动记录功能-1开 0关}
Procedure InitDebugSystem(ImainForm: TForm);
Procedure TrackOnTrack(Iobj:TObject);
Public
{是否在程序结束的时候自动保存除错信息 默认是False}
WantAutoSaveLog: boolean;
{开始记录时间}
Procedure StartLogTime;
{停止记录并且返回时间差单位毫秒}
Function EndLogTIme: Cardinal;
{弹出变量的值}
Function ShowVar(Ivar: Variant): Variant;
{添加到Log容器}
Function AddLogShower(Ivar: Variant): Variant; Overload;
Function AddLogShower(IDesc: String; Ivar: Variant): Variant; Overload;
Function AddLogShower(IStrings:TStringList): Variant; Overload;
{显示Debug窗体}
Procedure ShowDebugform;
{将所有记录的东东保存成日志}
Procedure SaveLog(IfileName: String = 'LogFile.log');
Constructor Create;
Destructor Destroy; Override;
End;
Var
Gob_Debug: TBaseDebug;
Implementation
{ TMyInterfacedObject }
Function TMyInterfaceObject._AddRef: Integer;
Begin
Result := 0;
End;
Function TMyInterfaceObject._Release: Integer;
Begin
Result := 0;
End;
Function TMyInterfaceObject.QueryInterface(Const IID: TGUID;
Out Obj): HResult;
Begin
Result := 0;
End;
{ TDebugLog }
Function TDebugLog.AddShow(ICon: String): Integer;
Begin
If FIsAddTime Then
ICon := DateTimeToStr(Now) + ' ' + Icon;
If FIsNeedSplt Then
ICon := ICon + #13#10 + FSplitChar;
Result := DoAdd(ICon);
If assigned(FLog) Then
FLog.AddLog(ICon);
If Assigned(FAfterShowed) Then
FAfterShowed(ICon);
End;
Constructor TDebugLog.Create(IShower: TComponent; IlogFIleDir: String = ');
Begin
FClearTager := 1000;
IsAddTime := True;
FIsNeedSplt := True;
FSplitChar := CSplitStr;
FShower := IShower;
Shower := Self;
If IlogFIleDir <> ' Then
FLog := TDebugLogFile.Create(IlogFIleDir);
End;
Destructor TDebugLog.Destroy;
Begin
If assigned(FLog) Then
FLog.Free;
Inherited;
End;
Function TDebugLog.DoAdd(Icon: String): Integer;
Begin
If (FShower Is TMemo) Then Begin
Result := TMemo(FShower).Lines.Add(Icon);
If Result >= FClearTager Then TMemo(FShower).Clear
End
Else If (FShower Is TListBox) Then Begin
Result := TListBox(FShower).Items.Add(Icon);
If Result >= FClearTager Then TListBox(FShower).Clear
End
Else
Raise Exception.Create('默认容器错误:' + FShower.ClassName);
End;
{ TDebugLogFile }
Procedure TDebugLogFile.AddLog(Icon: String);
Begin
Try
Append(FText);
Writeln(FText, icon);
Except
IOResult;
End;
End;
Constructor TDebugLogFile.Create(Iparth: String);
Var
Ltep: String;
Begin
FIsCreateToNew := True;
FFileParth := Iparth;
If Not DirectoryExists(FFileParth) Then
If Not CreateDir(FFileParth) Then Begin
Raise Exception.Create('错误的路径，日值类对象不能被创建');
exit;
End;
Ltep := FormatDateTime('yyyymmddhhnnss', Now);
FileClose(FileCreate(FFileParth + ltep + ClogFileName));
AssignFile(FText, FFileParth + ltep + ClogFileName);
End;
Destructor TDebugLogFile.Destroy;
Begin
Try
CloseFile(FText);
Except
End;
Inherited;
End;
{ TBaseDebug }
Function TBaseDebug.AddLogShower(Ivar: Variant): Variant;
Begin
Try
Result := Ivar;
FLoger.Shower.AddShow(Ivar);
Except
On e: Exception Do
AddLogShower(e.Message);
End;
End;
Function TBaseDebug.AddLogShower(IDesc: String; Ivar: Variant): Variant;
Var
Ltep: String;
Begin
Try
Ltep := Ivar;
Result := Ivar;
FLoger.Shower.AddShow('描述<' + IDesc + '> <值: ' + Ltep + '>');
Except
On e: Exception Do
AddLogShower(e.Message);
End;
End;
Constructor TBaseDebug.Create;
Begin
FBugShowForm := TForm.Create(FBugShowForm);
FBugShowForm.FormStyle := fsStayOnTop;
FBugShowForm.Caption := '小草的Debug系统';
FBugShowForm.Visible := False;
FBugShowForm.Position := poScreenCenter;
FBugShowForm.OnKeyDown := FormKeyDown;
FBugShowForm.AlphaBlend:=True;
FBugShowForm.Width:=430;
FBugShowForm.Height:=300;
FShower := TMemo.Create(FBugShowForm);
FShower.Parent := FBugShowForm;
FShower.Align := alClient;
FShower.ScrollBars := ssBoth;
FShower.OnKeyDown := FormKeyDown;
FLoger := TDebugLog.Create(FShower);
FLoger.IsNeedSplitChar := False;
FLoger.ClearTager := 10000;
FTimer:=TTimer.Create(Nil);
FTimer.OnTimer:=TimerOnTimer;
FGroupBox:=TGroupBox.Create(FBugShowForm);
FGroupBox.Parent:=FBugShowForm;
FGroupBox.Align:=alBottom;
FGroupBox.Height:=40;
FGroupBox.Caption:='透明度';
FtrackBar:=TTrackBar.Create(nil);
FtrackBar.Min:=50;
FtrackBar.Max:=255;
FtrackBar.Parent:=FGroupBox;
FtrackBar.Position:=200;
FtrackBar.Align:=alClient;
FtrackBar.TickStyle:=tsNone;
FtrackBar.OnChange:=TrackOnTrack;
FtrackBar.OnChange(FtrackBar);
WantAutoSaveLog := False;
AddLogShower(Format('程序启动...', []));
AddLogShower(Format('程序标题(%s)', [Application.Title]));
AddLogShower(Format('程序名(%s)',[Application.ExeName]));
End;
Destructor TBaseDebug.Destroy;
Begin
AddLogShower(Format('程序结束时间(%s)', [DateTimeToStr(now)]));
If WantAutoSaveLog Then
SaveLog();
FtrackBar.Free;
FGroupBox.Free;
FLoger.Free;
FShower.Free;
FBugShowForm.Free;
Inherited;
End;
Function TBaseDebug.EndLogTIme: Cardinal;
Begin
FEndTime := GetTickCount;
Result := FEndTime - FStartTime;
End;
Procedure TBaseDebug.FormKeyDown(Sender: TObject; Var Key: Word;
Shift: TShiftState);
Begin
If (ssAlt In Shift) Then Begin
Case Key Of //
ord('o'), Ord('O'): Begin
FBugShowForm.Visible := Not FBugShowForm.Visible;
Application.MainForm.SetFocus;
End;
ord('P'), ord('p'): Begin
WantAutoSaveLog := Not WantAutoSaveLog;
AddLogShower('当前自动保存的状态改为： ');
AddLogShower(WantAutoSaveLog)
End;
End; // case
End;
End;
Procedure TBaseDebug.InitDebugSystem(ImainForm: TForm);
Begin
ImainForm.KeyPreview := True;
ImainForm.OnKeyDown := FormKeyDown;
End;
procedure TBaseDebug.TimerOnTimer(Iobj:TObject);
begin
If Application.MainForm<>nil Then Begin
InitDebugSystem(Application.MainForm);
TTimer(Iobj).Enabled:=False;
TTimer(Iobj).Free;
End;
end;
Procedure TBaseDebug.SaveLog(IfileName: String);
Begin
Try
CreateDir(ExtractFilePath(Application.ExeName) + 'DebugLog\');
FShower.Lines.SaveToFile(ExtractFilePath(Application.ExeName) + 'DebugLog\' + Format('%s', [FormatDateTime('yyyymmddhhnnss', now) + IfileName]));
Except
Raise Exception.Create('保存Debug日志失败');
End;
End;
Procedure TBaseDebug.ShowDebugform;
Begin
FBugShowForm.Show;
End;
Function TBaseDebug.ShowVar(Ivar: Variant): Variant;
Var
S: String;
Begin
Try
Result := Ivar;
s := Ivar;
MessageBox(0, Pchar(s), 'Debug', 0);
Except
On e: Exception Do
AddLogShower(e.Message);
End;
End;
Procedure TBaseDebug.StartLogTime;
Begin
FStartTime := GetTickCount;
End;
procedure TBaseDebug.TrackOnTrack(Iobj: TObject);
begin
FBugShowForm.AlphaBlendValue:=TTrackBar(Iobj).Position;
end;
function TBaseDebug.AddLogShower(IStrings: TStringList): Variant;
Var
I: Integer;
begin
AddLogShower('>>>开始显示StringList');
For I := 0 To IStrings.Count - 1 Do
AddLogShower(IStrings.Strings[i]);
AddLogShower('显示StringList结束<<<');
end;
Initialization
Gob_Debug := TBaseDebug.Create;
Finalization
Gob_Debug.Free;
End. |
