summaryrefslogtreecommitdiff
path: root/examples/apps/debugserver
diff options
context:
space:
mode:
authorGraeme Geldenhuys <graemeg@gmail.com>2013-04-27 13:02:34 +0100
committerGraeme Geldenhuys <graemeg@gmail.com>2013-04-27 13:02:34 +0100
commit4578b9d0f17ad07eb31f801074dec6e344780e16 (patch)
tree86c9f871d0c57c06d7cdd96b6048df553350cedb /examples/apps/debugserver
parentdbab5c2b7f03118f86fa1a17ae2b94acbe412151 (diff)
downloadfpGUI-4578b9d0f17ad07eb31f801074dec6e344780e16.tar.xz
debugserver: adds new Live View grid that will track values.
The "live view" values are not added to the usual messages list. They are very handy for tracking short lived debug info like the position of a mouse cursor, position of a trackbar or scrollbar etc.
Diffstat (limited to 'examples/apps/debugserver')
-rw-r--r--examples/apps/debugserver/fra_liveview.pas65
-rw-r--r--examples/apps/debugserver/frm_main.pas50
2 files changed, 114 insertions, 1 deletions
diff --git a/examples/apps/debugserver/fra_liveview.pas b/examples/apps/debugserver/fra_liveview.pas
new file mode 100644
index 00000000..80820dd5
--- /dev/null
+++ b/examples/apps/debugserver/fra_liveview.pas
@@ -0,0 +1,65 @@
+unit fra_liveview;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ SysUtils,
+ Classes,
+ fpg_base,
+ fpg_main,
+ fpg_form,
+ fpg_panel,
+ fpg_grid;
+
+type
+
+ TLiveViewFrame = class(TfpgFrame)
+ private
+ {@VFD_HEAD_BEGIN: fra_liveview}
+ Grid1: TfpgStringGrid;
+ {@VFD_HEAD_END: fra_liveview}
+ public
+ procedure AfterCreate; override;
+ end;
+
+{@VFD_NEWFORM_DECL}
+
+implementation
+
+{@VFD_NEWFORM_IMPL}
+
+procedure TLiveViewFrame.AfterCreate;
+begin
+ {%region 'Auto-generated GUI code' -fold}
+ {@VFD_BODY_BEGIN: fra_liveview}
+ Name := 'fra_liveview';
+ SetPosition(359, 215, 442, 104);
+ WindowTitle := 'fra_liveview';
+ Hint := '';
+
+ Grid1 := TfpgStringGrid.Create(self);
+ with Grid1 do
+ begin
+ Name := 'Grid1';
+ SetPosition(0, 4, 444, 98);
+ Anchors := [anLeft,anRight,anTop,anBottom];
+ BackgroundColor := TfpgColor($80000002);
+ AddColumn('Desc', 100, taLeftJustify);
+ AddColumn('Value', 310, taLeftJustify);
+ FontDesc := '#Grid';
+ HeaderFontDesc := '#GridHeader';
+ Hint := '';
+ RowCount := 5;
+ RowSelect := False;
+ ShowHeader := False;
+ TabOrder := 1;
+ end;
+
+ {@VFD_BODY_END: fra_liveview}
+ {%endregion}
+end;
+
+
+end.
diff --git a/examples/apps/debugserver/frm_main.pas b/examples/apps/debugserver/frm_main.pas
index 12584f41..89543763 100644
--- a/examples/apps/debugserver/frm_main.pas
+++ b/examples/apps/debugserver/frm_main.pas
@@ -82,6 +82,7 @@ uses
,fpg_memo
,simpleipc
,dbugmsg
+ ,fra_liveview
;
type
@@ -101,6 +102,7 @@ type
btnClear: TfpgButton;
btnExpandView: TfpgButton;
Bevel3: TfpgBevel;
+ btnLiveView: TfpgButton;
{@VFD_HEAD_END: MainForm}
miPause: TfpgMenuItem;
FIPCSrv: TSimpleIPCServer;
@@ -109,6 +111,7 @@ type
FDiscarded: Integer;
FShowOnMessage: Boolean;
FMemo: TfpgMemo;
+ FLiveViewFrame: TLiveViewFrame;
procedure StartServer;
procedure StopServer;
procedure CheckMessages(Sender: TObject);
@@ -125,9 +128,12 @@ type
procedure btnClearClicked(Sender: TObject);
procedure btnPauseClicked(Sender: TObject);
procedure btnStartClicked(Sender: TObject);
+ procedure btnLiveViewClicked(Sender: TObject);
procedure GridDrawCell(Sender: TObject; const ARow, ACol: Integer; const ARect: TfpgRect; const AFlags: TfpgGridDrawState; var ADefaultDrawing: boolean);
procedure GridRowChanged(Sender: TObject; ARow: Integer);
procedure GridClicked(Sender: TObject);
+ procedure CreateLiveViewFrame;
+ procedure DestroyLiveViewFrame;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@@ -214,6 +220,31 @@ begin
FMemo.Text := grdMessages.Cells[2, grdMessages.FocusRow];
end;
+procedure TMainForm.CreateLiveViewFrame;
+begin
+ if Assigned(FLiveViewFrame) then
+ FLiveViewFrame.Free;
+ FLiveViewFrame := TLiveViewFrame.Create(self);
+ grdMessages.Height := grdMessages.Height - FLiveViewFrame.Height;
+ grdMessages.UpdateWindowPosition;
+ FLiveViewFrame.SetPosition(grdMessages.Left, grdMessages.Bottom+1, grdMessages.Width, FLiveViewFrame.Height);
+end;
+
+procedure TMainForm.DestroyLiveViewFrame;
+begin
+ grdMessages.Height := grdMessages.Height + FLiveViewFrame.Height;
+ FreeAndNil(FLiveViewFrame);
+ grdMessages.UpdateWindowPosition;
+end;
+
+procedure TMainForm.btnLiveViewClicked(Sender: TObject);
+begin
+ if btnLiveView.Down then
+ CreateLiveViewFrame
+ else
+ DestroyLiveViewFrame;
+end;
+
procedure TMainForm.StartServer;
begin
FIPCSrv := TSimpleIPCServer.Create(nil);
@@ -308,7 +339,7 @@ const
begin
if btnExpandView.Down then
begin
- FMemo := CreateMemo(self, grdMessages.Right + cSpacing, grdMessages.Top, 200, grdMessages.Height);
+ FMemo := CreateMemo(self, grdMessages.Right + cSpacing, grdMessages.Top, 200, Height - grdMessages.Top - cSpacing);
FMemo.UpdateWindowPosition;
grdMessages.Anchors := grdMessages.Anchors - [anRight];
Width := Width + FMemo.Width + (2 * cSpacing);
@@ -557,6 +588,23 @@ begin
Style := bsLowered;
end;
+ btnLiveView := TfpgButton.Create(Bevel1);
+ with btnLiveView do
+ begin
+ Name := 'btnLiveView';
+ SetPosition(156, 2, 24, 24);
+ Text := 'LV';
+ AllowAllUp := True;
+ Flat := True;
+ FontDesc := '#Label1';
+ GroupIndex := 3;
+ Hint := '';
+ ImageName := '';
+ TabOrder := 8;
+ Focusable := False;
+ OnClick := @btnLiveViewClicked;
+ end;
+
{@VFD_BODY_END: MainForm}
{%endregion}