summaryrefslogtreecommitdiff
path: root/examples/gui
diff options
context:
space:
mode:
authorgraemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf>2007-07-24 14:23:24 +0000
committergraemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf>2007-07-24 14:23:24 +0000
commit7b306401872c09d5996a748ce1e4e8a90306e980 (patch)
treef2c6a225519b0e41d50b0fbcd728ecbebe4ae6df /examples/gui
parent8cede30bc7849a64720b7d34d7f3d3770489ca93 (diff)
downloadfpGUI-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.lpi53
-rw-r--r--examples/gui/bevel/beveltest.lpr110
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.
+