想做一个可改变颜色的TButton控件,请大虾教我(源码在内)(100分)

  • 主题发起人 主题发起人 月涌长云
  • 开始时间 开始时间

月涌长云

Unregistered / Unconfirmed
GUEST, unregistred user!
unit ColorButton;

interface

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

type
TColorButton = class(TButton)
private
{ Private declarations }
FColor:TColor;//表面颜色
protected
{ Protected declarations }
procedure SetColor(NewColor:TColor);virtual;
public
{ Public declarations }
constructor Create(AOwner:TComponent);override;
procedure Repaint;override;//是否重载错了方法?
published
{ Published declarations }
// property Color;
property Color:TColor read FColor write SetColor;
end;

procedure Register;

implementation

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

{-------下面为实现部分--------------}

constructor TColorButton.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
FColor:=ClBtnFace;
end;

procedure TColorButton.Repaint;
begin
Brush.Color:=FColor;
inherited Repaint;
end;

procedure TColorButton.SetColor(NewColor:TColor);
begin
FColor:=NewColor;
InvalidateRect(Handle,nil,True);
end;

{--------上面为实现部分------------}
 
为什么没有人回答呀?up
 
Tbutton 只是封装 Windows 标准的 Button,要改变颜色可以从 TBitButton 派生。
 
Windows标准的不可以派生吗?

为什么我从TBitBtn派生也不可以?请大侠指教

代码大同小异,如下:
unit ColorBitBtn;

interface

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

type
TColorBitBtn = class(TBitBtn)
private
{ Private declarations }
FColor:TColor;//表面颜色
protected
{ Protected declarations }
procedure SetColor(NewColor:TColor);virtual; //
public
{ Public declarations }
constructor Create(AOwner:TComponent);override;
procedure Repaint;override;//画表面
published
{ Published declarations }
// property Color;
property Color:TColor read FColor write SetColor;
end;

procedure Register;

implementation

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

{-------下面为实现部分--------------}

constructor TColorBitBtn.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
FColor:=ClGreen;
end;

procedure TColorBitBtn.Repaint;//是否重载的方法不对?
begin
Brush.Color:=FColor;
inherited Repaint;
end;

procedure TColorBitBtn.SetColor(NewColor:TColor);
begin
FColor:=NewColor;
InvalidateRect(Handle,nil,True);//这个用法正确吗?
end;

{--------上面为实现部分------------}

end.
 
>>Windows标准的不可以派生吗
当然可以,只不过你要自己画按钮!给你贴一段,你自己改吧。
TButton1=class(TButton)
private
FCanvas:TCanvas;
procedure CNDrawItem(var Msg:TWMDrawItem);message CN_DrawItem;

protected
procedure CreateParams(var Params:TCreateParams);override;
procedure SetButtonStyle(ADefault: Boolean); override;
public
constructor Create(AOwner:TComponent);override;
end;
implementation

{ TButton1 }


procedure TButton1.CNDrawItem(var Msg: TWMDrawItem);
var
OdsDown, OdsFocus, ActionFocus: Boolean;
Rect: TRect;
begin
FCanvas.Handle := Msg.DrawItemStruct^.hDC;
Rect := ClientRect;
with Msg.DrawItemStruct^ do
begin
OdsDown := itemState and ODS_SELECTED <> 0;
OdsFocus := itemState and ODS_FOCUS <> 0;
ActionFocus := ItemAction = oda_Focus
end;
with FCanvas do
begin
Brush.Color := clRed;
if not ActionFocus then
begin
Brush.Style := bsSolid;
FillRect (Rect);
end;
Brush.Style := bsClear;
InflateRect (Rect, - Width div 5, - Height div 5);
if OdsDown then
begin
Inc (Rect.Left, 2);
Inc (Rect.Top, 2);
end;
Font := Self.Font;
DrawText (FCanvas.Handle, PChar (Caption), -1,
Rect, dt_SingleLine or dt_Center or dt_VCenter);
Brush.Style := bsSolid;
Pen.Color:= clBlack;
Brush.Color := clWhite;
if OdsFocus or ActionFocus then
DrawFocusRect (Rect);
end;
FCanvas.Handle := 0;
Msg.Result := 1;
end;

constructor TButton1.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Caption:='Hello';
FCanvas:=TCanvas.Create;
end;

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



procedure TButton1.SetButtonStyle(ADefault: Boolean);
begin
Invalidate;
end;

