Canvas + OnDraw-Event für Buttons

[taaktaak]

Moin, Moin.
Habe heute in der Mittagspause mal ein wenig gebastelt. Gedanke war, auf einem TButton / TBitBtn / TSpeedbutton beliebig auf einem Canvas malen zu können - so etwas habe ich hier nicht gefunden. Herausgekommen ist folgendes kleines Testprogramm. Vielleicht kann das noch verbessert oder auch von Anderen verwendet werden:

Delphi-Quellcode:

unit test16_u1;

interface { ----------------------------------------------------------------- }

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

type TBitBtn = class(Buttons.TBitBtn)

                private

                 FCanvas                : TControlCanvas;
                 FShowFocus             : Boolean;
                 FOnDraw                : TNotifyEvent;

                 procedure   CNDrawItem (var Message:TWMDrawItem); message CN_DRAWITEM;
                 procedure   WMPaint    (var Message:TWMPaint);    message WM_PAINT;

                public

                 property    Canvas     : TControlCanvas read FCanvas    write FCanvas;
                 property    OnDraw     : TNotifyEvent   read FOnDraw    write FOnDraw;
                 property    ShowFocus  : Boolean        read FShowFocus write FShowFocus;

                 constructor Create     (AOwner:TComponent); override;
                 destructor  Destroy;                        override;

                end;

      TfoTest16 = class(TForm)

                   BitBtn1                   : TBitBtn;
                   CheckBox1                 : TCheckBox;

                   procedure OnDrawBitButton (Sender:TObject);
                   procedure CheckBox1Click  (Sender:TObject);
                   procedure FormCreate      (Sender:TObject);

                   private
                   public
                   end;

var  foTest16  : TfoTest16;

implementation { ------------------------------------------------------------ }

{$R *.DFM}

constructor TBitBtn.Create(AOwner:TComponent);
begin
  inherited;
  FCanvas:=TControlCanvas.Create;
  FCanvas.Control:=TControl(Self);
  FShowFocus:=true;
  FOnDraw   :=nil
end;

procedure TBitBtn.WMPaint(var Message:TWMPaint);
begin
  inherited;
  if Assigned(FOnDraw) then FOnDraw(Self)
end;

procedure TBitBtn.CNDrawItem(var Message:TWMDrawItem);
begin
  if not(FShowFocus) then                      
    with Message.DrawItemStruct^ do
      ItemState:=(ItemState and not(ODS_Focus));
  inherited;
  if Assigned(FOnDraw) then FOnDraw(Self)
end;

destructor TBitBtn.Destroy;
begin
  FreeAndNil(FCanvas);
  inherited
end;

// ----------------------------------------------------------------------------

procedure TfoTest16.FormCreate(Sender:TObject);
begin
  BitBtn1.OnDraw   :=OnDrawBitButton;
  BitBtn1.ShowFocus:=true;
  Checkbox1.Checked:=BitBtn1.ShowFocus;
end;

procedure TfoTest16.OnDrawBitButton(Sender:TObject);
begin
  with TBitBtn(Sender).Canvas do begin
    Pen.Width:=3;
    Pen.Color:=clRed;
    MoveTo( 0, 0);    // sinnfrei und nur
    LineTo(30,30);    // beispielhaft 
    end
end;

procedure TfoTest16.CheckBox1Click(Sender:TObject);
begin
  BitBtn1.ShowFocus:=Checkbox1.Checked
end;

end.

Die Ergänzung um das optionale "Verstecken" des Fokusrechtecks ist an anderer Stelle hier in DP schon von Hawkeye219 vorgestellt worden.