unit ButtonA;

//  Replacement Buttons as original buttons
//  do not work in QT5
//  Need to avoid using Bitblt SCRAND & SCRPAINT
//  PB Nov-20


interface

uses
    Classes, Graphics, ButtonBase, LCLExceptionStackTrace;

type
    TButtonA = class (TButtonBase)
      constructor Create (aOwner: TComponent); override;
    private
        FCaption: string;
        procedure SetCaption (Txt: string);
        procedure SetFont (const Fnt: TFont);

    protected
        procedure SetGlyph;  override;

    public
        property Font: TFont write SetFont;
        procedure CheckGlyph;  override;

    published
        property Graphic: TBitmap read GetGraphic write SetGraphic;
        property Caption: string  read FCaption write SetCaption;
    end;

procedure Register;


implementation

procedure Register;
begin
    RegisterComponents ('C-evo', [TButtonA]);
end;


const Wd = 100;
      Ht = 25;

constructor TButtonA.Create (aOwner: TComponent);
begin
    inherited;
    SetBounds(0, 0, Wd, Ht);
    FCaption := '';
    Glyph.Width  := Wd;
    Glyph.Height := Ht;
end;


procedure TButtonA.SetGlyph;
const
    Xg = 195; Yg = 243;
var
    Dest, Src : TRect;
begin
    with Glyph.Canvas do
    begin
        Dest  := Rect (0,   0,    Wd,    Ht);
        Src   := Rect (Xg, Yg, Xg+Wd, Yg+Ht);

        CopyRect (Dest, GetGraphic.Canvas, src);
        Brush.Style := bsClear;
        Textout (50 - (TextWidth (FCaption) + 1) div 2, 12 - textheight (FCaption) div 2, FCaption);
    end;
end;

procedure TButtonA.CheckGlyph;
begin
    if (GetGraphic <> nil) and (FCaption <> '') then
        SetGlyph;
end;

procedure TButtonA.SetCaption (Txt: string);
begin
    if Txt <> FCaption then
    begin
        FCaption := Txt;
        CheckGlyph;
    end;
end;

procedure TButtonA.SetFont (const Fnt: TFont);
begin
    Canvas.Font.Assign (Fnt);
    Canvas.Font.Color := clBlack;
end;

end.
