Skip to content

Commit

Permalink
Better TSimbaButton
Browse files Browse the repository at this point in the history
  • Loading branch information
@ollydev
ollydev committed Mar 2, 2024
1 parent 69f4322 commit 554dd42
Show file tree
Hide file tree
Showing 8 changed files with 270 additions and 89 deletions.
302 changes: 238 additions & 64 deletions Source/components/simba.component_button.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,12 +10,13 @@
interface

uses
Classes, SysUtils, Controls, StdCtrls, Buttons, Graphics, LMessages;
Classes, SysUtils, Controls, StdCtrls, Buttons, Graphics, LMessages, ImgList;

type
{$push}
{$scopedenums on}
ESimbaButtonImage = (
NONE,
OK,
CLOSE,
CLEAR_FILTER,
Expand All @@ -29,6 +30,7 @@ interface

const
IMG_TO_LAZ_GLYPH: array[ESimbaButtonImage] of String = (
'',
'btn_ok',
'btn_cancel',
'btnfiltercancel',
Expand All @@ -40,20 +42,64 @@ interface
);

type
TSimbaButton = class(TSpeedButton)
TSimbaButton = class(TCustomControl)
protected
FImageList: TImageList;
FImageIndex: Integer;
FImage: ESimbaButtonImage;

FDown: Boolean;
FXPadding: Integer;
FYPadding: Integer;

function HasImage: Boolean;
function ImageSize: TPoint;
function CalculateSize: TPoint;

procedure MouseEnter; override;
procedure MouseLeave; override;
procedure TextChanged; override;

procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override;

// Use parent font size, but use SimbaTheme.FontStyle and font styles if changed
procedure CMParentFontChanged(var Message: TLMessage); message CM_PARENTFONTCHANGED;

procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override;
procedure PaintBackground(var PaintRect: TRect); override;
procedure SetDown(AValue: Boolean);
procedure SetXPadding(AValue: Integer);
procedure SetYPadding(AValue: Integer);

procedure SetImage(Img: ESimbaButtonImage);
procedure SetImageIndex(Index: Integer);
public
XPadding: Integer;
YPadding: Integer;
procedure Paint; override;
procedure Click; override; // make click public

constructor Create(AOwner: TComponent); override;

procedure SetImage(Img: ESimbaButtonImage);
property ImageList: TImageList read FImageList write FImageList;
property ImageIndex: Integer read FImageIndex write SetImageIndex;
property Image: ESimbaButtonImage read FImage write SetImage;

property Down: Boolean read FDown write SetDown;
property XPadding: Integer read FXPadding write SetXPadding;
property YPadding: Integer read FYPadding write SetYPadding;

property OnMouseDown;
property OnMouseUp;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
end;

TSimbaToggleButton = class(TSimbaButton)
public
procedure Click; override;
end;

TSimbaCheckButton = class(TSimbaToggleButton)
public
constructor Create(AOwner: TComponent); override;
end;

TSimbaLabeledButton = class(TCustomControl)
Expand All @@ -68,21 +114,9 @@ TSimbaLabeledButton = class(TCustomControl)
property Button: TSimbaButton read FButton;
end;

TSimbaToggleButton = class(TSimbaButton)
public
constructor Create(AOwner: TComponent); override;
end;

TSimbaTransparentButton = class(TSimbaButton)
protected
procedure PaintBackground(var PaintRect: TRect); override;
public
constructor Create(AOwner: TComponent); override;
end;

TSimbaCheckButton = class(TSimbaToggleButton)
public
constructor Create(AOwner: TComponent); override;
procedure Paint; override;
end;

TSimbaLabeledCheckButton = class(TCustomControl)
Expand Down Expand Up @@ -112,36 +146,15 @@ TSimbaCheckButtonGroup = class(TCustomControl)
implementation

uses
simba.theme, simba.main,
simba.theme, simba.main, simba.fonthelpers,
ATCanvasPrimitives;

procedure TSimbaTransparentButton.PaintBackground(var PaintRect: TRect);
begin
if Enabled and (Down or MouseInClient) then
Canvas.Brush.Color := SimbaTheme.ColorActive
else
Canvas.Brush.Color := Color;

Canvas.FillRect(PaintRect);
if Down or MouseInClient then
CanvasPaintRoundedCorners(Canvas, PaintRect, [acckLeftTop, acckRightTop, acckLeftBottom, acckRightBottom], Color, Canvas.Brush.Color, Canvas.Brush.Color);
end;

constructor TSimbaTransparentButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);

