Create a button that accepts .PNG images as Glyph - delphi

Question

I'm trying to understand how the SpeedButton Glyph property work, I find that the field declared as:
FGlyph: TObject;
While the property as:
property Glyph: TBitmap read GetGlyph write SetGlyph stored HasCustomGlyph;
That put me in a way where I can't understand that code even if I read it line by line, when I was trying to create my own SpeedButton that accepts .PNG images too instead of .bmp images only.
For the first time I was thinking to declare the property as TPicture instead of TBitmap.
Is there any way to create MySpeedButton with Glyph : TPicture?
What I try is below:
TMyButton = class(TSpeedButton)
private
//
FGlyph: TPicture;
procedure SetGlyph(const Value: TPicture);
protected
//
public
//
published
//
Property Glyph : TPicture read FGlyph write SetGlyph;
end;
And the procedure:
procedure TMyButton.SetGlyph(const Value: TPicture);
begin
FGlyph := Value;
end;

Answer 1

Your SetGlyph() needs to call FGlyph.Assign(Value) instead of FGlyph := Value. Be sure to create FGlyph in the constructor and destroy it in the destructor. Then you can call draw the graphic in an overriden Paint() when Graphic is not empty.
type
TMyButton = class(TGraphicControl)
private
FGlyph: TPicture;
procedure GlyphChanged(Sender: TObject);
procedure SetGlyph(const Value: TPicture);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Glyph : TPicture read FGlyph write SetGlyph;
end;
constructor TMyButton.Create(AOwner: TComponent);
begin
inherited;
FGlyph := TPicture.Create;
FGlyph.OnChange := GlyphChanged;
end;
destructor TMyButton.Destroy;
begin
FGlyph.Free;
inherited;
end;
procedure TMyButton.GlyphChanged(Sender: TObject);
begin
Invalidate;
end;
procedure TMyButton.SetGlyph(const Value: TPicture);
begin
FGlyph.Assign(Value):
end;
procedure TMyButton.Paint;
begin
...
if (FGlyph.Graphic <> nil) and (not FGlyph.Graphic.Empty) then
Canvas.Draw(..., FGlyph.Graphic);
...
end;

Answer 2

