Delphi組件的偷梁換柱

    在使用Delphi可視化設計時，有時覺得某個元件缺少點自己需要的功能或者屬性，或者需要的功能或者屬性是protected，沒法直接得到。比如TPanel，是個容器類組件，其功能是用來放置其它視窗組件和圖形組件，但是，如果想在它的介面上畫點什麼就不那麼方便了，既沒有OnPaint事件，也不能直接擷取其Canvas（該屬性是protected）。

    碰到這類問題，我們採用的策略一般有2個：

1. 重新寫一個該組件的衍生類別，註冊到IDE的組件面板中，或者動態建立這個類，插入到視窗中，對於類似TPanel的組件，由於可能要在其上放置其它組件，只能選擇註冊，但是由於我們需要的新增功能不多，或者只是想得到組件的protected方法或屬性，註冊一個新組件似乎很“冤”，對較大項目的維護也很不利。
2. 採用替換法，如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