Delphi组件的偷梁换柱

在使用Delphi可视化设计时，有时觉得某个元件缺少点自己需要的功能或者属性，或者需要的功能或者属性是protected，没法直接得到。
正在装载数据……
比如TPanel，是个容器类组件，其功能是用来放置其它窗口组件和图形组件，但是，如果想在它的界面上画点什么就不那么方便了，既没有OnPaint事件，也不能直接获取其Canvas（该属性是protected）。

碰到这类问题，我们采用的策略一般有2个：

重新写一个该组件的派生类，注册到IDE的组件面板中，或者动态建立这个类，插入到窗口中，对于类似TPanel的组件，由于可能要在其上放置其它组件，只能选择注册，但是由于我们需要的新增功能不多，或者只是想得到组件的protected方法或属性，注册一个新组件似乎很“冤”，对较大项目的维护也很不利。
采用替换法，如TPanel，写成TMyPanel = class(TPanle)，然后通过强制转换后取得其protected方法和属性，或者使用新增的属性和方法。不过这样也很麻烦，有时也会有些问题，比如上面所说的要在TPanle上画点什么，只能在TForm.OnPaint事件进行，下面是替换法的例子，在Panel1的界面上画一个红色矩形：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TMyPanel = class(TPanel);

  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    procedure FormPaint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.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;
}
  with TMyPanel(Panel1) do
  begin
    Canvas.Pen.Color := clRed;
    Canvas.Rectangle(10, 10, 100, 100);
  end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Invalidate;
end;

end.

运行上面例子，由于Form在开始显示时，其OnPaint在TPanel.Paint方法前被调用，所以窗口开始显示时，我们得不到应有的效果，必须借助一次刷新才行，而且这个刷新还不知道在哪个事件中进行才合适，笔者在Form的OnCreate、OnShow、OnActive以及OnResize事件中都试过，都不起作用（使用FormOnPaint中被注释的代码也是一样），笔者愚钝，只好借助按钮Click事件刷新一次。

采用本文介绍的组件“偷梁换柱”法，可以方便的解决这类问题。请看和上面例子同样功能的代码：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TPanel = class(ExtCtrls.TPanel)
  public
    procedure Paint; override;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TPanel }

procedure TPanel.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只能接受汉字和“，”，并且屏蔽粘贴功能，我当时给的方案如下：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    LowCh: Boolean;
    C: Word;
    OldWndProc: TWndMethod;
    procedure WndProc(var Message: TMessage);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WndProc(var Message: TMessage);
var
  ch: Word;
begin
  if Message.Msg = WM_PASTE then Exit;
  if Message.Msg = WM_CHAR then
  begin
    if Message.LParam = -1 then
      Message.LParam := 0
    else if (Message.WParam and $80) <> 0  then
    begin
      if not LowCh then
      begin
        if ((Message.WParam and $7f) xor $20) < $10 then
        begin
          C := Message.WParam;
          LowCh := True;
          Exit;
        end;
      end else
      begin
        LowCh := False;
        ch := (Message.WParam shl 8) or C;
        if ((ch and $7f7f) xor $2020) = $0c03 then
          PostMessage(Edit1.Handle, WM_CHAR, ch, -1);
        Exit;
      end;
    end else if Message.WParam >= 32 then exit;
  end;
  OldWndProc(Message);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  OldWndProc := Edit1.WindowProc;
  Edit1.WindowProc := WndProc;
end;

end.

该方案确实能达到了提问者的要求，但是如果有多个TEdit，就很麻烦了：必须在FormCreate反复赋值，还得要用多个变量或者数组保存每个Edit原先的WindowProc，在新的WinProc过程中还得判断是哪个Edit被激活，以便调用它原先的WindowProc等。这给以后的修改和维护带来了极大的隐患。

按照本文介绍的方法，就不存在这个问题，可以写一个新的TEdit放在另一个单元：

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, StdCtrls;

type
  TEdit = class(StdCtrls.TEdit)
  private
    LowCh: Boolean;
    C: Word;
    procedure WMChar(var Message: TWMChar); message WM_CHAR;
    procedure WMPASTE(var Message: TMessage); message WM_PASTE;
  end;

implementation

{ TEdit }

procedure TEdit.WMChar(var Message: TWMChar);
var
  ch: Word;
begin
  if Message.KeyData = -1 then
    Message.KeyData := 0
  else if (Message.CharCode and $80) <> 0  then
  begin
    if not LowCh then
    begin
      if ((Message.CharCode and $7f) xor $20) < $10 then
      begin
        C := Message.CharCode;
        LowCh := True;
        Exit;
      end;
    end else
    begin
      LowCh := False;
      ch := (Message.CharCode shl 8) or C;
      if ((ch and $7f7f) xor $2020) = $0c03 then
        PostMessage(Handle, WM_CHAR, ch, -1);
      Exit;
    end;
  end else if Message.CharCode >= 32 then exit;
  inherited;
end;

procedure TEdit.WMPASTE(var Message: TMessage);
begin

end;

end.

只要正确引用该单元，任何窗口的任何TEdit 对象都有同样的功能，而且利于维护，测试例子就不写了，读者可以自己测试，只要保证uses列表中Unit2在StdCtrls后面就行了。

当然，该方法也有局限，如本例，如果窗口上有多个Edit，只有其中几个需要屏蔽功能，使用该方法就不适合了，不过，也还是有解决办法，如本例，可使用TEdit.Tag进行分组判断，以实现各组不同的需求。如果需要的功能太多，太复杂，还是应该写成新的组件或者使用第三方组件。

如有错误请指正，我的邮件地址：maozefa@hotmail.com

本文来源：http://blog.csdn.net/maozefa/archive/2007/08/06/1728621.aspx

最新热点		最新推荐		相关文章
		在delphi中使用xml文档有… 初探delphi 7 中的插件编… delphi 2006(dexter) & … 获得windows的版本信息。 “序列号输入助手”源代… rs232串口通讯模块 ado方式下判断数据表是否…		Ant入门－配置和使用选… 浅析Spring框架下PropertyPl… SPRING+STRUTS+HIBERNATE登录… MVP——Model-Viewer-Presen… C++ Object Model constructor and destructor 绑定HGE到AngelScript脚本系… delegate C#关键字 (委托类型… Boyer-Moore String Searchi… 【游戏制作基础】网络游戏设…