说三道四技术文摘-感悟人生的经典句子
说三道四 > 文档快照

改变VCL的行为--一个使用可视化元件的实例-Delphi资料

HTML文档下载 WORD文档下载 PDF文档下载
改变VCL的行为--一个使用可视化元件的实例-Delphi资料

要使一个可视化控件的行为与其默认行为不同,我们通常要从这个原始类继承,创建一个新的控件。本文将介绍如何在不创建新类的情况下动态改变原生Delphi可视化控件的行为。

这可能实现吗?秘密在于在控件之前抢先截获Windows消息。这可以通过使用一个叫做WindowProc的TControl属性来实现,这个属性实质上指向控件的Windows消息事件处理器(event handler)。

为了展示这一技术,我们将创建一个LinkedLabel控件,可以将它连接到任何TControl控件并且动态改变它的行为。TLinkedLabel由TLabel继承而来,附加4个公开的属性:

? Associate —— 将被改变行为的相连控件

? CapsLock —— 当这个Boolean属性被设置为True时,特定类型的控件将把小写键盘输入作为大写来处理。这个属性并不对所有控件有效,因为并不是所有的控件都以相同的方式相应WM_CHAR消息。经测试Edit,MaskEdit,Memo,和RichEdit控件都对CapsLock属性有响应,但是ComboBox则不响应。很明显,CapsLock属性对于很多其他控件(如Button、CheckBox等)只有很小的影响,或者没有影响。

? Gap —— LinkedLabel与相连控件的距离

? OnTop —— 这个Boolean属性决定LinkedLabel出现在相连控件的左侧还是顶端。

另外,TlinkedLabel将保持自身和相连控件的Enabled和Visible属性相一致。它也会保持自身和相连控件的距离和角度,也就是说,当你移动LinkedLabel时,其关联也会随之移动,反之亦然。

我们来看一下TLinkedLabel类的声明,如图1所示。

unit LinkedLabel;

interface

uses

Messages

Classes

Controls

StdCtrls;

type

TLinkedLabel = class(TLabel)

private

// 相连控件.

FAssociate: TControl;

// 将 FAssociate 置为全大写模式

FCapsLock: Boolean;

// 标签与关联控件之间的距离

FGap: Integer;

// 标签在关联控件顶端时为true

FOnTop: Boolean;

// 保存 FAssociate.WindowProc的原始值

FOldWinProc: TWndMethod;

// 用于防止无限更新循环

FUpdating: Boolean;

protected

procedure Adjust(MoveLabel: Boolean);

procedure SetGap(Value: Integer);

procedure SetOnTop(Value: Boolean);

procedure SetAssociate(Value: TControl);

procedure NewWinProc(var Message: TMessage);

procedure Notification(AComponent: TComponent;

Operation: TOperation); override;

procedure WndProc(var Message: TMessage); override;

public

constructor Create(AOwner :TComponent); override;

destructor Destroy; override;

published

property Associate: TControl

read FAssociate write SetAssociate;

property CapsLock: Boolean

read FCapsLock write FCapsLock;

property Gap: Integer read FGap write SetGap default 8;

property OnTop: Boolean read FOnTop write SetOnTop;

end;

现在让我们来仔细看看这个控件中的不同方法,先由构造器(constructor)开始。首先说明一下,当创建一个新对象时,与它相关联的所有内存都被清空。这个动作将会自动把Fassociate和FoldWinProc设置为nil,将FcapsLock、FonTop、Fupdating设置为False。所有这些都不需要在构造器中明确的初始化它们。因此,唯一需要我们在构造器中设置的就是Gap的默认值。

implementation

constructor TLinkedLabel.Create(AOwner: TComponent);

begin

inherited;

FGap := 8;

end;

