mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-19 13:09:36 +02:00
leakview: store interface settings: OnTop flag, window bounds, recently opened files
git-svn-id: trunk@25747 -
This commit is contained in:
dmitry
parent
08ca74b42e
commit
70a56f036c
@ -1,102 +1,82 @@
|
||||
object HeapTrcViewForm: THeapTrcViewForm
|
||||
Left = 470
|
||||
Height = 424
|
||||
Top = 325
|
||||
Width = 672
|
||||
Left = 440
|
||||
Height = 516
|
||||
Top = 302
|
||||
Width = 689
|
||||
Caption = 'HeapTrcViewForm'
|
||||
ClientHeight = 424
|
||||
ClientWidth = 672
|
||||
ClientHeight = 516
|
||||
ClientWidth = 689
|
||||
FormStyle = fsStayOnTop
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
LCLVersion = '0.9.29'
|
||||
object lblTrcFile: TLabel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = edtTrcFileName
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 6
|
||||
Height = 14
|
||||
Height = 18
|
||||
Top = 9
|
||||
Width = 35
|
||||
Width = 45
|
||||
BorderSpacing.Left = 6
|
||||
Caption = '.trc file'
|
||||
ParentColor = False
|
||||
end
|
||||
object edtTrcFileName: TEdit
|
||||
AnchorSideLeft.Control = lblTrcFile
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = Owner
|
||||
AnchorSideRight.Control = btnBrowse
|
||||
Left = 47
|
||||
Height = 21
|
||||
Top = 6
|
||||
Width = 581
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 6
|
||||
BorderSpacing.Right = 6
|
||||
TabOrder = 0
|
||||
end
|
||||
object btnUpdate: TButton
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = edtTrcFileName
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 23
|
||||
Top = 39
|
||||
Width = 61
|
||||
Height = 20
|
||||
Top = 40
|
||||
Width = 70
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 12
|
||||
Caption = 'Update'
|
||||
OnClick = btnUpdateClick
|
||||
TabOrder = 1
|
||||
TabOrder = 0
|
||||
end
|
||||
object chkStayOnTop: TCheckBox
|
||||
AnchorSideTop.Control = btnUpdate
|
||||
AnchorSideTop.Side = asrCenter
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 592
|
||||
Height = 17
|
||||
Top = 42
|
||||
Width = 74
|
||||
Left = 591
|
||||
Height = 18
|
||||
Top = 41
|
||||
Width = 92
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Right = 6
|
||||
Caption = 'Stay on top'
|
||||
OnChange = chkStayOnTopChange
|
||||
TabOrder = 2
|
||||
TabOrder = 1
|
||||
end
|
||||
object btnBrowse: TButton
|
||||
AnchorSideTop.Control = edtTrcFileName
|
||||
AnchorSideTop.Side = asrCenter
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 634
|
||||
Left = 645
|
||||
Height = 20
|
||||
Top = 6
|
||||
Width = 32
|
||||
Top = 9
|
||||
Width = 38
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Right = 6
|
||||
Caption = '...'
|
||||
OnClick = btnBrowseClick
|
||||
TabOrder = 3
|
||||
TabOrder = 2
|
||||
end
|
||||
object chkUseRaw: TCheckBox
|
||||
AnchorSideLeft.Control = btnClipboard
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = btnUpdate
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 180
|
||||
Height = 17
|
||||
Top = 42
|
||||
Width = 86
|
||||
Left = 211
|
||||
Height = 18
|
||||
Top = 41
|
||||
Width = 107
|
||||
BorderSpacing.Left = 6
|
||||
Caption = 'Raw leak data'
|
||||
Checked = True
|
||||
OnChange = chkUseRawChange
|
||||
State = cbChecked
|
||||
TabOrder = 4
|
||||
TabOrder = 3
|
||||
end
|
||||
object ctrlPanel: TPanel
|
||||
AnchorSideLeft.Control = Owner
|
||||
@ -107,24 +87,24 @@ object HeapTrcViewForm: THeapTrcViewForm
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 350
|
||||
Top = 68
|
||||
Width = 660
|
||||
Height = 444
|
||||
Top = 66
|
||||
Width = 677
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Around = 6
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 350
|
||||
ClientWidth = 660
|
||||
TabOrder = 5
|
||||
ClientHeight = 444
|
||||
ClientWidth = 677
|
||||
TabOrder = 4
|
||||
object trvTraceInfo: TTreeView
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 0
|
||||
Height = 258
|
||||
Height = 352
|
||||
Top = 6
|
||||
Width = 660
|
||||
Width = 677
|
||||
Align = alClient
|
||||
BorderSpacing.Top = 6
|
||||
DefaultItemHeight = 15
|
||||
DefaultItemHeight = 19
|
||||
ReadOnly = True
|
||||
TabOrder = 0
|
||||
OnDblClick = trvTraceInfoDblClick
|
||||
@ -133,8 +113,8 @@ object HeapTrcViewForm: THeapTrcViewForm
|
||||
object memoSummary: TMemo
|
||||
Left = 0
|
||||
Height = 81
|
||||
Top = 269
|
||||
Width = 660
|
||||
Top = 363
|
||||
Width = 677
|
||||
Align = alBottom
|
||||
ReadOnly = True
|
||||
ScrollBars = ssVertical
|
||||
@ -144,8 +124,8 @@ object HeapTrcViewForm: THeapTrcViewForm
|
||||
Cursor = crVSplit
|
||||
Left = 0
|
||||
Height = 5
|
||||
Top = 264
|
||||
Width = 660
|
||||
Top = 358
|
||||
Width = 677
|
||||
Align = alBottom
|
||||
ResizeAnchor = akBottom
|
||||
end
|
||||
@ -154,14 +134,28 @@ object HeapTrcViewForm: THeapTrcViewForm
|
||||
AnchorSideLeft.Control = btnUpdate
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = btnUpdate
|
||||
Left = 73
|
||||
Height = 23
|
||||
Top = 39
|
||||
Width = 101
|
||||
Left = 82
|
||||
Height = 20
|
||||
Top = 40
|
||||
Width = 123
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 6
|
||||
Caption = 'Paste Clipboard'
|
||||
OnClick = btnClipboardClick
|
||||
TabOrder = 5
|
||||
end
|
||||
object edtTrcFileName: TComboBox
|
||||
AnchorSideLeft.Control = lblTrcFile
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideRight.Control = btnBrowse
|
||||
Left = 57
|
||||
Height = 21
|
||||
Top = 8
|
||||
Width = 582
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Right = 6
|
||||
ItemHeight = 0
|
||||
TabOrder = 6
|
||||
end
|
||||
end
|
||||
|
||||
@ -6,7 +6,8 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
StdCtrls, ComCtrls, ExtCtrls, LeakInfo, LazIDEIntf, MenuIntf, contnrs, Clipbrd;
|
||||
StdCtrls, ComCtrls, ExtCtrls, LeakInfo, LazIDEIntf, MenuIntf, contnrs, Clipbrd,
|
||||
XMLConf;
|
||||
|
||||
type
|
||||
TJumpProc = procedure (Sender: TObject; const SourceName: string; Line: integer) of object;
|
||||
@ -18,7 +19,7 @@ type
|
||||
btnClipboard: TButton;
|
||||
chkUseRaw: TCheckBox;
|
||||
chkStayOnTop: TCheckBox;
|
||||
edtTrcFileName: TEdit;
|
||||
edtTrcFileName:TComboBox;
|
||||
lblTrcFile: TLabel;
|
||||
ctrlPanel: TPanel;
|
||||
memoSummary: TMemo;
|
||||
@ -47,6 +48,10 @@ type
|
||||
function GetStackTraceText(trace: TStackTrace; useRaw: Boolean): string;
|
||||
function GetStackLineText(const Line: TStackLine; useRaw: Boolean): string;
|
||||
|
||||
procedure SaveState(cfg: TXMLConfig);
|
||||
procedure LoadState(cfg: TXMLConfig);
|
||||
|
||||
procedure AddFileToList(const FileName: AnsiString);
|
||||
protected
|
||||
procedure LazarusJump(Sender: TObject; const SourceFile: string; Line: Integer);
|
||||
public
|
||||
@ -92,7 +97,7 @@ implementation
|
||||
|
||||
procedure ShowHeapTrcViewForm(JumpProc: TJumpProc);
|
||||
begin
|
||||
if not Assigned(HeapTrcViewForm) then HeapTrcViewForm := THeapTrcViewForm.Create(nil);
|
||||
if not Assigned(HeapTrcViewForm) then HeapTrcViewForm := THeapTrcViewForm.Create(Application);
|
||||
if not Assigned(JumpProc)
|
||||
then HeapTrcViewForm.OnJumpProc := @HeapTrcViewForm.LazarusJump
|
||||
else HeapTrcViewForm.OnJumpProc := JumpProc;
|
||||
@ -104,6 +109,7 @@ end;
|
||||
procedure THeapTrcViewForm.btnUpdateClick(Sender: TObject);
|
||||
begin
|
||||
DoUpdateLeaks;
|
||||
AddFileToList(edtTrcFileName.Text);
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.btnClipboardClick(Sender: TObject);
|
||||
@ -120,6 +126,7 @@ begin
|
||||
if not OpenDialog.Execute then Exit;
|
||||
edtTrcFileName.Text := OpenDialog.FileName;
|
||||
DoUpdateLeaks;
|
||||
AddFileToList(edtTrcFileName.Text);
|
||||
finally
|
||||
OpenDialog.Free;
|
||||
end;
|
||||
@ -137,24 +144,55 @@ begin
|
||||
trvTraceInfo.Invalidate;
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.FormCreate(Sender: TObject);
|
||||
var
|
||||
ConfigFileName : AnsiString = '';
|
||||
function CreateXMLConfig: TXMLConfig;
|
||||
begin
|
||||
//
|
||||
Caption := sfrmCap;
|
||||
lblTrcFile.Caption:= slblTrace;
|
||||
btnUpdate.Caption:= sbtnUpdate;
|
||||
btnClipboard.Caption:= sbtnClipBrd;
|
||||
chkUseRaw.Caption:= schkRaw;
|
||||
chkStayOnTop.Caption:= schkTop;
|
||||
//
|
||||
fItems := TList.Create;
|
||||
chkStayOnTop.Checked := FormStyle = fsStayOnTop;
|
||||
Result:=TXMLConfig.Create(nil);
|
||||
Result.RootName:='config';
|
||||
if (ConfigFileName='') and Assigned(LazarusIDE) then
|
||||
ConfigFileName:=IncludeTrailingPathDelimiter(LazarusIDE.GetPrimaryConfigPath)+'leakview.xml';
|
||||
Result.FileName:=ConfigFileName;
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.FormCreate(Sender: TObject);
|
||||
var
|
||||
cfg : TXMLConfig;
|
||||
begin
|
||||
Caption:=sfrmCap;
|
||||
lblTrcFile.Caption:=slblTrace;
|
||||
btnUpdate.Caption:=sbtnUpdate;
|
||||
btnClipboard.Caption:=sbtnClipBrd;
|
||||
chkUseRaw.Caption:=schkRaw;
|
||||
chkStayOnTop.Caption:=schkTop;
|
||||
fItems:=TList.Create;
|
||||
try
|
||||
cfg:=CreateXMLConfig;
|
||||
try
|
||||
LoadState(cfg);
|
||||
finally
|
||||
cfg.Free;
|
||||
end;
|
||||
except
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.FormDestroy(Sender: TObject);
|
||||
var
|
||||
cfg : TXMLConfig;
|
||||
begin
|
||||
ClearItems;
|
||||
fItems.Free;
|
||||
try
|
||||
cfg:=CreateXMLConfig;
|
||||
try
|
||||
SaveState(cfg);
|
||||
finally
|
||||
cfg.Free;
|
||||
end;
|
||||
except
|
||||
end;
|
||||
HeapTrcViewForm:=nil;
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.trvTraceInfoDblClick(Sender: TObject);
|
||||
@ -355,6 +393,93 @@ begin
|
||||
else Result := Format(StackLineFormat, ['$'+IntToHex(Addr, sizeof(Pointer)*2)]);
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.SaveState(cfg:TXMLConfig);
|
||||
var
|
||||
b : TRect;
|
||||
i : Integer;
|
||||
begin
|
||||
cfg.SetValue('isStayOnTop',FormStyle=fsStayOnTop);
|
||||
b:=BoundsRect;
|
||||
cfg.OpenKey('bounds');
|
||||
cfg.SetValue('left', b.Left);
|
||||
cfg.SetValue('top', b.Top);
|
||||
cfg.SetValue('right', b.Right);
|
||||
cfg.SetValue('bottom', b.Bottom);
|
||||
cfg.CloseKey;
|
||||
for i:=0 to edtTrcFileName.Items.Count-1 do
|
||||
cfg.SetValue('path'+IntToStr(i), UTF8Decode(edtTrcFileName.Items[i]) );
|
||||
end;
|
||||
|
||||
function PointInRect(p: TPoint; const r: TRect): Boolean;
|
||||
begin
|
||||
Result:=(p.X>=r.Left) and (p.X<=r.Right) and (p.y>=r.Top) and (p.y<=r.Bottom);
|
||||
end;
|
||||
|
||||
function inAnyMonitor(b: TRect): Boolean;
|
||||
begin
|
||||
Result:=Assigned(Screen.MonitorFromRect(b));
|
||||
if not Result then
|
||||
Result:=PointInRect( Point(b.Left, b.Top), Bounds(0, 0, Screen.Width, Screen.Height));
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.LoadState(cfg:TXMLConfig);
|
||||
var
|
||||
b : TRect;
|
||||
isTop : Boolean;
|
||||
st : TStringList;
|
||||
s : WideString;
|
||||
i : Integer;
|
||||
const
|
||||
InitFormStyle: array [Boolean] of TFormStyle = (fsNormal, fsStayOnTop);
|
||||
begin
|
||||
isTop:=True;
|
||||
b:=BoundsRect;
|
||||
st:=TStringList.Create;
|
||||
try
|
||||
istop:=cfg.GetValue('isStayOnTop',isTop);
|
||||
cfg.OpenKey('bounds');
|
||||
b.Left:=cfg.GetValue('left', b.Left);
|
||||
b.Top:=cfg.GetValue('top', b.Top);
|
||||
b.Right:=cfg.GetValue('right', b.Right);
|
||||
b.Bottom:=cfg.GetValue('bottom', b.Bottom);
|
||||
cfg.CloseKey;
|
||||
|
||||
if b.Right-b.Left<=0 then b.Right:=b.Left+40;
|
||||
if b.Bottom-b.Top<=0 then b.Bottom:=b.Top+40;
|
||||
|
||||
for i:=0 to 7 do begin
|
||||
s:=cfg.GetValue('path'+IntToStr(i), '');
|
||||
if s<>'' then st.Add(UTF8Encode(s));
|
||||
end;
|
||||
|
||||
except
|
||||
end;
|
||||
if not inAnyMonitor(b) then b:=Bounds(40,40, 200, 200);
|
||||
|
||||
FormStyle:=InitFormStyle[isTop];
|
||||
BoundsRect:=b;
|
||||
chkStayOnTop.Checked := isTop;
|
||||
if st.Count>0 then begin
|
||||
edtTrcFileName.Items.AddStrings(st);
|
||||
edtTrcFileName.ItemIndex:=0;
|
||||
end;
|
||||
|
||||
st.Free;
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.AddFileToList(const FileName:AnsiString);
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
i:=edtTrcFileName.Items.IndexOf(FileName);
|
||||
if (i<0) then begin
|
||||
if edtTrcFileName.Items.Count=8 then
|
||||
edtTrcFileName.Items.Delete(7);
|
||||
end else
|
||||
edtTrcFileName.Items.Delete(i);
|
||||
edtTrcFileName.Items.Insert(0, FileName);
|
||||
end;
|
||||
|
||||
procedure THeapTrcViewForm.LazarusJump(Sender: TObject; const SourceFile: string; Line: Integer);
|
||||
var
|
||||
nm : string;
|
||||
@ -378,8 +503,5 @@ begin
|
||||
@IDEMenuClicked);
|
||||
end;
|
||||
|
||||
finalization
|
||||
HeapTrcViewForm.Free;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user