谁能帮我把这个TcolorButton程序做一个注解,谢谢!(100分)

  • 主题发起人 pp800607
  • 开始时间
P

pp800607

Unregistered / Unconfirmed
GUEST, unregistred user!
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('MyVcl', [TColorButton]);
end;
-----------------------------------------------------------------------------------------
constructor TColorButton.Create(AOwner: TComponent);
inherited Create(AOwner);
FCanvas := TCanvas.Create;
-----------------------------------------------------------------------------------------
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.
 
析构函数中最好先Free,然后在继承。
一点儿个人意见,呵呵,请高手来注解
 
这是我见到的第3个ColoButton版本,在:www.play.icq有两个
 
//太长了
而且Create函数没有Begin和End
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;//Enabled 变化的消息
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
//画Button的事件

property Color;
end;

procedure Register;
implementation

procedure Register;
begin
RegisterComponents('MyVcl', [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.
 
顶部