您的位置:首页 > 其它

inherited在消息中的作用(编译器根据inherited所在的函数,直接转换成对祖先类同名动态函数的调用,或者转换成对DefaultHandler的调用)

2014-05-01 19:49 316 查看
好奇一下。看来Object Pascal确实与Windows深入结合了。

unit Unit1;

interface

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

const
UM_Test = WM_USER + 100;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure MyMessage(var Msg: TMessage); message UM_Test;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
Perform(UM_Test, 0, 0);
end;

procedure TForm1.MyMessage(var Msg: TMessage);
begin
inherited;
ShowMessage('Hello');
end;

end.


在message处理中和其他不一样的是inherited不会因为没有在祖先中找到一样的函数或者方法而将inherited失效,他会传入缺省的消息处理.
这里调用TFORM1的祖先的消息处理,由于tform和tcustomform没有这个实现UM_Test函数,所以直接调用的是tcustomform的defaulthandle.(注意这个方法是对twincontrol的override)。

但是,如果本类重载了DefaultHandler函数,就会直接调用本类的DefaultHandler函数:

unit Unit1;

interface

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

const
UM_Test = WM_USER + 100;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure MyMessage(var Msg: TMessage); message UM_Test;
procedure DefaultHandler(var Message); override;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
Perform(UM_Test, 0, 0);
end;

procedure TForm1.DefaultHandler(var Message);
begin
with TMessage(Message) do
begin
if Msg = UM_Test then ShowMessage('DefaultHandler');
end;
inherited;
end;

procedure TForm1.MyMessage(var Msg: TMessage);
begin
inherited;
ShowMessage('Hello');
end;

end.


顺便再看看这样改写的效果:

procedure TForm1.DefaultHandler(var Message);
begin
with TMessage(Message) do
begin
if Msg = UM_Test then ShowMessage('DefaultHandler');
if Msg = WM_SETTEXT then ShowMessage('WM_SETTEXT');
end;
inherited;
end;


理论解释:

因为WndProc里面调用了Dispatch,而Dispatch实际上是尝试调用动态方法,在动态方法表中查找Index是指定的方法,如果一直找到TObject都找不到Index是这个的方法,就会调用DefaultHandler。
这里面有几个概念,动态方法表和虚方法表,不要混了。
动态方法实际上在Class中是个最大65536的函数数组。调用的时候会根据Index到这个数组中来调用。而消息方法实际就是动态方法,方法声明后面的Message实际上就是Index。
VCL之所以对消息处理效率比VC等高,就是因为这个动态方法表,实际调用的就是用消息做下标直接调用方法。最多就是找几层继承的父类。而比VC的遍历要快。

Inherited动态方法的时候就是到父类的动态方法表找Index等于本方法Index的方法。如果父类没有这个方法就再到父类的父类找。都找不到就调用DefaultHandler。

动态方法和虚方法相比优点是省内存,另外能对Message的处理比较方便。虚方法不能做到对消息的方便处理。
虚方法则比较费内存,每个派生类都要有一套虚方法表。但是被调用的时候比动态方法要快,不需要到父类去找。

理论解释2:

你恰恰理解反了,不是Inherited会调用Dispatch,而是Dispatch会调用动态方法.
消息的调用次序实际上是
WndProc->Dispatch->动态方法或者DefaultHandler方法.

TControl.WndProc的最后一句就是Dispatch.
然后Dispatch就找Index的动态方法调用.
如果找不到就调用到DefaultHandler.
如果找到,就调用动态方法.
如果动态方法里面调用了Inherited,那么实际上inherited是编译器处理的.如果在祖宗里面有对应index的方法,那么就直接编译成调用该方法.如果祖宗里面没有该index的方法编译成调用DefaultHandler(存疑).
实际上这样处理效率比运行时处理要快.

Inherited必须由编译器处理的,因为Inherited有两种含义.动态方法和虚方法的实现机制不同必然要根据方法编译成不同的代码.

====================================================================