现在我们来看一下Adjust方法,它负责安排LinkedLabel或者关联控件的放置(取决于MoveLabel参数的取值)。正如你将在代码中看到的,LinkedLabel与相关控件的实际位置取决于Gap和OnTop属性(见图2)。虽然我们在OnTop中只提供了两种可能的选择,不过可以很容易的对其编程以提供更多的可能性。不过,把TlinkedLabel武装到牙齿(原文是“add a lot of "bells and whistles"”,译者注)并不是本文的重点,这项任务就委托给读者们来完成吧。

procedure TLinkedLabel.Adjust(MoveLabel: Boolean);

var

dx

dy: Integer;

begin

if (Assigned(FAssociate)) then begin

if (FOnTop) then

begin

dx := 0;

dy := Height + FGap;

end

else

begin

dx := Width + FGap;

dy := (Height - FAssociate.Height) div 2;

end;

if (MoveLabel) then

begin

Left := FAssociate.Left - dx;

Top := FAssociate.Top - dy;

end

else

begin

FAssociate.Left := Left + dx;

FAssociate.Top := Top + dy;

end;

end;

end;

现在,我们来完成Gap和OnTop属性的set方法(见图3),以便当Gap或者Onop属性被修改时我们可以改变LinkedLabel的位置。

procedure TLinkedLabel.SetGap(Value: Integer);

begin

if (FGap <> Value) then

begin

FGap := Value;

Adjust(True);

end;

end;

procedure TLinkedLabel.SetOnTop(Value: Boolean);

begin

if (FOnTop <> Value) then

begin

FOnTop := Value;

Adjust(True);

end;

end;

现在是SetAssociate方法

procedure TLinkedLabel.SetAssociate(Value: TControl);

begin

if (Value <> FAssociate) then begin

if (Assigned(FAssociate)) then

FAssociate.WindowProc := FOldWinProc;

FAssociate := Value;

if (Assigned(Value)) then

begin

Adjust(True);

Enabled := FAssociate.Enabled;

Visible := FAssociate.Visible;

FOldWinProc := FAssociate.WindowProc;

FAssociate.WindowProc := NewWinProc;

end;

end;

end;

为了便于理解,我们需要详细的讨论一下WindowProc属性。WindowProc被定义为TwndMethod类型。TwndMethod可以在Controls单元中找到,定义如下:

TWndMethod = procedure(var Message: TMessage) of object;

注意,FoldWinProc同样被定义为TwndMethod,并且NewWinProc方法拥有与TwndMethod相同的参数结构。这就允许我们将FoldWinProc指向WindowProc的当前值,并把WindowProc重定向到NewWinProc方法。如果WindowProc只是另一个事件属性的话,我们为什么需要使用FoldWinProc呢?因为WindowProc与其它事件属性的不同之处在于WindowProc指向一个已经存在的事件处理器。如果我们只是简单的将WindowProc指向我们的方法,这个控件将不能再对任何Windows消息产生响应。为了解决这个问题,我们在把WindowProc指向NewWinProc之前把FoldWinProc设置为WindowProc的当前值。

在NewWinProc中,我们通过FoldWinProc调用原先的消息处理器(message handler),并且处理特定的Windows消息。因为我们修改了关联控件的WindowProc值,因此要在把关联改变到一个新的控件之前恢复它从前的取值。

避免把关联控件的WindowProc属性指向一个不再存在的例程也同样重要。如同我们所见的,在析构器中调用SetAssociate(nil)将会把WindowProc恢复为初始值。

destructor TLinkedLabel.Destroy;

begin

SetAssociate(nil);

inherited;

end

另外,我们也不希望关联到一个不再存在控件。通过覆盖Notification方法,我们可以知道关联组件何时被销毁,从而重置关联的指针:

procedure TLinkedLabel.Notification(AComponent: TComponent;

Operation: TOperation);

begin

if ((Operation = opRemove) and

(AComponent = FAssociate)) then SetAssociate(nil);

end;

