From 7b306401872c09d5996a748ce1e4e8a90306e980 Mon Sep 17 00:00:00 2001 From: graemeg Date: Tue, 24 Jul 2007 14:23:24 +0000 Subject: * 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. --- examples/gui/bevel/beveltest.lpi | 53 +++++++++++++++++++ examples/gui/bevel/beveltest.lpr | 110 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 163 insertions(+) create mode 100644 examples/gui/bevel/beveltest.lpi create mode 100644 examples/gui/bevel/beveltest.lpr (limited to 'examples') 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 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 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. + -- cgit v1.2.3-70-g09d2