要使一个可视化控件的行为与其默认行为不同,我们通常要从这个原始类继承,创建一个新的控件?疚慕樯苋绾卧诓淮唇ㄐ吕嗟那榭鱿露谋湓鶧elphi可视化控件的行为。
　　这可能实现吗？秘密在于在控件之前抢先截获Windows消息。这可以通过使用一个叫做WindowProc的TControl属性来实现,这个属性实质上指向控件的Windows消息事件处理器(event handler)。
　　为了展示这一技术,我们将创建一个LinkedLabel控件,可以将它连接到任何TControl控件并且动态改变它的行为。TLinkedLabel由TLabel继承而来,附加4个公开的属性:
1. Associate -- 将被改变行为的相连控件
2. CapsLock -- 当这个Boolean属性被设置为True时,特定类型的控件将把小写键盘输入作为大写来处理。这个属性并不对所有控件有效,因为并不是所有的控件都以相同的方式相应WM_CHAR消息。经测试Edit,MaskEdit,Memo,和RichEdit控件都对CapsLock属性有响应,但是ComboBox则不响应。很明显,CapsLock属性对于很多其他控件(如Button、CheckBox等)只有很小的影响,或者没有影响。
3. Gap -- LinkedLabel与相连控件的距离
4. 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(＆#118alue: Integer); 
　procedure SetOnTop(＆#118alue: Boolean); 
　procedure SetAssociate(＆#118alue: 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的默认值。
implementationhttps://www.xin3721.com/
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(＆#118alue: Integer); 
begin
if (FGap <> ＆#118alue) then
begin
　FGap := ＆#118alue; 
　Adjust(True); 
end;
end;
procedure TLinkedLabel.SetOnTop(＆#118alue: Boolean); 
begin
　if (FOnTop <> ＆#118alue) then
begin
　FOnTop := ＆#118alue; 
　Adjust(True); 
end;
end;
现在是SetAssociate方法
procedure TLinkedLabel.SetAssociate(＆#118alue: TControl); 
begin
　if (＆#118alue <> FAssociate) then begin
　if (Assigned(FAssociate)) then
　FAssociate.WindowProc := FOldWinProc; 
　FAssociate := ＆#118alue; 
　if (Assigned(＆#118alue)) 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,而不是关联控件。这对为一个按钮创建＆#111nclick事件处理器来说也是一样的,＆#111nclick事件处理器是作为按钮父窗体的一部分,而不是扩充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变量。
1. 用户把 LinkedLabel 拖动到一个新位置。
2. WndProc 接收到一个 WM_WINDOWPOSCHANGED 消息,并且触发 Adjust(False) 来移动关联控件。
3. 作为对关联控件调整的一部分,Adjust 把FAssociate.Left设置为新值。 
4. FAssociate 触发 WM_MOVE 消息,指出它已经改变了位置。
5. NewWinProc 监测到 WM_MOVE 消息并调用 Adjust(True) 以修改 LinkedLabel 的位置配合关联控件的移动。
 
　　如你所见,在关联控件试图移动LinkedLabel之前我们没有什么机会改变关联控件的Top属性来配合LinkedLabel的新位置。通过使用Fupdating变量,关联控件不会注意到WM_MOVE消息,也不会试图调用Adjust来重新布置LinkedLabel。
一对问题
在这篇文章中我没有提及TlinkedLabel的一对问题。下面是对它们的大致说明:
　　1. 如果你把两个或者两个以上LinkedLabel关联到同一个控件然后释放它们之中的一个或者几个,就可能导致各种各样的问题。你可能会打断到其它LinkedLabel的关联,甚至可能导致被关联控件的WindowProc指向一个并不存在的历程。 
　　2. 如果你把 LinkedLabel 关联到另一个窗体上的控件,那么Notification 方法在那个控件被销毁时不会被调用。当控件被关联时调用 FreeNotification 可以解决这个问题,但这并没有真正指出问题所在。真正的问题在于我们允许它被关联在其它窗体的控件上。其实我们真正想实现的是把LinkedLabel与拥有相同Parent的控件相关联。虽然这么做并不难,不过要只在对象查看器的Associate属性下拉列表中显示符合条件的控件也需要一些小技巧。
结论
　　其实结论也没多少东西。替换现存控件的WindowProc确实有它的局限性,不过这毕竟是一种非常有用的技术。我想不出什么其它合适的方法来创建一个像TlinkedLabel这样的控件,让关联控件在被移动时也一并移动LinkedLabel。我可不想去尝试并且列出这种技术其它可能的用法,因为这种可能性是无限的,它只会被一个程序员的灵活性所局限。