现在我们来看NewProc方法。这里,我们只是寻找发送给关联控件的特定Windows消息。认识到这一点是很重要的:虽然方法通过关联控件调用,但它实际上是LinkedLabel的一部分,例如,Self=LinkedLabel,而不是关联控件。这对为一个按钮创建onclick事件处理器来说也是一样的,onclick事件处理器是作为按钮父窗体的一部分,而不是扩充Tbutton类的新方法。

procedure TLinkedLabel.NewWinProc(var Message: TMessage);

var

Ch: Char;

begin

if (Assigned(FAssociate) and (not FUpdating)) then begin

FUpdating := True;

try

case(Message.Msg) of

WM_CHAR:

if (FCapsLock) then begin

Ch := Char(TWMKey(Message).CharCode);

if (Ch >= ’a’) and (Ch <= ’z’) then

TWMKey(Message).CharCode := ord(UpCase(Ch));

end;

CM_ENABLEDCHANGED:

Enabled := FAssociate.Enabled;

CM_VISIBLECHANGED:

Visible := FAssociate.Visible;

WM_SIZE

WM_MOVE

WM_WINDOWPOSCHANGED:

Adjust(True);

end;

finally

FUpdating := False;

end;

end;

FOldWinProc(Message);

end;

如果你检查一下这个例程,就会发现我们并没有花多少力气去处理Windows消息。我们只注意几个特定的消息,然后就让关联通过调用FOldWinProc正常的处理它们。在处理WM_CHAR消息的时候,我们对消息的一部分做了改变,让控件认为我们按下的是大写字母键。

最后,我们关心一下两个不同的消息,以确定关联控件是否被移动了。这样做的原因在于从TwinControl继承的控件会在它们被移动时接到WM_MOVE消息,而此时其它的可视控件(如一个标签)则会收到WM_WINDOWPOSCHANGED消息。程序也检查了WM_SIZE消息,原因是如果OnTop属性为False,则LinkedLabel的位置会随控件的高度而变化。

我们这个控件的最后一个方法是:当LinkedLabel被改变时,要在关联的什么地方作修改?当然我们不使用覆盖Tlabel的现存方法来实现它,而是要用修改关联行为的相同技术来做。注意我们不是重新定向WindowsProc属性,而是覆盖了WndProc方法。为什么把它们叫做相同的技术呢?如果你看一下TControl的构造器,你可以发现WindowProc会被初始化以指向WndProc方法。所以从本质上讲,我们覆盖的是同一种方法,不过做得更“干净”,也不用去保存WindowProc的初始值。

procedure TLinkedLabel.WndProc(var Message: TMessage);

begin

if (Assigned(FAssociate) and (not FUpdating)) then begin

FUpdating := True;

try

case(Message.Msg) of

CM_ENABLEDCHANGED: FAssociate.Enabled := Enabled;

CM_VISIBLECHANGED: FAssociate.Visible := Visible;

WM_WINDOWPOSCHANGED: Adjust(False);

end;

finally

FUpdating := False;

end;

end;

inherited;

end;

对于刚刚完成的控件还有最后一点需要注意。你也许发现NewWinProc和WndProc中都使用了Fupdating。这个变量被用来通知LinkedLabel和它的关联控件其它控件正在发生改变。如果你忽略了这一步,很容易造成一个无限的更新循环,或者其它无法预料的结果。下面是一个事件流程,显示为什么需要Fupdating变量。

? 用户把 LinkedLabel 拖动到一个新位置。

? WndProc 接收到一个 WM_WINDOWPOSCHANGED 消息,并且触发 Adjust(False) 来移动关联控件。

? 作为对关联控件调整的一部分,Adjust 把FAssociate.Left设置为新值。

? FAssociate 触发 WM_MOVE 消息,指出它已经改变了位置。

? NewWinProc 监测到 WM_MOVE 消息并调用 Adjust(True) 以修改 LinkedLabel 的位置配合关联控件的移动。