procedure TObject.Dispatch(var Message);
asm
PUSH    ESI
MOV     SI,[EDX] //获取index
OR      SI,SI
JE      @@default //如果是0,到default,也就是调用DefaultHandler
CMP     SI,0C000H
JAE     @@default //如果不在合理范围内,到default,也就是调用DefaultHandler
PUSH    EAX
MOV     EAX,[EAX]
CALL    GetDynaMethod  //获取动态方法
POP     EAX
JE      @@default  //如果GetDynaMethod返回的是nil,到default,也就是调用DefaultHandler
MOV     ECX,ESI
POP     ESI
JMP     ECX //跳转到动态方法

@@default:
POP     ESI
MOV     ECX,[EAX]
JMP     DWORD PTR [ECX] + VMTOFFSET TObject.DefaultHandler
end;

procedure       GetDynaMethod;
{       function        GetDynaMethod(vmt: TClass; selector: Smallint) : Pointer;       }
asm
{ ->    EAX     vmt of class          }
{       SI      dynamic method index    }
{ <-    ESI pointer to routine  }
{       ZF = 0 if found         }
{       trashes: EAX, ECX          }

PUSH    EDI
XCHG    EAX,ESI
JMP     @@haveVMT
@@outerLoop:
MOV     ESI,[ESI]
@@haveVMT:
MOV     EDI,[ESI].vmtDynamicTable //根据vmt获取该类的动态方法表
TEST    EDI,EDI
JE      @@parent
MOVZX   ECX,word ptr [EDI]
PUSH    ECX
ADD     EDI,2
REPNE   SCASW
JE      @@found //跳到found
POP     ECX
@@parent:
MOV     ESI,[ESI].vmtParent //为空,那么找父类的
TEST    ESI,ESI //测试父类是否为空
JNE     @@outerLoop //跳出循环
JMP     @@exit //退出

@@found:
POP     EAX
ADD     EAX,EAX
SUB     EAX,ECX         { this will always clear the Z-flag ! }
MOV     ESI,[EDI+EAX*2-4]

@@exit:
POP     EDI
end;


对应的pascal代码如下

procedure TObject.Dispatch(var Message);
type
//THandlerProc = procedure(Self: Pointer; var Message) { of object };
THandlerProc = procedure(var Message) of object;
var
MsgID: Word;
Addr: Pointer;
M: THandlerProc;
begin
MsgID := TDispatchMessage(Message).MsgID;//消息id,也就是动态方法表的索引
if (MsgID <> 0) and (MsgID < $C000) then
begin
Addr := GetDynaMethod(PPointer(Self)^, MsgID);//获取class的动态方法表
if Addr <> nil then//如果拿到了动态方法就调用
begin
//THandlerProc(Addr)(Self, Message)
TMethod(M).Data := Self;
TMethod(M).Code := Addr;
M(Message);
end
else
Self.DefaultHandler(Message);//如果找不到动态方法则调用defaultHandler
end
else
Self.DefaultHandler(Message);//如果index范围不在应该在的范围内也调用DefaultHandler
end;

function GetDynaMethod(vmt: TClass; selector: SmallInt): Pointer;
type
TDynaMethodTable = record
Count: Word;
Selectors: array[0..9999999] of SmallInt;
{Addrs: array[0..0] of Pointer;}
end;
PDynaMethodTable = ^TDynaMethodTable;
var
dynaTab: PDynaMethodTable;
Parent: Pointer;
Addrs: PPointer;
I: Cardinal;
begin
while True do
begin
dynaTab := PPointer(PByte(vmt) + vmtDynamicTable)^;//根据vmt获取该类的动态方法表
if dynaTab <> nil then
begin
for I := 0 to dynaTab.Count - 1 do
if dynaTab.Selectors[I] = selector then
begin
Addrs := PPointer(PByte(@dynaTab.Selectors) + dynaTab.Count * SizeOf(dynaTab.Selectors[0]));
Result := PPointer(PByte(Addrs) + I * SizeOf(Pointer))^;
Exit;//能找到则退出
end;
end;
Parent := PPointer(PByte(vmt) + vmtParent)^;//找不到则找父类的
if Parent = nil then Break;//如果父类是nil,也就是tobject了,则退出
vmt := PPointer(Parent)^;
end;
Result := nil;
end;
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: 
相关文章推荐