您的位置：首页 > 运维架构 > 网站架构

娃娃鸭深入核心VCL架构剖析(李维)笔记

2009-03-10 15:39 429 查看

39、Delphi窗体类处理窗口消息的机制

用户任何在主窗体中进行的工作，窗口都回调到主窗体的MainWndProc中，因此TWinControl的MainWndProc是Delphi中窗体处理窗口消息的函数。

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

procedure TCustomForm.WndProc(var Message: TMessage);
var
FocusHandle: HWND;
SaveIndex: Integer;
MenuItem: TMenuItem;
Canvas: TCanvas;
DC: HDC;
begin
with Message do
case Msg of
WM_ACTIVATE, WM_SETFOCUS, WM_KILLFOCUS:
begin
if not FocusMessages then Exit;
if (Msg = WM_SETFOCUS) and not (csDesigning in ComponentState) then
begin
FocusHandle := 0;
if FormStyle = fsMDIForm then
begin
if ActiveMDIChild <> nil then FocusHandle := ActiveMDIChild.Handle;
end
else if (FActiveControl <> nil) and (FActiveControl <> Self) then
FocusHandle := FActiveControl.Handle;
if FocusHandle <> 0 then
begin
Windows.SetFocus(FocusHandle);
Exit;
end;
end;
end;
CM_EXIT:
if HostDockSite <> nil then DeActivate;
CM_ENTER:
if HostDockSite <> nil then Activate;
WM_WINDOWPOSCHANGING:
if ([csLoading, csDesigning] * ComponentState = [csLoading]) then
begin
if (Position in [poDefault, poDefaultPosOnly]) and
(WindowState <> wsMaximized) then
with PWindowPos(Message.lParam)^ do flags := flags or SWP_NOMOVE;
if (Position in [poDefault, poDefaultSizeOnly]) and
(BorderStyle in [bsSizeable, bsSizeToolWin]) then
with PWindowPos(Message.lParam)^ do flags := flags or SWP_NOSIZE;
end;
WM_DRAWITEM:
with PDrawItemStruct(Message.LParam)^ do
if (CtlType = ODT_MENU) and Assigned(Menu) then
begin
MenuItem := Menu.FindItem(itemID, fkCommand);
if MenuItem <> nil then
begin
Canvas := TControlCanvas.Create;
with Canvas do
try
SaveIndex := SaveDC(hDC);
try
Handle := hDC;
Font := Screen.MenuFont;
Menus.DrawMenuItem(MenuItem, Canvas, rcItem,
TOwnerDrawState(LongRec(itemState).Lo));
finally
Handle := 0;
RestoreDC(hDC, SaveIndex)
end;
finally
Free;
end;
Exit;
end;
end;
WM_MEASUREITEM:
with PMeasureItemStruct(Message.LParam)^ do
if (CtlType = ODT_MENU) and Assigned(Menu) then
begin
MenuItem := Menu.FindItem(itemID, fkCommand);
if MenuItem <> nil then
begin
DC := GetWindowDC(Handle);
try
Canvas := TControlCanvas.Create;
with Canvas do
try
SaveIndex := SaveDC(DC);
try
Handle := DC;
Font := Screen.MenuFont;
TMenuItemAccess(MenuItem).MeasureItem(Canvas,
Integer(itemWidth), Integer(itemHeight));
finally
Handle := 0;
RestoreDC(DC, SaveIndex);
end;
finally
Canvas.Free;
end;
finally
ReleaseDC(Handle, DC);
end;
Exit;
end;
end;
else if Message.Msg = RM_TaskbarCreated then
begin
Perform(CM_WININICHANGE, 0, 0);
Perform(CM_SYSCOLORCHANGE, 0, 0);
Perform(CM_SYSFONTCHANGED, 0, 0);
Perform(CM_PARENTCOLORCHANGED, 0, 0);
Perform(CM_PARENTFONTCHANGED, 0, 0);
Perform(CM_PARENTBIDIMODECHANGED, 0, 0);
end;
end;
inherited WndProc(Message);
end;

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);
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;

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);
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);
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;

内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理

标签：

相关文章推荐

新的分享

章节导航