VCL消息机制概述

消息本身是作为一个记录传递给应用程序的，记录中包含消息的类型以及其它的信息！这
个记录类型叫做TMsg，它在WINDOWS单元中声明，这里就不一一列举（偶打字很辛苦的：P）

在WIN32中预定义的一些消息常量往往是以WM开头，以代表某一特定的消息。DELPHI的ME
SSAGE单元中定义了所有WINDOWS消息，如果有兴趣可以自己打开MESSAGE单元研究一下！

WINDOWS的消息系统由3部分组成：（1）消息队列，WINDOWS能够为所有的应用程序维护
一个消息队列，应用程序必须从消息队列中获取消息，然后分派给某个窗口。（2）消息循环
，通过这个循环机制，应用程序从消息队列中检索消息，再把它分派给适当的窗口，依次进
行。（3）窗口过程，每个窗口都有一个窗口过程，以接收WINDOWS传递给窗口的消息，窗口
过程的任务就是要获取消息并响应它（窗口过程是一个回调函数，处理完一个消息后，通常
要给WINDOWS一个返回值）。

从消息的产生到消息被一个窗口响应，这其中要经历以下几个步骤：（1）系统中发生了
某个事件。（2）WINDOWS把这个事件翻译成消息，然后把它放在消息队列中。（3）应用程序
从消息队列中接收这个消息，并把它存放在TMsg记录中。（4）应用程序把消息传递给一个适
当的窗口过程。（5）窗口过程响应这个消息并进行处理。

下面说说DELPHI的VCL消息系统处理原理：

DELPHI中的每一个VCL组件都有内在的消息处理机制，在建立一个窗体或加入一个组件
时，VCL就已经注册了一个消息接收例程MainWndProc，这个例程是每个窗体和组件固有的。
MainWndProc是定义在TWinControl类中的一个静态方法，不能被重载。它不直接处理消息，
而是交给WndProc处理并提供异常保护。如有异常发生，则调用Application.HandleExcepti
on方法处理异常。具体可以自己查看TWinControl类MainWndProc的实现代码，偶这里就不贴
了！

procedure TWinControl.MainWndProc(var Message: TMessage);
begin
try
try
WindowProc(Message);
finally
FreeDeviceContexts;
FreeMemoryContexts;
end;
except
Application.HandleException(Self);
end;
end;

WndProc是TControl类中的一个虚拟方法，这意味着它可以被覆盖，提供自定义的消息处
理例程（事实上，TControl构件中就是利用它来过滤并处理所有的鼠标消息（从WM_MOUSEFI
RST到WM_MOUSELAST）的）。WndProc调用DisPatch方法进行消息分配，具体代码可以查看TC
ontrol类WndProc的代码实现。

DisPatch方法是在TObject根类中定义的，传递给它的参数必须是一个记录类型，这个记
录中的第一个点必须是个Cardinal类型的字段。DisPatch方法根据消息号码调用组件的最后
继承类中处理此消息的句柄方法。如果此组件和它的祖先类中都没有对应此消息的处理句柄
，DisPatch方法便会调用DefaultHandler方法，DisPatch方法是定义于TObject类中的虚拟方
法，它只是简单的返回而不对消息做任何处理。我们可以对此虚拟方法的重载，在子类中实
现对消息的缺省处理（OH……MY GOD，怎么掉线了~~）。

这就是DELPHI对WINDOWS消息的处理流程！

发送消息：

DELPHI主要通过三种方式发送消息。Perform（），使用于所有的TControl派生对象。S
endMessage（）和PostMessage（）。这些想必都比较熟悉，不再多说了！如果需要跨进程发
送消息，就要用到RegisterWindowMessage（），它能够确保每个应用程序使用一致的消息序
号。具体使用方法可以参考帮助，很简单的！TWinControl派生的对象可以调用Broadcast（
）向它的子组件广播一个消息。当需要向一组组件发送相同的消息时，便可以使用这种技术
！如果要用SendMessage（）或PostMessage（）实现广播消息，只需要把第一个参数——目
标对象句柄——设置为HWND_BROADCAST就可以，它代表向所有应用的主窗口发送消息！

消息过滤：DELPHI消息过滤一般有3种方法，重载构件继承的虚方法WndProc；针对某消
息编写消息处理句柄；重载构件继承的虚方法DefaultHandler。其中第二中方法比较常用！

procedure TDockTree.WindowProc(var Message: TMessage);

