创建接受。PNG图像作为雕文

我想明白是怎么SpeedButtonGlyph性质的工作，我发现场宣布一个按钮：创建接受。PNG图像作为雕文

FGlyph: TObject;

虽然property为：

property Glyph: TBitmap read GetGlyph write SetGlyph stored HasCustomGlyph;

这让我的方式，我不明白，即使我一行行读它的代码，当我试图创建自己的SpeedButton仅接受.PNG图像，而不是.bmp图像。

我第一次想要宣布财产为TPicture而不是TBitmap。

有没有什么办法可以用Glyph : TPicture来创建MySpeedButton？

我试试下面是：

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;

来源

2017-10-15 Sami

我已经创建了一个类似的组件，它是一个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.

来源

2017-10-17 18:29:02

你SetGlyph()需要调用FGlyph.Assign(Value)而不是FGlyph := Value。一定要在构造函数中创建FGlyph，并在析构函数中销毁它。然后，当Graphic非空时，您可以调用绘制图形覆盖Paint()。

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;

来源

2017-10-15 18:02:48

非常感谢Remy，这段代码没有任何错误，但是我看不到窗体上的按钮或加载的图像。 – Sami

@Sami是否在绘制'Paint'中的按钮的其余部分？当你重写'Paint'时，你必须绘制所有的东西，包括背景，边框，文本等 –

不，我所做的全部是'Canvas.Draw（0,0，FGlyph.Graphic）;'，并且在设置顶部和左侧为0按钮显示在窗体中，但它看起来像一个图像（没有按下效果）。 – Sami

，第一部分是关于TSpeedButton工程，Glyph财产你似乎怎么会问，当你的问题的一部分。

虽然TSpeedButton的FGlyph字段被声明为TObject，但您会发现在代码中它实际上包含TButtonGlyph的实例。在TSpeedButton构造你会发现财产TSpeedButtonGlyph外观类似的行FGlyph := TButtonGlyph.Create; 和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并且设置器是这样实现的：

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使OOP方法像png有效类一样继承。甚至可以像雷米在评论中所建议的那样进一步去做：第三方组件。

如果权衡取舍但是可以接受的：

注意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通道之间的差异，但基于一个answer从安德烈亚斯Rejbrand存在用于该部分解决方案：

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;

来源

2017-10-16 11:25:49 nil

创建接受。PNG图像作为雕文

回答

相关问题