summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--examples/apps/debugserver/fpgDebugServer.lpi7
-rw-r--r--examples/apps/debugserver/fra_liveview.pas66
-rw-r--r--examples/apps/debugserver/frm_main.pas103
-rw-r--r--src/corelib/fpg_dbugintf.pas337
-rw-r--r--src/corelib/fpg_dbugmsg.pas95
-rw-r--r--src/corelib/gdi/fpgui_toolkit.lpk10
-rw-r--r--src/corelib/gdi/fpgui_toolkit.pas2
-rw-r--r--src/corelib/x11/fpgui_toolkit.lpk10
-rw-r--r--src/corelib/x11/fpgui_toolkit.pas26
9 files changed, 632 insertions, 24 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 @@
<PackageName Value="fpgui_toolkit"/>
</Item1>
</RequiredPackages>
- <Units Count="2">
+ <Units Count="3">
<Unit0>
<Filename Value="fpgDebugServer.lpr"/>
<IsPartOfProject Value="True"/>
@@ -49,6 +49,11 @@
<IsPartOfProject Value="True"/>
<UnitName Value="frm_main"/>
</Unit1>
+ <Unit2>
+ <Filename Value="fra_liveview.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="fra_liveview"/>
+ </Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>
diff --git a/examples/apps/debugserver/fra_liveview.pas b/examples/apps/debugserver/fra_liveview.pas
new file mode 100644
index 00000000..dd04e625
--- /dev/null
+++ b/examples/apps/debugserver/fra_liveview.pas
@@ -0,0 +1,66 @@
+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;
+ property Grid: TfpgStringGrid read Grid1;
+ 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 := 0;
+ 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..8ae9fe33 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,12 +111,14 @@ type
FDiscarded: Integer;
FShowOnMessage: Boolean;
FMemo: TfpgMemo;
+ FLiveViewFrame: TLiveViewFrame;
procedure StartServer;
procedure StopServer;
procedure CheckMessages(Sender: TObject);
procedure CheckDebugMessages;
procedure ReadDebugMessage;
procedure ShowDebugMessage(const AMsg: TDebugmessage);
+ procedure ShowLiveViewMessage(const AMsg: TDebugmessage);
procedure ShowMessageWindow;
procedure miPauseClicked(Sender: TObject);
procedure miFileQuit(Sender: TObject);
@@ -125,9 +129,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;
@@ -142,6 +149,7 @@ uses
dateutils
,fpg_dialogs
,fpg_constants
+ ,fpg_dbugintf
;
@@ -180,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);
@@ -214,6 +223,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);
@@ -248,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;
@@ -279,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
@@ -308,7 +377,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);
@@ -373,6 +442,7 @@ begin
WindowTitle := 'fpGUI''s Debug Server';
Hint := '';
ShowHint := True;
+ WindowPosition := wpScreenCenter;
MainMenu := TfpgMenuBar.Create(self);
with MainMenu do
@@ -557,6 +627,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}
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 @@
<Description Value="fpGUI Toolkit"/>
<License Value="LGPL 2 with static linking exception."/>
<Version Major="1"/>
- <Files Count="98">
+ <Files Count="100">
<Item1>
<Filename Value="..\stdimages.inc"/>
<Type Value="Include"/>
@@ -424,6 +424,14 @@
<Filename Value="..\render\software\Agg2D.pas"/>
<UnitName Value="Agg2D"/>
</Item98>
+ <Item99>
+ <Filename Value="..\fpg_dbugintf.pas"/>
+ <UnitName Value="fpg_dbugintf"/>
+ </Item99>
+ <Item100>
+ <Filename Value="..\fpg_dbugmsg.pas"/>
+ <UnitName Value="fpg_dbugmsg"/>
+ </Item100>
</Files>
<LazDoc Paths="../../../docs/xml/corelib;../../../docs/xml/corelib/x11;../../../docs/xml/corelib/gdi;../../../docs/xml/gui"/>
<RequiredPkgs Count="1">
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 @@
<Description Value="fpGUI Toolkit"/>
<License Value="LGPL 2 with static linking exception."/>
<Version Major="1"/>
- <Files Count="99">
+ <Files Count="101">
<Item1>
<Filename Value="../stdimages.inc"/>
<Type Value="Include"/>
@@ -426,6 +426,14 @@
<Filename Value="../render/software/Agg2D.pas"/>
<UnitName Value="Agg2D"/>
</Item99>
+ <Item100>
+ <Filename Value="../fpg_dbugintf.pas"/>
+ <UnitName Value="fpg_dbugintf"/>
+ </Item100>
+ <Item101>
+ <Filename Value="../fpg_dbugmsg.pas"/>
+ <UnitName Value="fpg_dbugmsg"/>
+ </Item101>
</Files>
<LazDoc Paths="../../../docs/xml/corelib;../../../docs/xml/corelib/x11;../../../docs/xml/corelib/gdi;../../../docs/xml/gui"/>
<RequiredPkgs Count="1">
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
generated by cgit v1.2.3-70-g09d2 (git 2.48.0) at 2025-01-13 22:30:34 +0000