From 4578b9d0f17ad07eb31f801074dec6e344780e16 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Sat, 27 Apr 2013 13:02:34 +0100 Subject: 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. --- examples/apps/debugserver/fra_liveview.pas | 65 ++++++++++++++++++++++++++++++ examples/apps/debugserver/frm_main.pas | 50 ++++++++++++++++++++++- 2 files changed, 114 insertions(+), 1 deletion(-) create mode 100644 examples/apps/debugserver/fra_liveview.pas 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} -- cgit v1.2.3-70-g09d2 From 146539ae2553981da86d5a41fc7b5bceee8dff6f Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Sat, 27 Apr 2013 18:38:30 +0100 Subject: debugserver: LiveView frame now has a Grid property for easy access. --- examples/apps/debugserver/fra_liveview.pas | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/examples/apps/debugserver/fra_liveview.pas b/examples/apps/debugserver/fra_liveview.pas index 80820dd5..dd04e625 100644 --- a/examples/apps/debugserver/fra_liveview.pas +++ b/examples/apps/debugserver/fra_liveview.pas @@ -22,6 +22,7 @@ type {@VFD_HEAD_END: fra_liveview} public procedure AfterCreate; override; + property Grid: TfpgStringGrid read Grid1; end; {@VFD_NEWFORM_DECL} @@ -51,7 +52,7 @@ begin FontDesc := '#Grid'; HeaderFontDesc := '#GridHeader'; Hint := ''; - RowCount := 5; + RowCount := 0; RowSelect := False; ShowHeader := False; TabOrder := 1; -- cgit v1.2.3-70-g09d2 From 15e40c9ea4544a1a74f571f495e00d4bd122c76c Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Sat, 27 Apr 2013 18:41:17 +0100 Subject: new debug interface unit for use with out Debug Server application. Added debug interface units to 'corelib' and to the fpgui_toolkit packages --- src/corelib/fpg_dbugintf.pas | 337 ++++++++++++++++++++++++++++++++++++++ src/corelib/fpg_dbugmsg.pas | 95 +++++++++++ src/corelib/gdi/fpgui_toolkit.lpk | 10 +- src/corelib/gdi/fpgui_toolkit.pas | 2 +- src/corelib/x11/fpgui_toolkit.lpk | 10 +- src/corelib/x11/fpgui_toolkit.pas | 26 +-- 6 files changed, 465 insertions(+), 15 deletions(-) create mode 100644 src/corelib/fpg_dbugintf.pas create mode 100644 src/corelib/fpg_dbugmsg.pas diff --git a/src/corelib/fpg_dbugintf.pas b/src/corelib/fpg_dbugintf.pas new file mode 100644 index 00000000..8e9d9874 --- /dev/null +++ b/src/corelib/fpg_dbugintf.pas @@ -0,0 +1,337 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2005 by Michael Van Canneyt, member of + the Free Pascal development team + Copyright (C) 2013 by Graeme Geldenhuys + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + Originally from the Free Pascal FCL. Since then the code has + diverged and was customised for fpGUI usage. + + This is the Client Interface for the debug server, which is + based on SimpleIPC. +} +unit fpg_dbugintf; + +{$mode objfpc}{$h+} + +interface + +uses + Classes, + fpg_base; + +Type + TDebugLevel = (dlStop, dlInformation, dlWarning, dlError, dlIdentify, dlLive); + +procedure SendBoolean(const Identifier: string; const Value: Boolean); +procedure SendDateTime(const Identifier: string; const Value: TDateTime); +procedure SendInteger(const Identifier: string; const Value: Integer; HexNotation: Boolean = False); +procedure SendPoint(const Identifier: string; const Value: TPoint; const ADbgLevel: TDebugLevel = dlLive); +procedure SendPointer(const Identifier: string; const Value: Pointer); +procedure SendRect(const Identifier: string; const Value: TRect; const ADbgLevel: TDebugLevel = dlInformation); +procedure SendRect(const Identifier: string; const Value: TfpgRect; const ADbgLevel: TDebugLevel = dlInformation); +procedure SendDebugEx(const Msg: string; MType: TDebugLevel); +procedure SendDebug(const Msg: string); +procedure SendMethodEnter(const MethodName: string); +procedure SendMethodExit(const MethodName: string); +procedure SendSeparator; +procedure SendDebugFmt(const Msg: string; const Args: array of const); +procedure SendDebugFmtEx(const Msg: string; const Args: array of const; MType: TDebugLevel; const ATitle: string = ''); + +procedure SetDebuggingEnabled(const AValue : boolean); +function GetDebuggingEnabled : Boolean; + +{ low-level routines } + +Function StartDebugServer : integer; +Function InitDebugClient : Boolean; +Function DebugMessageName(msgType: TDebugLevel) : String; + +Const + SendError : String = ''; + +ResourceString + SProcessID = 'Process %s'; + SEntering = '> Entering '; + SExiting = '< Exiting '; + SSeparator = '>-=-=-=-=-=-=-=-=-=-=-=-=-=-=-<'; + SServerStartFailed = 'Failed to start debugserver. (%s)'; + +implementation + +Uses + SysUtils, + process, + simpleipc, + fpg_dbugmsg; + +const + IndentChars = 2; + +var + DebugClient : TSimpleIPCClient = nil; + MsgBuffer : TMemoryStream = Nil; + ServerID : Integer; + DebugDisabled : Boolean = False; + Indent : Integer = 0; + +function RectToStr(const ARect: TRect): String; +begin + with ARect do + Result := Format('(Left: %d; Top: %d; Right: %d; Bottom: %d)', [Left, Top, Right, Bottom]); +end; + +function fpgRectToStr(const ARect: TfpgRect): String; +begin + with ARect do + Result := Format('(Left: %d; Top: %d; Width: %d; Height: %d)', [Left, Top, Width, Height]); +end; + +function PointToStr(const APoint: TPoint): String; +begin + with APoint do + Result := Format('(X: %d; Y: %d)', [X, Y]); +end; + +procedure WriteMessage(Const Msg : TDebugMessage); +begin + MsgBuffer.Seek(0, soFromBeginning); + WriteDebugMessageToStream(MsgBuffer, Msg); + DebugClient.SendMessage(mtUnknown, MsgBuffer); +end; + +procedure SendDebugMessage(Var Msg : TDebugMessage); +begin + if DebugDisabled then exit; + try + If (DebugClient=Nil) then + if InitDebugClient = false then exit; + if (Indent > 0) then + Msg.Msg := StringOfChar(' ', Indent) + Msg.Msg; + WriteMessage(Msg); + except + On E: Exception do + SendError := E.Message; + end; +end; + +procedure SendBoolean(const Identifier: string; const Value: Boolean); +const + Booleans : Array[Boolean] of string = ('False','True'); +begin + SendDebugFmt('%s = %s',[Identifier,Booleans[value]]); +end; + +procedure SendDateTime(const Identifier: string; const Value: TDateTime); +begin + SendDebugFmt('%s = %s',[Identifier,DateTimeToStr(Value)]); +end; + +procedure SendInteger(const Identifier: string; const Value: Integer; HexNotation: Boolean = False); +const + Msgs : Array[Boolean] of string = ('%s = %d','%s = %x'); +begin + SendDebugFmt(Msgs[HexNotation],[Identifier,Value]); +end; + +procedure SendPoint(const Identifier: string; const Value: TPoint; const ADbgLevel: TDebugLevel); +begin + SendDebugFmtEx('%s = %s',[Identifier, PointToStr(Value)], ADbgLevel); +end; + +procedure SendPointer(const Identifier: string; const Value: Pointer); +begin + SendDebugFmt('%s = %p',[Identifier,Value]); +end; + +procedure SendRect(const Identifier: string; const Value: TRect; const ADbgLevel: TDebugLevel); +begin + SendDebugFmtEx('%s',[RectToStr(Value)], ADbgLevel, Identifier); +end; + +procedure SendRect(const Identifier: string; const Value: TfpgRect; const ADbgLevel: TDebugLevel); +begin + SendDebugFmtEx('%s',[fpgRectToStr(Value)], ADbgLevel, Identifier); +end; + +procedure SendDebugEx(const Msg: string; MType: TDebugLevel); +var + Mesg : TDebugMessage; +begin + Mesg.MsgTimeStamp:=Now; + Mesg.MsgType:=Ord(MTYpe); + Mesg.Msg:=Msg; + SendDebugMessage(Mesg); +end; + +procedure SendDebug(const Msg: string); +var + Mesg : TDebugMessage; +begin + Mesg.MsgTimeStamp:=Now; + Mesg.MsgType:=Ord(dlInformation); + Mesg.Msg:=Msg; + SendDebugMessage(Mesg); +end; + +procedure SendMethodEnter(const MethodName: string); +begin + SendDebug(SEntering+MethodName); + inc(Indent,IndentChars); +end; + +procedure SendMethodExit(const MethodName: string); +begin + Dec(Indent,IndentChars); + If (Indent<0) then + Indent:=0; + SendDebug(SExiting+MethodName); +end; + +procedure SendSeparator; +begin + SendDebug(SSeparator); +end; + +procedure SendDebugFmt(const Msg: string; const Args: array of const); +var + Mesg : TDebugMessage; +begin + Mesg.MsgTimeStamp:=Now; + Mesg.MsgType:= Ord(dlInformation); + Mesg.Msg:=Format(Msg,Args); + SendDebugMessage(Mesg); +end; + +procedure SendDebugFmtEx(const Msg: string; const Args: array of const; MType: TDebugLevel; const ATitle: string); +var + Mesg: TDebugMessage; +begin + Mesg.MsgTimeStamp := Now; + Mesg.MsgType := Ord(mType); + if MType = dlLive then + Mesg.MsgTitle := ATitle + else + Mesg.MsgTitle := ' '; + Mesg.Msg := Format(Msg,Args); + SendDebugMessage(Mesg); +end; + +procedure SetDebuggingEnabled(const AValue: boolean); +begin + DebugDisabled := not AValue; +end; + +function GetDebuggingEnabled: Boolean; +begin + Result := not DebugDisabled; +end; + +function StartDebugServer : Integer; +begin + With TProcess.Create(Nil) do + begin + Try + CommandLine:='dbugsrv'; + Execute; + Result:=ProcessID; + Except On E: Exception do + begin + SendError := Format(SServerStartFailed,[E.Message]); + Result := 0; + end; + end; + Free; + end; +end; + +procedure FreeDebugClient; +var + msg : TDebugMessage; +begin + try + If (DebugClient<>Nil) and + (DebugClient.ServerRunning) then + begin + Msg.MsgType := Ord(dlStop); + Msg.MsgTimeStamp := Now; + Msg.Msg := Format(SProcessID,[ApplicationName]); + WriteMessage(Msg); + end; + if assigned(MsgBuffer) then + FreeAndNil(MsgBuffer); + if assigned(DebugClient) then + FreeAndNil(DebugClient); + except + end; +end; + +function InitDebugClient : Boolean; +var + msg : TDebugMessage; + I : Integer; +begin + Result := False; + DebugClient:=TSimpleIPCClient.Create(Nil); + DebugClient.ServerID:=DebugServerID; + If not DebugClient.ServerRunning then + begin + ServerID:=StartDebugServer; + if ServerID = 0 then + begin + DebugDisabled := True; + FreeAndNil(DebugClient); + Exit; + end + else + DebugDisabled := False; + I:=0; + While (I<10) and not DebugClient.ServerRunning do + begin + Inc(I); + Sleep(100); + end; + end; + try + DebugClient.Connect; + except + FreeAndNil(DebugClient); + DebugDisabled:=True; + Raise; + end; + MsgBuffer := TMemoryStream.Create; + Msg.MsgType := Ord(dlIdentify); + Msg.MsgTimeStamp := Now; + Msg.Msg := Format(SProcessID,[ApplicationName]); + WriteMessage(Msg); + Result := True; +end; + +Function DebugMessageName(msgType : TDebugLevel) : String; +begin + Case MsgType of + dlStop : Result := 'Stop'; + dlInformation : Result := 'Information'; + dlWarning : Result := 'Warning'; + dlError : Result := 'Error'; + dlIdentify : Result := 'Identify'; + dlLive : Result := 'LiveView'; + else + Result := 'Unknown'; + end; +end; + + +finalization + FreeDebugClient; + +end. diff --git a/src/corelib/fpg_dbugmsg.pas b/src/corelib/fpg_dbugmsg.pas new file mode 100644 index 00000000..502b697e --- /dev/null +++ b/src/corelib/fpg_dbugmsg.pas @@ -0,0 +1,95 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2005 by Michael Van Canneyt, member of + the Free Pascal development team + Copyright (C) 2013 by Graeme Geldenhuys + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + Originally from the Free Pascal FCL. Since then the code has + diverged and was customised for fpGUI usage. +} +unit fpg_dbugmsg; + +{$mode objfpc}{$h+} + +interface + +uses Classes; + +Const + DebugServerID : String = 'fpgDebugServer'; + +Type + TDebugMessage = record + MsgType : Integer; + MsgTimeStamp : TDateTime; + MsgTitle : string; + Msg : string; + end; + +Procedure ReadDebugMessageFromStream(AStream : TStream; Var Msg : TDebugMessage); +Procedure WriteDebugMessageToStream(AStream : TStream; Const Msg : TDebugMessage); + + +implementation + + +procedure ReadDebugMessageFromStream(AStream : TStream; Var Msg : TDebugMessage); +var + MsgSize: Integer; +begin + MsgSize := 0; + with AStream do + begin + ReadBuffer(Msg.MsgType, SizeOf(Integer)); + ReadBuffer(Msg.MsgTimeStamp, SizeOf(TDateTime)); + + ReadBuffer(MsgSize, SizeOf(Integer)); + SetLength(Msg.MsgTitle, MsgSize); + if (MsgSize<>0) then + ReadBuffer(Msg.MsgTitle[1], MsgSize); + + ReadBuffer(MsgSize, SizeOf(Integer)); + SetLength(Msg.Msg, MsgSize); + if (MsgSize<>0) then + ReadBuffer(Msg.Msg[1], MsgSize); + end; +end; + +procedure WriteDebugMessageToStream(AStream : TStream; Const Msg : TDebugMessage); +var + MsgSize : Integer; + lTitle: string; +begin + with AStream do + begin + WriteBuffer(Msg.MsgType, SizeOf(Integer)); + WriteBuffer(Msg.MsgTimeStamp, SizeOf(TDateTime)); + + MsgSize := Length(Msg.MsgTitle); + if MsgSize = 0 then // fake a title + begin + MsgSize := 1; + lTitle := ' '; + end + else + lTitle := Msg.MsgTitle; + WriteBuffer(MsgSize, SizeOf(Integer)); + WriteBuffer(lTitle[1], MsgSize); + + MsgSize := Length(Msg.Msg); + WriteBuffer(MsgSize, SizeOf(Integer)); + WriteBuffer(Msg.Msg[1], MsgSize); + end; +end; + + +end. diff --git a/src/corelib/gdi/fpgui_toolkit.lpk b/src/corelib/gdi/fpgui_toolkit.lpk index bf019e5f..0434ab23 100644 --- a/src/corelib/gdi/fpgui_toolkit.lpk +++ b/src/corelib/gdi/fpgui_toolkit.lpk @@ -31,7 +31,7 @@ - + @@ -424,6 +424,14 @@ + + + + + + + + diff --git a/src/corelib/gdi/fpgui_toolkit.pas b/src/corelib/gdi/fpgui_toolkit.pas index 05501714..922109c3 100644 --- a/src/corelib/gdi/fpgui_toolkit.pas +++ b/src/corelib/gdi/fpgui_toolkit.pas @@ -21,7 +21,7 @@ uses fpg_interface, fpg_editbtn, fpg_imgfmt_jpg, fpg_imgutils, fpg_stylemanager, fpg_style_win2k, fpg_style_motif, fpg_style_clearlooks, fpg_style_bluecurve, fpg_style_bitmap, fpg_readonly, fpg_imgfmt_png, U_Command, U_Pdf, U_Report, - U_ReportImages, U_Visu, fpg_trayicon, Agg2D; + U_ReportImages, U_Visu, fpg_trayicon, Agg2D, fpg_dbugintf, fpg_dbugmsg; implementation diff --git a/src/corelib/x11/fpgui_toolkit.lpk b/src/corelib/x11/fpgui_toolkit.lpk index c769331e..4616f7c4 100644 --- a/src/corelib/x11/fpgui_toolkit.lpk +++ b/src/corelib/x11/fpgui_toolkit.lpk @@ -29,7 +29,7 @@ - + @@ -426,6 +426,14 @@ + + + + + + + + diff --git a/src/corelib/x11/fpgui_toolkit.pas b/src/corelib/x11/fpgui_toolkit.pas index 10dc7f27..65239b89 100644 --- a/src/corelib/x11/fpgui_toolkit.pas +++ b/src/corelib/x11/fpgui_toolkit.pas @@ -8,19 +8,21 @@ interface uses fpg_base, fpg_main, fpg_cmdlineparams, fpg_command_intf, fpg_constants, - fpg_extinterpolation, fpg_imagelist, fpg_imgfmt_bmp, fpg_pofiles, fpg_popupwindow, - fpg_stdimages, fpg_stringhashlist, fpg_translations, fpg_stringutils, fpg_utils, - fpg_widget, fpg_wuline, fpg_impl, fpg_x11, fpg_netlayer_x11, fpg_keyconv_x11, - fpg_xft_x11, fpg_animation, fpg_basegrid, fpg_button, fpg_checkbox, fpg_combobox, - fpg_customgrid, fpg_dialogs, fpg_editcombo, fpg_edit, fpg_form, fpg_gauge, fpg_grid, - fpg_hyperlink, fpg_iniutils, fpg_label, fpg_listbox, fpg_listview, fpg_memo, fpg_menu, + fpg_extinterpolation, fpg_imagelist, fpg_imgfmt_bmp, fpg_pofiles, + fpg_popupwindow, fpg_stdimages, fpg_stringhashlist, fpg_translations, + fpg_stringutils, fpg_utils, fpg_widget, fpg_wuline, fpg_impl, fpg_x11, + fpg_netlayer_x11, fpg_keyconv_x11, fpg_xft_x11, fpg_animation, fpg_basegrid, + fpg_button, fpg_checkbox, fpg_combobox, fpg_customgrid, fpg_dialogs, + fpg_editcombo, fpg_edit, fpg_form, fpg_gauge, fpg_grid, fpg_hyperlink, + fpg_iniutils, fpg_label, fpg_listbox, fpg_listview, fpg_memo, fpg_menu, fpg_mru, fpg_panel, fpg_popupcalendar, fpg_progressbar, fpg_radiobutton, - fpg_scrollbar, fpg_style, fpg_tab, fpg_trackbar, fpg_tree, fpgui_db, fpg_splitter, - fpg_hint, fpg_spinedit, fpg_extgraphics, fpg_ColorMapping, fpg_ColorWheel, - fpg_interface, fpg_editbtn, fpg_imgfmt_jpg, fpg_imgutils, fpg_stylemanager, - fpg_style_win2k, fpg_style_motif, fpg_style_clearlooks, fpg_style_bluecurve, - fpg_style_bitmap, fpg_readonly, fpg_imgfmt_png, U_Command, U_Pdf, U_Report, - U_ReportImages, U_Visu, fpg_trayicon, Agg2D; + fpg_scrollbar, fpg_style, fpg_tab, fpg_trackbar, fpg_tree, fpgui_db, + fpg_splitter, fpg_hint, fpg_spinedit, fpg_extgraphics, fpg_ColorMapping, + fpg_ColorWheel, fpg_interface, fpg_editbtn, fpg_imgfmt_jpg, fpg_imgutils, + fpg_stylemanager, fpg_style_win2k, fpg_style_motif, fpg_style_clearlooks, + fpg_style_bluecurve, fpg_style_bitmap, fpg_readonly, fpg_imgfmt_png, + U_Command, U_Pdf, U_Report, U_ReportImages, U_Visu, fpg_trayicon, Agg2D, + fpg_dbugintf, fpg_dbugmsg; implementation -- cgit v1.2.3-70-g09d2 From 0d4e42a4f03deb86e7718c084bc7317490b0c825 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Sat, 27 Apr 2013 18:42:48 +0100 Subject: debugserver: Now support LiveView messages. LiveView messages don't appear in the normal log message window. Instead they appear in a separate non-scrolling grid where the previous values get replaced with the new values. --- examples/apps/debugserver/fpgDebugServer.lpi | 7 +++- examples/apps/debugserver/frm_main.pas | 53 ++++++++++++++++++++++++---- 2 files changed, 52 insertions(+), 8 deletions(-) diff --git a/examples/apps/debugserver/fpgDebugServer.lpi b/examples/apps/debugserver/fpgDebugServer.lpi index f26f35ee..582e7494 100644 --- a/examples/apps/debugserver/fpgDebugServer.lpi +++ b/examples/apps/debugserver/fpgDebugServer.lpi @@ -38,7 +38,7 @@ - + @@ -49,6 +49,11 @@ + + + + + diff --git a/examples/apps/debugserver/frm_main.pas b/examples/apps/debugserver/frm_main.pas index 89543763..8ae9fe33 100644 --- a/examples/apps/debugserver/frm_main.pas +++ b/examples/apps/debugserver/frm_main.pas @@ -118,6 +118,7 @@ type procedure CheckDebugMessages; procedure ReadDebugMessage; procedure ShowDebugMessage(const AMsg: TDebugmessage); + procedure ShowLiveViewMessage(const AMsg: TDebugmessage); procedure ShowMessageWindow; procedure miPauseClicked(Sender: TObject); procedure miFileQuit(Sender: TObject); @@ -148,6 +149,7 @@ uses dateutils ,fpg_dialogs ,fpg_constants + ,fpg_dbugintf ; @@ -186,12 +188,13 @@ begin ADefaultDrawing := False; try i := StrToInt(grdMessages.Cells[ACol, ARow]); + { TODO: This needs improving. We need to somehow referce TDebugLevel instead } case i of - -1: img := fpgImages.GetImage('dbs.state.stop'); - 0: img := fpgImages.GetImage('dbs.state.info'); - 1: img := fpgImages.GetImage('dbs.state.warning'); - 2: img := fpgImages.GetImage('dbs.state.error'); - 3: img := fpgImages.GetImage('dbs.state.identify'); + 0: img := fpgImages.GetImage('dbs.state.stop'); + 1: img := fpgImages.GetImage('dbs.state.info'); + 2: img := fpgImages.GetImage('dbs.state.warning'); + 3: img := fpgImages.GetImage('dbs.state.error'); + 4: img := fpgImages.GetImage('dbs.state.identify'); end; dx := (grdMessages.ColumnWidth[ACol] - 16) div 2; grdMessages.Canvas.DrawImage(ARect.Left + dx, ARect.Top {+ y}, img); @@ -279,9 +282,14 @@ var Msg: TDebugMessage; begin FIPCSrv.MsgData.Seek(0, soFromBeginning); - ReadDebugMessageFromStream(FIPCSrv.MsgData, MSg); + ReadDebugMessageFromStream(FIPCSrv.MsgData, Msg); if not FPaused then - ShowDebugMessage(Msg) + begin + if Msg.MsgType = Ord(dlLive) then + ShowLiveViewMessage(Msg) + else + ShowDebugMessage(Msg); + end else Inc(FDiscarded); end; @@ -310,6 +318,36 @@ begin ShowMessageWindow; end; +procedure TMainForm.ShowLiveViewMessage(const AMsg: TDebugmessage); +var + r: integer; + lFound: Boolean; +begin + if not Assigned(FLiveViewFrame) then + Exit; + lFound := False; + FLiveViewFrame.Grid.BeginUpdate; + for r := 0 to FLiveViewFrame.Grid.RowCount-1 do + begin + if FLiveViewFrame.Grid.Cells[0, r] = AMsg.MsgTitle then + begin + lFound := True; + Break; + end; + end; + if lFound then + begin + FLiveViewFrame.Grid.Cells[1, r] := AMsg.Msg; + end + else + begin + FLiveViewFrame.Grid.RowCount := FLiveViewFrame.Grid.RowCount + 1; + FLiveViewFrame.Grid.Cells[0, FLiveViewFrame.Grid.RowCount-1] := AMsg.MsgTitle; + FLiveViewFrame.Grid.Cells[1, FLiveViewFrame.Grid.RowCount-1] := AMsg.Msg; + end; + FLiveViewFrame.Grid.EndUpdate; +end; + procedure TMainForm.ShowMessageWindow; begin if not Visible then @@ -404,6 +442,7 @@ begin WindowTitle := 'fpGUI''s Debug Server'; Hint := ''; ShowHint := True; + WindowPosition := wpScreenCenter; MainMenu := TfpgMenuBar.Create(self); with MainMenu do -- cgit v1.2.3-70-g09d2