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 SetGraphic (Bmp: TBitmap);
        procedure SetCaption(Txt: string);
        procedure SetFont(const Fnt: TFont);
        procedure SetGlyph;
    public
        property Font: TFont write SetFont;
        procedure CheckGlyph;
    published
        property Graphic: TBitmap read FGraphic 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, FGraphic.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 (FGraphic <> nil) and (FCaption <> '') then
        SetGlyph;
end;

procedure TButtonA.SetGraphic(Bmp: TBitmap);
begin
    FGraphic := Bmp;
    CheckGlyph;
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 := $000000;
end;

end.
