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.

[Forlan]

Find ich gut

Sowas hab ich vor Jahren mal gesucht, konnte es aber nicht finden bzw. selber implementieren damals.

[himitsu]

vielleicht noch sowas ... dann muß nicht immer selber in gecastet und das Canvas gesucht werden

Delphi-Quellcode:

type TControlDrawEvent = procedure(Sender: TObject; Canvas: TCanvas) of object;

property OnDraw : TControlDrawEvent

TCanvas ist wirklich gemeint, TControlCanvas ist ja davon abgeleitet und die Funktionen dieses Vorfahren reichen ja an dieser Stelle vollkommen aus.

[taaktaak]

Ok, den ersten Teil verstehe ich:
Da wir bequeme Leute sind, definieren wir ein spezielles Event, das den Canvas mitgibt, damit entfällt das casten.

Aber dann:
TCanvas anstatt TControlCanvas verwenden?
Hmm, wie schaut's in OnCreate() aus?

 TCanvas.Control:=TControl(Self) funktioniert dann ja nicht mehr?


EDIT: Oder bezieht sich die Bemerkung nur auf den Typ in der Parameterzeile des Events?

[himitsu]

Es würde zwar auch nur im Event reichen, aber du kannst auch überall gleich TCanvas nehmen, da du zusätzliche Funktionalitäten von TControlCanvas ja eh nur an einer Stelle nutzt.

und dann nur noch

Code:

FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := [color=silver]TControl([/color]Self[color=silver])[/color];

Der User braucht ja nur die Funktionen von TCanvas
und viele kennen TControlCanvas nicht, da ist es mit TCanvas auch verständlicher.

[taaktaak]

Zitat:

da ist es mit TCanvas auch verständlicher

Ja, sehe ich auch so - es erscheint dann konsistenter!

PS:

Hatte es der Vollständigkeit halber auch noch mal mit TButton umsetzen wollen. Da funktioniert das Verfahren nicht: Bei Erhalt/Verlust des Fokus wird augenscheinlich nicht die Message CN_DRAWITEM aufgerufen. Da man aber den TButton immer durch TBitBtn ersetzen kann (oder?), ist das ja nicht weiter tragisch.

[himitsu]

die VCL verschickt beim Button (weiß aber nicht, ob auch schon in D7) CM_ENTER und CM_EXIT, wenn der Button den Fokus bekommt und verliert.

[edit]
CM_ENTER = WM_SETFOCUS