您的位置:首页 > 其它

我在做一个自定义组件,到处是错误?

2009-01-04 16:48 363 查看
我在做一个自定义组件,到处是错误? 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不行呢?
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: 
相关文章推荐