summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--examples/gui/command_interface/commands.pas90
-rw-r--r--examples/gui/command_interface/extrafpc.cfg5
-rw-r--r--examples/gui/command_interface/frm_main.pas124
-rw-r--r--examples/gui/command_interface/test.lpi61
-rw-r--r--examples/gui/command_interface/test.lpr32
-rw-r--r--extras/tiopf/tiOPFfpGUI.lpk12
-rw-r--r--src/corelib/fpgfx.pas26
-rw-r--r--src/gui/gui_dialogs.pas2
-rw-r--r--src/gui/gui_menu.pas45
9 files changed, 372 insertions, 25 deletions
diff --git a/examples/gui/command_interface/commands.pas b/examples/gui/command_interface/commands.pas
new file mode 100644
index 00000000..2824a04d
--- /dev/null
+++ b/examples/gui/command_interface/commands.pas
@@ -0,0 +1,90 @@
+{
+ Here we define some commands that can be reused throughout a application.
+ Command actions are kept separate from the UI code (Forms).
+}
+unit commands;
+
+{$mode objfpc}{$H+}
+{$INTERFACES CORBA}
+
+interface
+
+uses
+ gfx_command_intf,
+ gui_memo;
+
+type
+ // non reference counted interface
+ TNullInterfacedObject = class(TObject)
+ protected
+ function QueryInterface(const IID: TGUID; out Obj): longint; stdcall;
+ function _AddRef: longint; stdcall;
+ function _Release: longint; stdcall;
+ end;
+
+
+ TAddCommand = class(TInterfacedObject, ICommand)
+ private
+ FMemo: TfpgMemo;
+ public
+ constructor Create(AMemo: TfpgMemo); reintroduce;
+ procedure Execute;
+ end;
+
+
+ TExitCommand = class(TInterfacedObject, ICommand)
+ public
+ procedure Execute;
+ end;
+
+
+implementation
+
+uses
+ fpgfx, SysUtils;
+
+{ TNullInterfacedObject }
+
+function TNullInterfacedObject.QueryInterface(const IID: TGUID; out Obj): longint; stdcall;
+begin
+ if GetInterface(IID, Obj) then
+ Result := 0
+ else
+ result := integer(e_nointerface);
+end;
+
+function TNullInterfacedObject._AddRef: longint; stdcall;
+begin
+ Result := -1;
+end;
+
+function TNullInterfacedObject._Release: longint; stdcall;
+begin
+ Result := -1;
+end;
+
+{ TAddCommand }
+
+constructor TAddCommand.Create(AMemo: TfpgMemo);
+begin
+ inherited Create;
+ FMemo := AMemo;
+end;
+
+procedure TAddCommand.Execute;
+begin
+ Writeln('>> TAddComand.Execute');
+ FMemo.Lines.Add('Hello ' + IntToStr(Random(500)));
+ FMemo.Invalidate;
+end;
+
+{ TExitCommand }
+
+procedure TExitCommand.Execute;
+begin
+ Writeln('>> TExitComand.Execute');
+ fpgApplication.Terminated := True;
+end;
+
+end.
+
diff --git a/examples/gui/command_interface/extrafpc.cfg b/examples/gui/command_interface/extrafpc.cfg
new file mode 100644
index 00000000..073dc4b6
--- /dev/null
+++ b/examples/gui/command_interface/extrafpc.cfg
@@ -0,0 +1,5 @@
+-FUunits
+-Fu../../../lib
+-Xs
+-XX
+-CX
diff --git a/examples/gui/command_interface/frm_main.pas b/examples/gui/command_interface/frm_main.pas
new file mode 100644
index 00000000..28bb18cf
--- /dev/null
+++ b/examples/gui/command_interface/frm_main.pas
@@ -0,0 +1,124 @@
+{
+ This demonstrates the usage of ICommand and ICommandHolder. They work
+ similar to Delphi's TAction classes
+}
+unit frm_main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ SysUtils, Classes, gfxbase, fpgfx, gui_edit,
+ gfx_widget, gui_form, gui_label, gui_button,
+ gui_listbox, gui_memo, gui_combobox, gui_grid,
+ gui_dialogs, gui_checkbox, gui_tree, gui_trackbar,
+ gui_progressbar, gui_radiobutton, gui_tab, gui_menu,
+ gui_bevel;
+
+type
+
+ TMainForm = class(TfpgForm)
+ private
+ procedure CommandHandler(Sender: TObject);
+ public
+ {@VFD_HEAD_BEGIN: MainForm}
+ btnAdd: TfpgButton;
+ memName1: TfpgMemo;
+ btnQuit: TfpgButton;
+ MainMenu: TfpgMenuBar;
+ mnuFile: TfpgPopupMenu;
+ {@VFD_HEAD_END: MainForm}
+ procedure AfterCreate; override;
+ end;
+
+{@VFD_NEWFORM_DECL}
+
+implementation
+
+uses
+ gfx_command_intf,
+ commands;
+
+{@VFD_NEWFORM_IMPL}
+
+{ A single event handler that handles all Command based events. }
+procedure TMainForm.CommandHandler(Sender: TObject);
+var
+ cmd: ICommand;
+ holder: ICommandHolder;
+begin
+ if Supports(Sender, ICommandHolder, holder) then
+ begin
+ cmd := holder.GetCommand;
+ cmd.Execute;
+ end;
+end;
+
+procedure TMainForm.AfterCreate;
+begin
+ {@VFD_BODY_BEGIN: MainForm}
+ Name := 'MainForm';
+ SetPosition(293, 236, 284, 254);
+ WindowTitle := 'Command Interface Test';
+ WindowPosition := wpScreenCenter;
+
+ btnAdd := TfpgButton.Create(self);
+ with btnAdd do
+ begin
+ Name := 'btnAdd';
+ SetPosition(204, 36, 75, 24);
+ Text := 'Add';
+ FontDesc := '#Label1';
+ ImageName := '';
+ OnClick := @CommandHandler;
+ end;
+
+ memName1 := TfpgMemo.Create(self);
+ with memName1 do
+ begin
+ Name := 'memName1';
+ SetPosition(8, 36, 188, 208);
+ FontDesc := '#Edit1';
+ end;
+
+ btnQuit := TfpgButton.Create(self);
+ with btnQuit do
+ begin
+ Name := 'btnQuit';
+ SetPosition(204, 220, 75, 24);
+ Text := 'Quit';
+ FontDesc := '#Label1';
+ ImageName := '';
+ OnClick := @CommandHandler;
+ end;
+
+ MainMenu := TfpgMenuBar.Create(self);
+ with MainMenu do
+ begin
+ Name := 'MainMenu';
+ SetPosition(0, 0, 284, 24);
+ Anchors := [anLeft,anRight,anTop];
+ end;
+
+ mnuFile := TfpgPopupMenu.Create(self);
+ with mnuFile do
+ begin
+ Name := 'mnuFile';
+ SetPosition(44, 72, 120, 20);
+ AddMenuItem('Quit', '', @CommandHandler);
+ end;
+
+ {@VFD_BODY_END: MainForm}
+
+ MainMenu.AddMenuItem('File', nil).SubMenu := mnuFile;
+
+ // instantiate the Command classes
+ btnAdd.SetCommand(TAddCommand.Create(memName1));
+ btnQuit.SetCommand(TExitCommand.Create);
+ // The menu item File|Quit shares the command of btnQuit
+ mnuFile.MenuItemByName('Quit').SetCommand(btnQuit.GetCommand);
+end;
+
+
+end.
diff --git a/examples/gui/command_interface/test.lpi b/examples/gui/command_interface/test.lpi
new file mode 100644
index 00000000..64acd093
--- /dev/null
+++ b/examples/gui/command_interface/test.lpi
@@ -0,0 +1,61 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <PathDelim Value="/"/>
+ <Version Value="6"/>
+ <General>
+ <Flags>
+ <SaveOnlyProjectUnits Value="True"/>
+ </Flags>
+ <SessionStorage Value="InProjectDir"/>
+ <MainUnit Value="0"/>
+ <IconPath Value="./"/>
+ <TargetFileExt Value=""/>
+ </General>
+ <VersionInfo>
+ <ProjectVersion Value=""/>
+ </VersionInfo>
+ <PublishOptions>
+ <Version Value="2"/>
+ <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+ <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+ </PublishOptions>
+ <RunParams>
+ <local>
+ <FormatVersion Value="1"/>
+ <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+ </local>
+ </RunParams>
+ <RequiredPackages Count="1">
+ <Item1>
+ <PackageName Value="fpgui_package"/>
+ </Item1>
+ </RequiredPackages>
+ <Units Count="3">
+ <Unit0>
+ <Filename Value="test.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="test"/>
+ </Unit0>
+ <Unit1>
+ <Filename Value="frm_main.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="frm_main"/>
+ </Unit1>
+ <Unit2>
+ <Filename Value="commands.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="commands"/>
+ </Unit2>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="5"/>
+ <CodeGeneration>
+ <Generate Value="Faster"/>
+ </CodeGeneration>
+ <Other>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
diff --git a/examples/gui/command_interface/test.lpr b/examples/gui/command_interface/test.lpr
new file mode 100644
index 00000000..663e2e2f
--- /dev/null
+++ b/examples/gui/command_interface/test.lpr
@@ -0,0 +1,32 @@
+program test;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Classes, fpgfx, gui_form, frm_main, commands, fpgui_package;
+
+
+procedure MainProc;
+var
+ frm: TMainForm;
+begin
+ fpgApplication.Initialize;
+ Randomize;
+ frm := TMainForm.Create(nil);
+ try
+ frm.Show;
+ fpgApplication.Run;
+ finally
+ frm.Free;
+ end;
+end;
+
+begin
+ MainProc;
+end.
+
+
+
diff --git a/extras/tiopf/tiOPFfpGUI.lpk b/extras/tiopf/tiOPFfpGUI.lpk
index 3b116810..860ec462 100644
--- a/extras/tiopf/tiOPFfpGUI.lpk
+++ b/extras/tiopf/tiOPFfpGUI.lpk
@@ -1,6 +1,6 @@
<?xml version="1.0"?>
<CONFIG>
- <Package Version="2">
+ <Package Version="3">
<Name Value="tiOPFfpGUI"/>
<Author Value="Graeme Geldenhuys"/>
<CompilerOptions>
@@ -20,7 +20,7 @@
"/>
<License Value="Mozilla Public License v1.1
"/>
- <Version Major="2" Release="3"/>
+ <Version Major="2" Release="4"/>
<Files Count="7">
<Item1>
<Filename Value="gui/tiGUIUtils.pas"/>
@@ -53,16 +53,16 @@
</Files>
<RequiredPkgs Count="3">
<Item1>
- <PackageName Value="FCL"/>
- <MinVersion Major="1" Valid="True"/>
+ <PackageName Value="fpgui_package"/>
+ <MinVersion Minor="5" Valid="True"/>
</Item1>
<Item2>
<PackageName Value="tiOPF"/>
<MinVersion Major="2" Release="3" Valid="True"/>
</Item2>
<Item3>
- <PackageName Value="fpgui_package"/>
- <MinVersion Minor="5" Valid="True"/>
+ <PackageName Value="FCL"/>
+ <MinVersion Major="1" Valid="True"/>
</Item3>
</RequiredPkgs>
<UsageOptions>
diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas
index a10685f6..bd6d15d5 100644
--- a/src/corelib/fpgfx.pas
+++ b/src/corelib/fpgfx.pas
@@ -278,12 +278,13 @@ function fpgGetTickCount: DWord;
// Rectangle routines
-function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
-function InflateRect(var Rect: TfpgRect; dx: Integer; dy: Integer): Boolean;
-function OffsetRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
-function OffsetRect(var Rect: TfpgRect; dx: Integer; dy: Integer): Boolean;
-function CenterPoint(const Rect: TRect): TPoint;
-function fpgRect(ALeft, ATop, AWidth, AHeight: integer): TfpgRect;
+function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
+function InflateRect(var Rect: TfpgRect; dx: Integer; dy: Integer): Boolean;
+function OffsetRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
+function OffsetRect(var Rect: TfpgRect; dx: Integer; dy: Integer): Boolean;
+function CenterPoint(const Rect: TRect): TPoint;
+function CenterPoint(const Rect: TfpgRect): TPoint;
+function fpgRect(ALeft, ATop, AWidth, AHeight: integer): TfpgRect;
// Debug rountines
procedure PrintRect(var Rect: TRect);
@@ -441,11 +442,14 @@ end;
function CenterPoint(const Rect: TRect): TPoint;
begin
- with Rect do
- begin
- Result.X := (Left+Right) div 2;
- Result.Y := (Top+Bottom) div 2;
- end;
+ Result.X := (Rect.Left + Rect.Right) div 2;
+ Result.Y := (Rect.Top + Rect.Bottom) div 2;
+end;
+
+function CenterPoint(const Rect: TfpgRect): TPoint;
+begin
+ Result.X := (Rect.Left + Rect.Right) div 2;
+ Result.Y := (Rect.Top + Rect.Bottom) div 2;
end;
function fpgRect(ALeft, ATop, AWidth, AHeight: integer): TfpgRect;
diff --git a/src/gui/gui_dialogs.pas b/src/gui/gui_dialogs.pas
index 94a388af..e3537243 100644
--- a/src/gui/gui_dialogs.pas
+++ b/src/gui/gui_dialogs.pas
@@ -190,7 +190,7 @@ uses
gfx_widget,
gfx_utf8utils
{$IFDEF MSWINDOWS}
- ,Windows
+ ,Windows // used by File Dialog
{$ENDIF}
;
diff --git a/src/gui/gui_menu.pas b/src/gui/gui_menu.pas
index eab5e6d6..ac49070e 100644
--- a/src/gui/gui_menu.pas
+++ b/src/gui/gui_menu.pas
@@ -35,7 +35,8 @@ uses
fpgfx,
gfx_widget,
gfx_popupwindow,
- gfx_UTF8utils;
+ gfx_UTF8utils,
+ gfx_command_intf;
type
TfpgHotKeyDef = string;
@@ -45,8 +46,9 @@ type
TfpgMenuBar = class;
- TfpgMenuItem = class(TComponent)
+ TfpgMenuItem = class(TComponent, ICommandHolder)
private
+ FCommand: ICommand;
FEnabled: boolean;
FHotKeyDef: TfpgHotKeyDef;
FOnClick: TNotifyEvent;
@@ -65,6 +67,8 @@ type
function Selectable: boolean;
function GetAccelChar: string;
procedure DrawText(ACanvas: TfpgCanvas; x, y: TfpgCoord);
+ function GetCommand: ICommand;
+ procedure SetCommand(ACommand: ICommand);
property Text: string read FText write SetText;
property HotKeyDef: TfpgHotKeyDef read FHotKeyDef write SetHotKeyDef;
property Separator: boolean read FSeparator write SetSeparator;
@@ -114,7 +118,8 @@ type
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Close; override;
- function AddMenuItem(const menuname: string; const hotkeydef: string; HandlerProc: TNotifyEvent): TfpgMenuItem;
+ function AddMenuItem(const AMenuName: string; const hotkeydef: string; HandlerProc: TNotifyEvent): TfpgMenuItem;
+ function MenuItemByName(const AMenuName: string): TfpgMenuItem;
property BackgroundColor: TfpgColor read FBackgroundColor write SetBackgroundColor;
property BeforeShow: TNotifyEvent read FBeforeShow write FBeforeShow;
end;
@@ -280,6 +285,16 @@ begin
ACanvas.DrawString(x, y, s);
end;
+function TfpgMenuItem.GetCommand: ICommand;
+begin
+ Result := FCommand;
+end;
+
+procedure TfpgMenuItem.SetCommand(ACommand: ICommand);
+begin
+ FCommand := ACommand;
+end;
+
{ TfpgMenuBar }
procedure TfpgMenuBar.SetBackgroundColor(const AValue: TfpgColor);
@@ -1144,13 +1159,13 @@ begin
end;
end;
-function TfpgPopupMenu.AddMenuItem(const menuname: string;
- const hotkeydef: string; HandlerProc: TNotifyEvent): TfpgMenuItem;
+function TfpgPopupMenu.AddMenuItem(const AMenuName: string;
+ const hotkeydef: string; HandlerProc: TNotifyEvent): TfpgMenuItem;
begin
result := TfpgMenuItem.Create(self);
- if menuname <> '-' then
+ if AMenuName <> '-' then
begin
- result.Text := menuname;
+ result.Text := AMenuName;
result.hotkeydef := hotkeydef;
result.OnClick := HandlerProc;
end
@@ -1160,6 +1175,22 @@ begin
end;
end;
+function TfpgPopupMenu.MenuItemByName(const AMenuName: string): TfpgMenuItem;
+var
+ i: integer;
+begin
+ Result := nil;
+ for i := 0 to ComponentCount-1 do
+ begin
+ if Components[i] is TfpgMenuItem then
+ if SameText(TfpgMenuItem(Components[i]).Text, AMenuName) then
+ begin
+ Result := TfpgMenuItem(Components[i]);
+ Exit; //==>
+ end;
+ end;
+end;
+
initialization
uFocusedPopupMenu := nil;
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-10-16 15:26:02 +0000