end.
 
看了一下 VCL 的 Source,发现应该从 TButton 继承更方便,TBitBtn 的 CNDrawItem 消息
处理中把 Brush.color 都写死了。下面参考了 balaschen 和 Tbitbtn 的代码:
unit Button1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons;

type
TButton1 = class(TButton)
private
FColor: TColor;
FCanvas: TCanvas;
IsFocused: Boolean;
procedure SetColor(Value: TColor);
procedure DrawItem(const DrawItemStruct: TDrawItemStruct);
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;

procedure DrawButtonText(Canvas: TCanvas; const Caption: string;
TextBounds: TRect; State: TButtonState);

protected
procedure CreateParams(var Params: TCreateParams); override;
procedure SetButtonStyle(ADefault: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Color: TColor read FColor write SetColor default clBtnFace;
{ Published declarations }
end;

procedure Register;

implementation

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

{ TButton1 }

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

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

procedure TButton1.CNDrawItem(var Message: TWMDrawItem);
begin
DrawItem(Message.DrawItemStruct^);
end;

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

constructor TButton1.Create(AOwner: TComponent);
begin
inherited;
FCanvas := TCanvas.Create;
FColor := clBtnFace;
end;

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

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

procedure TButton1.DrawButtonText(Canvas: TCanvas; const Caption: string;
TextBounds: TRect; State: TButtonState);
begin
with Canvas do
begin
Brush.Style := bsClear;
if State = bsDisabled then
begin
OffsetRect(TextBounds, 1, 1);
Font.Color := clWhite;
DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, 0);
OffsetRect(TextBounds, -1, -1);
Font.Color := clDkGray;
DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, 0);
end else
DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
DT_CENTER or DT_VCENTER or DT_SINGLELINE);
end;
end;

procedure TButton1.DrawItem(const DrawItemStruct: TDrawItemStruct);
var
IsDown, IsDefault: Boolean;
State: TButtonState;
R: TRect;
begin
FCanvas.Handle := DrawItemStruct.hDC;
R := ClientRect;

with DrawItemStruct do
begin
IsDown := itemState and ODS_SELECTED <> 0;
IsDefault := itemState and ODS_FOCUS <> 0;
if not Enabled then State := bsDisabled
else if IsDown then State := bsDown
else State := bsUp;
end;

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

InflateRect(R, -1, -1);
end;

if IsDown then
begin
FCanvas.Pen.Color := clBtnShadow;
FCanvas.Pen.Width := 1;
FCanvas.Brush.Color := FColor;
FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
InflateRect(R, -1, -1);
end
else
with FCanvas do
begin
DrawEdge(Handle, R, BDR_RAISEDINNER or BDR_RAISEDOUTER, BF_RECT or BF_ADJUST);
FCanvas.Pen.Color := FColor;
FCanvas.Pen.Width := 1;
FCanvas.Brush.Color := FColor;
FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
InflateRect(R, -1, -1);
end;

if IsFocused then
begin
R := ClientRect;
InflateRect(R, -1, -1);
end;

FCanvas.Font := Self.Font;
if IsDown then
OffsetRect(R, 1, 1);
DrawButtonText(FCanvas, Caption, R, State);
if IsFocused then
begin
R := ClientRect;
InflateRect(R, -4, -4);
FCanvas.Pen.Color := clWindowFrame;
FCanvas.Brush.Color := FColor;
DrawFocusRect(FCanvas.Handle, R);
end;

FCanvas.Handle := 0;
end;

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

procedure TButton1.SetColor(Value: TColor);
begin
if FColor <> Value then
begin
FColor := Value;
Invalidate;
end;
end;
end.
基本是 copy TBitbtn 的源码。
 
OK,果然不错

感谢两位,顺便多问一句,VCL的Source在哪里可以看到?
 
就在 Delphi5 目录下的 Source 子目录里,不过要 Enterprise 或 Professional edition
才有的。
 
问一下CN_DRAWITEM,CN_MEASUREITEM,CM_FONTCHANGED,CM_ENABLEDCHANGED这些消息是在哪
里定义的,我在delphi的帮助和sdk里都找不到,还有前缀CN代表什么意思,是什么的缩写?
 
你可以在delphi中按下ctrl键,再用鼠标点击CN_DRAWITEM,delphi会自动帮你定位到它们所
在的单元.
CN:Control Notify
 
后退
顶部