Delphi对象变成Windows控件的前世今生（关键是设置句柄和回调函数）goodx

----------------------------------------------------------------------
第一步，准备工作：预定义一个全局Win控件变量，以及一个精简化的Win控件类
var
CreationControl: TWinControl = nil; // 定义全局变量，用来表示每次刚创建的Win控件

TWinControl = class(TControl)
private
FDefWndProc: Pointer; // 记录原有的窗口过程，但只有真正创建句柄的时候才会记录。只有Windows控件才有默认窗口处理过程，而TControl有FWindowProc，不是一回事
FObjectInstance: Pointer; // 普通指针(连函数指针都不是)。当转发消息的时候，使用这个普通窗口函数地址（不是类窗口函数地址）。控件创建的时候就会做转换。
FHandle: HWnd; // Windows窗口的真实句柄
FParentWindow: HWnd; // 父窗口的句柄也要记录下来。父控件(类，具有许多额外功能)与父句柄(Windows指针，特简单)不是一回事。这个属性在一般VCL控件里根本用不到，只有ActiveX可能用到
protected
procedure MainWndProc(var Message: TMessage); // 非虚函数，调用WindowProc函数，不希望被覆盖（如果要覆盖就覆盖WndProc函数，而且这也不是唯一的办法）
procedure WndProc(var Message: TMessage); override; // 虚函数，处理少部分消息，最后调用父类同名函数
// 创建和销毁窗口句柄，按调用顺序排列：
procedure CreateHandle; virtual; // 虚函数，关键入口，被UpdateShowing和HandleNeeded调用，事实是子类从来没有被覆盖。
procedure CreateWnd; virtual; // 虚函数，注册窗口类。很多子类都覆盖它，为的是加上一些额外的功能，比如TEdit
procedure CreateParams(var Params: TCreateParams); virtual; // 第一次出现。只有windows控件才需要准备一大堆内容
procedure CreateWindowHandle(const Params: TCreateParams); virtual; // 虚函数，简单函数，调用API, 看名字就很清楚功能。子类有时候覆盖它，TEdit和TMemo
end;

----------------------------------------------------------------------
第二步，调用控件构造函数，申请Delphi控件对象的内存空间。此时这个内存中的控件：
1. 没有Windows句柄，
2. 预备了一个MakeObjectInstance转换后的窗口回调函数指针FObjectInstance，它封装了MainWndProc函数（或者说，它就是MainWndProc函数）。MainWndProc封装了程序员要用到的窗口回调函数WndProc。但这步仅仅是预备窗口函数指针FObjectInstance，并没有做任何使用和设置，使它与一个Windows窗口联系起来。
到这步，在内存中还仅仅是简单的Delphi内存对象，并没有把它与Windows操作系统联系起来使之真正成为一个Windows窗口对象。

TButton.Create;
调用inherited Create(AOwner);

TWinControl.Create;
调用inherited Create(AOwner);
调用FObjectInstance := Classes.MakeObjectInstance(MainWndProc); // 全局函数，把类函数指针MainWndProc转换成普通指针(连函数指针都不是)。注意只有Windows控件才有这项

