unit ButtonC;

{ Replacement Buttons as original buttons          }
{ do not work in QT5                               }
{ Need to avoid using Bitblt SCRAND & SCRPAINT     }
{                                                  }
{ Create a new button class, a double size ButtonC }
{  12 pixel buttons too small on modern screens    }
{ PB Sep-21                                       }
{}

interface

uses
    Classes, Controls, Graphics, ButtonBase, LCLExceptionStackTrace;

const
    bC2w = 24;  {Width of button C2}

type
    TButtonBaseC = class(TButtonBase)
    protected
        procedure SetGlyph;   virtual; abstract;
        procedure CheckGlyph; virtual; abstract;
        procedure SetupBounds (mysize : integer);
        procedure SetIndex(Ind: Integer); virtual;

    public
        procedure MouseDown(Button: TMouseButton; Shift: TShiftState; x, y: integer); override;

    published
        property ButtonIndex: integer read FIndex  write SetIndex;
    end;


    TButtonC = class(TButtonBaseC)
    protected
        procedure SetGraphic (Bmp: TBitmap);
        procedure SetGlyph;  override;
        const mysize = 12; { Square button }

    public
        procedure CheckGlyph; override;

    published
        constructor Create (aOwner: TComponent); override;
        property Graphic: TBitmap read FGraphic  write SetGraphic;
    end;


    { Double size button C }
    TButtonC2 = class(TButtonC)
    private
        C2Graphic : TBitMap;

    protected
        procedure SetGlyph;   override;
        const mysize = bC2w;

    public
        procedure CheckGlyph; override;
        destructor Destroy; override;

    published
        constructor Create (aOwner: TComponent); override;
    end;


procedure Register;


implementation uses Directories, ScreenTools;

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


procedure TButtonBaseC.SetUpBounds (mysize : integer);
begin
    SetBounds (0, 0, mysize, mysize);
    Glyph.Width  := mysize;
    Glyph.Height := mysize;
end;

procedure TButtonBaseC.SetIndex (Ind: integer);
begin
    FIndex := Ind;
    CheckGlyph;
end;

procedure TButtonBaseC.MouseDown(Button: TMouseButton; Shift: TShiftState; x, y: integer);
begin
    Inherited;
    Down := Not Down; { use button as Toggle }

    if @DownChangedProc <> nil then
        DownChangedProc(self);
end;


{================== Button C ======================}
constructor TButtonC.Create (aOwner: TComponent);
begin
    inherited;
    SetUpBounds (mysize);
end;

procedure TButtonC.SetGraphic (Bmp: TBitmap);
begin
    FGraphic := Bmp;
    CheckGlyph;
end;

procedure TButtonC.SetGlyph;
const Xg = 169; Yg = 159; {System.png offsets}
var XX, YY : integer;
    Dest, Src : TRect;
begin
    XX    := Xg;
    YY    := Yg + FIndex * (mysize+1);
    Dest  := Rect (0, 0, mysize, mysize);
    Src   := Rect (XX, YY, XX+mysize, YY+mysize);
    Glyph.Canvas.CopyRect(dest, FGraphic.Canvas, src);
end;

procedure TButtonC.CheckGlyph;
begin
    if (FIndex >= 0) and (FGraphic <> nil) then
        SetGlyph;
end;


{================== Button C2 =====================}
constructor TButtonC2.Create (aOwner: TComponent);
begin
    inherited;
    SetUpBounds (mysize);
    C2Graphic := TBitMap.Create;
    LoadGraphicFile (C2Graphic, GetGraphicsDir + DirectorySeparator + 'ButtonsC2.png');
end;

destructor TButtonC2.Destroy;
begin
    C2graphic.free;
    inherited;
end;

procedure TButtonC2.SetGlyph;
var Y : integer;
    Dest, Src : TRect;
begin
    Y    := FIndex * (mysize+2);
    Dest := Rect (0, 0, mysize, mysize);
    Src  := Rect (0, Y, mysize, mysize+Y);
    Glyph.Canvas.CopyRect(dest, C2Graphic.Canvas, src);
end;

procedure TButtonC2.CheckGlyph;
begin
    if (FIndex >= 0) and (C2Graphic <> nil) then
        SetGlyph;
end;

end.
