Window SubClassing之另类运用（之一）
所谓Window SubClassing，中文通常译为窗口子类化，简单说来就是截获并处理窗口过程的技术。可能很多程序员都已经了解这项技术，并且或多或少在自己的程序中使用过它。在微软的MFC类库中就大量使用了Window SubClassing方法，以至于有人说“MFC is about Subclassing”。即使你没有用过，至少你也应该听说过它。所谓另类，有不循常理、不拘一格的意思。我在这里将要描述都可以说是一些“旁门左道”的应用，不过或许能够让你有耳目一新的感觉。
我的第一个应用是所谓“延时自动关闭的对话框”。Windows中用来显示信息的MessageBox函数非常简单方便，但是它有一个致命的缺陷，就是除非用户按下某个按钮，否则整个程序的执行都会挂起。这对于无人值守的自动化程序来说是无论如何都不能接受的。如果是在比较依赖于时序的应用程序中（例如多线程程序或者基于定时器的应用），MessageBox还可能严重干扰整个程序的执行流程。为了解决这个问题，自己定义一个新的、能够自动关闭的对话框当然是最直观的做法，但是我发现这也是应用SubClass的一个好地方，因为我们并不需要在UI上花什么功夫，唯一需要做的就是为对话框增加一条WM_TIMER的消息和对应的处理程序就行了。
想法虽然简单，实现起来却有一点小小的麻烦。首先指出一点：要实现SubClass，唯一的充分必要条件是我们需要获得某个特定窗口的句柄。就是这个简单的要求，对于MessageBox来说却很棘手，因为它是一个模态对话框，窗口在调用MessageBox之后才建立，而在MessageBox返回的时候就已经撤销了。我们如何获得这个窗口呢？
这里的关键在于，在调用MessageBox的同时，系统将把应用程序的主线程挂起，在MessageBox返回后才把控制权交还，所以我们没有获得这个窗口的机会。既然知道了症结所在，解决方案也就来了：主线程虽然挂起了，但是我可以使用子线程，看你能奈我何？
方法已经找到，接下来的实现可以说是势如破竹了。首先，声明必须的类型和变量：
type
TWindowProc = function(AWnd:HWND; uMsg:UINT; wp:WPARAM; lp:LPARAM) : LongInt; stdcall;
var
OldProc : TWindowProc = nil;
既然是SubClass，我们免不了要自己写一个窗口过程。唯一需要处理的就是WM_TIMER 消息，在收到这个消息的时候关闭对话框即可：
function NewProc(AWnd:HWND; uMsg:UINT; wp:WPARAM; lp:LPARAM):LongInt;stdcall;
begin
Result := 0;
case uMsg of
WM_TIMER:
begin
KillTimer(AWnd, 1);
PostMessage(AWnd, WM_COMMAND, IDCANCEL, 0);
end;
end;
if Assigned(OldProc) then
Result := OldProc(AWnd, uMsg, wp, lp);
end;
然后需要生成一个线程对象，并修改它的执行方法如下：
procedure TMsgThread.Execute;
var
wnd, wndDesktop : HWND;
ClassName : array[0..80] of char;
begin
WaitForInputIdle(GetCurrentProcess(), INFINITE);
wndDesktop := GetDesktopWindow();
wnd := GetWindow(wndDesktop, GW_CHILD);
while IsWindow(wnd) do begin
GetClassName(wnd, ClassName, 80);
if (lstrcmpi(ClassName, '#32770')=0)
and (GetParent(wnd)=Application.MainForm.Handle) then begin
OldProc := TWindowProc(GetWindowLong(wnd, GWL_WNDPROC));
SetWindowLong(wnd, GWL_WNDPROC, LongInt(@NewProc));
SetTimer(wnd, 1, 3000, nil);
Break;
end;
wnd := GetWindow(wnd, GW_HWNDNEXT);
end;
end;
请注意WaitForInputIdle的调用，因为线程对象必须先于MessageBox调用，所以我们必须等待操作系统将对话框的初始化工作完成后，再执行下面的动作，否则查找MessageBox窗口的任务很可能会失败。另外，信息框的窗口类是#32770，够特别的吧！
测试代码就更简单了：
procedure TForm1.Button1Click(Sender: TObject);
var
MsgThread : TMsgThread;
begin
MsgThread := TMsgThread.Create(False);
try
MessageBox(Handle, 'Test Msg', 'TestDlg', MB_OK);
finally
MsgThread.Free;
end;
end;
我们的工作到此告一段落。当然，你还可以将上述所有的代码封装成一个构件，像OpenDialog或者FontDialog那样，添加一个Execute方法即可。这项工作就留给有兴趣的读者自己完成了。
