我在做一个自定义组件,到处是错误? VCL组件开发及应用http://www.delphi2007.net/DelphiVCL/html/delphi_20061221101039230.html
我在做一个自定义组件,到处是错误?
我还是照着书上来的!
那位高手,帮我看看!
unit MyButton;
interface
uses
SysUtils, Classes, Controls, StdCtrls,Graphics,Messages,Types;
type
TMyButton = class(TButton)
private
FColor:TColor;
FCanvas:TCanvas;
IsFocused:Boolean;
SetColor:TColor;
procedure CNDrawItem(var CMessage: TWMDrawItem); message WM_DRAWITEM;
{ Private declarations }
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure SetButton(var ADefault:Boolean);
{ Protected declarations }
public
procedure Create(AOwner:TComponent);override;
procedure Destroy;override;
{ Public declarations }
published
property Color:TColor read FColor write SetColor default clWhite;
{ Published declarations }
end;
procedure Register;
implementation
procedure CNDrawItem(var CMessage: TWMDrawItem); message WM_DRAWITEM;
var
IsDown, IsDefault: Boolean;
ARect: TRect;
Flags: Longint;
DrawItemStruct: TDrawItemStruct;
wh:TSize;
begin
DrawItemStruct:=CMessage.DrawItemStruct^;
FCanvas.Handle := DrawItemStruct.hDC;
ARect := ClientRect;
with DrawItemStruct do
begin
IsDown := itemState and ODS_SELECTED <> 0;
IsDefault := itemState and ODS_FOCUS <> 0;
end;
Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
if IsDown then Flags := Flags or DFCS_PUSHED;
if DrawItemStruct.itemState and ODS_DISABLED <> 0 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(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
InflateRect(ARect, -1, -1);
end;
FCanvas.Pen.Color := clBtnShadow;
FCanvas.Pen.Width := 1;
FCanvas.Brush.Color := FColor;
if IsDown then begin
//按钮被按下时的状态绘制
FCanvas.Rectangle(ARect.Left , ARect.Top, ARect.Right, ARect.Bottom);
InflateRect(ARect, -1, -1);
end else
//绘制一个未按下的按钮
DrawFrameControl(DrawItemStruct.hDC, ARect, DFC_BUTTON, Flags);
FCanvas.FillRect(ARect);
//绘制Caption文本内容
FCanvas.Font := Self.Font;
ARect:=ClientRect;
wh:=FCanvas.TextExtent(Caption);
FCanvas.Pen.Width := 1;
FCanvas.Brush.Style := bsClear;
if not Enabled then
begin //按钮失效时应多绘一次Caption文本
FCanvas.Font.Color := clBtnHighlight;
FCanvas.TextOut((Width div 2)-(wh.cx div 2)+1,
(height div 2)-(wh.cy div 2)+1,
Caption);
FCanvas.Font.Color := clBtnShadow;
end;
FCanvas.TextOut((Width div 2)-(wh.cx div 2),(height div 2)-(wh.cy div 2),Caption);
//绘制得到焦点时的内框虚线
if IsFocused and IsDefault then
begin
ARect := ClientRect;
InflateRect(ARect, -4, -4);
FCanvas.Pen.Color := clWindowFrame;
FCanvas.Brush.Color := FColor;
DrawFocusRect(FCanvas.Handle, ARect);
end;
FCanvas.Handle := 0;
end;
procedure SetButton(var ADefault:Boolean);
begin
if ADefault <> IsFocused then
begin
IsFocused := ADefault;
Refresh;
end;
end;
procedure CreateParams(var Params:TCreateParams);override;
begin
with Params do
Style=Style or BS_OWNERDRAW;
end;
procedure Create(AOwner:TComponent);override;
begin
inherited;
FCanvas:=TCanvas.Create;
end;
procedure Destroy;override;
begin
FCanvas.Free;
inherited;
end;
procedure Register;
begin
RegisterComponents('MyLib', [TMyButton]);
end;
end.
而且在写的时候,没有智能提示?
你看的是什么书啊.稍稍看了一下,N多错,看不下去了,自定义控件很多书上有,换一本书吧
前面的几个错为:
public
procedure Create(AOwner:TComponent);override; //1
procedure Destroy;override; //2
1. 你的控件基于TButton,它的Create定义为构造函数,所以要定义为:
constructor Create(AOwner:TComponent);override;
2.同理:
destructor Destroy;override;
implementation
procedure CNDrawItem(var CMessage: TWMDrawItem); message WM_DRAWITEM; //3
3.CNDrawItem是你类中的函数.所以要写成
procedure TMyButton.CNDrawItem(var CMessage: TWMDrawItem);
另外,message WM_DRAWITEM;是函数申明时用,实现(定义)时不能有
DrawItemStruct: TDrawItemStruct;
你的TDrawItemStruct在哪里定义的?
...
TDrawItemStruct没有定义.它应该是一个系统中的变量吧?
TDrawItemStruct是WINDOWS中定义的.我加入了.
但是它提示:
IsDown := (itemState) and (ODS_SELECTED <> 0);
IsDefault := (itemState) and (ODS_FOCUS <> 0);
这个句出错.
提示:"Operator not applicable to this Operand type."
很简单，找个简单组件看一下就好了，如SPCOMM等，主要是继承自TComponent类，增加些属性方法，构造析构，然后Register注册组件
你看参考下vcl的源代码, tbitbtn这个类是从tbutton继承过来的.
建议去看看windows程序设计.
tbitbtn这个类,应该很有参考价值。
编译完成了,并已安装了.在是在使用时出错,
system error. code:87
参数错误.
怎回事?
帮你改了一下,可以编译安装成功,至于能否达到你的要求,你可试一下:
unit MyButton;
interface
uses
SysUtils, Classes, Controls, StdCtrls,Graphics,Messages,Types,WINDOWS;
type
TMyButton = class(TButton)
private
FColor:TColor;
FCanvas:TCanvas;
IsFocused:Boolean;
SetColor:TColor;
procedure CNDrawItem(var CMessage: TWMDrawItem); message WM_DRAWITEM;
{ Private declarations }
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure SetButton(var ADefault:Boolean);
{ Protected declarations }
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
{ Public declarations }
published
property Color:TColor read FColor write SetColor default clWhite;
{ Published declarations }
end;
procedure Register;
implementation
procedure TMyButton.CNDrawItem(var CMessage: TWMDrawItem); // message WM_DRAWITEM;
var
IsDown, IsDefault: Boolean;
ARect: TRect;
Flags: Longint;
DrawItemStruct: TDrawItemStruct;
wh:TSize;
begin
DrawItemStruct:=CMessage.DrawItemStruct^;
FCanvas.Handle := DrawItemStruct.hDC;
ARect := ClientRect;
with DrawItemStruct do
begin
IsDown := itemState and ODS_SELECTED <> 0;
IsDefault := itemState and ODS_FOCUS <> 0;
end;
Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
if IsDown then Flags := Flags or DFCS_PUSHED;
if DrawItemStruct.itemState and ODS_DISABLED <> 0 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(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
InflateRect(ARect, -1, -1);
end;
FCanvas.Pen.Color := clBtnShadow;
FCanvas.Pen.Width := 1;
FCanvas.Brush.Color := FColor;
if IsDown then begin
//按钮被按下时的状态绘制
FCanvas.Rectangle(ARect.Left , ARect.Top, ARect.Right, ARect.Bottom);
InflateRect(ARect, -1, -1);
end else
//绘制一个未按下的按钮
DrawFrameControl(DrawItemStruct.hDC, ARect, DFC_BUTTON, Flags);
FCanvas.FillRect(ARect);
//绘制Caption文本内容
FCanvas.Font := Self.Font;
ARect:=ClientRect;
wh:=FCanvas.TextExtent(Caption);
FCanvas.Pen.Width := 1;
FCanvas.Brush.Style := bsClear;
if not Enabled then
begin //按钮失效时应多绘一次Caption文本
FCanvas.Font.Color := clBtnHighlight;
FCanvas.TextOut((Width div 2)-(wh.cx div 2)+1,
(height div 2)-(wh.cy div 2)+1,
Caption);
FCanvas.Font.Color := clBtnShadow;
end;
FCanvas.TextOut((Width div 2)-(wh.cx div 2),(height div 2)-(wh.cy div 2),Caption);
//绘制得到焦点时的内框虚线
if IsFocused and IsDefault then
begin
ARect := ClientRect;
InflateRect(ARect, -4, -4);
FCanvas.Pen.Color := clWindowFrame;
FCanvas.Brush.Color := FColor;
DrawFocusRect(FCanvas.Handle, ARect);
end;
FCanvas.Handle := 0;
end;
procedure TMyButton.SetButton(var ADefault:Boolean);
begin
if ADefault <> IsFocused then
begin
IsFocused := ADefault;
Refresh;
end;
end;
procedure TMyButton.CreateParams(var Params:TCreateParams);
begin
inherited CreateParams(Params);
with Params.WindowClass do
Style:=Style or BS_OWNERDRAW;
end;
constructor TMyButton.Create(AOwner:TComponent);
begin
inherited;
FCanvas:=TCanvas.Create;
end;
destructor TMyButton.Destroy;
begin
FCanvas.Free;
inherited;
end;
procedure Register;
begin
RegisterComponents('MyLib', [TMyButton]);
end;
end.
keiy() :
我编译完成了,并已安装了.只是在使用时出错,我新建一个工程,当我把这个控件放到FORM中时出错:
system error. code:87
参数错误.
怎回事?
keiy改得没有问题,是你自己编译没有更新
最好将以期的代码改名备份重新编译
参考下面改进后的代码：
unit MyButton;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Graphics;
type
TMyButton = class(TButton)
private
FCanvas: TCanvas;
IsFocused: Boolean;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM; // 换成CN_DRAWITE不是WM_DRAWITE
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure SetButtonStyle(ADefault: Boolean); override; // 这条必须加,才能触发CN_DRAWITEM
public
constructor Create(AOwner: TComponent);override;
destructor Destroy; override;
published
property Color default clWhite; // Color在父类中已经有声明
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('MyLib', [TMyButton]);
end;
procedure TMyButton.CNDrawItem(var Message: TWMDrawItem);
var
IsDown, IsDefault: Boolean;
ARect: TRect;
Flags: Longint;
DrawItemStruct: TDrawItemStruct;
wh: TSize;
begin
DrawItemStruct := Message.DrawItemStruct^;
FCanvas.Handle := DrawItemStruct.hDC;
ARect := ClientRect;
with DrawItemStruct do
begin
IsDown := itemState and ODS_SELECTED <> 0;
IsDefault := itemState and ODS_FOCUS <> 0;
end;
Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
if IsDown then Flags := Flags or DFCS_PUSHED;
if DrawItemStruct.itemState and ODS_DISABLED <> 0 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(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
InflateRect(ARect, -1, -1);
end;
FCanvas.Pen.Color := clBtnShadow;
FCanvas.Pen.Width := 1;
FCanvas.Brush.Color := Color;
if IsDown then
begin
//按钮被按下时的状态绘制
FCanvas.Rectangle(ARect.Left , ARect.Top, ARect.Right, ARect.Bottom);
InflateRect(ARect, -1, -1);
end else
//绘制一个未按下的按钮
DrawFrameControl(DrawItemStruct.hDC, ARect, DFC_BUTTON, Flags);
FCanvas.FillRect(ARect);
//绘制Caption文本内容
FCanvas.Font.Assign(Font);
ARect := ClientRect;
wh := FCanvas.TextExtent(Caption);
FCanvas.Pen.Width := 1;
FCanvas.Brush.Style := bsClear;
if not Enabled then
begin //按钮失效时应多绘一次Caption文本
FCanvas.Font.Color := clBtnHighlight;
FCanvas.TextOut((Width div 2) - (wh.cx div 2) + 1,
(Height div 2) - (wh.cy div 2) + 1, Caption);
FCanvas.Font.Color := clBtnShadow;
end;
FCanvas.TextOut((Width div 2) - (wh.cx div 2),
(Height div 2) - (wh.cy div 2), Caption);
//绘制得到焦点时的内框虚线
if IsFocused and IsDefault then
begin
ARect := ClientRect;
InflateRect(ARect, -4, -4);
FCanvas.Pen.Color := clWindowFrame;
FCanvas.Brush.Color := Color;
DrawFocusRect(FCanvas.Handle, ARect);
end;
FCanvas.Handle := 0;
end;
procedure TMyButton.SetButtonStyle(ADefault: Boolean);
begin
if ADefault <> IsFocused then
begin
IsFocused := ADefault;
Refresh;
end;
end;
procedure TMyButton.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do Style := Style or BS_OWNERDRAW; // 不是Params.WindowClass
end;
constructor TMyButton.Create(AOwner: TComponent);
begin
inherited;
FCanvas := TCanvas.Create;
Color := clWhite; // 默认值需要在Create中设置
end;
destructor TMyButton.Destroy;
begin
FCanvas.Free;
inherited;
end;
end.
开始我也发现system error. code:87错,用我上面的,注意以下部分
procedure TMyButton.CreateParams(var Params:TCreateParams);
begin
inherited CreateParams(Params);
with Params.WindowClass do
Style:=Style or BS_OWNERDRAW;
end;
另外,按zswang(伴水清清)(专家门诊清洁工)所说,重新编译
出错:
procedure SetButtonStyle(ADefault: Boolean); override;
提示:Declaration of 'setbuttonstyle' differs from previous declaration.
是不是说定义出父类的不一样?
不会吧,用我的程序,贴到你的unit中试试(我安装使用没问题)
如果你用zswang(伴水清清)(专家门诊清洁工)的程序,头上和下面的SetButtonStyle都要改
ok了，谢谢大家！
不过有几个问题不明白：
1、procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM; // 换成CN_DRAWITEM不是WM_DRAWITE 为什么要换成CN_DRAWITEM ,WINDOWS消息不是WM_DRAWITEM,怎么变成CN_DRAWITEM。
2、 SetButtonStyle(ADefault: Boolean); 函数既然是父类的函数,在我DELPHI的帮助中TBUTTON类里找不到SetButtonStyle 这个函数?
1、你自己换成WM_DRAWITEM自己看看效果，少动口多动手
看TBitBtn怎么封装就怎么封装，VCL是开源的
你学自定义组建最好的学习对象就是VCL的源代码
2、
TButton = class(TButtonControl)
private
//。。。。
protected
//。。。。
procedure SetButtonStyle(ADefault: Boolean); virtual;
//。。。。
end;
WIDNOWS消息以WM开头的,怎么又变成CN开头了,我想知道原因,我现在已经搞定了,可我还是不知道为什么是CN_
我要知道它为什么这样.
CN_XXX是delphi使用的自定义消息
那用WM_DRAWITEM代替CN_DRAWITEM可以吗?
这个问题还需要问吗？你自己替换测试一下就得到结果了
我试过了不行,可是我不明白为什么WM_DRAWITEM不行,WINDOWS中本来就有这条消息.为什么不行.
还有既然有CN_DRAWITEM,那有没有CN_LBUTTON等呢?
我赞成这样的书
代码贴上去就能用跟没看有啥区别？
让你找错才是它真正的目的
楼主可以查询一下其他的基础书籍，等你解决了问题，你会发现自己学到很多
为什么用WM_DRAWITEM不行呢?