Przycisk Delphi z obrazem tła

Question

Mam Delphi 7 i teraz zainstalowałem Delphi XE2. Nie mam doświadczenia w projektowaniu, VCL itp., Ale chciałbym mieć przycisk (z podpisem!) I prosty obraz tła (PNG). Mam 3 zdjęcia niestandardowych przycisków (1 dla kliknięcia, 1 dla przesunięcia myszy i 1 dla przesunięcia kursora myszy). Próbowałem prawie wszystkiego, ale nie mogę znaleźć sposobu na prosty przycisk z napisem po środku i obrazami w tle. Proszę pomóż.

PS .: Przycisk powinien wizualnie nie zejść na kliknięcie (to już w PNG.)

Answer 1

Można dostosować ten mały element, nie trzeba instalować do testowania

Test:

procedure TForm1.MyOnClick(Sender: TObject); 
begin 

    ShowMessage('Hallo'); 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
    With TImageButton.Create(self) do 
     begin 
     parent := Self; 
     images := Imagelist1; 
     index := 0; 
     hoverindex := 1; 
     DownIndex := 2; 
     Caption := 'test'; 
     OnClick := MyOnClick; 
     Width := Imagelist1.Width; 
     Height := Imagelist1.Height; 
     Font.Size := 12; 
     Font.Style := [fsBold]; 
     end; 
end; 

i kod:

unit ImageButton; 

// 2013 bummi 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    ExtCtrls, StdCtrls,ImgList; 

Type 

    TState = (MouseIn, MouseOut, Pressed); 

    TImageButton = class(TGraphicControl) 
    private 
    FChangeLink:TChangeLink; 
    FImages: TCustomImageList; 
    FDownIndex: Integer; 
    FIndex: Integer; 
    FHoverIndex: Integer; 
    FState: TState; 
    FCaption: String; 
    FOwner: TComponent; 
    FAutoWidth: Boolean; 
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; 
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; 
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED; 
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; 
    procedure WMLBUTTONDOWN(var Message: TMessage); message WM_LBUTTONDOWN; 
    procedure WMLBUTTONUP(var Message: TMessage); message WM_LBUTTONUP; 
    procedure SetDownIndex(const Value: Integer); 
    procedure SetHoverIndex(const Value: Integer); 
    procedure SetIndex(const Value: Integer); 
    procedure SetImages(const Value: TCustomImageList); 
    procedure SetCaption(const Value: String); 
    procedure ImagelistChange(Sender: TObject); 
    procedure SetAutoWidth(const Value: Boolean); 
    procedure CheckAutoWidth; 
    protected 
    procedure Paint; override; 
    public 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; Override; 
    published 
    property AutoWidth:Boolean read FAutoWidth Write SetAutoWidth; 
    property Caption; 
    property DownIndex: Integer read FDownIndex Write SetDownIndex; 
    property Font; 
    property HoverIndex: Integer read FHoverIndex Write SetHoverIndex; 
    property Images: TCustomImageList read FImages write SetImages; 
    property Index: Integer read FIndex Write SetIndex; 
    End; 

procedure Register; 

implementation 

procedure TImageButton.ImagelistChange(Sender:TObject); 
begin 
    invalidate; 
    CheckAutoWidth; 
end; 

Constructor TImageButton.create(AOwner: TComponent); 
begin 
    inherited Create(AOwner); 
    FOwner := AOwner; 
    FState := MouseOut; 
    Width := 200; 
    Height := 200; 
    FChangeLink:=TChangeLink.Create; 
    FChangeLink.OnChange := ImagelistChange; 
end; 

Destructor TImageButton.Destroy; 
begin 
    if Assigned(FImages) then FImages.UnRegisterChanges(FChangeLink); 
    FChangeLink.Free; 
    inherited Destroy; 
end; 

procedure TImageButton.Paint; 
var 
    ico: TIcon; 
    idx: Integer; 
    DestRect: TRect; 
    L_Caption: String; 
begin 
    inherited; 
    idx := -1; 
    if Assigned(FImages) then 
    begin 
    case FState of 
     MouseIn: 
     if FImages.Count > HoverIndex then 
      idx := HoverIndex; 
     MouseOut: 
     if FImages.Count > Index then 
      idx := Index; 
     Pressed: 
     if FImages.Count > DownIndex then 
      idx := DownIndex; 
    end; 
    if idx > -1 then 
     try 
     ico := TIcon.create; 
     FImages.GetIcon(idx, ico); 
     Canvas.Draw(0, 0, ico); 
     finally 
     ico.Free; 
     end; 
    end 
    else 
    begin 
    Canvas.Rectangle(ClientRect); 
    end; 
    Canvas.Brush.Style := bsClear; 
    DestRect := ClientRect; 
    L_Caption := Caption; 
    Canvas.Font.Assign(Font); 
    Canvas.TextRect(DestRect, L_Caption, [tfVerticalCenter, tfCenter, tfSingleLine]); 
