inherited在消息中的作用

好奇一下。看来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没有这个实现，所以直接调用的是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的方法编译成调用DefaultHandle（存疑）r.
实际上这样处理效率比运行时处理要快.

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;