summaryrefslogtreecommitdiff
path: root/examples/gui
diff options
context:
space:
mode:
Diffstat (limited to 'examples/gui')
-rw-r--r--examples/gui/alignment/aligntest.dpr107
-rw-r--r--examples/gui/alignment/aligntest.lpi52
-rw-r--r--examples/gui/imgtest/bitmaptest.dpr86
-rw-r--r--examples/gui/imgtest/bitmaptest.lpi60
-rw-r--r--examples/gui/modalforms/modalforms.lpi52
-rw-r--r--examples/gui/modalforms/modalforms.lpr165
-rw-r--r--examples/gui/stdimages/stdimglist.lpi51
-rw-r--r--examples/gui/stdimages/stdimglist.lpr93
-rw-r--r--examples/gui/timertest/timertest.lpi53
-rw-r--r--examples/gui/timertest/timertest.lpr125
10 files changed, 844 insertions, 0 deletions
diff --git a/examples/gui/alignment/aligntest.dpr b/examples/gui/alignment/aligntest.dpr
new file mode 100644
index 00000000..7099b761
--- /dev/null
+++ b/examples/gui/alignment/aligntest.dpr
@@ -0,0 +1,107 @@
+program aligntest;
+
+{$mode objfpc}{$H+}
+
+uses
+ Classes, SysUtils,
+ fpgfx, gfxbase, gfx_widget, gui_form, gui_label;
+
+type
+ TMainForm = class(TfpgForm)
+ private
+ lblTop: array[1..3] of TfpgLabel;
+ lblBottom: array[1..3] of TfpgLabel;
+ lblLeft: array[1..3] of TfpgLabel;
+ lblRight: array[1..3] of TfpgLabel;
+ lblClient: TfpgLabel;
+ lblNone: TfpgLabel;
+ AlignRect: TfpgRect;
+ public
+ procedure AfterCreate; override;
+ end;
+
+
+{ TMainForm }
+
+procedure TMainForm.AfterCreate;
+var
+ x: integer;
+ y: integer;
+ n: integer;
+ ColorArray: array[1..3] of TfpgColor;
+begin
+ x := 10;
+ y := 10;
+ ColorArray[1] := clDodgerBlue;
+ ColorArray[2] := clDeepSkyBlue;
+ ColorArray[3] := clSkyBlue;
+
+ for n := low(lblTop) to high(lblTop) do
+ begin
+ lblTop[n] := CreateLabel(self, x, y, 'alTop '+IntToStr(n));
+ lblTop[n].BackgroundColor := ColorArray[n];
+ lblTop[n].Align := alTop;
+ lblTop[n].Width := 100;
+ inc(y,20);
+ end;
+
+ y := 280;
+ for n:=low(lblBottom) to high(lblBottom) do
+ begin
+ lblBottom[n] := CreateLabel(self, x, y, 'alBottom '+IntToStr(n));
+ lblBottom[n].BackgroundColor := ColorArray[n];
+ lblBottom[n].Align := alBottom;
+ dec(y,20);
+ end;
+
+ y := 100;
+ x := 10;
+ for n:=low(lblLeft) to high(lblLeft) do
+ begin
+ lblLeft[n] := CreateLabel(self, x, y, 'L'+IntToStr(n));
+ lblLeft[n].BackgroundColor := ColorArray[n];
+ lblLeft[n].Align := alLeft;
+ inc(x,30);
+ end;
+
+ x := 200;
+ for n:=low(lblRight) to high(lblRight) do
+ begin
+ lblRight[n] := CreateLabel(self, x, y, 'R'+IntToStr(n));
+ lblRight[n].BackgroundColor := ColorArray[n];
+ lblRight[n].Align := alRight;
+ dec(x,30);
+ end;
+
+ lblClient := CreateLabel(self, 150, 150, 'alClient');
+ lblClient.BackgroundColor := clWhite;
+ lblClient.Align := alClient;
+
+ lblNone := CreateLabel(self, 15, 120, 'Resize the form to see Align in action');
+ lblNone.Color := clWhite;
+ lblNone.BackgroundColor := clBlack;
+end;
+
+
+procedure MainProc;
+var
+ frm : TMainForm;
+begin
+ fpgApplication.Initialize;
+
+ frm := TMainForm.Create(nil);
+ frm.WindowPosition := wpScreenCenter;
+ frm.Width := 300;
+ frm.Height := 300;
+ frm.MinWidth := 250;
+ frm.MinHeight := 150;
+ frm.WindowTitle := 'fpGUI Align Example';
+ frm.Show;
+
+ fpgApplication.Run;
+end;
+
+begin
+ MainProc;
+end.
+
diff --git a/examples/gui/alignment/aligntest.lpi b/examples/gui/alignment/aligntest.lpi
new file mode 100644
index 00000000..5d943df0
--- /dev/null
+++ b/examples/gui/alignment/aligntest.lpi
@@ -0,0 +1,52 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <PathDelim Value="/"/>
+ <Version Value="5"/>
+ <General>
+ <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="fpGFX2"/>
+ </Item1>
+ </RequiredPackages>
+ <Units Count="1">
+ <Unit0>
+ <Filename Value="aligntest.dpr"/>
+ <IsPartOfProject Value="True"/>
+ </Unit0>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="5"/>
+ <SearchPaths>
+ <IncludeFiles Value="../src/"/>
+ <OtherUnitFiles Value="../src/"/>
+ </SearchPaths>
+ <CodeGeneration>
+ <Generate Value="Faster"/>
+ </CodeGeneration>
+ <Other>
+ <CustomOptions Value="-FUunits"/>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
diff --git a/examples/gui/imgtest/bitmaptest.dpr b/examples/gui/imgtest/bitmaptest.dpr
new file mode 100644
index 00000000..8ab86361
--- /dev/null
+++ b/examples/gui/imgtest/bitmaptest.dpr
@@ -0,0 +1,86 @@
+program bitmaptest;
+
+{$mode objfpc}{$H+}
+
+uses
+ Classes,
+ SysUtils,
+ gfxbase,
+ fpgfx,
+ gfx_imgfmt_bmp;
+
+type
+
+ TMainForm = class(TfpgWindow)
+ private
+ img: TfpgImage;
+ procedure MsgPaint(var msg: TfpgMessageRec); message FPGM_PAINT;
+ procedure MsgClose(var msg: TfpgMessageRec); message FPGM_CLOSE;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Show;
+ end;
+
+
+{ TMainForm }
+
+procedure TMainForm.MsgPaint(var msg: TfpgMessageRec);
+begin
+ Canvas.BeginDraw;
+ Canvas.DrawImage(0, 0, img);
+ Canvas.EndDraw;
+end;
+
+procedure TMainForm.MsgClose(var msg: TfpgMessageRec);
+begin
+ ReleaseWindowHandle;
+ Halt(0);
+end;
+
+constructor TMainForm.Create(AOwner: TComponent);
+var
+ i, j: integer;
+begin
+ inherited Create(AOwner);
+ FWidth := 256;
+ FHeight := 256;
+ WindowAttributes := [waScreenCenterPos];
+
+ img := TfpgImage.Create;
+ img.AllocateImage(32, 256, 256);
+ img.UpdateImage;
+ // populate the bitmap with pretty colors :-)
+ for j := 0 to 255 do
+ for i := 0 to 255 do
+ PLongWord(img.ImageData)[j * 256 + i] := (i shl 16) or (j shl 8);
+end;
+
+destructor TMainForm.Destroy;
+begin
+ img.Free;
+ inherited Destroy;
+end;
+
+procedure TMainForm.Show;
+begin
+ AllocateWindowHandle;
+ // We can only set the title once we have a window handle.
+ SetWindowTitle('fpGUI Bitmap Test');
+end;
+
+
+procedure MainProc;
+var
+ frm: TMainForm;
+begin
+ fpgApplication.Initialize;
+ frm := TMainForm.Create(nil);
+ frm.Show;
+ fpgApplication.Run;
+end;
+
+begin
+ MainProc;
+end.
+
diff --git a/examples/gui/imgtest/bitmaptest.lpi b/examples/gui/imgtest/bitmaptest.lpi
new file mode 100644
index 00000000..c8bf98e0
--- /dev/null
+++ b/examples/gui/imgtest/bitmaptest.lpi
@@ -0,0 +1,60 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <PathDelim Value="\"/>
+ <Version Value="5"/>
+ <General>
+ <Flags>
+ <SaveOnlyProjectUnits Value="True"/>
+ </Flags>
+ <SessionStorage Value="InProjectDir"/>
+ <MainUnit Value="0"/>
+ <IconPath Value=".\"/>
+ <TargetFileExt Value=""/>
+ <Title Value="bitmaptest"/>
+ </General>
+ <VersionInfo>
+ <ProjectVersion Value=""/>
+ </VersionInfo>
+ <PublishOptions>
+ <Version Value="2"/>
+ <DestinationDirectory Value="$(TestDir)\publishedproject\"/>
+ <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="fpGFX2"/>
+ </Item1>
+ </RequiredPackages>
+ <Units Count="1">
+ <Unit0>
+ <Filename Value="bitmaptest.dpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="bitmaptest"/>
+ </Unit0>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="5"/>
+ <PathDelim Value="\"/>
+ <SearchPaths>
+ <IncludeFiles Value="..\source\"/>
+ <OtherUnitFiles Value="..\source\;..\source\x11\;..\gui\"/>
+ </SearchPaths>
+ <CodeGeneration>
+ <Generate Value="Faster"/>
+ </CodeGeneration>
+ <Other>
+ <CustomOptions Value="-FUunits
+"/>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
diff --git a/examples/gui/modalforms/modalforms.lpi b/examples/gui/modalforms/modalforms.lpi
new file mode 100644
index 00000000..2d2e9d9d
--- /dev/null
+++ b/examples/gui/modalforms/modalforms.lpi
@@ -0,0 +1,52 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <PathDelim Value="/"/>
+ <Version Value="5"/>
+ <General>
+ <Flags>
+ <SaveOnlyProjectUnits Value="True"/>
+ </Flags>
+ <SessionStorage Value="InProjectDir"/>
+ <MainUnit Value="0"/>
+ <TargetFileExt Value=""/>
+ </General>
+ <VersionInfo>
+ <ProjectVersion Value=""/>
+ </VersionInfo>
+ <PublishOptions>
+ <Version Value="2"/>
+ <IgnoreBinaries Value="False"/>
+ <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="fpGFX2"/>
+ </Item1>
+ </RequiredPackages>
+ <Units Count="1">
+ <Unit0>
+ <Filename Value="modalforms.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="modalforms"/>
+ </Unit0>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="5"/>
+ <CodeGeneration>
+ <Generate Value="Faster"/>
+ </CodeGeneration>
+ <Other>
+ <CustomOptions Value="-FUunits"/>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
diff --git a/examples/gui/modalforms/modalforms.lpr b/examples/gui/modalforms/modalforms.lpr
new file mode 100644
index 00000000..c3faeaf3
--- /dev/null
+++ b/examples/gui/modalforms/modalforms.lpr
@@ -0,0 +1,165 @@
+{
+ Demo of modal forms in action.
+
+ NOTE: Model form are not 100% implemented yet!
+}
+program modalforms;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Classes,
+ fpgfx,
+ gui_form,
+ gui_dialogs,
+ gui_button,
+ gui_label;
+
+type
+ // forward declaration
+ TForm1 = class;
+ TForm2 = class;
+
+ TMainForm = class(TfpgForm)
+ private
+ btnClose: TfpgButton;
+ btnOpenForm1: TfpgButton;
+ procedure btnCloseClick(Sender: TObject);
+ procedure btnOpenForm1Click(Sender: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ end;
+
+
+ TForm1 = class(TfpgForm)
+ private
+ Label1: TfpgLabel;
+ btnClose: TfpgButton;
+ btnOpenForm2: TfpgButton;
+ procedure btnCloseClick(Sender: TObject);
+ procedure btnOpenForm2Click(Sender: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ end;
+
+
+ TForm2 = class(TfpgForm)
+ private
+ Label1: TfpgLabel;
+ btnClose: TfpgButton;
+ procedure btnCloseClick(Sender: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ end;
+
+
+{ TForm2 }
+
+procedure TForm2.btnCloseClick(Sender: TObject);
+begin
+ Close;
+end;
+
+constructor TForm2.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ WindowTitle := 'Form2';
+ Sizeable := False;
+ SetPosition(200, 200, 200, 200);
+
+ Label1 := CreateLabel(self, 10, 10, 'This is Form2');
+
+ btnClose := CreateButton(self, 110, 170, 80, 'Quit', @btnCloseClick);
+ btnClose.ImageName := 'stdimg.Quit';
+ btnClose.ShowImage := True;
+end;
+
+{ TForm1 }
+
+procedure TForm1.btnCloseClick(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TForm1.btnOpenForm2Click(Sender: TObject);
+var
+ frm: TForm2;
+begin
+ try
+ frm := TForm2.Create(nil);
+ frm.ShowModal;
+ writeln('Form2: This should only appear after the form closes.');
+ finally
+ frm.Free;
+ end;
+end;
+
+constructor TForm1.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ WindowTitle := 'Form1';
+ Sizeable := False;
+ SetPosition(150, 150, 200, 200);
+
+ Label1 := CreateLabel(self, 10, 10, 'This is Form1');
+
+ btnClose := CreateButton(self, 110, 170, 80, 'Quit', @btnCloseClick);
+ btnClose.ImageName := 'stdimg.Quit';
+ btnClose.ShowImage := True;
+
+ btnOpenForm2 := CreateButton(self, 70, 100, 80, 'Open Form2', @btnOpenForm2Click);
+end;
+
+
+{ TMainForm }
+
+procedure TMainForm.btnCloseClick(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TMainForm.btnOpenForm1Click(Sender: TObject);
+var
+ frm: TForm1;
+begin
+ try
+ frm := TForm1.Create(nil);
+ frm.ShowModal;
+ writeln('Form1: This should only appear after the form closes.');
+ finally
+ frm.Free;
+ end;
+end;
+
+constructor TMainForm.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ WindowTitle := 'Modal Form Demo';
+ Sizeable := False;
+ SetPosition(100, 100, 400, 200);
+
+ btnClose := CreateButton(self, 310, 170, 80, 'Quit', @btnCloseClick);
+ btnClose.ImageName := 'stdimg.Quit';
+ btnClose.ShowImage := True;
+
+ btnOpenForm1 := CreateButton(self, 100, 100, 80, 'Open Form1', @btnOpenForm1Click);
+end;
+
+
+procedure MainProc;
+var
+ frm: TMainForm;
+begin
+ fpgApplication.Initialize;
+ frm := TMainForm.Create(nil);
+ frm.Show;
+ fpgApplication.Run;
+end;
+
+begin
+ MainProc;
+end.
+
diff --git a/examples/gui/stdimages/stdimglist.lpi b/examples/gui/stdimages/stdimglist.lpi
new file mode 100644
index 00000000..f43952b3
--- /dev/null
+++ b/examples/gui/stdimages/stdimglist.lpi
@@ -0,0 +1,51 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <PathDelim Value="/"/>
+ <Version Value="5"/>
+ <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="fpGFX2"/>
+ </Item1>
+ </RequiredPackages>
+ <Units Count="1">
+ <Unit0>
+ <Filename Value="stdimglist.lpr"/>
+ <IsPartOfProject Value="True"/>
+ </Unit0>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="5"/>
+ <CodeGeneration>
+ <Generate Value="Faster"/>
+ </CodeGeneration>
+ <Other>
+ <CustomOptions Value="-FUunits"/>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
diff --git a/examples/gui/stdimages/stdimglist.lpr b/examples/gui/stdimages/stdimglist.lpr
new file mode 100644
index 00000000..06212cfc
--- /dev/null
+++ b/examples/gui/stdimages/stdimglist.lpr
@@ -0,0 +1,93 @@
+program stdimglist;
+
+{$mode objfpc}{$H+}
+
+uses
+ Classes, SysUtils,
+ fpgfx, gfxbase, gui_form, gfx_imgfmt_bmp, gui_button;
+
+type
+
+ TMainForm = class(TfpgForm)
+ private
+ btnClose: TfpgButton;
+ procedure btnCloseClick(Sender: TObject);
+ protected
+ procedure HandlePaint; override;
+ public
+ constructor Create(aowner: TComponent); override;
+ procedure AfterCreate; override;
+ end;
+
+{ TMainForm }
+
+procedure TMainForm.AfterCreate;
+begin
+ SetPosition(100,100,700,500);
+ WindowTitle := 'fpGUI Standard Image Listing';
+end;
+
+procedure TMainForm.btnCloseClick(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TMainForm.HandlePaint;
+var
+ n: integer;
+ x: TfpgCoord;
+ y: TfpgCoord;
+ sl: TStringList;
+ img: TfpgImage;
+begin
+ Canvas.BeginDraw; // begin double buffering
+ inherited HandlePaint;
+
+ sl := TStringList.Create;
+ x := 8;
+ y := 8;
+ fpgImages.ListImages(sl);
+
+ for n := 0 to sl.Count-1 do
+ begin
+ Canvas.DrawString(x, y, sl[n]+':');
+
+ img := TfpgImage(sl.Objects[n]);
+ if img <> nil then
+ Canvas.DrawImage(x+150, y, img);
+
+ inc(y, img.Height+8);
+ if y > Height-32 then // largest images are 32 in height
+ begin
+ inc(x, 200);
+ y := 8;
+ end;
+ end;
+
+ Canvas.EndDraw;
+ sl.Free;
+end;
+
+constructor TMainForm.Create(aowner: TComponent);
+begin
+ inherited Create(aowner);
+ // Place button in bottom right corner.
+ btnClose := CreateButton(self, Width-90, Height-35, 75, 'Quit', @btnCloseClick);
+ btnClose.ImageName := 'stdimg.quit';
+// btnClose.Focusable := False;
+ btnClose.Anchors := [anRight, anBottom];
+end;
+
+procedure MainProc;
+var
+ frm : TMainForm;
+begin
+ fpgApplication.Initialize;
+ frm := TMainForm.Create(nil);
+ frm.Show;
+ fpgApplication.Run;
+end;
+
+begin
+ MainProc;
+end.
diff --git a/examples/gui/timertest/timertest.lpi b/examples/gui/timertest/timertest.lpi
new file mode 100644
index 00000000..0dfae648
--- /dev/null
+++ b/examples/gui/timertest/timertest.lpi
@@ -0,0 +1,53 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <PathDelim Value="\"/>
+ <Version Value="5"/>
+ <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="fpGFX2"/>
+ </Item1>
+ </RequiredPackages>
+ <Units Count="1">
+ <Unit0>
+ <Filename Value="timertest.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="timertest"/>
+ </Unit0>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="5"/>
+ <PathDelim Value="\"/>
+ <CodeGeneration>
+ <Generate Value="Faster"/>
+ </CodeGeneration>
+ <Other>
+ <CustomOptions Value="-FUunits"/>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
diff --git a/examples/gui/timertest/timertest.lpr b/examples/gui/timertest/timertest.lpr
new file mode 100644
index 00000000..7c4209df
--- /dev/null
+++ b/examples/gui/timertest/timertest.lpr
@@ -0,0 +1,125 @@
+program timertest;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Classes, SysUtils, fpgfx, gfxbase, gui_form, gui_button, gui_label;
+
+type
+ TMainForm = class(TfpgForm)
+ private
+ btnClose: TfpgButton;
+ btnStopStart: TfpgButton;
+ timer1: TfpgTimer;
+ timer2: TfpgTimer;
+ timer3: TfpgTimer;
+ lblTimer1: TfpgLabel;
+ lblTimer2: TfpgLabel;
+ lblTimer3: TfpgLabel;
+ cnt1: integer;
+ cnt2: integer;
+ procedure MyTimer1(Sender: TObject);
+ procedure MyTimer2(Sender: TObject);
+ procedure MyTimer3(Sender: TObject);
+ procedure btnCloseClick(Sender: TObject);
+ procedure btnStopStartClick(Sender: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ end;
+
+
+{ TMainForm }
+
+procedure TMainForm.MyTimer1(Sender: TObject);
+begin
+ lblTimer1.Text := FormatDateTime('hh:nn:ss.zzz', now);
+end;
+
+procedure TMainForm.MyTimer2(Sender: TObject);
+begin
+ Inc(cnt1);
+ lblTimer2.Text := IntToStr(cnt1);
+end;
+
+procedure TMainForm.MyTimer3(Sender: TObject);
+begin
+ Inc(cnt2);
+ lblTimer3.Text := IntToStr(cnt2);
+end;
+
+procedure TMainForm.btnCloseClick(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TMainForm.btnStopStartClick(Sender: TObject);
+begin
+ if btnStopStart.Text = 'Stop' then
+ btnStopStart.Text := 'Start'
+ else
+ btnStopStart.Text := 'Stop';
+
+ timer1.Enabled := not timer1.Enabled;
+end;
+
+constructor TMainForm.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ WindowTitle := 'fpGUI Timer test';
+ WindowPosition := wpScreenCenter;
+ Width := 400;
+ Height := 250;
+
+ cnt1 := 0;
+ cnt2 := 0;
+
+ btnClose := CreateButton(self, 320, 220, 75, 'Close', @btnCloseClick);
+ btnStopStart := CreateButton(self, 200, 50, 75, 'Stop', @btnStopStartClick);
+
+ lblTimer1 := CreateLabel(self, 50, 50, '---');
+ lblTimer1.FontDesc := 'Arial-14:bold';
+ lblTimer1.Height := lblTimer1.Font.Height;
+ lblTimer1.Width := 150;
+
+ lblTimer2 := CreateLabel(self, 50, 80, '---');
+ lblTimer2.FontDesc := 'Arial-14:bold';
+ lblTimer2.Height := lblTimer2.Font.Height;
+ lblTimer2.Width := 150;
+
+ lblTimer3 := CreateLabel(self, 50, 110, '---');
+ lblTimer3.FontDesc := 'Arial-14:bold';
+ lblTimer3.Height := lblTimer3.Font.Height;
+ lblTimer3.Width := 150;
+
+ timer1 := TfpgTimer.Create(50);
+ timer1.OnTimer := @MyTimer1;
+ timer1.Enabled := True;
+
+ timer2 := TfpgTimer.Create(200);
+ timer2.OnTimer := @MyTimer2;
+ timer2.Enabled := True;
+
+ timer3 := TfpgTimer.Create(1000);
+ timer3.OnTimer := @MyTimer3;
+ timer3.Enabled := True;
+end;
+
+
+procedure MainProc;
+var
+ frm: TMainForm;
+begin
+ fpgApplication.Initialize;
+ frm := TMainForm.Create(nil);
+ frm.Show;
+ fpgApplication.Run;
+end;
+
+
+begin
+ MainProc;
+end.
+
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-10-16 08:56:36 +0000