----------------------------------------------------------------------
第三步，依次调用函数，注册Windows窗口类，使之与当前Delphi对象联系起来（其实是Delphi对象包含它，因为Delphi对象包括了许多其它内容），最关键的有：
0. 在CreateHandle中(即入口函数)，它会调用CreateWnd函数，而CreateHandle本身又会被UpdateShowing和HandleNeeded调用，其中UpdateShowing会被TWinControl.UpdateControlState;调用，UpdateControlState会被TWinControl.InsertControl调用，InsertControl会被TControl.SetParent调用，详情见：
http://www.cnblogs.com/findumars/p/3917061.html
http://www.cnblogs.com/findumars/p/3667031.html
1. 在CreateWnd中，根据Delphi控件的值，准备Params
2. 在CreateWnd中，强行取消注册当前Delphi类（比如TButton），然后设置窗口函数Params.WindowClass.lpfnWndProc := @InitWndProc;
3. 在CreateWnd中，重新注册了Windows窗口Windows.RegisterClass(Params.WindowClass)
4. 在CreateWnd中，执行CreationControl := Self; 此时这个CreationControl就是代表Delphi内存控件
5. 在CreateWnd中，执行CreateWindowHandle(Params); 真正创建Windows窗口，并立即给这个窗口发送WM_NCCREATE消息，在函数返回之前，就跳转到回调函数InitWndProc里执行(即后面的6～10)，然后才将其句柄赋值给Delphi控件属性FHandle（这个赋值其实多余，去掉赋值照样没问题，因为在回调函数里已经赋值了）。
注意1，通过实验发现，在CreateWindowEx这个WINAPI返回之前，就已经发送了WM_NCCREATE消息，因此WINAPI返回之前就会执行InitWndProc回调函数。可以这样理解：CreateWindowEx函数的内部实现就是先创造FHandle，然后就是SendMessage(FHandle, WM_NCCREATE)，回调函数会立刻工作，而此时还没有跳出CreateWindowEx函数呢，因为后面还有两个消息要发送，外加其它善后事宜。
我的理解是，只要成功创建了这个windows窗口就会有句柄（这是将来消息找到这个窗口的唯一依据），不管这个windows窗口是否显示，更不管它是否与Delphi对象相联系，Windows都会给它发送WM_NCCREATE消息。注意这个Windows的窗口函数在注册Windows窗口类的时候就已经存在了（即InitWndProc），所以一定可以执行和处理这个消息。
注意2，由于在回调函数里已经给FHandle属性赋值了，所以FHandle := CreateWindowEx(ExStyle...)，这里的FHanle赋值可以去掉，运行几个demo都正常。但是百思不得其解的是，把InitWndProc的CreationControl.FHandle := HWindow;屏蔽掉，留下FHandle := CreateWindowEx(ExStyle...)却始终报错A call to an OS function failed。经过检测，发现此时CreateWindowEx的返回值为0，不懂为什么。
6. 在InitWndProc中，当第一个消息(WM_NCCREATE)来的时候，就执行CreationControl.FHandle := HWindow;，这样当前Delphi控件第一次有了句柄（最关键的第一步）。
注意，必须执行这一步，如果屏蔽这句话就会出现A call to an OS function failed的错误。即使想了个花招（这招可以使主Form和Button正常创建，然后用Button动态创建TEdit，且Edit.tag=100，这样可以专用测试），if (CreationControl.tag<>100) CreationControl.FHandle := HWindow; 也不行。报错的语句显然是if FHandle = 0 then RaiseLastOSError; 通过单步测试，此时InitWndProc仍可正常执行，但不知道为什么FHandle := CreateWindowEx(ExStyle...)的返回值就变0了。
7. 在InitWndProc中，重新设置以HWindow代表的Windows窗口实例（也就是Delphi控件实例）的窗口函数为预设的FObjectInstance，这样当前Delphi控件的窗口回调函数就是FObjectInstance了，即指向Delphi类的虚函数WndProc了（最关键的第二步）。
8. 在InitWndProc中，对回调函数所需要的4个参数依次压栈，使之符合Windows标准回调函数的stdcall口味
9. 在InitWndProc中，将CreationControl的地址值转移到EAX，并将CreationControl清空，即CreationControl代表的Delphi控件实例的临时任务完成了，准备让下一个新的Delphi控件实例使用
10.在InitWndProc中，使用EAX到内存中找到当前Delphi控件，把它转化成TWinControl，然后直接调用它的FObjectInstance函数处理消息，参数就是刚才压栈的那些参数，这样第一个消息就处理完毕了。处理这个消息的目的有多个，都十分重要，依次为：
1）记录windows控件的句柄到Delphi对象的属性里
2）把这个Windows窗口的回调函数替换为Delphi对象的FObjectInstance，使之间接调用Delphi对象的虚函数WndProc，方便程序员改写
3）用三种方法在全局记录这个windows句柄的ID
4) 上述三个主要目的已经达到，所以尽管WM_NCCREATE消息本身没什么用（一般情况下，因为程序员仍可改写），但消息来了必须处理，所以通过变换手段之后，使用新的回调函数FObjectInstance对消息进行处理。如果程序员也需要使用WM_NCCREATE消息执行某些逻辑，仍可在WndProc和动态函数中正常执行。有一个疑问是，如果屏蔽这段汇编就会出错，错误停留在TWinControl.DefaultHandler的CallWindowProc(FDefWndProc,FHandle,Msg,WParam,LParam);处；把这段汇编改成CALL DefWindowProc也是一样的错误，原因可能是消息必须处理？
11.在CreateHandle中，以当前Delphi控件的FHandle属性为依据，调用SetWindowPos显示了这个Windows窗口，对于一般程序员的理解，就是显示了这个Delphi控件
需要强调的是，以上11个步骤，每次生成Delphi实例（比如TButton实例）都要这样来一遍，但2、3两步不必再次执行，因为Delphi类（比如TButton类）的默认窗口函数始终指向InitWndProc（这也是为什么每个TButton实例都会首先执行InitWndProc窗口函数的原因，Delphi强力保证了这一点，一旦整个类的默认窗口函数被改变，那么取消注册后重新注册，因为InitWndProc的内容的第一遍执行对每个Delphi实例来说实在太重要了，怎么说都不过分），然后重新替换那个Delphi实例的回调函数为它自己的FObjectInstance。

