在线时间:8:00-16:00
迪恩网络APP
随时随地掌握行业动态
扫描二维码
关注迪恩网络微信公众号
前提:WM_NCHITTEST是很重要的,只要鼠标在活动,Windows无时无刻在发这个消息进行探测。 -------------------------------------------------------------------------------- TWinControl = class(TControl) private procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; end; procedure TWinControl.WMNCHitTest(var Message: TWMNCHitTest); begin with Message do if (csDesigning in ComponentState) and (FParent <> nil) then Result := HTCLIENT else inherited; 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; 虽然WndProc具有优先权,但是却刻意调用了inherited WndProc(Message);,因此会首先执行TWinControl.WMNCHitTest,如果发现是透明并且能找到一个TControl,那么就算击中了HTCLIENT THintWindow = class(TCustomControl) private procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; end; procedure THintWindow.WMNCHitTest(var Message: TWMNCHitTest); begin Message.Result := HTTRANSPARENT; end; -------------------------------------------------------------------------------- TScrollBox = class(TScrollingWinControl) private procedure WMNCHitTest(var Message: TMessage); message WM_NCHITTEST; end; procedure TScrollBox.WMNCHitTest(var Message: TMessage); begin DefaultHandler(Message); // TScrollBox和TScrollingWinControl都没有覆盖DefaultHandler函数,因此它会调用TWinControl.DefaultHandler end; -------------------------------------------------------------------------------- procedure TCustomForm.ClientWndProc(var Message: TMessage); procedure Default; begin with Message do Result := CallWindowProc(FDefClientProc, ClientHandle, Msg, wParam, lParam); end; function MaximizedChildren: Boolean; var I: Integer; begin for I := 0 to MDIChildCount - 1 do if MDIChildren[I].WindowState = wsMaximized then begin Result := True; Exit; end; Result := False; end; var DC: HDC; PS: TPaintStruct; R: TRect; begin with Message do case Msg of WM_NCHITTEST: begin Default; if Result = HTCLIENT then Result := HTTRANSPARENT; end; WM_ERASEBKGND: begin FillRect(TWMEraseBkGnd(Message).DC, ClientRect, Brush.Handle); { Erase the background at the location of an MDI client window } if (FormStyle = fsMDIForm) and (FClientHandle <> 0) then begin Windows.GetClientRect(FClientHandle, R); FillRect(TWMEraseBkGnd(Message).DC, R, Brush.Handle); end; Result := 1; end; $3F://! begin Default; if FFormStyle = fsMDIForm then ShowMDIClientEdge(FClientHandle, (MDIChildCount = 0) or not MaximizedChildren); end; WM_PAINT: begin DC := TWMPaint(Message).DC; if DC = 0 then TWMPaint(Message).DC := BeginPaint(ClientHandle, PS); try if DC = 0 then begin GetWindowRect(FClientHandle, R); R.TopLeft := ScreenToClient(R.TopLeft); MoveWindowOrg(TWMPaint(Message).DC, -R.Left, -R.Top); end; PaintHandler(TWMPaint(Message)); finally if DC = 0 then EndPaint(ClientHandle, PS); end; end; else Default; end; end; -------------------------------------------------------------------------------- procedure TScreen.SetCursor(Value: TCursor); var P: TPoint; Handle: HWND; Code: Longint; begin if Value <> Cursor then begin FCursor := Value; if Value = crDefault then begin { Reset the cursor to the default by sending a WM_SETCURSOR to the window under the cursor } GetCursorPos(P); Handle := WindowFromPoint(P); if (Handle <> 0) and (GetWindowThreadProcessId(Handle, nil) = GetCurrentThreadId) then begin Code := SendMessage(Handle, WM_NCHITTEST, 0, LongInt(PointToSmallPoint(P))); SendMessage(Handle, WM_SETCURSOR, Handle, MakeLong(Code, WM_MOUSEMOVE)); Exit; end; end; Windows.SetCursor(Cursors[Value]); end; Inc(FCursorCount); end; -------------------------------------------------------------------------------- procedure TCustomCombo.ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer); var Point: TPoint; Form: TCustomForm; begin try with Message do begin case 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: if csDesigning in ComponentState then begin Result := HTTRANSPARENT; Exit; end; CN_KEYDOWN, CN_CHAR, CN_SYSKEYDOWN, CN_SYSCHAR: begin WndProc(Message); Exit; end; end; Result := CallWindowProc(ComboProc, ComboWnd, Msg, WParam, LParam); if (Msg = WM_LBUTTONDBLCLK) and (csDoubleClicks in ControlStyle) then DblClick; end; except Application.HandleException(Self); end; end; --------------------------------------------------------------------------------
|
2023-10-27
2022-08-15
2022-08-17
2022-09-23
2022-08-13
请发表评论