lasarus_compotents/bgracontrols/bgrathemebutton.pas

// SPDX-License-Identifier: LGPL-3.0-linking-exception
unit BGRAThemeButton;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
  BGRATheme, Types, ExtCtrls, BGRASVGImageList;

type

  { TBGRAThemeButton }

  TBGRAThemeButton = class(TBGRAThemeControl)
  private
    FImageIndex: integer;
    FImageList: TBGRASVGImageList;
    FModalResult: TModalResult;
    FState: TBGRAThemeButtonState;
    FTimerHover: TTimer;
    procedure SetImageIndex(AValue: integer);
    procedure SetImageList(AValue: TBGRASVGImageList);
    procedure SetState(AValue: TBGRAThemeButtonState);
    procedure TimerHoverElapse(Sender: TObject);
  protected
    procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
      WithThemeSpace: Boolean); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    class function GetControlClassDefaultSize: TSize; override;
    procedure MouseEnter; override;
    procedure MouseLeave; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
    procedure Click; override;
    procedure SetEnabled(Value: boolean); override;
    procedure TextChanged; override;
    procedure Paint; override;
    procedure Resize; override;
    procedure UpdateHoverState;
    property State: TBGRAThemeButtonState read FState write SetState;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Action;
    property ModalResult: TModalResult
      read FModalResult write FModalResult default mrNone;
    property Align;
    property Anchors;
    property BorderSpacing;
    property Caption;
    property Enabled;
    property Font;
    property ImageList: TBGRASVGImageList read FImageList write SetImageList;
    property ImageIndex: integer read FImageIndex write SetImageIndex;
    property OnClick;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseEnter;
    property OnMouseLeave;
  end;

procedure Register;

implementation

uses BGRABitmapTypes;

procedure Register;
begin
  RegisterComponents('BGRA Themes', [TBGRAThemeButton]);
end;

{ TBGRAThemeButton }

procedure TBGRAThemeButton.SetState(AValue: TBGRAThemeButtonState);
begin
  if FState = AValue then
    Exit;
  FState := AValue;
  FTimerHover.Enabled := (FState = btbsHover);
  Invalidate;
end;

procedure TBGRAThemeButton.SetImageIndex(AValue: integer);
begin
  if FImageIndex = AValue then
    Exit;
  FImageIndex := AValue;
  Invalidate;
end;

procedure TBGRAThemeButton.SetImageList(AValue: TBGRASVGImageList);
begin
  if FImageList = AValue then
    Exit;
  FImageList := AValue;
  Invalidate;
end;

procedure TBGRAThemeButton.TimerHoverElapse(Sender: TObject);
begin
  UpdateHoverState;
end;

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

  if AutoSize then
  begin
    PreferredWidth := Canvas.TextWidth(Caption) + Theme.PreferredButtonWidth(Assigned(FImageList));
    PreferredHeight := Canvas.TextHeight(Caption) + Theme.PreferredButtonHeight(Assigned(FImageList));
    if Assigned(FImageList) then
    begin
      PreferredWidth := PreferredWidth + FImageList.Width;
      PreferredHeight := PreferredHeight + FImageList.Height;
    end;
  end;
end;

procedure TBGRAThemeButton.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FImageList) then
    FImageList := nil;
end;

class function TBGRAThemeButton.GetControlClassDefaultSize: TSize;
begin
  Result.CX := 125;
  Result.CY := 35;
end;

procedure TBGRAThemeButton.MouseEnter;
begin
  inherited MouseEnter;
  if Enabled then
    State := btbsHover
  else
    State := btbsDisabled;
end;

procedure TBGRAThemeButton.MouseLeave;
begin
  inherited MouseLeave;
  if Enabled then
    State := btbsNormal
  else
    State := btbsDisabled;
end;

procedure TBGRAThemeButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  State := btbsActive;
end;

procedure TBGRAThemeButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  UpdateHoverState;
end;

procedure TBGRAThemeButton.Click;
var
  Form: TCustomForm;
begin
  UpdateHoverState;
  if ModalResult <> mrNone then
  begin
    Form := GetParentForm(Self);
    if Form <> nil then
      Form.ModalResult := ModalResult;
  end;
  inherited Click;
end;

procedure TBGRAThemeButton.SetEnabled(Value: boolean);
begin
  inherited SetEnabled(Value);
  if Value then
    State := btbsNormal
  else
    State := btbsDisabled;
end;

procedure TBGRAThemeButton.TextChanged;
begin
  inherited TextChanged;
  Invalidate;
end;

procedure TBGRAThemeButton.Paint;
var
  surface: TBGRAThemeSurface;
begin
  Canvas.Font.Assign(Font);
  surface := TBGRAThemeSurface.Create(self);
  try
    if Assigned(Theme) then
      Theme.DrawButton(Caption, FState, Focused, ClientRect, surface, FImageIndex, FImageList)
    else
      BGRADefaultTheme.DrawButton(Caption, FState, Focused, ClientRect, surface, FImageIndex, FImageList);
  finally
    surface.Free;
  end;
end;

procedure TBGRAThemeButton.Resize;
begin
  Invalidate;
  inherited Resize;
end;

procedure TBGRAThemeButton.UpdateHoverState;
var
  p: TPoint;
begin
  p := ScreenToClient(Mouse.CursorPos);
  if (p.x >= 0) and (p.x <= Width) and (p.y >= 0) and (p.y <= Height) then
    State := btbsHover
  else
  if Enabled then
    State := btbsNormal
  else
    State := btbsDisabled;
end;

constructor TBGRAThemeButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FState := btbsNormal;

  ControlStyle := ControlStyle + [csParentBackground];

  with GetControlClassDefaultSize do
    SetInitialBounds(0, 0, CX, CY);

  FTimerHover := TTimer.Create(self);
  FTimerHover.Enabled := False;
  FTimerHover.Interval := 100;
  FTimerHover.OnTimer := @TimerHoverElapse;
end;

end.