唤醒控件曾经拥有的能力

控件的祖先 TControl 有很多功能, 但它的有些子孙确丧失了很多(为了专用).

譬如 TBevel 就没有把一些常规的事件继承下来, 那些没有被继承的功能一般都隐藏在 protected 区, 如果重新继承是可以使用的.

这里尝试了另外一种方法: 自己没有继承时, 问一问有继承的兄弟、叔伯获取其它亲戚; 当然应先确保自己的祖先有该功能且没被覆盖过.
通过传统的继承法让 TBevel 相应双击事件:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TMyBevel = class(TBevel)
  protected
    procedure DblClick; override;
  end;

procedure TMyBevel.DblClick;
begin
  inherited;
  ShowMessage(ClassName);
end;

//
procedure TForm1.FormCreate(Sender: TObject);
begin
  with TMyBevel.Create(Self) do
  begin
    Left := 10;
    Top := 10;
    Parent := Self;
  end;
end;

end.

先在窗体上添加一个 TBevel, 它没有双击事件, 问一问 TForm 吧:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Bevel1: TBevel;
    procedure FormCreate(Sender: TObject);
  private
    procedure MyDbClick(Sender: TObject);
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  TForm(Bevel1).OnDblClick := MyDbClick;
end;

procedure TForm1.MyDbClick(Sender: TObject);
begin
  ShowMessage(TComponent(Sender).Name);
end;

end.

TBevel 通过 TForm 唤醒了对 OnMouseDown、OnMouseMove、OnMouseUp 的记忆, 从而实现被拖动的动能:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Bevel1: TBevel;
    procedure FormCreate(Sender: TObject);
  private
  protected
    procedure MyMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
    procedure MyMouseMove(Sender: TObject; Shift: TShiftState; X: Integer; Y: Integer);
    procedure MyMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  a,b: Integer;
  f: Boolean;

procedure TForm1.FormCreate(Sender: TObject);
begin
  TForm(Bevel1).OnMouseDown := MyMouseDown;
  TForm(Bevel1).OnMouseMove := MyMouseMove;
  TForm(Bevel1).OnMouseUp := MyMouseUp;
end;

procedure TForm1.MyMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  f := True;
  a := X;
  b := Y;
end;

procedure TForm1.MyMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if f then with TControl(Sender) do
  begin
    Left := Left + X - a;
    Top := Top + Y - b;
  end;
end;

procedure TForm1.MyMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  f := False;
end;

end.