在使用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

 

Logo

权威|前沿|技术|干货|国内首个API全生命周期开发者社区

更多推荐