Windows应用程序的每一个窗口都有一个大的消息循环以及一个窗口函数(WndProc)用以分发和处理消息。VCL作为一个Framework,当然会将这些东西隐藏起来,而重新提供一种易用的、易理解的虚拟机制给程序员。
那么VCL是如何做到的呢?
本节就来解答这个问题。
只要代码单元中包含了Forms.pas,就会得到一个对象——Application。利用它可以帮助我们完成许多工作。例如要退出应用程序,可以使用
Application.Terminate();
Application对象是VCL提供的,在Forms.pas中可以看到如下这个定义:
var
Application: TApplication;
当创建一个默认的应用程序时,会自动得到以下几行代码:
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
这几行代码很简洁地展示了TApplication的功能、初始化、创建必要的窗体、运行……
但是,这几行代码具体做了什么幕后操作呢?Application.Run之后,程序流程走向了哪里?
1.脱离VCL的Windows程序
在此,给出一个用纯Pascal所编写的十分简单的Windows应用程序,以演示标准Windows程序是如何被建立及运行的。
就是这样一个简单的程序,演示了标准Windows程序的流程:
(1)从入口函数WinMain开始。
(2)注册窗口类及窗口函数(Window Procedure)。
(3)创建并显示窗口。
(4)进入主消息循环,从消息队列中获取并分发消息。
(5)消息被分发后,由Windows操作系统调用窗口函数,由窗口函数对消息进行 处理。
在Object Pascal中看不到所谓的“WinMain”函数。不过,其实整个program的begin处就是Windows程序的入口。
注册窗口类通过系统API函数RegisterClass()来完成,它向Windows系统注册一个窗口的类型。
注册窗口类型完成后,就可以创建这个类型的窗口实例。创建出一个真正的窗口可通过API函数CreateWindow()来实现。
创建出的窗口实例通过API函数ShowWindow()来使得它显示在屏幕上。
当这一切都完成后,窗口开始进入一个while循环以处理各种消息,直至API函数GetMessage()返回0才退出程序。循环中,程序需要从主线程的消息队列中取出各种消息,并将它分发给系统,然后由Windows系统调用窗口的窗口函数(WndProc),以完成窗口对消息的响应处理。
TApplication除了定义一个应用程序的特性及行为外,另一个重要的使命就是封装以上的那些令人讨厌的、繁琐的步骤。
2.Application对象的本质
注意:Application是一个0*0大小的不可见窗口!并且这个窗口是windows应用程序的主窗口,delphi应用程序的主窗体是这个窗口的子窗口,因此会以一个消息循环接受窗口消息并且加以分派和处理。TApplication类封装了创建秘密窗口和消息循环的程序代码。所有的事情发生在全局对象Application对象被创建之时。
TApplication的构造函数中:
构造函数会调用CreateHandle方法(非常重要的函数)。查看该方法源代码可知,该方法的任务正是注册窗口类,并创建一个窗口实例。
SetWindowLong(FHandle, GWL_WNDPROC, Longint(FObjectInstance));
此时,SetWindowLong()的第3个参数为窗口函数实例的地址,其中FObjectInstance是由CreateHandle()的第1行代码
FObjectInstance := Classes.MakeObjectInstance(WndProc);
所创建的实例的指针,而WndProc()则成了真正的窗口函数。
TApplication本身有一个private成员FMainForm,它指向程序员所定义的主窗体,并在TApplication.CreateForm方法中判断并赋值:
因此,Delphi为每个应用程序自动生成的代码中就有对CreateForm的调用,如:
Application.CreateForm(TForm1, Form1);
值得注意的是,如果有一系列的多个CreateForm的调用,则第一个调用CreateForm被创建的窗体,就是整个Application的MainForm。
3.TApplication创建主消息循环
在TApplication的CreateHandle方法中可以看到,SetWindowLong()的调用将TApplication.WndProc设置成了那个0×0大小窗口的窗口函数。
也就是说,在TApplication的构造函数中主要完成了两件事情:注册窗口类及窗口函数,创建Application窗口实例。TApplication类的Run方法中:
是的,这就是主消息循环。看上去似乎没有取消息、分发消息的过程,其实它们都被包含在HandleMessage()方法中了。HandleMessage()方法其实是对ProcessMessage()方法的调用,而在ProcessMessage()中就可以看到取消息、分发消息的动作了。
4.窗口函数(WndProc)处理消息
窗口函数是一个回调函数,它被Windows系统所调用,其参数会被给出消息编号、消息参数等信息,以便进行处理。
典型的窗口函数中会包含一个大的case分支,以处理不同的消息。TApplication.CreateHandle()的代码时提到过,CreateHandle()将Application窗口的窗口函数设置为WndProc()。那么,现在就来看一下这个WndProc:
整个WndProc()方法,基本上只包含了一个庞大的case分支,其中给出了每个消息的处理代码,“WM_”打头的为Windows定义的窗口消息,“CM_”打头的为VCL库自定义的消息。
需要注意的是,这里给出WndProc是属于TApplication的,也就是那个0×0大小的Application窗口的窗口函数,而每个Form另外都有自己的窗口函数。
那么VCL是如何做到的呢?
本节就来解答这个问题。
只要代码单元中包含了Forms.pas,就会得到一个对象——Application。利用它可以帮助我们完成许多工作。例如要退出应用程序,可以使用
Application.Terminate();
Application对象是VCL提供的,在Forms.pas中可以看到如下这个定义:
var
Application: TApplication;
当创建一个默认的应用程序时,会自动得到以下几行代码:
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
这几行代码很简洁地展示了TApplication的功能、初始化、创建必要的窗体、运行……
但是,这几行代码具体做了什么幕后操作呢?Application.Run之后,程序流程走向了哪里?
1.脱离VCL的Windows程序
在此,给出一个用纯Pascal所编写的十分简单的Windows应用程序,以演示标准Windows程序是如何被建立及运行的。
program WindowDemo;
uses Windows, Messages;
// 窗口函数,窗口接到消息时被Windows所调用
function WindowProc(hwnd : HWND; uMsg : Cardinal; wParam : WPARAM;
lParam : LPARAM) : LResult; stdcall;
begin
Result := 0;
case uMsg of
// 关闭窗口消息,当用户关闭窗口后,通知主消息循环结束程序
WM_CLOSE : PostMessage(hwnd, WM_QUIT, 0, 0);
// 鼠标左键按下消息
WM_LBUTTONDOWN : MessageBox(hwnd, 'Hello!', '和您打个招呼',
MB_ICONINFORMATION);
else
// 其他消息做默认处理
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;
end;
var
wndcls : WNDCLASS; // 窗口类的记录(结构)类型
hWnd : THandle;
Msg : tagMSG; // 消息类型
begin
wndcls.style := CS_DBLCLKS; // 允许窗口接受鼠标双击
wndcls.lpfnWndProc := @WindowProc; // 为窗口类指定窗口函数
wndcls.cbClsExtra := 0;
wndcls.cbWndExtra := 0;
wndcls.hInstance := hInstance;
wndcls.hIcon := 0;
wndcls.hCursor := LoadCursor(hInstance, 'IDC_ARROW');
wndcls.hbrBackground := COLOR_WINDOWFRAME;
wndcls.lpszMenuName := nil;
wndcls.lpszClassName := 'WindowClassDemo'; // 窗口类名称
// 注册窗口类
if RegisterClass(wndcls) = 0 then
Exit;
// 创建窗口
hWnd := CreateWindow(
'WindowClassDemo', // 窗口类名称
'WindowDemo', // 窗口名称
WS_BORDER or WS_CAPTION or WS_SYSMENU, // 窗口类型
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
0,
0,
hInstance,
nil
);
if hWnd = 0 then
Exit;
// 显示窗口
ShowWindow(hWnd, SW_SHOWNORMAL);
UpdateWindow(hWnd);
// 创建主消息循环,处理消息队列中的消息并分发
// 直至收到WM_QUIT消息,退出主消息循环,并结束程序
// WM_QUIT消息由PostMessage()函数发送
while GetMessage(Msg, hWnd, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.
该程序没有使用VCL,它所做的事情就是显示一个窗口。当在窗口上单击鼠标右键时,会弹出一个友好的对话框向您问好。如果从来不曾了解过这些,那么建议您实际运行一下光盘上的这个程序,对其多一些感性认识。uses Windows, Messages;
// 窗口函数,窗口接到消息时被Windows所调用
function WindowProc(hwnd : HWND; uMsg : Cardinal; wParam : WPARAM;
lParam : LPARAM) : LResult; stdcall;
begin
Result := 0;
case uMsg of
// 关闭窗口消息,当用户关闭窗口后,通知主消息循环结束程序
WM_CLOSE : PostMessage(hwnd, WM_QUIT, 0, 0);
// 鼠标左键按下消息
WM_LBUTTONDOWN : MessageBox(hwnd, 'Hello!', '和您打个招呼',
MB_ICONINFORMATION);
else
// 其他消息做默认处理
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;
end;
var
wndcls : WNDCLASS; // 窗口类的记录(结构)类型
hWnd : THandle;
Msg : tagMSG; // 消息类型
begin
wndcls.style := CS_DBLCLKS; // 允许窗口接受鼠标双击
wndcls.lpfnWndProc := @WindowProc; // 为窗口类指定窗口函数
wndcls.cbClsExtra := 0;
wndcls.cbWndExtra := 0;
wndcls.hInstance := hInstance;
wndcls.hIcon := 0;
wndcls.hCursor := LoadCursor(hInstance, 'IDC_ARROW');
wndcls.hbrBackground := COLOR_WINDOWFRAME;
wndcls.lpszMenuName := nil;
wndcls.lpszClassName := 'WindowClassDemo'; // 窗口类名称
// 注册窗口类
if RegisterClass(wndcls) = 0 then
Exit;
// 创建窗口
hWnd := CreateWindow(
'WindowClassDemo', // 窗口类名称
'WindowDemo', // 窗口名称
WS_BORDER or WS_CAPTION or WS_SYSMENU, // 窗口类型
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
0,
0,
hInstance,
nil
);
if hWnd = 0 then
Exit;
// 显示窗口
ShowWindow(hWnd, SW_SHOWNORMAL);
UpdateWindow(hWnd);
// 创建主消息循环,处理消息队列中的消息并分发
// 直至收到WM_QUIT消息,退出主消息循环,并结束程序
// WM_QUIT消息由PostMessage()函数发送
while GetMessage(Msg, hWnd, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.
就是这样一个简单的程序,演示了标准Windows程序的流程:
(1)从入口函数WinMain开始。
(2)注册窗口类及窗口函数(Window Procedure)。
(3)创建并显示窗口。
(4)进入主消息循环,从消息队列中获取并分发消息。
(5)消息被分发后,由Windows操作系统调用窗口函数,由窗口函数对消息进行 处理。
在Object Pascal中看不到所谓的“WinMain”函数。不过,其实整个program的begin处就是Windows程序的入口。
注册窗口类通过系统API函数RegisterClass()来完成,它向Windows系统注册一个窗口的类型。
注册窗口类型完成后,就可以创建这个类型的窗口实例。创建出一个真正的窗口可通过API函数CreateWindow()来实现。
创建出的窗口实例通过API函数ShowWindow()来使得它显示在屏幕上。
当这一切都完成后,窗口开始进入一个while循环以处理各种消息,直至API函数GetMessage()返回0才退出程序。循环中,程序需要从主线程的消息队列中取出各种消息,并将它分发给系统,然后由Windows系统调用窗口的窗口函数(WndProc),以完成窗口对消息的响应处理。
TApplication除了定义一个应用程序的特性及行为外,另一个重要的使命就是封装以上的那些令人讨厌的、繁琐的步骤。
2.Application对象的本质
注意:Application是一个0*0大小的不可见窗口!并且这个窗口是windows应用程序的主窗口,delphi应用程序的主窗体是这个窗口的子窗口,因此会以一个消息循环接受窗口消息并且加以分派和处理。TApplication类封装了创建秘密窗口和消息循环的程序代码。所有的事情发生在全局对象Application对象被创建之时。
TApplication的构造函数中:
constructor TApplication.Create(AOwner: TComponent)
var
if not IsLibrary then CreateHandle;
end;
var
if not IsLibrary then CreateHandle;
end;
构造函数会调用CreateHandle方法(非常重要的函数)。查看该方法源代码可知,该方法的任务正是注册窗口类,并创建一个窗口实例。
procedure TApplication.CreateHandle;
var
TempClass: TWndClass;
SysMenu: HMenu;
begin
if not FHandleCreated and not IsConsole then
begin
FObjectInstance := Classes.MakeObjectInstance(WndProc);
// 如果窗口类不存在,则注册窗口类
if not GetClassInfo(HInstance, WindowClass.lpszClassName, TempClass) then
begin
WindowClass.hInstance := HInstance;
if Windows.RegisterClass(WindowClass) = 0 then
raise EOutOfResources.Create(SWindowClass);
end;
// 创建窗口,长度和宽度都是0,位置在屏幕中央,返回的句柄FHandle
// 也就是Tapplication.Handle的值
FHandle := CreateWindow(WindowClass.lpszClassName, PChar(FTitle),
WS_POPUP or WS_CAPTION or WS_CLIPSIBLINGS or WS_SYSMENU
or WS_MINIMIZEBOX,
GetSystemMetrics(SM_CXSCREEN) div 2,
GetSystemMetrics(SM_CYSCREEN) div 2,
0, 0, 0, 0, HInstance, nil);
FTitle := '';
FHandleCreated := True;
// 调用SetWindowLong设置窗口的窗口函数(WndProc)
SetWindowLong(FHandle, GWL_WNDPROC, Longint(FObjectInstance));
if NewStyleControls then
begin
SendMessage(FHandle, WM_SETICON, 1, GetIconHandle);
SetClassLong(FHandle, GCL_HICON, GetIconHandle);
end;
SysMenu := GetSystemMenu(FHandle, False);
DeleteMenu(SysMenu, SC_MAXIMIZE, MF_BYCOMMAND);
DeleteMenu(SysMenu, SC_SIZE, MF_BYCOMMAND);
if NewStyleControls then DeleteMenu(SysMenu, SC_MOVE, MF_BYCOMMAND);
end;
end;
对照一下此前使用纯API编写的窗口程序,就会发现一些它们的相似之处。在CreateHandle()中,可以看到熟悉的RegisterClass()、CreateWindow()等API函数的调用。比较特别的是,CreateHandle()中通过API函数SetWindowLong()来设置窗口的窗口函数:var
TempClass: TWndClass;
SysMenu: HMenu;
begin
if not FHandleCreated and not IsConsole then
begin
FObjectInstance := Classes.MakeObjectInstance(WndProc);
// 如果窗口类不存在,则注册窗口类
if not GetClassInfo(HInstance, WindowClass.lpszClassName, TempClass) then
begin
WindowClass.hInstance := HInstance;
if Windows.RegisterClass(WindowClass) = 0 then
raise EOutOfResources.Create(SWindowClass);
end;
// 创建窗口,长度和宽度都是0,位置在屏幕中央,返回的句柄FHandle
// 也就是Tapplication.Handle的值
FHandle := CreateWindow(WindowClass.lpszClassName, PChar(FTitle),
WS_POPUP or WS_CAPTION or WS_CLIPSIBLINGS or WS_SYSMENU
or WS_MINIMIZEBOX,
GetSystemMetrics(SM_CXSCREEN) div 2,
GetSystemMetrics(SM_CYSCREEN) div 2,
0, 0, 0, 0, HInstance, nil);
FTitle := '';
FHandleCreated := True;
// 调用SetWindowLong设置窗口的窗口函数(WndProc)
SetWindowLong(FHandle, GWL_WNDPROC, Longint(FObjectInstance));
if NewStyleControls then
begin
SendMessage(FHandle, WM_SETICON, 1, GetIconHandle);
SetClassLong(FHandle, GCL_HICON, GetIconHandle);
end;
SysMenu := GetSystemMenu(FHandle, False);
DeleteMenu(SysMenu, SC_MAXIMIZE, MF_BYCOMMAND);
DeleteMenu(SysMenu, SC_SIZE, MF_BYCOMMAND);
if NewStyleControls then DeleteMenu(SysMenu, SC_MOVE, MF_BYCOMMAND);
end;
end;
SetWindowLong(FHandle, GWL_WNDPROC, Longint(FObjectInstance));
此时,SetWindowLong()的第3个参数为窗口函数实例的地址,其中FObjectInstance是由CreateHandle()的第1行代码
FObjectInstance := Classes.MakeObjectInstance(WndProc);
所创建的实例的指针,而WndProc()则成了真正的窗口函数。
TApplication本身有一个private成员FMainForm,它指向程序员所定义的主窗体,并在TApplication.CreateForm方法中判断并赋值:
procedure TApplication.CreateForm(InstanceClass: TComponentClass; var Reference);
var
Instance: TComponent;
begin
Instance := TComponent(InstanceClass.NewInstance);
TComponent(Reference) := Instance;
try
Instance.Create(Self);
except
TComponent(Reference) := nil;
raise;
end;
// 第一个创建的窗体实例就是MainForm
if (FMainForm = nil) and (Instance is TForm) then
begin
TForm(Instance).HandleNeeded;
FMainForm := TForm(Instance);
end;
end;
var
Instance: TComponent;
begin
Instance := TComponent(InstanceClass.NewInstance);
TComponent(Reference) := Instance;
try
Instance.Create(Self);
except
TComponent(Reference) := nil;
raise;
end;
// 第一个创建的窗体实例就是MainForm
if (FMainForm = nil) and (Instance is TForm) then
begin
TForm(Instance).HandleNeeded;
FMainForm := TForm(Instance);
end;
end;
因此,Delphi为每个应用程序自动生成的代码中就有对CreateForm的调用,如:
Application.CreateForm(TForm1, Form1);
值得注意的是,如果有一系列的多个CreateForm的调用,则第一个调用CreateForm被创建的窗体,就是整个Application的MainForm。
3.TApplication创建主消息循环
在TApplication的CreateHandle方法中可以看到,SetWindowLong()的调用将TApplication.WndProc设置成了那个0×0大小窗口的窗口函数。
也就是说,在TApplication的构造函数中主要完成了两件事情:注册窗口类及窗口函数,创建Application窗口实例。TApplication类的Run方法中:
procedure TApplication.Run;
begin
FRunning := True;
try
AddExitProc(DoneApplication);
if FMainForm <> nil then
begin
case CmdShow of
SW_SHOWMINNOACTIVE: FMainForm.FWindowState := wsMinimized;
SW_SHOWMAXIMIZED: MainForm.WindowState := wsMaximized;
end;
if FShowMainForm then
if FMainForm.FWindowState = wsMinimized then
Minimize else
FMainForm.Visible := True;
repeat
try
HandleMessage;
except
HandleException(Self);
end;
until Terminated;
end;
finally
FRunning := False;
end;
end;
begin
FRunning := True;
try
AddExitProc(DoneApplication);
if FMainForm <> nil then
begin
case CmdShow of
SW_SHOWMINNOACTIVE: FMainForm.FWindowState := wsMinimized;
SW_SHOWMAXIMIZED: MainForm.WindowState := wsMaximized;
end;
if FShowMainForm then
if FMainForm.FWindowState = wsMinimized then
Minimize else
FMainForm.Visible := True;
repeat
try
HandleMessage;
except
HandleException(Self);
end;
until Terminated;
end;
finally
FRunning := False;
end;
end;
是的,这就是主消息循环。看上去似乎没有取消息、分发消息的过程,其实它们都被包含在HandleMessage()方法中了。HandleMessage()方法其实是对ProcessMessage()方法的调用,而在ProcessMessage()中就可以看到取消息、分发消息的动作了。
procedure TApplication.HandleMessage;
var
Msg: TMsg;
begin
if not ProcessMessage(Msg) then Idle(Msg);
end;
function TApplication.ProcessMessage(var Msg: TMsg): Boolean;
var
Handled: Boolean;
begin
Result := False;
// 取消息
if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
begin
Result := True;
if Msg.Message <> WM_QUIT then
begin
Handled := False;
if Assigned(FOnMessage) then FOnMessage(Msg, Handled);
if not IsHintMsg(Msg) and not Handled and not IsMDIMsg(Msg) and
not IsKeyMsg(Msg) and not IsDlgMsg(Msg) then
begin
// 熟悉的分发消息过程
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end
else
// 如果取到的消息为WM_QUIT,则将Fterminate设为真
// 以通知主消息循环退出
// 这和WindowDemo程序中判断GetMessage()函数返回值是否为0等效
// 因为GetMessage()函数取出的消息如果是WM_QUIT,它的返回值为0
FTerminate := True;
end;
end;
var
Msg: TMsg;
begin
if not ProcessMessage(Msg) then Idle(Msg);
end;
function TApplication.ProcessMessage(var Msg: TMsg): Boolean;
var
Handled: Boolean;
begin
Result := False;
// 取消息
if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
begin
Result := True;
if Msg.Message <> WM_QUIT then
begin
Handled := False;
if Assigned(FOnMessage) then FOnMessage(Msg, Handled);
if not IsHintMsg(Msg) and not Handled and not IsMDIMsg(Msg) and
not IsKeyMsg(Msg) and not IsDlgMsg(Msg) then
begin
// 熟悉的分发消息过程
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end
else
// 如果取到的消息为WM_QUIT,则将Fterminate设为真
// 以通知主消息循环退出
// 这和WindowDemo程序中判断GetMessage()函数返回值是否为0等效
// 因为GetMessage()函数取出的消息如果是WM_QUIT,它的返回值为0
FTerminate := True;
end;
end;
4.窗口函数(WndProc)处理消息
窗口函数是一个回调函数,它被Windows系统所调用,其参数会被给出消息编号、消息参数等信息,以便进行处理。
典型的窗口函数中会包含一个大的case分支,以处理不同的消息。TApplication.CreateHandle()的代码时提到过,CreateHandle()将Application窗口的窗口函数设置为WndProc()。那么,现在就来看一下这个WndProc:
procedure TApplication.WndProc(var Message: TMessage);
type // 函数内嵌定义的类型,只限函数内部使用
TInitTestLibrary = function(Size: DWord; PAutoClassInfo: Pointer): Boolean; stdcall;
var
I: Integer;
SaveFocus, TopWindow: HWnd;
InitTestLibrary: TInitTestLibrary;
// 内嵌函数,默认的消息处理
// 调用Windows的API函数DefWindowProc
procedure Default;
begin
with Message do
Result := DefWindowProc(FHandle, Msg, WParam, LParam);
end;
procedure DrawAppIcon;
var
DC: HDC;
PS: TPaintStruct;
begin
with Message do
begin
DC := BeginPaint(FHandle, PS);
DrawIcon(DC, 0, 0, GetIconHandle);
EndPaint(FHandle, PS);
end;
end;
begin
try
Message.Result := 0;
for I := 0 to FWindowHooks.Count - 1 do
if TWindowHook(FWindowHooks[I]^)(Message) then Exit;
CheckIniChange(Message);
with Message do
// 开始庞大的case分支,对不同的消息做出不同的处理
case Msg of
WM_SYSCOMMAND:
case WParam and $FFF0 of
SC_MINIMIZE: Minimize;
SC_RESTORE: Restore;
else
Default;
end;
WM_CLOSE:
if MainForm <> nil then MainForm.Close;
WM_PAINT:
if IsIconic(FHandle) then DrawAppIcon else Default;
WM_ERASEBKGND:
begin
Message.Msg := WM_ICONERASEBKGND;
Default;
end;
WM_QUERYDRAGICON:
Result := GetIconHandle;
WM_SETFOCUS:
begin
PostMessage(FHandle, CM_ENTER, 0, 0);
Default;
end;
WM_ACTIVATEAPP:
begin
Default;
FActive := TWMActivateApp(Message).Active;
if TWMActivateApp(Message).Active then
begin
RestoreTopMosts;
PostMessage(FHandle, CM_ACTIVATE, 0, 0)
end
else
begin
NormalizeTopMosts;
PostMessage(FHandle, CM_DEACTIVATE, 0, 0);
end;
end;
WM_ENABLE:
if TWMEnable(Message).Enabled then
begin
RestoreTopMosts;
if FWindowList <> nil then
begin
EnableTaskWindows(FWindowList);
FWindowList := nil;
end;
Default;
end else
begin
Default;
if FWindowList = nil then
FWindowList := DisableTaskWindows(Handle);
NormalizeAllTopMosts;
end;
WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
Result := SendMessage(LParam, CN_BASE + Msg, WParam, LParam);
WM_ENDSESSION: if TWMEndSession(Message).EndSession then FTerminate := True;
WM_COPYDATA:
if (PCopyDataStruct(Message.lParam)^.dwData = DWORD($DE534454)) and
(FAllowTesting) then
if FTestLib = 0 then
begin
FTestLib := SafeLoadLibrary('vcltest3.dll');
if FTestLib <> 0 then
begin
Result := 0;
@InitTestLibrary := GetProcAddress(FTestLib, 'RegisterAutomation');
if @InitTestLibrary <> nil then
InitTestLibrary(PCopyDataStruct(Message.lParam)^.cbData,
PCopyDataStruct(Message.lParam)^.lpData);
end
else
begin
Result := GetLastError;
FTestLib := 0;
end;
end
else
Result := 0;
CM_ACTIONEXECUTE, CM_ACTIONUPDATE:
Message.Result := Ord(DispatchAction(Message.Msg, TBasicAction(Message.LParam)));
CM_APPKEYDOWN:
if IsShortCut(TWMKey(Message)) then Result := 1;
CM_APPSYSCOMMAND:
if MainForm <> nil then
with MainForm do
if (Handle <> 0) and IsWindowEnabled(Handle) and
IsWindowVisible(Handle) then
begin
FocusMessages := False;
SaveFocus := GetFocus;
Windows.SetFocus(Handle);
Perform(WM_SYSCOMMAND, WParam, LParam);
Windows.SetFocus(SaveFocus);
FocusMessages := True;
Result := 1;
end;
CM_ACTIVATE:
if Assigned(FOnActivate) then FOnActivate(Self);
CM_DEACTIVATE:
if Assigned(FOnDeactivate) then FOnDeactivate(Self);
CM_ENTER:
if not IsIconic(FHandle) and (GetFocus = FHandle) then
begin
TopWindow := FindTopMostWindow(0);
if TopWindow <> 0 then Windows.SetFocus(TopWindow);
end;
WM_HELP, // MessageBox( MB_HELP)
CM_INVOKEHELP: InvokeHelp(WParam, LParam);
CM_WINDOWHOOK:
if wParam = 0 then
HookMainWindow(TWindowHook(Pointer(LParam)^)) else
UnhookMainWindow(TWindowHook(Pointer(LParam)^));
CM_DIALOGHANDLE:
if wParam = 1 then
Result := FDialogHandle
else
FDialogHandle := lParam;
WM_SETTINGCHANGE:
begin
Mouse.SettingChanged(wParam);
SettingChange(TWMSettingChange(Message));
Default;
end;
WM_FONTCHANGE:
begin
Screen.ResetFonts;
Default;
end;
WM_NULL:
CheckSynchronize;
else
Default;
end;
except
HandleException(Self);
end;
end;
type // 函数内嵌定义的类型,只限函数内部使用
TInitTestLibrary = function(Size: DWord; PAutoClassInfo: Pointer): Boolean; stdcall;
var
I: Integer;
SaveFocus, TopWindow: HWnd;
InitTestLibrary: TInitTestLibrary;
// 内嵌函数,默认的消息处理
// 调用Windows的API函数DefWindowProc
procedure Default;
begin
with Message do
Result := DefWindowProc(FHandle, Msg, WParam, LParam);
end;
procedure DrawAppIcon;
var
DC: HDC;
PS: TPaintStruct;
begin
with Message do
begin
DC := BeginPaint(FHandle, PS);
DrawIcon(DC, 0, 0, GetIconHandle);
EndPaint(FHandle, PS);
end;
end;
begin
try
Message.Result := 0;
for I := 0 to FWindowHooks.Count - 1 do
if TWindowHook(FWindowHooks[I]^)(Message) then Exit;
CheckIniChange(Message);
with Message do
// 开始庞大的case分支,对不同的消息做出不同的处理
case Msg of
WM_SYSCOMMAND:
case WParam and $FFF0 of
SC_MINIMIZE: Minimize;
SC_RESTORE: Restore;
else
Default;
end;
WM_CLOSE:
if MainForm <> nil then MainForm.Close;
WM_PAINT:
if IsIconic(FHandle) then DrawAppIcon else Default;
WM_ERASEBKGND:
begin
Message.Msg := WM_ICONERASEBKGND;
Default;
end;
WM_QUERYDRAGICON:
Result := GetIconHandle;
WM_SETFOCUS:
begin
PostMessage(FHandle, CM_ENTER, 0, 0);
Default;
end;
WM_ACTIVATEAPP:
begin
Default;
FActive := TWMActivateApp(Message).Active;
if TWMActivateApp(Message).Active then
begin
RestoreTopMosts;
PostMessage(FHandle, CM_ACTIVATE, 0, 0)
end
else
begin
NormalizeTopMosts;
PostMessage(FHandle, CM_DEACTIVATE, 0, 0);
end;
end;
WM_ENABLE:
if TWMEnable(Message).Enabled then
begin
RestoreTopMosts;
if FWindowList <> nil then
begin
EnableTaskWindows(FWindowList);
FWindowList := nil;
end;
Default;
end else
begin
Default;
if FWindowList = nil then
FWindowList := DisableTaskWindows(Handle);
NormalizeAllTopMosts;
end;
WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
Result := SendMessage(LParam, CN_BASE + Msg, WParam, LParam);
WM_ENDSESSION: if TWMEndSession(Message).EndSession then FTerminate := True;
WM_COPYDATA:
if (PCopyDataStruct(Message.lParam)^.dwData = DWORD($DE534454)) and
(FAllowTesting) then
if FTestLib = 0 then
begin
FTestLib := SafeLoadLibrary('vcltest3.dll');
if FTestLib <> 0 then
begin
Result := 0;
@InitTestLibrary := GetProcAddress(FTestLib, 'RegisterAutomation');
if @InitTestLibrary <> nil then
InitTestLibrary(PCopyDataStruct(Message.lParam)^.cbData,
PCopyDataStruct(Message.lParam)^.lpData);
end
else
begin
Result := GetLastError;
FTestLib := 0;
end;
end
else
Result := 0;
CM_ACTIONEXECUTE, CM_ACTIONUPDATE:
Message.Result := Ord(DispatchAction(Message.Msg, TBasicAction(Message.LParam)));
CM_APPKEYDOWN:
if IsShortCut(TWMKey(Message)) then Result := 1;
CM_APPSYSCOMMAND:
if MainForm <> nil then
with MainForm do
if (Handle <> 0) and IsWindowEnabled(Handle) and
IsWindowVisible(Handle) then
begin
FocusMessages := False;
SaveFocus := GetFocus;
Windows.SetFocus(Handle);
Perform(WM_SYSCOMMAND, WParam, LParam);
Windows.SetFocus(SaveFocus);
FocusMessages := True;
Result := 1;
end;
CM_ACTIVATE:
if Assigned(FOnActivate) then FOnActivate(Self);
CM_DEACTIVATE:
if Assigned(FOnDeactivate) then FOnDeactivate(Self);
CM_ENTER:
if not IsIconic(FHandle) and (GetFocus = FHandle) then
begin
TopWindow := FindTopMostWindow(0);
if TopWindow <> 0 then Windows.SetFocus(TopWindow);
end;
WM_HELP, // MessageBox( MB_HELP)
CM_INVOKEHELP: InvokeHelp(WParam, LParam);
CM_WINDOWHOOK:
if wParam = 0 then
HookMainWindow(TWindowHook(Pointer(LParam)^)) else
UnhookMainWindow(TWindowHook(Pointer(LParam)^));
CM_DIALOGHANDLE:
if wParam = 1 then
Result := FDialogHandle
else
FDialogHandle := lParam;
WM_SETTINGCHANGE:
begin
Mouse.SettingChanged(wParam);
SettingChange(TWMSettingChange(Message));
Default;
end;
WM_FONTCHANGE:
begin
Screen.ResetFonts;
Default;
end;
WM_NULL:
CheckSynchronize;
else
Default;
end;
except
HandleException(Self);
end;
end;
整个WndProc()方法,基本上只包含了一个庞大的case分支,其中给出了每个消息的处理代码,“WM_”打头的为Windows定义的窗口消息,“CM_”打头的为VCL库自定义的消息。
需要注意的是,这里给出WndProc是属于TApplication的,也就是那个0×0大小的Application窗口的窗口函数,而每个Form另外都有自己的窗口函数。