如你所见,在关联控件试图移动LinkedLabel之前我们没有什么机会改变关联控件的Top属性来配合LinkedLabel的新位置。通过使用Fupdating变量,关联控件不会注意到WM_MOVE消息,也不会试图调用Adjust来重新布置LinkedLabel。

一对问题

在这篇文章中我没有提及TlinkedLabel的一对问题。下面是对它们的大致说明:

? 如果你把两个或者两个以上LinkedLabel关联到同一个控件然后释放它们之中的一个或者几个,就可能导致各种各样的问题。你可能会打断到其它LinkedLabel的关联,甚至可能导致被关联控件的WindowProc指向一个并不存在的历程。

? 如果你把 LinkedLabel 关联到另一个窗体上的控件,那么Notification 方法在那个控件被销毁时不会被调用。当控件被关联时调用 FreeNotification 可以解决这个问题,但这并没有真正指出问题所在。真正的问题在于我们允许它被关联在其它窗体的控件上。其实我们真正想实现的是把LinkedLabel与拥有相同Parent的控件相关联。虽然这么做并不难,不过要只在对象查看器的Associate属性下拉列表中显示符合条件的控件也需要一些小技巧。

结论

其实结论也没多少东西。替换现存控件的WindowProc确实有它的局限性,不过这毕竟是一种非常有用的技术。我想不出什么其它合适的方法来创建一个像TlinkedLabel这样的控件,让关联控件在被移动时也一并移动LinkedLabel。我可不想去尝试并且列出这种技术其它可能的用法,因为这种可能性是无限的,它只会被一个程序员的灵活性所局限。