ParentColor := True;
end;

constructor TSimbaCheckButton.Create(AOwner: TComponent);
procedure TSimbaTransparentButton.Paint;
begin
inherited Create(AOwner);
if Assigned(Parent) then
Color := Parent.Color;

XPadding := 0;
Images := SimbaForm.Images;
PressedImageIndex := 62;
SelectedImageIndex := 62;
inherited Paint();
end;

procedure TSimbaLabeledCheckButton.TextChanged;
Expand Down Expand Up @@ -213,7 +226,7 @@ function TSimbaCheckButtonGroup.Add(ACaption: String): Integer;
CheckButton.Caption := ACaption;
CheckButton.Align := alBottom;

Result := Self.GetControlIndex(CheckButton);
Result := GetControlIndex(CheckButton);
end;

procedure TSimbaButton.CMParentFontChanged(var Message: TLMessage);
Expand All @@ -234,36 +247,205 @@ procedure TSimbaButton.CMParentFontChanged(var Message: TLMessage);
end;
end;

procedure TSimbaButton.SetDown(AValue: Boolean);
begin
if FDown=AValue then Exit;
FDown:=AValue;
Invalidate;
end;

procedure TSimbaButton.SetXPadding(AValue: Integer);
begin
if FXPadding=AValue then Exit;
FXPadding := Scale96ToScreen(AValue);

AdjustSize();
end;

procedure TSimbaButton.SetYPadding(AValue: Integer);
begin
if FYPadding=AValue then Exit;
FYPadding := Scale96ToScreen(AValue);

AdjustSize();
end;

function TSimbaButton.HasImage: Boolean;
begin
Result := (FImage <> ESimbaButtonImage.NONE) or (FImageIndex > -1);
end;

function TSimbaButton.ImageSize: TPoint;
begin
if (FImage <> ESimbaButtonImage.NONE) then
begin
Result.X := LCLGlyphs.WidthForPPI[FImageList.Width, Font.PixelsPerInch];
Result.Y := LCLGlyphs.HeightForPPI[FImageList.Width, Font.PixelsPerInch];
end
else if (FImageIndex > -1) then
begin
Result.X := FImageList.WidthForPPI[FImageList.Width, Font.PixelsPerInch];
Result.Y := FImageList.HeightForPPI[FImageList.Width, Font.PixelsPerInch];
end;
end;

function TSimbaButton.CalculateSize: TPoint;
begin
Result.X := 0;
Result.Y := 0;

if (Caption <> '') then
with TBitmap.Create() do
try
Canvas.Font := Self.Font;
Canvas.Font.Size := GetFontSize(Self, 1);

Result.X := Canvas.TextWidth(Caption) + (BorderWidth * 2);
Result.Y := Canvas.TextHeight('Fj') + (BorderWidth * 2);
finally
Free();
end;

if HasImage then
begin
Result.X += ImageSize.X;
if ImageSize.Y > Result.Y then
Result.Y := ImageSize.Y;
end;

Result.X += XPadding * 2;
Result.Y += YPadding * 2;
end;

procedure TSimbaButton.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean);
begin
inherited CalculatePreferredSize(PreferredWidth, PreferredHeight, WithThemeSpace);

PreferredWidth += XPadding * 2;
PreferredHeight += YPadding * 2;
with CalculateSize() do
begin
PreferredWidth := X;
PreferredHeight := Y;
end;
end;

procedure TSimbaButton.MouseEnter;
begin
inherited MouseEnter;