procedure CalcSplitterPos;
var
MinWidth,
TestLimit: Integer;
begin
MinWidth := FGrabberSize;
if (FSizingZone.FParentZone.FOrientation = doHorizontal) then
begin
TestLimit := FSizingZone.Top + MinWidth;
if FSizePos.y <= TestLimit then FSizePos.y := TestLimit;
TestLimit := GetNextLimit(FSizingZone) - MinWidth;
if FSizePos.y >= TestLimit then FSizePos.y := TestLimit;
end
else begin
TestLimit := FSizingZone.Left + MinWidth;
if FSizePos.x <= TestLimit then FSizePos.x := TestLimit;
TestLimit := GetNextLimit(FSizingZone) - MinWidth;
if FSizePos.x >= TestLimit then FSizePos.x := TestLimit;
end;
end;

const
SizeCursors: array[TDockOrientation] of TCursor = (crDefault, crVSplit, crHSplit);
var
TempZone: TDockZone;
Control: TControl;
P: TPoint;
R: TRect;
HitTestValue: Integer;
Msg: TMsg;
begin
case Message.Msg of
CM_DOCKNOTIFICATION:
with TCMDockNotification(Message) do
if (NotifyRec.ClientMsg = CM_VISIBLECHANGED) then
ControlVisibilityChanged(Client, Boolean(NotifyRec.MsgWParam));
WM_MOUSEMOVE:
if FSizingZone <> nil then
begin
DrawSizeSplitter;
FSizePos := SmallPointToPoint(TWMMouse(Message).Pos);
CalcSplitterPos;
DrawSizeSplitter;
end;
WM_LBUTTONDBLCLK:
begin
TempZone := InternalHitTest(SmallPointToPoint(TWMMouse(Message).Pos),
HitTestValue);
if TempZone <> nil then
with TempZone do
if (FChildControl <> nil) and (HitTestValue = HTCAPTION) then
begin
CancelDrag;
FChildControl.ManualDock(nil, nil, alTop);
end;
end;
WM_LBUTTONDOWN:
begin
P := SmallPointToPoint(TWMMouse(Message).Pos);
TempZone := InternalHitTest(P, HitTestValue);
if (TempZone <> nil) then
begin
if HitTestValue = HTBORDER then
SplitterMouseDown(TempZone, P)
else if HitTestValue = HTCAPTION then
begin
if (not PeekMessage(Msg, FDockSite.Handle, WM_LBUTTONDBLCLK,
WM_LBUTTONDBLCLK, PM_NOREMOVE)) and
(TempZone.FChildControl is TWinControl) then
TWinControl(TempZone.FChildControl).SetFocus;
if (TempZone.FChildControl.DragKind = dkDock) and
(TempZone.FChildControl.DragMode = dmAutomatic)then
TempZone.FChildControl.BeginDrag(False);
Exit;
end;
end;
end;
WM_LBUTTONUP:
if FSizingZone = nil then
begin
P := SmallPointToPoint(TWMMouse(Message).Pos);
TempZone := InternalHitTest(P, HitTestValue);
if (TempZone <> nil) and (HitTestValue = HTCLOSE) then
begin
if TempZone.FChildControl is TCustomForm then
TCustomForm(TempZone.FChildControl).Close
else
TempZone.FChildControl.Visible := False;
end;
end
else
SplitterMouseUp;
WM_SETCURSOR:
begin
GetCursorPos(P);
P := FDockSite.ScreenToClient(P);
with TWMSetCursor(Message) do
if (Smallint(HitTest) = HTCLIENT) and (CursorWnd = FDockSite.Handle)
and (FDockSite.VisibleDockClientCount > 0) then
begin
TempZone := InternalHitTest(P, HitTestValue);
if (TempZone <> nil) and (HitTestValue = HTBORDER) then
begin
Windows.SetCursor(Screen.Cursors[SizeCursors[TempZone.FParentZone.
FOrientation]]);
Result := 1;
Exit;
end;
end;
end;
CM_HINTSHOW:
with TCMHintShow(Message) do
begin
FOldWndProc(Message);
if Result = 0 then
begin
Control := HitTest(HintInfo^.CursorPos, HitTestValue);
if HitTestValue = HTBORDER then
HintInfo^.HintStr := ''
else if (Control <> nil) and (HitTestValue in [HTCAPTION, HTCLOSE]) then
begin
R := Control.BoundsRect;
AdjustDockRect(Control, R);
Dec(R.Left, 2 * (R.Left - Control.Left));
Dec(R.Top, 2 * (R.Top - Control.Top));
Dec(R.Right, 2 * (Control.Width - (R.Right - R.Left)));
Dec(R.Bottom, 2 * (Control.Height - (R.Bottom - R.Top)));
HintInfo^.HintStr := Control.Caption;
HintInfo^.CursorRect := R;
end;
end;
Exit;
end;
end;
if Assigned(FOldWndProc) then
FOldWndProc(Message);
end;

转载于:https://www.cnblogs.com/spiritofcloud/p/3978327.html