TButton Farbe

[Hansa]

So geht es jedenfalls, fragt mich nur nicht, wo das her ist, die WinApi ist mir zwar fast unbekannt, aber Assarbards ??OwnerDraw ist irgendwo drin:

Delphi-Quellcode:

unit colorbutton;

interface 

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

type 
  TDrawButtonEvent = procedure(Control: TWinControl; 
    Rect: TRect; State: TOwnerDrawState) of object; 

  TColorButton = class(TButton) 
  private 
    FCanvas: TCanvas; 
    IsFocused: Boolean; 
    FOnDrawButton: TDrawButtonEvent; 
  protected 
    procedure CreateParams(var Params: TCreateParams); override; 
    procedure SetButtonStyle(ADefault: Boolean); override; 
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; 
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; 
    procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM; 
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM; 
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; 
    procedure DrawButton(Rect: TRect; State: UINT); 
  public 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; 
    property Canvas: TCanvas read FCanvas; 
  published 
    property OnDrawButton: TDrawButtonEvent read FOnDrawButton write FOnDrawButton; 
    property Color; 
  end; 

procedure Register; 

implementation 

procedure Register; 
begin 
  RegisterComponents('Samples', [TColorButton]); 
end; 

constructor TColorButton.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner); 
  FCanvas := TCanvas.Create; 
end; 

destructor TColorButton.Destroy; 
begin 
  inherited Destroy; 
  FCanvas.Free; 
end; 

procedure TColorButton.CreateParams(var Params: TCreateParams); 
begin 
  inherited CreateParams(Params); 
  with Params do Style := Style or BS_OWNERDRAW; 
end; 

procedure TColorButton.SetButtonStyle(ADefault: Boolean); 
begin 
  if ADefault <> IsFocused then 
  begin 
    IsFocused := ADefault; 
    Refresh; 
  end; 
end; 

procedure TColorButton.CNMeasureItem(var Message: TWMMeasureItem); 
begin 
  with Message.MeasureItemStruct^ do 
  begin 
    itemWidth  := Width; 
    itemHeight := Height; 
  end; 
end; 

procedure TColorButton.CNDrawItem(var Message: TWMDrawItem); 
var 
  SaveIndex: Integer; 
begin 
  with Message.DrawItemStruct^ do 
  begin 
    SaveIndex := SaveDC(hDC); 
    FCanvas.Lock; 
    try 
      FCanvas.Handle := hDC; 
      FCanvas.Font := Font; 
      FCanvas.Brush := Brush; 
      DrawButton(rcItem, itemState); 
    finally 
      FCanvas.Handle := 0; 
      FCanvas.Unlock; 
      RestoreDC(hDC, SaveIndex); 
    end; 
  end; 
  Message.Result := 1; 
end; 

procedure TColorButton.CMEnabledChanged(var Message: TMessage); 
begin 
  inherited; 
  Invalidate; 
end; 

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

procedure TColorButton.WMLButtonDblClk(var Message: TWMLButtonDblClk); 
begin 
  Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos)); 
end; 

procedure TColorButton.DrawButton(Rect: TRect; State: UINT); 
var 
  Flags, OldMode: Longint; 
  IsDown, IsDefault, IsDisabled: Boolean; 
  OldColor: TColor; 
  OrgRect: TRect; 
begin 
  OrgRect := Rect; 
  Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT; 
  IsDown := State and ODS_SELECTED <> 0; 
  IsDefault := State and ODS_FOCUS <> 0; 
  IsDisabled := State and ODS_DISABLED <> 0; 

  if IsDown then Flags := Flags or DFCS_PUSHED; 
  if IsDisabled then Flags := Flags or DFCS_INACTIVE; 

  if IsFocused or IsDefault then 
  begin 
    FCanvas.Pen.Color := clWindowFrame; 
    FCanvas.Pen.Width := 1; 
    FCanvas.Brush.Style := bsClear; 
    FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); 
    InflateRect(Rect, - 1, - 1); 
  end; 

  if IsDown then 
  begin 
    FCanvas.Pen.Color := clBtnShadow; 
    FCanvas.Pen.Width := 1; 
    FCanvas.Brush.Color := clBtnFace; 
    FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); 
    InflateRect(Rect, - 1, - 1); 
  end 
  else 
    DrawFrameControl(FCanvas.Handle, Rect, DFC_BUTTON, Flags); 

  if IsDown then OffsetRect(Rect, 1, 1); 

  OldColor := FCanvas.Brush.Color; 
  FCanvas.Brush.Color := Color; 
  FCanvas.FillRect(Rect); 
  FCanvas.Brush.Color := OldColor; 
  OldMode := SetBkMode(FCanvas.Handle, TRANSPARENT); 
  FCanvas.Font.Color := clBtnText; 
  if IsDisabled then 
    DrawState(FCanvas.Handle, FCanvas.Brush.Handle, nil, Integer(Caption), 0, 
    ((Rect.Right - Rect.Left) - FCanvas.TextWidth(Caption)) div 2, 
    ((Rect.Bottom - Rect.Top) - FCanvas.TextHeight(Caption)) div 2, 
      0, 0, DST_TEXT or DSS_DISABLED) 
  else 
    DrawText(FCanvas.Handle, PChar(Caption), - 1, Rect, 
      DT_SINGLELINE or DT_CENTER or DT_VCENTER); 
  SetBkMode(FCanvas.Handle, OldMode); 

  if Assigned(FOnDrawButton) then 
    FOnDrawButton(Self, Rect, TOwnerDrawState(LongRec(State).Lo)); 

  if IsFocused and IsDefault then 
  begin 
    Rect := OrgRect; 
    InflateRect(Rect, - 4, - 4); 
    FCanvas.Pen.Color := clWindowFrame; 
    FCanvas.Brush.Color := clBtnFace; 
    DrawFocusRect(FCanvas.Handle, Rect); 
  end; 
end; 

end.

Also gehen tut es, was weiß ich warum ?

[edit=Daniel B]Delphi-Tags eingefügt. MfG Daniel B.[/edit]