留下一个疑问是，CreationControl是全局变量，InitWndProc是全局函数，且都没有加任何保护，因此在多线程里，VCL是不安全的。以前在书上也多次见过，说VCL是线程不安全的，不知道是不是这个意思。其实WM_NCCREATE作为第一个创建窗口就自动发送过来的消息，几乎是电光火花之间的事情，几乎不可能乱套，尽管理论上存在这种可能。但是一旦错乱将是非常严重的问题，因为怎么可能Button1使用的是Button2的FObjectInstance，反之亦然，同时ID，FHandle都错位。不过貌似加上临界区保护也不难。为什么Delphi的设计者不去这么做？

实际调用关系如下：
TWinControl.CreateHandle;
调用CreateWnd;
调用SetWindowPos(FHandle,SWP_NOMOVE + SWP_NOSIZE + SWP_NOACTIVATE);

TWinControl.CreateWnd;
申请Params: TCreateParams;
调用CreateParams(Params);
调用FDefWndProc := Params.WindowClass.lpfnWndProc; // 更改之前，先记录到Delphi的类属性
调用Params.WindowClass.lpfnWndProc := @InitWndProc; // 更改Delphi类（比如TButton类）的窗口函数为Delphi的全局函数，以后也不会有改变，改变的是Delphi实例的窗口函数。
调用CreationControl := Self; // 全局变量，只此一处使用，记录下来以供InitWndProc使用。注意，每次的Self值是不同的，实际上是不同的Delphi对象的地址值。

TWinControl.CreateParams;
申请Params: TCreateParams; // 是一个Record，即在栈上分配内存。出了这个函数，这部分内存就被收回。
调用CreateParams(Params); // 虚函数，类函数，就这一处被调用。
调用Params.WindowClass.lpfnWndProc := @DefWindowProc; // API，某个Delphi的默认窗口函数，会很快被替换掉。这只是给类的窗口函数，但对于每个实例，它们的每个窗口函数都被换掉了。

TWinControl.CreateWindowHandle;
调用FHandle := CreateWindowEx(ExStyle, WinClassName, Caption, Style, X, Y, Width, Height, WndParent, 0, WindowClass.hInstance, Param);
这个API会发送 WM_NCCREATE, WM_NCCALCSIZE, 和 WM_CREATE，实际上执行了前两个消息对应的函数，最后一个消息的功能被构造函数替代了。
创建后取得窗口句柄，存储在Delphi对象的FHandle属性里

全局函数 InitWndProc(HWindow: HWnd; Message, WParam, LParam: Longint): Longint;
调用CreationControl.FHandle := HWindow;
调用SetWindowLong(HWindow, GWL_WNDPROC, Longint(CreationControl.FObjectInstance)); // 使用事先准备好的FObjectInstance作为普通窗口函数地址，千万注意，这里替换的是某一个Windows窗口的窗口函数，不是整个类的窗口函数。
调用
PUSH LParam // 压栈4个格子
PUSH WParam
PUSH Message
PUSH HWindow
MOV EAX,CreationControl // 把刚才创建的控件地址放到EAX寄存器里。混用汇编和Delphi，直接引用Delphi变量，给下一个函数准备参数。
MOV CreationControl,0 // 用完以后立刻清空，准备让下一个新的Control使用
CALL [EAX].TWinControl.FObjectInstance // 根据寄存器里的内存地址在内存中找到控件，转化为Win控件，并调用它的窗口函数，参数就在栈里
MOV Result,EAX // 处理完(WM_NCCREATE)消息后，把结果传回来

