开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
SourceLocDemoMain.pas
资源名称：JCL.v1.98.1.2530.Full.Source.Delphi.BCB.BDS.Kylix.　[点击查看]
上传用户：scb3804
上传日期：2013-10-18
资源大小：2185k
文件大小：3k
源码类别：

Delphi控件源码

开发平台：

Delphi

SourceLocDemoMain.pas：源码内容
  1. unit SourceLocDemoMain;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, Spin;
  9. type
  10.   TForm1 = class(TForm)
  11.     Memo1: TMemo;
  12.     CallerBtn: TButton;
  13.     LevelSpinEdit: TSpinEdit;
  14.     AddrBtn: TButton;
  15.     AddrEdit: TEdit;
  16.     StackBtn: TButton;
  17.     Label1: TLabel;
  18.     Label2: TLabel;
  19.     TraceLocBtn: TButton;
  20.     ProcBtn: TButton;
  21.     ModuleBtn: TButton;
  22.     RawCheckBox: TCheckBox;
  23.     procedure CallerBtnClick(Sender: TObject);
  24.     procedure AddrBtnClick(Sender: TObject);
  25.     procedure FormCreate(Sender: TObject);
  26.     procedure StackBtnClick(Sender: TObject);
  27.     procedure TraceLocBtnClick(Sender: TObject);
  28.     procedure ProcBtnClick(Sender: TObject);
  29.     procedure ModuleBtnClick(Sender: TObject);
  30.   private
  31.     { Private declarations }
  32.   public
  33.     procedure ReportLocation(Addr: Pointer);
  34.     procedure ReportTime(T: Extended);
  35.   end;
  37. var
  38.   Form1: TForm1;
  40. implementation
  42. {$R *.DFM}
  44. uses
  45.   JclCounter, JclDebug;
  47. procedure TForm1.FormCreate(Sender: TObject);
  48. var
  49.   P: Pointer;
  50. begin
  51.   P := @TForm1.AddrBtnClick;
  52.   AddrEdit.Text := IntToHex(Integer(P), 8);
  53. end;
  55. procedure TForm1.ReportLocation(Addr: Pointer);
  56. var
  57.   C: TJclCounter;
  58.   S: string;
  59.   T: Extended;
  60. begin
  61.   StartCount(C);
  62.   S := GetLocationInfoStr(Addr, False, True, True);
  63.   T := StopCount(C);
  64.   Memo1.Lines.Add(S);
  65.   ReportTime(T);
  66. end;
  68. procedure TForm1.ReportTime(T: Extended);
  69. begin
  70.   Memo1.Lines.Add(Format('Time: %4.3f ms'#13#10, [T * 1000]));
  71. end;
  73. procedure TForm1.CallerBtnClick(Sender: TObject);
  74. begin
  75.   ReportLocation(Caller(LevelSpinEdit.Value));
  76. end;
  78. procedure TForm1.AddrBtnClick(Sender: TObject);
  79. var
  80.   Addr: Pointer;
  81. begin
  82.   Addr := Pointer(StrToInt('$' + Trim(AddrEdit.Text)));
  83.   ReportLocation(Addr);
  84. end;
  86. procedure TForm1.StackBtnClick(Sender: TObject);
  87. var
  88.   C: TJclCounter;
  89.   T: Extended;
  90.   SL: TStringList;
  91. begin
  92.   SL := TStringList.Create;
  93.   try
  94.     StartCount(C);
  95.     with TJclStackInfoList.Create(RawCheckBox.Checked, 0, nil) do
  96.     try
  97.       AddToStrings(SL, False, True, True);
  98.       T := StopCount(C);
  99.       Memo1.Lines.AddStrings(SL);
  100.       ReportTime(T);
  101.     finally
  102.       Free;
  103.     end;
  104.   finally
  105.     SL.Free;
  106.   end;
  107. end;
  109. procedure TForm1.TraceLocBtnClick(Sender: TObject);
  110. begin
  111.   TraceLoc('text');
  112. end;
  114. procedure TForm1.ProcBtnClick(Sender: TObject);
  115. begin
  116.   ShowMessage(ProcByLevel);
  117. end;
  119. procedure TForm1.ModuleBtnClick(Sender: TObject);
  120. begin
  121.   ShowMessage(ModuleByLevel);
  122. end;
  124. end.