end; 


procedure TImageButton.CheckAutoWidth; 
begin 
    if FAutoWidth and Assigned(FImages) then 
    begin 
     Width := FImages.Width; 
     Height := FImages.Height; 
    end; 

end; 

procedure TImageButton.SetAutoWidth(const Value: Boolean); 
begin 
    FAutoWidth := Value; 
    CheckAutoWidth; 
end; 

procedure TImageButton.SetCaption(const Value: String); 
begin 
    FCaption := Value; 
    Invalidate; 
end; 

procedure TImageButton.SetDownIndex(const Value: Integer); 
begin 
    FDownIndex := Value; 
    Invalidate; 
end; 

procedure TImageButton.SetHoverIndex(const Value: Integer); 
begin 
    FHoverIndex := Value; 
    Invalidate; 
end; 

procedure TImageButton.SetImages(const Value: TCustomImageList); 
begin 
    if Assigned(FImages) then FImages.UnRegisterChanges(FChangeLink); 
    FImages := Value; 
    if Assigned(FImages) then 
     begin 
     FImages.RegisterChanges(FChangeLink); 
     FImages.FreeNotification(FOwner); 
     CheckAutoWidth; 
     end; 
    Invalidate; 
end; 

procedure TImageButton.SetIndex(const Value: Integer); 
begin 
    FIndex := Value; 
    Invalidate; 
end; 

procedure TImageButton.WMLBUTTONDOWN(var Message: TMessage); 
begin 
    inherited; 
    FState := Pressed; 
    Invalidate; 
end; 

procedure TImageButton.WMLBUTTONUP(var Message: TMessage); 
begin 
    inherited; 
    FState := MouseIn; 
    Invalidate; 
end; 

procedure TImageButton.CMFontChanged(var Message: TMessage); 
begin 
    Invalidate; 
end; 

Procedure TImageButton.CMMouseEnter(var Message: TMessage); 
Begin 
    inherited; 
    if (csDesigning in ComponentState) then 
    Exit; 
    if FState <> MouseIn then 
    begin 
    FState := MouseIn; 
    Invalidate; 
    end; 
end; 

Procedure TImageButton.CMMouseLeave(var Message: TMessage); 
Begin 
    inherited; 
    if (csDesigning in ComponentState) then 
    Exit; 
    if FState <> MouseOut then 
    begin 
    FState := MouseOut; 
    Invalidate; 
    end; 
end; 

procedure TImageButton.CMTextChanged(var Message: TMessage); 
begin 
    invalidate; 
end; 

procedure Register; 
begin 
    RegisterComponents('Own', [TImageButton]) 
end; 

end. 

uszanuje folie czy stosowanie z PNG i Imagelist cd32Bit

Answer 2

można dziedziczyć TBitBtn i zastąpić CN_DRAWITEM wiadomość obsługi - to stworzy całkowicie normalny przycisk z naciskiem, z dowolne obrazy potrzebne jako tło i wszystkie komunikaty w oknach, których przyciski potrzebują (zobacz wiadomości BM_XXX). Można również zaimplementować wirtualną metodę wykonywania innych rodzajów przycisków, przy jednoczesnym zastąpieniu tej metody.

Coś takiego:

TOwnerDrawBtn = class(TBitBtn) 
private 
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM; 
    procedure CMFocusChanged(var Message: TMessage); message CM_FOCUSCHANGED; 
protected 
    procedure DrawButton(const DrawItemStruct: TDrawItemStruct); virtual; 
end; 

procedure TOwnerDrawBtn.CNDrawItem(var Message: TWMDrawItem); 
begin 
    DrawButton(Message.DrawItemStruct^); 
    Message.Result := Integer(True); 
end; 

procedure TOwnerDrawBtn.CMFocusChanged(var Message: TMessage); 
begin 
    inherited; 
    Invalidate; 
end; 

procedure TOwnerDrawBtn.DrawButton(const DrawItemStruct: TDrawItemStruct); 
var 
    Canvas: TCanvas; 
begin 
    Canvas := TCanvas.Create; 
    try 
    Canvas.Handle := DrawItemStruct.hDC; 

    //do any drawing here 
    finally 
    Canvas.Handle := 0; 
    Canvas.Free; 
    end; 
end; 

Answer 3

można po prostu użyć TJvTransparentButton z JEDI-Project JVCL.
Za pomocą tego komponentu można użyć pojedynczego obrazu dla wszystkich zdarzeń i wszystkich innych przycisków, więcej zdarzeń ze stanem obrazu, innym stylem, podpisem, glifem, naciśnięciem przycisku i ....