Invalidate();
end;

procedure TSimbaButton.MouseLeave;
begin
inherited MouseLeave;

Invalidate();
end;

procedure TSimbaButton.TextChanged;
begin
inherited TextChanged;

AdjustSize();
end;

procedure TSimbaButton.PaintBackground(var PaintRect: TRect);
procedure TSimbaButton.Paint;
var
Style: TTextStyle;
R: TRect;
ImgPoint: TPoint;
begin
if Down or MouseInClient then
if MouseInClient or FDown then
Canvas.Brush.Color := SimbaTheme.ColorActive
else
Canvas.Brush.Color := SimbaTheme.ColorScrollBarActive;
Canvas.Brush.Color := Color;

Canvas.FillRect(ClientRect);
CanvasPaintRoundedCorners(Canvas, ClientRect, [acckLeftTop, acckRightTop, acckLeftBottom, acckRightBottom], SimbaTheme.ColorFrame, Canvas.Brush.Color, Canvas.Brush.Color);

if HasImage then
begin
if (Caption = '') then
begin
ImgPoint.X := (ClientWidth div 2) - (ImageSize.X div 2);
ImgPoint.Y := (ClientHeight div 2) - (ImageSize.Y div 2);
end else
begin
ImgPoint.X := XPadding;
ImgPoint.Y := (ClientHeight div 2) - (ImageSize.Y div 2);
end;

if (FImage <> ESimbaButtonImage.NONE) then
LCLGlyphs.DrawForControl(Canvas, ImgPoint.X, ImgPoint.Y, LCLGlyphs.GetImageIndex(IMG_TO_LAZ_GLYPH[FImage]), LCLGlyphs.Width, Self, Enabled)
else
FImageList.DrawForControl(Canvas, ImgPoint.X, ImgPoint.Y, FImageIndex, FImageList.Width, Self, Enabled);
end;

Canvas.FillRect(PaintRect);
CanvasPaintRoundedCorners(Canvas, PaintRect, [acckLeftTop, acckRightTop, acckLeftBottom, acckRightBottom], SimbaTheme.ColorFrame, Canvas.Brush.Color, Canvas.Brush.Color);
Style := Canvas.TextStyle;
Style.Layout := tlCenter;
Style.Alignment:= taCenter;

if (Caption <> '') then
begin
Canvas.Font.Color := SimbaTheme.ColorFont;

R := ClientRect;
R.Bottom -= 2;
if HasImage then
R.Left := ImageSize.X + XPadding;

Canvas.TextRect(R, 0,0, Caption, Style);
end;

inherited Paint;
end;

procedure TSimbaButton.Click;
begin
inherited Click;
end;

constructor TSimbaButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);

Color := SimbaTheme.ColorScrollBarActive;
AutoSize := True;
XPadding := 5;

FImageList := SimbaForm.Images;
FImageIndex := -1;

XPadding := 6;
YPadding := 1;
end;

procedure TSimbaButton.SetImage(Img: ESimbaButtonImage);
begin
ButtonGlyph.LCLGlyphName := IMG_TO_LAZ_GLYPH[Img];
FImage := Img;

AdjustSize();
end;

procedure TSimbaButton.SetImageIndex(Index: Integer);
begin
FImageIndex := Index;
FImage := ESimbaButtonImage.NONE;

AdjustSize();
end;

procedure TSimbaToggleButton.Click;
begin
inherited Click();

Down := not Down;
end;

constructor TSimbaCheckButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);

SetImageIndex(IMG_TICK);
end;

procedure TSimbaLabeledButton.TextChanged;
Expand Down Expand Up @@ -294,13 +476,5 @@ constructor TSimbaLabeledButton.Create(AOwner: TComponent);
FLabel.Layout := tlCenter;
end;

constructor TSimbaToggleButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);

AllowAllUp := True;
GroupIndex := 1 + AOwner.ComponentCount;
end;

end.

0 comments on commit 554dd42

Please sign in to comment.