建立简单的任务栏应用程序-Delphi资料 将程序放在Windows启动中-Delphi资料 将光标限制在某区域-Delphi资料 将文件放入回收站-Delphi资料 禁止用户切换任务-Delphi资料 控制面板大全-Delphi资料 控 制 系 统 菜 单-Delphi资料 拦截消息处理过程-Delphi资料 利用API函数开发DELPHI程序三例 利用Hook技术实现键盘监控-Delphi资料 利用浏览窗口 DragDrop 任意文件-Delphi资料 利用未公开函数实现Shell操作监视-Delphi资料 妙用Delphi的标识号 判断Windows类型和版本-Delphi资料 判断一个程序是否dos版本:-Delphi资料 屏蔽系统按键-Delphi资料 屏幕抓字技术揭密(转载)-Delphi资料 启动控制面板-Delphi资料 取得系统所有窗口的方法-Delphi资料 全部窗体可使用鼠标点中移动-Delphi资料 让图像旋转-Delphi资料 热启动控制-Delphi资料 如果隐藏和显示Windows的任务条-Delphi资料 如何把文件删除到回收站中-Delphi资料 如何从任务栏上隐藏应用程序的按纽?-Delphi资料 如何得到Windows 的temp路径-Delphi资料 如何得到WINDOWS的SYSTEM路径-Delphi资料 如何得到上一个激活的组件-Delphi资料 如何得到系统目录-Delphi资料 如何得到执行程序的当前路径-Delphi资料 如何访问一个进程的内存空间-Delphi资料 问一个数据库文件的问题! PB7 连接 MSSQLServer 6.5为什么需要那么长的时间并且内存要占用100多M? 关于使用VB6创建的控件后的部署问题 Delphi与bcb有何联系与差异 关于WIN2000网络上的问题 盼高手来解决,阿菜勿进 我用PHP通过ADO连接ACCESS 为什么i=很大 怎么样改变statusbar的某个Panels的字体颜色 如何制作MID窗体的背景图片平铺? sqlserver有一个带参数的存储过程,为什么不能生成DW.?? 急(送100分):多个image控件如何用imagexxx使用? 如何得到CPU的时钟频率? 各位大佬,0x1 是什么? 一个页面只让一个用户来修改 请问哪儿有Lotus Notes C API的教程?以及要进行编程必须进行哪些配置? PB7连接MSSQLServer6.5的时候为什么需要那么长的时间和占用100多M的内存? 推荐在代理服务器上安装什么邮件网关软件? 在线等待 请各位帮助 如何得到开机时间? 我想把smalldatetime类型显示为“yyyy_mm_dd 00:00:00” 急须一个完全免费的MP3刻录软件 怎样修改xml的节点的值? Tabpage(子项)可以改变颜色,但Tabcontrol(父项)改变不了颜色。高手帮忙。 MM说:“你可真够没良心的!”! (邀请水园MM请参与) 测试流程! 在用ADO时如何判断在所取得的记录中,值为null的的情况 急(送100分):多个image控件如何用imagexxx使用? 关于数组的问题。 Weblogic 死锁的问题 想到亚信去,请各位兄台给点建议!(有分!) 请问能不能用System.Drawing对象在一个页里里画多张图? 索引和自增字段 关于对话框? 求能人?或给思路 请问哪儿有Lotus Notes C API的教程?以及要进行编程必须进行哪些配置? 100分求助:怎麼判斷數據庫服務器存在與否? JUnit重复测试的问题 请问一个hyperlink简单问题 求助:datagrid中控件事件的使用问题? 在C中写文件的内容,在线等待!!! 装了linux后,我的win2000和linux的时间老是都不对了 如果结束会话 如何送分呀? 谁有这个文档的中文资料,谢谢,高分奉送!!! 急!!!请问系统恢复盘的问题! 自定义数据类型如何定义?(数组) dw疑问 请问一下,李维的哪几本书比较好,我有VC基础,想学学DELPHI,望各位给个建议谢谢! jbuild好用吗? 怎样将一个单值的String类型赋给char类型的变量? 哪位有实现(首页 上一页 下一页 末页)的例子? 对话框?求救? 盟友打起“退堂鼓” 奥巴马遭遇院内外埃及反对军事打击叙利亚法国慎言军事干预叙利亚美军轰炸传闻在即 以色列群众争抢防毒美发射一颗“间谍卫星”专家认为:美对叙动武为进军伊朗前奏法国调查美“棱镜”计划中新关系开新局英国国会投票反对政府向叙利亚动武西方暂缓对叙开战步伐 联合国化武调查科学家培养出“迷你人脑” 可用于疾病英国防长:英国不会参加对叙军事行动洛杉矶打击酒驾与超速 逾千人被拘捕美国称将按照符合美国利益原则对叙采取美国称将按照符合美国利益原则对叙采取英国防长:英国不会参加对叙军事行动洛杉矶打击酒驾与超速 逾千人被拘捕日本增兵那霸 意在经略西南俄称联合国专家工作中断后不应结束叙化国际新闻早报:美国向叙利亚附近海域增[组图]中国女星闪耀威尼斯 盘点出席市民网购大闸蟹券 国庆过了好几天螃蟹天气:连续两天普降中雨 气温降幅达到天津征集“爱心妈妈” 为孤残儿童织毛时代奥城车库改“洗车坊” 居民:只整范志毅赴法甲取经 笑称法足坛教父为法天津增雨飞机火箭高炮齐上阵 降水增5桥园公园收集雨水灌溉 靠天喝水年节水英国5周岁婴儿捐肾 成为最年轻器官捐赫哲族萨满文化和鱼皮制品亮相北京美媒:\"基地\"组织高级头目已被押巴西队鸟巢首训 众将轻松备战非洲冠军中乙秘书长:青海可能全计0-3 绝不媒体解密中国主要“伙伴关系”及其内涵加拿大兰里堡南瓜大赛 华裔携千磅南瓜英国白金汉宫再遭入侵持刀男子被捕 安丽水市政协调研组赴青田调研华侨村官工狂牛怒闯大马街头 4名新加坡华人游客台湾“立法院”对峙 与会者戴面具斗嘴宁波市防指将防汛应急响应由Ⅲ级下调为七天六夜连续奋战 宁波城管抗击台风\江东打造\"网上枫桥\":变\"单兵
备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