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

https://github.com/the-Arioch/jcl · Pascal · 124 lines · 105 code · 17 blank · 2 comment · 0 complexity · 5c19cc2293b67fc784c6e769b3e0bf28 MD5 · raw file

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