diff options
author | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2007-07-23 09:40:43 +0000 |
---|---|---|
committer | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2007-07-23 09:40:43 +0000 |
commit | 652ba160012b1eda3a1f6dafb9311b0dcade476c (patch) | |
tree | 8abf8d7cc6246484c646b8160b8ab0179ac5b069 /examples/gui | |
parent | 6bda2054c8dda9b98f9958c54fce9f27927642c5 (diff) | |
download | fpGUI-652ba160012b1eda3a1f6dafb9311b0dcade476c.tar.xz |
Restructure Part 3.
* Moved all the examples over from the prototype directory.
* Removed obsolete GFX examples.
Diffstat (limited to 'examples/gui')
-rw-r--r-- | examples/gui/alignment/aligntest.dpr | 107 | ||||
-rw-r--r-- | examples/gui/alignment/aligntest.lpi | 52 | ||||
-rw-r--r-- | examples/gui/imgtest/bitmaptest.dpr | 86 | ||||
-rw-r--r-- | examples/gui/imgtest/bitmaptest.lpi | 60 | ||||
-rw-r--r-- | examples/gui/modalforms/modalforms.lpi | 52 | ||||
-rw-r--r-- | examples/gui/modalforms/modalforms.lpr | 165 | ||||
-rw-r--r-- | examples/gui/stdimages/stdimglist.lpi | 51 | ||||
-rw-r--r-- | examples/gui/stdimages/stdimglist.lpr | 93 | ||||
-rw-r--r-- | examples/gui/timertest/timertest.lpi | 53 | ||||
-rw-r--r-- | examples/gui/timertest/timertest.lpr | 125 |
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. + |