{

  You cannot change the color of a standard TButton,

  since the windows button control always paints itself with the

  button color defined in the control panel.

  But you can derive derive a new component from TButton and handle

  the and drawing behaviour there.

 

}

 

 

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.