VCL中消息处理初探

TObject是基类，所以我们先看一下TObject的DISPATCH方法。Dispatch根据传入的message来寻找相应的消息处理方法，如果找不到的话，就继续向上到父类的消息处理方法表中寻找响应的处理方法，一直到找到为止，如果找到顶还没有，则调用DefaultHandle来处理该消息。message可以是任何的类型，Dispatch假设message的头两位是消息的ID，它就是根据ID来寻找消息处理方法的。虽然任何类型的message都可以被接受，但是TObject的子类还是希望传入的message参数是TMessage的记录类型或其他证明的记录类型。

以下声明和注释摘自与system.pas:

{ TObject.Dispatch accepts any data type as its Message parameter. The

first 2 bytes of the data are taken as the message id to search for

in the object's message methods. TDispatchMessage is an example of

such a structure with a word field for the message id.

}

TDispatchMessage = record

MsgID: word;

end;

类的继承关系如下：

TObject->TPersistent->TComponent->TControl

TControl是所以可视化组件的父类，TControl提供了一个新的方法，WndProc:

procedure TControl.WndProc(var Message: TMessage);

var

Form: TCustomForm;

KeyState: TKeyboardState;

WheelMsg: TCMMouseWheel;

begin

//如果处在设计期

if (csDesigning in ComponentState) then

begin

Form := GetParentForm(Self);//得到拥有该组件的窗体

if (Form <> nil) and (Form.Designer <> nil) and

Form.Designer.IsDesignMsg(Self, Message) then Exit //消息由窗体来处理

end;

//窗体可以为其拥有的组件来处理键盘消息。

if (Message.Msg >= WM_KEYFIRST) and (Message.Msg <= WM_KEYLAST) then

begin

Form := GetParentForm(Self);

if (Form <> nil) and Form.WantChildKey(Self, Message) then Exit;

end

//关于鼠标的消息

else if (Message.Msg >= WM_MOUSEFIRST) and (Message.Msg <= WM_MOUSELAST) then

begin

//如果组件不可以接受和处理双击消息，就将双击消息映射为单击消息。

if not (csDoubleClicks in ControlStyle) then

case Message.Msg of

WM_LBUTTONDBLCLK, WM_RBUTTONDBLCLK, WM_MBUTTONDBLCLK:

Dec(Message.Msg, WM_LBUTTONDBLCLK - WM_LBUTTONDOWN);

end;

case Message.Msg of

WM_MOUSEMOVE: Application.HintMouseMessage(Self, Message);//如果是鼠标移动的消息，则出现hint窗口

WM_LBUTTONDOWN, WM_LBUTTONDBLCLK://如果是左键被按下，或者双击，如果是自动拖动模式，则开始拖动，并将左键按下的状态加入组件的状态。

begin

if FDragMode = dmAutomatic then

begin

BeginAutoDrag;

Exit;

end;

Include(FControlState, csLButtonDown);

end;

WM_LBUTTONUP:

Exclude(FControlState, csLButtonDown); //如果是左键放开，则将左键按下的状态剔除。

else

with Mouse do

if WheelPresent and (RegWheelMessage <> 0) and //如果鼠标有滚轮，并且滚轮滑动时发出了消息

(Message.Msg = RegWheelMessage) then

begin

GetKeyboardState(KeyState); //将256虚拟键的状态拷贝到缓存中去

with WheelMsg do //填充记录

begin

Msg := Message.Msg;

ShiftState := KeyboardStateToShiftState(KeyState);

WheelDelta := Message.WParam;

Pos := TSmallPoint(Message.LParam);

end;

MouseWheelHandler(TMessage( WheelMsg)); //派发鼠标滚轮的消息

Exit;

end;

end;

end

else if Message.Msg = CM_VISIBLECHANGED then

with Message do

SendDockNotification(Msg, WParam, LParam); //处理自定义消息

Dispatch(Message); //派发未处理的消息

end;

但是只有TWinControl可以获得焦点：

procedure TWinControl.WndProc(var Message: TMessage);

var

Form: TCustomForm;

begin

case Message.Msg of

WM_SETFOCUS: //设置控件的焦点

begin

Form := GetParentForm(Self);

if (Form <> nil) and not Form.SetFocusedControl(Self) then Exit;

end;

WM_KILLFOCUS:

if csFocusing in ControlState then Exit;

//当鼠标有活动的时候发出该消息，如果鼠标没有被捕捉到，则消息发往鼠标下面的那个窗口，否则消息将发往捕捉到鼠标的那个窗口。

WM_NCHITTEST:

begin

inherited WndProc(Message); //调用父类的处理方法

//如果窗体被挡住并且在指定的点没有控件，则返回结果为在client区。

if (Message.Result = HTTRANSPARENT) and (ControlAtPos(ScreenToClient(

SmallPointToPoint(TWMNCHitTest(Message).Pos)), False) <> nil) then

Message.Result := HTCLieNT;

Exit;

end;

WM_MOUSEFIRST..WM_MOUSELAST:

if IsControlMouseMsg(TWMMouse(Message)) then //鼠标消息是否直接发往组件的窗体子组件

begin

{ Check HandleAllocated because IsControlMouseMsg might have freed the

window if user code executed something like Parent := nil. }

if (Message.Result = 0) and HandleAllocated then

DefWindowProc(Handle, Message.Msg, Message.wParam, Message.lParam);//调用默认的的消息处理方法对该消息进行默认处理。

Exit;

end;

WM_KEYFIRST..WM_KEYLAST:

if Dragging then Exit;

WM_CANCELMODE:

if (GetCapture = Handle) and (CaptureControl <> nil) and

(CaptureControl.Parent = Self) then

CaptureControl.Perform(WM_CANCELMODE, 0, 0);

end;

inherited WndProc(Message);

end;

TApplication在程序中发挥着重要的作用：

Application.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;

//一个消息循环直到Terminated为True时才退出。

repeat

try

HandleMessage;

except

HandleException( Self);

end;

until Terminated;

end;

finally

FRunning := False;

end;

end;

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

FTerminate := True;

end;

end;