diff options
author | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2007-07-24 14:23:24 +0000 |
---|---|---|
committer | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2007-07-24 14:23:24 +0000 |
commit | 7b306401872c09d5996a748ce1e4e8a90306e980 (patch) | |
tree | f2c6a225519b0e41d50b0fbcd728ecbebe4ae6df /examples/gui | |
parent | 8cede30bc7849a64720b7d34d7f3d3770489ca93 (diff) | |
download | fpGUI-7b306401872c09d5996a748ce1e4e8a90306e980.tar.xz |
* Fixed a minor repaint bug in TfpgLabel and AutoSize. If text was set
to something smaller, old text still remained on the canvas.
* Implemented a new TfpgBevel widget
* Added a example project showing the features of the TfpgBevel.
Diffstat (limited to 'examples/gui')
-rw-r--r-- | examples/gui/bevel/beveltest.lpi | 53 | ||||
-rw-r--r-- | examples/gui/bevel/beveltest.lpr | 110 |
2 files changed, 163 insertions, 0 deletions
diff --git a/examples/gui/bevel/beveltest.lpi b/examples/gui/bevel/beveltest.lpi new file mode 100644 index 00000000..a99498ff --- /dev/null +++ b/examples/gui/bevel/beveltest.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"/> + <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="fpgui_package"/> + <MinVersion Minor="5" Valid="True"/> + </Item1> + </RequiredPackages> + <Units Count="1"> + <Unit0> + <Filename Value="beveltest.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="beveltest"/> + </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/bevel/beveltest.lpr b/examples/gui/bevel/beveltest.lpr new file mode 100644 index 00000000..e339825e --- /dev/null +++ b/examples/gui/bevel/beveltest.lpr @@ -0,0 +1,110 @@ +program beveltest; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, + typinfo, + fpgfx, + gui_form, + gui_button, + gui_bevel, + gui_label; + +type + TMainForm = class(TfpgForm) + private + bevel: TfpgBevel; + btnQuit: TfpgButton; + btnStyles: TfpgButton; + btnShapes: TfpgButton; + lblTitle: TfpgLabel; + lblStyle: TfpgLabel; + lblShape: TfpgLabel; + lblNext: TfpgLabel; + procedure btnQuitClick(Sender: TObject); + procedure btnStylesClick(Sender: TObject); + procedure btnShapesClick(Sender: TObject); + public + constructor Create(AOwner: TComponent); override; + end; + +{ TMainForm } + +procedure TMainForm.btnQuitClick(Sender: TObject); +begin + Close; +end; + +procedure TMainForm.btnStylesClick(Sender: TObject); +begin + if Bevel.Style = bsRaised then + begin + Bevel.Style := bsLowered; + lblStyle.Text := 'Bevel is bsLowered'; + btnStyles.Text := 'bsRaised'; + end + else + begin + Bevel.Style := bsRaised; + lblStyle.Text := 'Bevel is bsRaised'; + btnStyles.Text := 'bsLowered'; + end; +end; + +procedure TMainForm.btnShapesClick(Sender: TObject); +var + next: TBevelShape; +begin + if Bevel.Shape = High(TBevelShape) then + Bevel.Shape := Low(TBevelShape) + else + Bevel.Shape := TBevelShape(Ord(Bevel.Shape) + 1); + lblShape.Text := 'Shape is ' + GetEnumName(TypeInfo(TBevelShape), Ord(Bevel.Shape)); + + if Bevel.Shape = High(TBevelShape) then + next := Low(TBevelShape) + else + next := TBevelShape(Ord(Bevel.Shape) + 1); + btnShapes.Text := GetEnumName(TypeInfo(TBevelShape), Ord(next)); +end; + +constructor TMainForm.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + WindowTitle := 'Bevel test'; + SetPosition(100, 100, 300, 250); + + lblTitle := CreateLabel(self, 6, 6, 'Click buttons to change properties'); + bevel := CreateBevel(self, 20, 30, 150, 150, bsBox, bsRaised); + + btnQuit := CreateButton(self, 210, 220, 80, 'Quit', @btnQuitClick); + btnQuit.ImageName := 'stdimg.quit'; + btnQuit.ShowImage := True; + + lblNext := CreateLabel(self, 200, 80, 'Next value is...'); + btnShapes := CreateButton(self, 200, 100, 90, 'bsFrame', @btnShapesClick); + btnStyles := CreateButton(self, 200, 130, 90, 'bsLowered', @btnStylesClick); + + lblShape := CreateLabel(self, 6, 190, 'Shape is bsBox'); + lblStyle := CreateLabel(self, 6, 210, 'Style is bsRaised'); +end; + + +procedure MainProc; +var + frm: TMainForm; +begin + fpgApplication.Initialize; + frm := TMainForm.Create(nil); + frm.Show; + fpgApplication.Run; +end; + +begin + MainProc; +end. + |