到这里CreationControl和它的窗口函数都被替换了。留下的是一个Delphi对象，有了正确的Handle值，并有了单独的窗口函数(FObjectInstance指向MainWndProc指向WndProc）。甚至还使用FDefWndProc记录了默认窗口函数地址。

-----------------------------------------------------------
第四步，善后工作

TWinControl.Destroy;
调用if FObjectInstance <> nil then Classes.FreeObjectInstance(FObjectInstance); // 全局函数，释放窗口函数的内存

-----------------------------------------------------------
题外话，由Handle找到Delphi控件(内存对象)

主要是利用了Controls单元里定义的1个全局函数FindControl和一个局部函数ObjectFromHWnd

function FindControl(Handle: HWnd): TWinControl;

var

OwningProcess: DWORD;

begin

Result := nil;

if (Handle <> 0) and (GetWindowThreadProcessID(Handle, OwningProcess) <> 0) and

(OwningProcess = GetCurrentProcessId) then

begin

// 第一种方法

if GlobalFindAtom(PChar(ControlAtomString)) = ControlAtom then

Result := Pointer(GetProp(Handle, MakeIntAtom(ControlAtom)))

// 第二种方法（通常用这种）

else

Result := ObjectFromHWnd(Handle);

end;

end;

function ObjectFromHWnd(Handle: HWnd): TWinControl;

var

OwningProcess: DWORD;

begin

if (GetWindowThreadProcessID(Handle, OwningProcess) <> 0) and (OwningProcess = GetCurrentProcessID) then

Result := Pointer(SendMessage(Handle, RM_GetObjectInstance, 0, 0))

else

Result := nil;

end;

另外还有两个有意思的函数，全局函数FindVCLWindow和局部函数IsDelphiHandle：

function FindVCLWindow(const Pos: TPoint): TWinControl;

var

  Handle: HWND;

begin

  Handle := WindowFromPoint(Pos); // API

  Result := nil;

  while Handle <> 0 do

  begin

    Result := FindControl(Handle); // 全局函数

    if Result <> nil then Exit;

    Handle := GetParent(Handle); // API

  end;

end;

function IsDelphiHandle(Handle: HWND): Boolean;

var

  OwningProcess: DWORD;

begin

  Result := False;

  if (Handle <> 0) and (GetWindowThreadProcessID(Handle, OwningProcess) <> 0) and (OwningProcess = GetCurrentProcessId) then

  begin

    if GlobalFindAtom(PChar(WindowAtomString)) = WindowAtom then // API

      Result := GetProp(Handle, MakeIntAtom(WindowAtom)) <> 0    // API

    else

      Result := ObjectFromHWnd(Handle) <> nil;

  end;

end;

-----------------------------------------------------------

对第一个问题的解答：
第6行对窗口类的Fhandle进行赋值，这么做是必要的，因为正常情况下Fhandle只有到CreateWindowsEx返回之后才能得到赋值，在这个函数调用的过程中，系统发送WM_CREATE消息给窗口，在外部，我们可以得到WM_CREATE的处理器进行处理，如果没有第6行的赋值，则那时我们将没有办法得到窗口句柄。我想这也是InitWndProc存在的原因之一。（注：我认为这个答案有启发，但不完善）

参考：http://blog.csdn.net/linzhengqun/article/details/1451088 （有许多好东西）

此外，Delphi这种把类函数转化成普通函数的手法称为“Thunk技术”，网上有很多文章，比如：

http://www.cnblogs.com/memset/p/thunk_in_cpp.html

-----------------------------------------------------------

VC++里也有类似的问题，参考：
http://qiusuoge.com/8119.html

秒客网

Delphi对象变成Windows控件的前世今生（关键是设置句柄和回调函数）goodx

相关文章