捐赠 | 广告 | 注册 | 发布 | 上传 | 关于我们    
  粤ICP备10103342号-1 DELPHI盒子 | 盒子文章 | 盒子问答悬赏 | 最新更新 | 盒子检索 | 下载中心 | 高级搜索    
  精品专区 | 繁體中文 | 奖励公告栏 | 直通车账号登陆 | 关闭GOOGLE广告 | 临时留言    
盒子资源分类
全部展开 - 全部合拢
PMyBaseDebug (清凉级Debug工具单元)
关键字：PMyBaseDebug 工具 单元 时间
来　自：原创
平　台：Win9x,Win2k/XP/NT,Win2003 下载所需：0 火柴
深浅度：初级 完成时间：2005/4/11
发布者：mmzmagic 发布时间：2005/4/11
编辑器：DELPHI7 语　　种：简体中文
分　类：对象 下载浏览：1310/11449
加入到我的收藏
下载错误报错
登陆以后才能下载
 用户名：
 密　码：
自动登陆(30天有效)
图片如果打不开，说明流量不够了，请稍候下载……
小草呢清凉级调试单元PMyBaseDebug。
我喜欢写类，可每写一个类总得建一个工程来为这个类Debug，时间长了就有好多工程O_O；突然发现我总是在做同样重复的事，比如我要比较2个算法消耗的时间，我总要在调用这个算法的过程前边加上时间计算：
var
 Ls,Le:Cradinal;
begin
  Ls:=Gettickcount;
  {调用算法}
  Le:=Gettickcount;
  Showmessage(Format('此算法消耗了%s豪秒',[intTostr(Le-ls)]));
end;
当我在断点时想看鼠标下显示某个变量的值时Delphi的Ide老不喜欢显示给我看-_-；想用个Showmessage或者MessageBox把它弹出来吧 又会碰上此算法执行在线程中无法弹出，想找个地方把它输出吧，又要麻烦的建立容器和传递容器，So动手写了个方便自己日常debug的工具单元，为什么是单元呢？因为我不太喜欢写成组件感觉有些多余的东西。
在你的程序里引用了它，就具备了基本的Debug能力并且可以方便的记录和显示你想输出的值或者信息，相信会让你省不少事的。
希望能在你Codeing的时候带来一丝方便；同时请不要拿她去跟别的工具(如CodeSite)比较这是没得比的；我都说了这是清凉级的。
喜欢的朋友下去用用，源代码在里边了可以根据自己需要定制功能^_^
demo界面请看“截图”
如何使用请看“使用方法”
Demo代码在“Demo文件”里边，把那个rar文件望桌面拖就可以。
PmyBaseDebug.pas在“单元文件”里，同样望桌面拖。
Google
 
本站原创作品，未经作者许可，严禁任何方式转载；转载作品，如果侵犯了您的权益，请联系我们！
龙脉加密锁 15元起 Grid++Report 报表 申请支付@网
　相关文章
没有相关文章
相关评论
共有评论5条 当前显示最后5条评论
wyz1738 2005/4/12 8:29:16
简单，实用，够用就好。
szkingrose 2005/4/13 14:52:33
8错，先试用一下。
mmzmagic 2005/4/14 8:32:32
改进了一下
改成自动注册热键，不用在主窗体创建时注册热键。
增加窗体透明拖动条，这样就不会挡住被调试的界面。 以下是代码
==========
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.
mmzmagic 2005/4/14 11:34:13
欢迎入住小草的窝~~~ 极度热爱编程的朋友来~~ 群号码：2019237 
讨论一切技术问题，初级除外~~抓紧喔~进来后请积极参与不要罐水
努力建立一个高素质的群
mmzmagic 2008/10/9 21:36:29
由于工作太忙，群友们太热情 无暇招呼，只好关闭群，实在抱歉 ：）
我要发表评论 查看全部评论
 
  DELPHI盒子版权所有 技术支持:深圳市麟瑞科技有限公司 1999-2024 V4.01 粤ICP备10103342号-1 更新RSS列表