/jcl/examples/windows/debug/sourceloc/SourceLocDemoMain.pas

  1unit SourceLocDemoMain;
  2
  3interface
  4
  5uses
  6  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7  StdCtrls, Spin;
  8
  9type
 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;
 36
 37var
 38  Form1: TForm1;
 39
 40implementation
 41
 42{$R *.DFM}
 43
 44uses
 45  JclCounter, JclDebug;
 46
 47procedure TForm1.FormCreate(Sender: TObject);
 48var
 49  P: Pointer;
 50begin
 51  P := @TForm1.AddrBtnClick;
 52  AddrEdit.Text := IntToHex(Integer(P), 8);
 53end;
 54
 55procedure TForm1.ReportLocation(Addr: Pointer);
 56var
 57  C: TJclCounter;
 58  S: string;
 59  T: Extended;
 60begin
 61  StartCount(C);
 62  S := GetLocationInfoStr(Addr, False, True, True);
 63  T := StopCount(C);
 64  Memo1.Lines.Add(S);
 65  ReportTime(T);
 66end;
 67
 68procedure TForm1.ReportTime(T: Extended);
 69begin
 70  Memo1.Lines.Add(Format('Time: %4.3f ms'#13#10, [T * 1000]));
 71end;
 72
 73procedure TForm1.CallerBtnClick(Sender: TObject);
 74begin
 75  ReportLocation(Caller(LevelSpinEdit.Value));
 76end;
 77
 78procedure TForm1.AddrBtnClick(Sender: TObject);
 79var
 80  Addr: Pointer;
 81begin
 82  Addr := Pointer(StrToInt('$' + Trim(AddrEdit.Text)));
 83  ReportLocation(Addr);
 84end;
 85
 86procedure TForm1.StackBtnClick(Sender: TObject);
 87var
 88  C: TJclCounter;
 89  T: Extended;
 90  SL: TStringList;
 91begin
 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;
107end;
108
109procedure TForm1.TraceLocBtnClick(Sender: TObject);
110begin
111  TraceLoc('text');
112end;
113
114procedure TForm1.ProcBtnClick(Sender: TObject);
115begin
116  ShowMessage(ProcByLevel);
117end;
118
119procedure TForm1.ModuleBtnClick(Sender: TObject);
120begin
121  ShowMessage(ModuleByLevel);
122end;
123
124end.