創建接受。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圖像作爲雕文

回答

相關問題