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