Delphi对WM_NCHITTEST消息的处理
前提: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 = ) 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, , );
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 := to MDIChildCount - 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 <> ) then
begin
Windows.GetClientRect(FClientHandle, R);
FillRect(TWMEraseBkGnd(Message).DC, R, Brush.Handle);
end;
Result := ;
end;
$3F://!
begin
Default;
if FFormStyle = fsMDIForm then
ShowMDIClientEdge(FClientHandle, (MDIChildCount = ) or
not MaximizedChildren);
end;
WM_PAINT:
begin
DC := TWMPaint(Message).DC;
if DC = then
TWMPaint(Message).DC := BeginPaint(ClientHandle, PS);
try
if DC = 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 = 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 <> ) and
(GetWindowThreadProcessId(Handle, nil) = GetCurrentThreadId) then
begin
Code := SendMessage(Handle, WM_NCHITTEST, , 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对WM_NCHITTEST消息的处理的更多相关文章
- [转]关于WM_NCHITTEST消息
http://www.cnblogs.com/GnagWang/archive/2010/09/12/1824394.html 我为了移动一个无标题栏的窗体,使用了WM_NCHITTEST消息,这个消 ...
- 对WM_NCHITTEST消息的了解+代码实例进行演示(消息产生消息,共24个枚举值)
这个消息比较实用也很关键,它代表非显示区域命中测试.这个消息优先于所有其他的显示区域和非显示区域鼠标消息.其中lParam参数含有鼠标位置的x和y屏幕坐标,wParam 这里没有用. Windows应 ...
- 终于懂了:Delphi重定义消息结构随心所欲,只需要前4个字节是消息编号就行了(有了这个,就有了主动)
Delphi重定义消息结构随心所欲,只需要前4个字节是消息编号就行了,跟Windows消息虽然尽量保持一致,但其实相互没有特别大的关系.有了这个,就有了主动,带不带句柄完全看需要. 比如这个结构就带句 ...
- 深刻:截获windows的消息并分析实例(DefWindowProc),以WM_NCHITTEST举例(Windows下每一个鼠标消息都是由 WM_NCHITTEST 消息产生的,这个消息的参数包含了鼠标位置的信息)
1,回调函数工作机制 回调函数由操作系统自动调用,回调函数的返回值当然也是返回给操作系统了. 2,截获操作系统发出的消息,截获到后,将另外一个消息返回给操作系统,已达到欺骗操作系统的目的. 下面还是以 ...
- 关于WM_NCHITTEST消息
我为了移动一个无标题栏的窗体,使用了WM_NCHITTEST消息,这个消息大概如下: 通常,我们拖动对话框窗口的标题栏来移动窗口,但有时候,我们想通过鼠标在客户区上拖动来移动窗口. 一个容易想到的方案 ...
- Delphi 实现无窗口移动(发WM_NCHITTEST消息计算,然后再发WM_SYSCOMMAND消息,带参数SC_DRAGMOVE)
procedure imgListMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer) ...
- Delphi中window消息截获的实现方式(2)
Delphi是Borland公司提供的一种全新的WINDOWS编程开发工具.由于它采用了具有弹性的和可重用的面向对象Pascal(object-orientedpascal)语言,并有强大的数据库引擎 ...
- QT中异形窗口的绘制(winEvent处理WM_NCHITTEST消息)
这里讨论的只是Windows平台上的实现. 在QT中绘制异形窗口,只要设定 windowFlag 为 CustomizeWindowHint,再结合setMask()就可以做出各种奇形怪状的窗口.相对 ...
- Delphi中的消息截获(六种方法:Hook,SubClass,Override WndProc,Message Handler,RTTI,Form1.WindowProc:=@myfun)good
Windows是一个基于消息驱动的系统,因此,在很多时候,我们需要截获一些消息然后自己进行处理.而VCL系统又有一些特定的消息.下面对我所了解的delphi环境中截获消息进行一些总结. 就个 ...
随机推荐
- 基于visual Studio2013解决C语言竞赛题之0803报数
题目
- 杭电OJ——1007 Quoit Design(最近点对问题)
Quoit Design Problem Description Have you ever played quoit in a playground? Quoit is a game in whic ...
- 超级坑人的Couchbase数据库问题!!!
官网:http://www.couchbase.com/ 版本:1.8版 问题描述: 某次服务器因意外断电重启后,就进入不了Couchbase控制台,显示 "无法显示该页" 的错误 ...
- JS中setTimeout()的使用方法具体解释
1. SetTimeOut() 1.1 SetTimeOut()语法样例 1.2 用SetTimeOut()运行Function ...
- VMware machine里的文件
.nvram——虚拟机BIOS或EFI配置文件. .vmdk——虚拟磁盘特性文件,是存放虚拟磁盘当前状况和上次执行快照时的状况之间的差异的快照文件. .vmsd——虚拟机快照,包含虚拟机快照信息的数据 ...
- 1941. Scary Martian Word
1941. Scary Martian Word 这道题 一个长度为3的字符串视为 一个 火星文 字母(ASCII 33-122) ,给出一个火星人认为恐怖的单词(由火星字母组成) 然后 给你一篇文章 ...
- AngularJS_百度百科
AngularJS_百度百科 AngularJS 编辑 AngularJS是为克服HTML在构建应用上的不足而设计的. 目录 1简介引引 端对 ...
- iPhone5C三大看点:性能不输iPhone5 或售3399元
乐杨俊编辑修改转载: iPhone 5C的发售时间或最早在9月18日,抢在中秋节前:最迟至国庆十一假期期间. [IT商业新闻网综合讯](记者 林涛)苹果2013年秋季发布会还有几个小时即将开幕,除了i ...
- ioctl、文件操作接口函数以及nand的升级模式的操作过程详解
概述 内核中驱动文件的操作通常是通过write和read函数进行的,但是很多时候再用户空间进行的操作或许不是内核中公共代码部分提供的功能,此时就需要使用一种个性化的方法进行操作--ioctl系统调用. ...
- 如何删除JAVA集合中的元素
经常我们要删除集合中的某些元素.有些可能会这么写. public void operate(List list){ for (Iterator it = list.iterator(); it.has ...