Delphi对WM_NCHITTEST消息的处理
2016-03-31 16:32
696 查看
前提:WM_NCHITTEST是很重要的,只要鼠标在活动,Windows无时无刻在发这个消息进行探测。
--------------------------------------------------------------------------------
虽然WndProc具有优先权,但是却刻意调用了inherited WndProc(Message);,因此会首先执行TWinControl.WMNCHitTest,如果发现是透明并且能找到一个TControl,那么就算击中了HTCLIENT
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
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;
--------------------------------------------------------------------------------
相关文章推荐
- delphi遇到的一个实参错误(Format ‘%1’ invalid or incompatible with argument )
- Delphi与JAVA互加解密AES算法
- delphi Firemonkey ListView 使用参考
- Delphi基础:回调函数及其使用
- DelphiXE7中创建WebService(服务端+客户端) good
- Delphi-JAVA互加解密AES算法
- delphi RTTI 反射技术
- delphi 自我删除和线程池(1000行代码,需要仔细研究)
- hprose rpc使用实例(同时有Java和Delphi客户端的例子)
- Delphi数据类型转换(有几个字符串函数没见过,比如StringToWideChar和WideCharToString)
- delphi cmd(4个例子都是通过管道取得)
- Delphi中@,^,#,$特殊符号意义
- delphi 文件的读取(二进制文件和文本文件)
- delphi中用代码实现注册Ocx和Dll(有点怪异,使用CallWindowProc来调用指定函数DllRegisterServer)
- delphi 控件大全(确实很全)
- delphi 对抗任务管理器关闭(提升进程到Debug模式,然后设置进程信息SE_PROC_INFO)
- 为Delphi程序增加UAC功能(每个步骤都很详细)
- delphi string.split 按照任意字符串分割语句
- Delphi TChart 学习(一)
- 使用delphi+intraweb进行微信开发5—准备实现微信API,先从获取AccessToken开始