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