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

2023-06-20 18:14•css•阅读 4339

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

第一步，准备工作：预定义一个全局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

上一篇 »JavaScript - 异步的前世今生
下一篇 »delphi 怎样设置组合键？

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

相关推荐

Apache Beam是什么？

Delphi WebBrowser控件的使用

如何 Delphi Edit 让密码变成点？

【Delphi】FMX 如何设置 TVertScrollBox的滚动位置，使其回到顶部原点？

Delphi 调用C/C++的Dll，stdcall关键字, 会导致函数名分裂. 此时函数名变成_stdadd@8

关于delphi编译路径设置问题

nodejs、npm、grunt——名词解释

Delphi7 THTTPRIO 控件设置超时