Файл: Изменить цвет TButton.doc

{

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