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. --- src/gui/fpgui_package.lpk | 8 ++- src/gui/fpgui_package.pas | 2 +- src/gui/gui_bevel.pas | 126 ++++++++++++++++++++++++++++++++++++++++++++++ src/gui/gui_label.pas | 1 + 4 files changed, 134 insertions(+), 3 deletions(-) create mode 100644 src/gui/gui_bevel.pas (limited to 'src') diff --git a/src/gui/fpgui_package.lpk b/src/gui/fpgui_package.lpk index ea9896d3..5ad6031a 100644 --- a/src/gui/fpgui_package.lpk +++ b/src/gui/fpgui_package.lpk @@ -6,7 +6,7 @@ - + @@ -18,7 +18,7 @@ - + @@ -59,6 +59,10 @@ + + + + diff --git a/src/gui/fpgui_package.pas b/src/gui/fpgui_package.pas index dcdc16ba..a6b53cdc 100644 --- a/src/gui/fpgui_package.pas +++ b/src/gui/fpgui_package.pas @@ -8,7 +8,7 @@ interface uses gui_button, gui_combobox, gui_dialogs, gui_edit, gui_form, gui_label, - gui_listbox, gui_memo, gui_popupwindow, gui_scrollbar; + gui_listbox, gui_memo, gui_popupwindow, gui_scrollbar, gui_bevel; implementation diff --git a/src/gui/gui_bevel.pas b/src/gui/gui_bevel.pas new file mode 100644 index 00000000..d531fde0 --- /dev/null +++ b/src/gui/gui_bevel.pas @@ -0,0 +1,126 @@ +unit gui_bevel; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, + SysUtils, + fpgfx, + gfxbase, + gfx_widget; + +type + + TBevelShape = (bsBox, bsFrame, bsTopLine, bsBottomLine, bsLeftLine, bsRightLine, bsSpacer); + + TBevelStyle = (bsLowered, bsRaised); + + + TfpgBevel = class(TfpgWidget) + private + FBevelShape: TBevelShape; + FBevelStyle: TBevelStyle; + procedure SetBevelShape(const AValue: TBevelShape); + procedure SetBevelStyle(const AValue: TBevelStyle); + protected + procedure HandlePaint; override; + public + constructor Create(AOwner: TComponent); override; + published + property Shape: TBevelShape read FBevelShape write SetBevelShape default bsBox; + property Style: TBevelStyle read FBevelStyle write SetBevelStyle default bsRaised; + end; + + +function CreateBevel(AOwner: TComponent; ALeft, ATop, AWidth, AHeight: TfpgCoord; + AShape: TBevelShape; AStyle: TBevelStyle): TfpgBevel; + + +implementation + + +function CreateBevel(AOwner: TComponent; ALeft, ATop, AWidth, + AHeight: TfpgCoord; AShape: TBevelShape; AStyle: TBevelStyle): TfpgBevel; +begin + Result := TfpgBevel.Create(AOwner); + Result.Left := ALeft; + Result.Top := ATop; + Result.Width := AWidth; + Result.Height := AHeight; + Result.Shape := AShape; + Result.Style := AStyle; +end; + +{ TfpgBevel } + +procedure TfpgBevel.SetBevelShape(const AValue: TBevelShape); +begin + if FBevelShape = AValue then + Exit; //==> + FBevelShape := AValue; + Repaint; +end; + +procedure TfpgBevel.SetBevelStyle(const AValue: TBevelStyle); +begin + if FBevelStyle = AValue then + Exit; //==> + FBevelStyle := AValue; + Repaint; +end; + +procedure TfpgBevel.HandlePaint; +begin + Canvas.BeginDraw; + inherited HandlePaint; + Canvas.Clear(clWindowBackground); + + Canvas.SetLineStyle(2, lsSolid); + Canvas.SetColor(clWindowBackground); + Canvas.DrawRectangle(1, 1, Width - 1, Height - 1); + Canvas.SetLineStyle(1, lsSolid); + + if Style = bsRaised then + Canvas.SetColor(clHilite2) + else + Canvas.SetColor(clShadow2); + + if Shape in [bsBox, bsFrame, bsTopLine] then + Canvas.DrawLine(0, 0, Width - 1, 0); + if Shape in [bsBox, bsFrame, bsLeftLine] then + Canvas.DrawLine(0, 1, 0, Height - 1); + if Shape in [bsFrame, bsRightLine] then + Canvas.DrawLine(Width - 2, 1, Width - 2, Height - 1); + if Shape in [bsFrame, bsBottomLine] then + Canvas.DrawLine(1, Height - 2, Width - 1, Height - 2); + + if Style = bsRaised then + Canvas.SetColor(clShadow2) + else + Canvas.SetColor(clHilite2); + + if Shape in [bsFrame, bsTopLine] then + Canvas.DrawLine(1, 1, Width - 2, 1); + if Shape in [bsFrame, bsLeftLine] then + Canvas.DrawLine(1, 2, 1, Height - 2); + if Shape in [bsBox, bsFrame, bsRightLine] then + Canvas.DrawLine(Width - 1, 0, Width - 1, Height - 1); + if Shape in [bsBox, bsFrame, bsBottomLine] then + Canvas.DrawLine(0, Height - 1, Width, Height - 1); + + Canvas.EndDraw; +end; + +constructor TfpgBevel.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FBevelShape := bsBox; + FBevelStyle := bsRaised; + FWidth := 80; + FHeight := 80; +end; + +end. + diff --git a/src/gui/gui_label.pas b/src/gui/gui_label.pas index 9e51b780..ea635be0 100644 --- a/src/gui/gui_label.pas +++ b/src/gui/gui_label.pas @@ -115,6 +115,7 @@ procedure TfpgLabel.ResizeLabel; begin Width := FFont.TextWidth(FText); Height := FFont.Height; + UpdateWindowPosition; end; constructor TfpgLabel.Create(AOwner: TComponent); -- cgit v1.2.3-70-g09d2