I have created a similar component that is a SpeedButton which accepts a TPicture as its Glyph.
this is the unit. I hope you benefit well from it.
unit ncrSpeedButtonunit;
interface
uses
Winapi.Windows, Vcl.Controls, Winapi.Messages, Vcl.Graphics, System.Classes;
type
TButtonState = (bs_Down, bs_Normal, bs_Active);
TGlyphCoordinates = class(TPersistent)
private
FX: integer;
FY: integer;
FOnChange: TNotifyEvent;
procedure SetX(aX: integer);
procedure SetY(aY: integer);
function GetX: integer;
function GetY: integer;
public
procedure Assign(aValue: TPersistent); override;
published
property X: integer read GetX write SetX;
property Y: integer read GetY write SetY;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
TNCRSpeedButton = class(TGraphicControl)
private
FGlyph: TPicture;
FGlyphCoordinates: TGlyphCoordinates;
FColor: TColor;
FActiveColor: TColor;
FDownColor: TColor;
FBorderColor: TColor;
Fstate: TButtonState;
FFlat: boolean;
FTransparent: boolean;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMMouseDown(var Message: TMessage); message WM_LBUTTONDOWN;
procedure CMMouseUp(var Message: TMessage); message WM_LBUTTONUP;
procedure SetGlyph(aGlyph: TPicture);
procedure SetGlyphCoordinates(aCoordinates: TGlyphCoordinates);
procedure SetColor(aColor: TColor);
procedure SetActiveColor(aActiveColor: TColor);
procedure SetDownColor(aDownColor: TColor);
procedure SetBorderColor(aBorderColor: TColor);
procedure SetFlat(aValue: boolean);
procedure GlyphChanged(Sender: TObject);
procedure CoordinatesChanged(Sender: TObject);
procedure SetTransparency(aValue: boolean);
protected
procedure Paint; override;
procedure Resize; override;
public
Constructor Create(Owner: TComponent); override;
Destructor Destroy; override;
published
property Glyph: Tpicture read FGlyph write SetGlyph;
property GlyphCoordinates: TGlyphCoordinates read FGlyphCoordinates write SetGlyphCoordinates;
property Color: TColor read FColor write SetColor;
property ActiveColor: TColor read FActiveColor write SetActiveColor;
property DownColor: TColor read FDownColor write SetDownColor;
property BorderColor: TColor read FBorderColor write SetBorderColor;
property Flat: boolean read FFlat write SetFlat;
property IsTransparent: boolean read FTransparent write SetTransparency;
property ParentShowHint;
property ParentBiDiMode;
property PopupMenu;
property ShowHint;
property Visible;
property OnClick;
property OnDblClick;
property OnMouseActivate;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
end;
implementation
{ TNCRSpeedButton }
Constructor TNCRSpeedButton.Create(Owner: TComponent);
begin
inherited Create(Owner);
FGlyph := TPicture.Create;
FGlyph.OnChange := GlyphChanged;
FGlyphCoordinates := TGlyphCoordinates.Create;
FGlyphCoordinates.OnChange := CoordinatesChanged;
FState := bs_Normal;
FColor := clBtnFace;
FActiveColor := clGradientActiveCaption;
FDownColor := clHighlight;
FBorderColor := clBlue;
FFlat := False;
FTransparent := False;
SetBounds(0, 0, 200, 50);
end;
Destructor TNCRSpeedButton.Destroy;
begin
FGlyph.Free;
FGlyphCoordinates.Free;
inherited;
end;
procedure CreateMask(aCanvas: TCanvas; Area: TRect; aColor: Tcolor);
var
EBitmap, OBitmap: TBitmap;
begin
EBitmap := TBitmap.Create;
OBitmap := TBitmap.Create;
try
EBitmap.Width := Area.Width ;
EBitmap.Height := Area.Height;
EBitmap.Canvas.CopyRect(Area, aCanvas, Area);
OBitmap.Width := Area.Width;
OBitmap.Height := Area.Height;
OBitmap.Canvas.CopyRect(Area, aCanvas, Area);
OBitmap.Canvas.Brush.Color := aColor;
OBitmap.Canvas.Pen.Style := psClear;
OBitmap.Canvas.Rectangle(Area);
aCanvas.Draw(0, 0, EBitmap);
aCanvas.Draw(0, 0, OBitmap, 127);
finally
EBitmap.free;
OBitmap.free;
end;
end;
procedure DrawParentImage(Control: TControl; Dest: TCanvas);
var
SaveIndex: Integer;
DC: HDC;
Position: TPoint;
begin
with Control do
begin
if Parent = nil then
Exit;
DC := Dest.Handle;
SaveIndex := SaveDC(DC);
GetViewportOrgEx(DC, Position);
SetViewportOrgEx(DC, Position.x - Left, Position.y - Top, nil);
IntersectClipRect(DC, 0, 0, Parent.ClientWidth, Parent.ClientHeight);
Parent.Perform(WM_ERASEBKGND, DC, 0);
Parent.Perform(WM_PAINT, DC, 0);
RestoreDC(DC, SaveIndex);
end;
end;
procedure TNCRSpeedButton.Paint;
var
BackgroundColor: TColor;
begin
case FState of
bs_Down: BackgroundColor := FDownColor;
bs_Normal: BackgroundColor := FColor;
bs_Active: BackgroundColor := FActiveColor;
else
BackgroundColor := FColor;
end;
// Drawing Background
if not FTransparent then
begin
Canvas.Brush.Color := BackgroundColor;
Canvas.FillRect(ClientRect);
end
else
begin
case FState of
bs_Down:
begin
DrawParentImage(parent, Canvas);
CreateMask(Canvas, ClientRect, FDownColor);
end;
bs_Normal:
begin
DrawParentImage(parent, Canvas);
end;
bs_Active:
begin
DrawParentImage(parent, Canvas);
CreateMask(Canvas, ClientRect, FActiveColor);
end;
end;
end;
// Drawing Borders
Canvas.Pen.Color := FBorderColor;
Canvas.MoveTo(0, 0);
if not FFlat then
begin
Canvas.LineTo(Width-1, 0);
Canvas.LineTo(Width-1, Height-1);
Canvas.LineTo(0, Height-1);
Canvas.LineTo(0, 0);
end;
// Drawing the Glyph
if (FGlyph.Graphic <> nil) and (not FGlyph.Graphic.Empty) then
begin
Canvas.Draw(FGlyphCoordinates.X, FGlyphCoordinates.Y, FGlyph.Graphic);
end;
end;
procedure TNCRSpeedButton.GlyphChanged(Sender: TObject);
begin
if (FGlyph.Graphic <> nil) and (not FGlyph.Graphic.Empty) then
begin
FGlyphCoordinates.OnChange := nil; // Prevent multiple invalidates
FGlyphCoordinates.X := (Width - FGlyph.Graphic.Width) div 2;
FGlyphCoordinates.Y := (Height - FGlyph.Graphic.Height) div 2;
FGlyphCoordinates.OnChange := CoordinatesChanged;
end;
Invalidate;
end;
procedure TNCRSpeedButton.CoordinatesChanged(Sender: TObject);
begin
Invalidate;
end;
procedure TNCRSpeedButton.CMMouseEnter(var Message: TMessage);
begin
inherited;
FState := bs_Active;
Invalidate;
end;
procedure TNCRSpeedButton.CMMouseLeave(var Message: TMessage);
begin
inherited;
FState := bs_Normal;
Invalidate;
end;
procedure TNCRSpeedButton.CMMouseDown(var Message: TMessage);
begin
inherited;
FState := bs_Down;
Invalidate;
end;
procedure TNCRSpeedButton.CMMouseUp(var Message: TMessage);
begin
inherited;
FState := bs_Active;
Invalidate;
end;
procedure TNCRSpeedButton.SetGlyph(aGlyph: TPicture);
begin
FGlyph.Assign(aGlyph);
end;
procedure TNCRSpeedButton.Resize;
begin
if (FGlyph.Graphic <> nil) and (not FGlyph.Graphic.Empty) then
begin
FGlyphCoordinates.OnChange := nil; // Prevent multiple invalidates
FGlyphCoordinates.X := (Width - FGlyph.Graphic.Width) div 2;
FGlyphCoordinates.Y := (Height - FGlyph.Graphic.Height) div 2;
FGlyphCoordinates.OnChange := CoordinatesChanged;
end;
inherited;
end;
procedure TNCRSpeedButton.SetGlyphCoordinates(aCoordinates: TGlyphCoordinates);
begin
FGlyphCoordinates.assign(aCoordinates);
end;
procedure TNCRSpeedButton.SetColor(aColor: TColor);
begin
FColor := aColor;
Invalidate;
end;
procedure TNCRSpeedButton.SetActiveColor(aActiveColor: TColor);
begin
FActiveColor := aActiveColor;
Invalidate;
end;
procedure TNCRSpeedButton.SetDownColor(aDownColor: TColor);
begin
FDownColor := aDownColor;
Invalidate;
end;
procedure TNCRSpeedButton.SetBorderColor(aBorderColor: TColor);
begin
FBorderColor := aBorderColor;
Invalidate;
end;
procedure TNCRSpeedButton.SetFlat(aValue: boolean);
begin
FFlat := aValue;
Invalidate;
end;
procedure TNCRSpeedButton.SetTransparency(aValue: boolean);
begin
FTransparent := aValue;
Invalidate;
end;
{TGlyphCoordinates}
procedure TGlyphCoordinates.SetX(aX: integer);
begin
FX := aX;
if Assigned(FOnChange) then
FOnChange(self);
end;
procedure TGlyphCoordinates.SetY(aY: integer);
begin
FY := aY;
if Assigned(FOnChange) then
FOnChange(self);
end;
function TGlyphCoordinates.GetX: integer;
begin
result := FX;
end;
function TGlyphCoordinates.GetY: integer;
begin
result := FY;
end;
procedure TGlyphCoordinates.assign(aValue: TPersistent);
begin
if aValue is TGlyphCoordinates then begin
FX := TGlyphCoordinates(aValue).FX;
FY := TGlyphCoordinates(aValue).FY;
end else
inherited;
end;
end.

