创建一个接受.PNG图像为Glyph的按钮

Question

我试图了解SpeedButton Glyph属性是如何工作的，我发现字段声明为：

FGlyph: TObject;

而property是：

property Glyph: TBitmap read GetGlyph write SetGlyph stored HasCustomGlyph;

这让我无法理解这段代码，即使我逐行阅读它，当我试图创建我自己的SpeedButton时，它也接受.PNG映像，而不是只接受.bmp图像。

这是我第一次考虑将属性声明为TPicture而不是TBitmap。

有没有办法用MySpeedButton创建Glyph : TPicture？

我试着做以下几点：

TMyButton = class(TSpeedButton)
    private
     //
    FGlyph: TPicture;
    procedure SetGlyph(const Value: TPicture);
    protected
    //
    public
    //
    published
    //
      Property Glyph : TPicture read FGlyph write SetGlyph;
  end;

以及程序：

procedure TMyButton.SetGlyph(const Value: TPicture);
begin
  FGlyph := Value;
end;

Answer 1

我已经创建了一个类似的组件，它是一个SpeedButton，它接受一个TPicture作为它的字形。

这是单位。我希望你能从中受益。

    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 2

您的SetGlyph()需要调用FGlyph.Assign(Value)而不是FGlyph := Value。确保在构造函数中创建FGlyph并在析构函数中销毁它。然后，当Paint()不为空时，可以调用overriden Graphic中的绘图。

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 3

第一部分是关于Glyph属性TSpeedButton是如何工作的，因为您似乎在问这是问题的一部分。

当TSpeedButton的FGlyph字段声明为TObject时，您会发现在代码中它实际上包含了TButtonGlyph的一个实例。在TSpeedButton构造函数中，您将发现FGlyph := TButtonGlyph.Create;行以及TSpeedButton的Glyph属性的setter和getter如下所示：

function TSpeedButton.GetGlyph: TBitmap;
begin
  Result := TButtonGlyph(FGlyph).Glyph;
end;

procedure TSpeedButton.SetGlyph(Value: TBitmap);
begin
  TButtonGlyph(FGlyph).Glyph := Value;
  Invalidate;
end;

因此，TSpeedButton的Glyph属性实际上访问了TButtonGlyph类的Glyph属性，这是在Vcl.Buttons中定义的一个内部类，它封装--除其他外--具有以下属性的实际TBitMap。

property Glyph: TBitmap read FOriginal write SetGlyph;

因此，TButtonGlyph有一个TBitMap字段FOriginal，setter的实现方式如下：

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;

在这一点上，如何定义接受.PNG是很重要的：

• 能够使用的PNG图像，以及一些权衡。
• 完全支持 PNG映像

对于后者，我相信雷米·莱博的回答是最好的建议。据我所见，内部类TButtonGylph使具有png能力的类的OOP方法(如继承)不可能实现。或者更进一步，如雷米在评论中所建议的那样:第三方组件。

然而，如果权衡是可以接受的，那么：

请注意，FOriginal.Assign(Value);已经可以帮助使用PNG，因为TPNGImage的AssignTo过程知道如何将自己分配给TBitMap。有了关于Glyph属性的上述知识，我们就可以使用以下代码分配PNG：

var
  APNG: TPngImage;
begin
  APNG := TPngImage.Create;
  try
    APNG.LoadFromFile('C:\Binoculars.png');
    SpeedButton1.Glyph.Assign(APNG);
  finally
    APNG.Free;
  end;

但是，由于位图和PNG之间的差异，这可能忽略PNG的alpha通道，但基于Andreas的answer，有一个部分解决方案：

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;