bgracolortheme.pas

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

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, BGRATheme,
  BGRABitmap, BGRABitmapTypes, BGRASVGImageList;

type

  { TBGRAColorTheme }

  TBGRAColorTheme = class(TBGRATheme)
  private
    FColorActive: TColor;
    FColorDisabled: TColor;
    FColorFocused: TColor;
    FColorHover: TColor;
    FColorNormal: TColor;
    FColorText: TColor;
    procedure SetFColorActive(AValue: TColor);
    procedure SetFColorDisabled(AValue: TColor);
    procedure SetFColorFocused(AValue: TColor);
    procedure SetFColorHover(AValue: TColor);
    procedure SetFColorNormal(AValue: TColor);
    procedure SetFColorText(AValue: TColor);

  protected

  public
    procedure DrawButton(Caption: string; State: TBGRAThemeButtonState;
      Focused: boolean; ARect: TRect; ASurface: TBGRAThemeSurface; AImageIndex: Integer = -1; AImageList: TBGRASVGImageList = nil); override;
    procedure DrawRadioButton(Caption: string; State: TBGRAThemeButtonState;
      {%H-}Focused: boolean; Checked: boolean; ARect: TRect; ASurface: TBGRAThemeSurface); override;
    procedure DrawCheckBox(Caption: string; State: TBGRAThemeButtonState;
      {%H-}Focused: boolean; Checked: boolean; ARect: TRect; ASurface: TBGRAThemeSurface); override;
  published
    property ColorNormal: TColor read FColorNormal write SetFColorNormal;
    property ColorHover: TColor read FColorHover write SetFColorHover;
    property ColorActive: TColor read FColorActive write SetFColorActive;
    property ColorDisabled: TColor read FColorDisabled write SetFColorDisabled;
    property ColorFocused: TColor read FColorFocused write SetFColorFocused;
    property ColorText: TColor read FColorText write SetFColorText;
  end;

procedure Register;

implementation

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

{ TBGRAColorTheme }

procedure TBGRAColorTheme.SetFColorActive(AValue: TColor);
begin
  if FColorActive = AValue then
    Exit;
  FColorActive := AValue;
end;

procedure TBGRAColorTheme.SetFColorDisabled(AValue: TColor);
begin
  if FColorDisabled = AValue then
    Exit;
  FColorDisabled := AValue;
end;

procedure TBGRAColorTheme.SetFColorFocused(AValue: TColor);
begin
  if FColorFocused = AValue then
    Exit;
  FColorFocused := AValue;
end;

procedure TBGRAColorTheme.SetFColorHover(AValue: TColor);
begin
  if FColorHover = AValue then
    Exit;
  FColorHover := AValue;
end;

procedure TBGRAColorTheme.SetFColorNormal(AValue: TColor);
begin
  if FColorNormal = AValue then
    Exit;
  FColorNormal := AValue;
end;

procedure TBGRAColorTheme.SetFColorText(AValue: TColor);
begin
  if FColorText = AValue then
    Exit;
  FColorText := AValue;
end;

procedure TBGRAColorTheme.DrawButton(Caption: string;
  State: TBGRAThemeButtonState; Focused: boolean; ARect: TRect;
  ASurface: TBGRAThemeSurface; AImageIndex: Integer;
  AImageList: TBGRASVGImageList);
var
  Style: TTextStyle;
begin
  with ASurface do
  begin
    case State of
      btbsNormal: DestCanvas.Brush.Color := ColorNormal;
      btbsHover: DestCanvas.Brush.Color := ColorHover;
      btbsActive: DestCanvas.Brush.Color := ColorActive;
      btbsDisabled: DestCanvas.Brush.Color := ColorDisabled;
    end;

    DestCanvas.Pen.Color := DestCanvas.Brush.Color;
    DestCanvas.Rectangle(ARect);

    if Focused then
    begin
      DestCanvas.Pen.Color := ColorFocused;
      DestCanvas.Rectangle(ARect);
    end;

    if Caption <> '' then
    begin
      fillchar(Style, sizeof(Style), 0);
      Style.Alignment := taCenter;
      Style.Layout := tlCenter;
      Style.Wordbreak := True;
      if ColorText <> clDefault then
        DestCanvas.Font.Color := ColorText;
      DestCanvas.TextRect(ARect, 0, 0, Caption, Style);
    end;
  end;
