diff options
author | Graeme Geldenhuys <graemeg@gmail.com> | 2013-04-27 13:02:34 +0100 |
---|---|---|
committer | Graeme Geldenhuys <graemeg@gmail.com> | 2013-04-27 13:02:34 +0100 |
commit | 4578b9d0f17ad07eb31f801074dec6e344780e16 (patch) | |
tree | 86c9f871d0c57c06d7cdd96b6048df553350cedb /examples/apps/debugserver | |
parent | dbab5c2b7f03118f86fa1a17ae2b94acbe412151 (diff) | |
download | fpGUI-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.pas | 65 | ||||
-rw-r--r-- | examples/apps/debugserver/frm_main.pas | 50 |
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} |