Answer 3

The first part is about how the Glyph property of TSpeedButton works, as you seem to be asking that as a part of your problem.
While TSpeedButton's FGlyph field is declared as an TObject, you will find that in code it actually contains an instance of TButtonGlyph.
In the TSpeedButton constructor you will find the line FGlyph := TButtonGlyph.Create;
and the setter and getter for the Glyph property of TSpeedButton look like this:
function TSpeedButton.GetGlyph: TBitmap;
begin
Result := TButtonGlyph(FGlyph).Glyph;
end;
procedure TSpeedButton.SetGlyph(Value: TBitmap);
begin
TButtonGlyph(FGlyph).Glyph := Value;
Invalidate;
end;
So TSpeedButton's Glyph property actually accesses the Glyph property of the TButtonGlyph class, an internal class defined in Vcl.Buttons, which encapsulates - among other things - the actual TBitMap with following property
property Glyph: TBitmap read FOriginal write SetGlyph;
So the TButtonGlyph has an TBitMap field FOriginal and the setter is implemented like this:
procedure TButtonGlyph.SetGlyph(Value: TBitmap);
var
Glyphs: Integer;
begin
Invalidate;
FOriginal.Assign(Value);
if (Value <> nil) and (Value.Height > 0) then
begin
FTransparentColor := Value.TransparentColor;
if Value.Width mod Value.Height = 0 then
begin
Glyphs := Value.Width div Value.Height;
if Glyphs > 4 then Glyphs := 1;
SetNumGlyphs(Glyphs);
end;
end;
end;
At this point it is important how accepts .PNG is defined:
Being able to use the PNG image, with some trade-offs.
Fully supports PNG images
For the latter I believe the answer of Remy Lebeau is the best advice. The internal class TButtonGylph makes OOP approaches like inheritance with png capable class impossible as far as I see. Or even go further and do as Remy suggests in a comment: third-party component.
If trade-offs are acceptable however:
Note the FOriginal.Assign(Value); which can already help in using PNGs, as TPNGImage's AssignTo procedure knows how to assign itself to a TBitMap.
With the above known about the Glyph property, we can simply assign a PNG with the following code:
var
APNG: TPngImage;
begin
APNG := TPngImage.Create;
try
APNG.LoadFromFile('C:\Binoculars.png');
SpeedButton1.Glyph.Assign(APNG);
finally
APNG.Free;
end;
Due to differences between bitmap and PNG this might however ignore alpha channel of the PNG, but based on an answer from Andreas Rejbrand there is a partial solution for that:
var
APNG: TPngImage;
ABMP: TBitmap;
begin
APNG := TPngImage.Create;
ABMP := TBitmap.Create;
try
APNG.LoadFromFile('C:\Binoculars.png');
ABMP.SetSize(APNG.Width, APNG.Height);
ABMP.Canvas.Brush.Color := Self.Color;
ABMP.Canvas.FillRect(Rect(0, 0, ABMP.Width, ABMP.Height));
ABMP.Canvas.Draw(0, 0, APNG);
SpeedButton1.Glyph.Assign(APNG);
finally
APNG.Free;
ABMP.Free;
end;
end;