end;

procedure TBGRAColorTheme.DrawRadioButton(Caption: string;
  State: TBGRAThemeButtonState; Focused: boolean; Checked: boolean;
  ARect: TRect; ASurface: TBGRAThemeSurface);
var
  Style: TTextStyle;
  Color: TBGRAPixel;
begin
  with ASurface do
  begin
    DestCanvas.Font.Color := ColorText;
    case State of
      btbsHover: Color := ColorHover;
      btbsActive: Color := ColorActive;
      btbsDisabled:
      begin
        DestCanvas.Font.Color := ColorDisabled;
        Color := ColorDisabled;
      end;
    else {btbsNormal}
      Color := ColorNormal;
    end;

    BitmapRect := RectWithSize(ARect.Left, ARect.Top, ARect.Height, ARect.Height);
    Bitmap.FillEllipseAntialias(Bitmap.Height / 2, Bitmap.Height / 2,
      Bitmap.Height / 2 - 2, Bitmap.Height / 2 - 2, BGRAWhite);
    Bitmap.EllipseAntialias(Bitmap.Height / 2, Bitmap.Height / 2,
      Bitmap.Height / 2 - 2, Bitmap.Height / 2 - 2, Color{%H-}, 1);
    if Checked then
      Bitmap.FillEllipseAntialias(Bitmap.Height / 2, Bitmap.Height /
        2, Bitmap.Height / 4, Bitmap.Height / 4, Color);
    DrawBitmap;

    if Caption <> '' then
    begin
      fillchar(Style, sizeof(Style), 0);
      Style.Alignment := taLeftJustify;
      Style.Layout := tlCenter;
      Style.Wordbreak := True;
      DestCanvas.TextRect(Rect(Arect.Height, 0, ARect.Right, ARect.Bottom),
        ARect.Height, 0, Caption, Style);
    end;
  end;
end;

procedure TBGRAColorTheme.DrawCheckBox(Caption: string;
  State: TBGRAThemeButtonState; Focused: boolean; Checked: boolean;
  ARect: TRect; ASurface: TBGRAThemeSurface);
var
  Style: TTextStyle;
  Color: TBGRAPixel;
  aleft, atop, aright, abottom: integer;
begin
  with ASurface do
  begin
    DestCanvas.Font.Color := ColorText;
    case State of
      btbsHover: Color := ColorHover;
      btbsActive: Color := ColorActive;
      btbsDisabled:
      begin
        DestCanvas.Font.Color := ColorDisabled;
        Color := ColorDisabled;
      end;
    else {btbsNormal}
      Color := ColorNormal;
    end;

    BitmapRect := RectWithSize(ARect.Left, ARect.Top, ARect.Height, ARect.Height);
    Bitmap.Rectangle(0, 0, Bitmap.Height, Bitmap.Height, Color, BGRAWhite);
    aleft := 0;
    aright := Bitmap.Height;
    atop := 0;
    abottom := Bitmap.Height;
    if Checked then
      Bitmap.DrawPolyLineAntialias(Bitmap.ComputeBezierSpline(
        [BezierCurve(pointF(aleft + 2, atop + 3), PointF((aleft + aright - 1) / 2, abottom - 3)),
        BezierCurve(PointF((aleft + aright - 1) / 2, abottom - 3), PointF(
        (aleft + aright - 1) / 2, (atop * 2 + abottom - 1) / 3), PointF(aright - 2, atop - 2))]),
        Color, 1.5);
    DrawBitmap;

    if Caption <> '' then
    begin
      fillchar(Style, sizeof(Style), 0);
      Style.Alignment := taLeftJustify;
      Style.Layout := tlCenter;
      Style.Wordbreak := True;
      DestCanvas.TextRect(Rect(Arect.Height, 0, ARect.Right, ARect.Bottom),
        ARect.Height, 0, Caption, Style);
    end;
  end;
end;

end.