Delphi组件的偷梁换柱
在使用Delphi可视化设计时，有时觉得某个元件缺少点自己需要的功能或者属性，或者需要的功能或者属性是protected，没法直接得到。比如TPanel，是个容器类组件，其功能是用来放置其它窗口组件和图形组件，但是，如果想在它的界面上画点什么就不那么方便了，既没有OnPaint事件，也不能直接获取其Canvas（该属性是protected）。
碰到这类问题，我们采用的策略一般有2个：
- 重新写一个该组件的派生类，注册到IDE的组件面板中，或者动态建立这个类，插入到窗口中，对于类似TPanel的组件，由于可能要在其上放置其它组件，只能选择注册，但是由于我们需要的新增功能不多，或者只是想得到组件的protected方法或属性，注册一个新组件似乎很“冤”，对较大项目的维护也很不利。
- 采用替换法，如TPanel，写成TMyPanel = class(TPanle)，然后通过强制转换后取得其protected方法和属性，或者使用新增的属性和方法。不过这样也很麻烦，有时也会有些问题，比如上面所说的要在TPanle上画点什么，只能在TForm.OnPaint事件进行，下面是替换法的例子，在Panel1的界面上画一个红色矩形：
interface
uses
Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
Dialogs,ExtCtrls,StdCtrls;
type
TMyPanel = class (TPanel);
TForm1 = class (TForm)
Panel1:TPanel;
Button1:TButton;
procedureFormPaint(Sender:TObject);
procedureButton1Click(Sender:TObject);
private
{Privatedeclarations}
public
{Publicdeclarations}
end;
var
Form1:TForm1;
implementation
{$R * .dfm}
procedureTForm1.FormPaint(Sender:TObject);
// var
// Canvas:TControlCanvas;
begin
{
Canvas: = TControlCanvas.Create;
Canvas.Control: = Panel1;
Canvas.Pen.Color: = clRed;
Canvas.Rectangle( 10 , 10 , 100 , 100 );
Canvas.Free;
}
withTMyPanel(Panel1) do
begin
Canvas.Pen.Color: = clRed;
Canvas.Rectangle( 10 , 10 , 100 , 100 );
end;
end;
procedureTForm1.Button1Click(Sender:TObject);
begin
Invalidate;
end;
end.
运行上面例子，由于Form在开始显示时，其OnPaint在TPanel.Paint方法前被调用，所以窗口开始显示时，我们得不到应有的效果，必须借助一次刷新才行，而且这个刷新还不知道在哪个事件中进行才合适，笔者在Form的OnCreate、OnShow、OnActive以及OnResize事件中都试过，都不起作用（使用FormOnPaint中被注释的代码也是一样），笔者愚钝，只好借助按钮Click事件刷新一次。
采用本文介绍的组件“偷梁换柱”法，可以方便的解决这类问题。请看和上面例子同样功能的代码：
interface
uses
Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
Dialogs,ExtCtrls;
type
TPanel = class (ExtCtrls.TPanel)
public
procedurePaint; override ;
end;
TForm1 = class (TForm)
Panel1:TPanel;
private
{Privatedeclarations}
public
{Publicdeclarations}
end;
var
Form1:TForm1;
implementation
{$R * .dfm}
{TPanel}
procedureTPanel.Paint;
begin
inherited;
Canvas.Pen.Color: = clRed;
Canvas.Rectangle( 10 , 10 , 100 , 100 );
end;
end.
其实，该例子也是一种替换法，和前面所说的替换法是一样的原理，只不过前面介绍的替换法是间接的，要借助外部事件进行强制转换；而该例子是借助编译器自动完成的。在设计期，使用的是原组件，但是编译的时候，使用的却是同名新组件。编译器遇到同样名称的类型，总是“就近”选取，而本例子中新的TPanel就在本单元，所以编译器选择了它，成了名副其实的“偷梁换柱”。如果新的TPanel在另外的单元，只要在uses中该单元排列在原TPanel所在单元的后面就行了，假如新TPanle所在单元名为MyPanel.pas，写成uses ExtCtrls, MyPanel;就行了。下面举一个复杂点的例子。
去年在论坛上，有人要求实现TEdit只能接受汉字和“，”，并且屏蔽粘贴功能，我当时给的方案如下：
interface
uses
Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
Dialogs,StdCtrls;
type
TForm1 = class (TForm)
Edit1:TEdit;
procedureFormCreate(Sender:TObject);
private
{Privatedeclarations}
LowCh:Boolean;
C:Word;
OldWndProc:TWndMethod;
procedureWndProc(varMessage:TMessage);
public
{Publicdeclarations}
end;
var
Form1:TForm1;
implementation
{$R * .dfm}
procedureTForm1.WndProc(varMessage:TMessage);
var
ch:Word;
begin
if Message.Msg = WM_PASTEthenExit;
if Message.Msg = WM_CHARthen
begin
if Message.LParam = - 1 then
Message.LParam: = 0
else if (Message.WParamand$ 80 ) <> 0 then
begin
if notLowChthen
begin
if ((Message.WParamand$7f)xor$ 20 ) < $ 10 then
begin
C: = Message.WParam;
LowCh: = True;
Exit;
end;
end else
begin
LowCh: = False;
ch: = (Message.WParamshl 8 )orC;
if ((chand$7f7f)xor$ 2020 ) = $0c03then
PostMessage(Edit1.Handle,WM_CHAR,ch, - 1 );
Exit;
end;
end else if Message.WParam >= 32 thenexit;
end;
OldWndProc(Message);
end;
procedureTForm1.FormCreate(Sender:TObject);
begin
OldWndProc: = Edit1.WindowProc;
Edit1.WindowProc: = WndProc;
end;
end.
该方案确实能达到了提问者的要求，但是如果有多个TEdit，就很麻烦了：必须在FormCreate反复赋值，还得要用多个变量或者数组保存每个Edit原先的WindowProc，在新的WinProc过程中还得判断是哪个Edit被激活，以便调用它原先的WindowProc等。这给以后的修改和维护带来了极大的隐患。
按照本文介绍的方法，就不存在这个问题，可以写一个新的TEdit放在另一个单元：
interface
uses
Windows,Messages,SysUtils,StdCtrls;
type
TEdit = class (StdCtrls.TEdit)
private
LowCh:Boolean;
C:Word;
procedureWMChar(varMessage:TWMChar);messageWM_CHAR;
procedureWMPASTE(varMessage:TMessage);messageWM_PASTE;
end;
implementation
{TEdit}
procedureTEdit.WMChar(varMessage:TWMChar);
var
ch:Word;
begin
if Message.KeyData = - 1 then
Message.KeyData: = 0
else if (Message.CharCodeand$ 80 ) <> 0 then
begin
if notLowChthen
begin
if ((Message.CharCodeand$7f)xor$ 20 ) < $ 10 then
begin
C: = Message.CharCode;
LowCh: = True;
Exit;
end;
end else
begin
LowCh: = False;
ch: = (Message.CharCodeshl 8 )orC;
if ((chand$7f7f)xor$ 2020 ) = $0c03then
PostMessage(Handle,WM_CHAR,ch, - 1 );
Exit;
end;
end else if Message.CharCode >= 32 thenexit;
inherited;
end;
procedureTEdit.WMPASTE(varMessage:TMessage);
begin
end;
end.
只要正确引用该单元，任何窗口的任何TEdit 对象都有同样的功能，而且利于维护，测试例子就不写了，读者可以自己测试，只要保证uses列表中Unit2在StdCtrls后面就行了。
当然，该方法也有局限，如本例，如果窗口上有多个Edit，只有其中几个需要屏蔽功能，使用该方法就不适合了，不过，也还是有解决办法，如本例，可使用TEdit.Tag进行分组判断，以实现各组不同的需求。如果需要的功能太多，太复杂，还是应该写成新的组件或者使用第三方组件。
如有错误请指正，我的邮件地址：[email protected]