PMyBaseDebug

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 := True;
  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.