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环境中截获消息进行一些总结. 就个 ...
随机推荐
- 在 Perl看来, 字符串只有两种形式. 一种是octets, 即8位序列, 也就是我们通常说的字节数组. 另一种utf8编码的字符串, perl管它叫string. 也就是说: Perl只熟悉两种编
在 Perl看来, 字符串只有两种形式. 一种是octets, 即8位序列, 也就是我们通常说的字节数组. 另一种utf8编码的字符串, perl管它叫string. 也就是说: Perl只熟悉两种编 ...
- boost:库program_options--第一篇
程式執行參數處理函式庫:Boost Program Options(1/N) 一般程式寫得大一點.或是需要比較有彈性,通常都需要在程式執行的時候,從外部讀取一些參數,來做為內部的設定值.一般來說,比較 ...
- 清华集训2014 day2 task1 简单回路
题目 如题. 算法 就是刚学习的插头DP. 从前往后和从后往前分别进行一次DP. 要点 合法的括号序列只有103个 如何合并两次dp的信息 一开始犯傻了,以为当且仅当两个轮廓线的状态相同才是合法的方案 ...
- SQLServer分页查询存储过程
项目中用到的SQLServer分页查询存储过程. [存储过程] create PROCEDURE prcPageResult -- 获得某一页的数据 -- @currPage int = 1, ...
- WM_PAINT消息在窗口重绘的时候产生,那什么时候窗口会重绘(异步工作方式效率高、灵活性强,还有UpdateWindow和RedrawWindow帮忙)
Q:wm_paint消息在窗口重绘的时候产生,那什么时候窗口会重绘?? A: 严格地说,只有当收到WM_PAINT消息后窗口会重绘 但是引起这个消息的事件有很多, 比如:1.首次创建 2.移动 3.改 ...
- python gzip 压缩文件
压缩数据创建gzip文件 先看一个略麻烦的做法 ? 1 2 3 4 5 6 import StringIO,gzip content = 'Life is short.I use python' zb ...
- 【C语言】在两个数成对出现的数组中找到一个单独的数。
//在两个数成对出现的数组中找到一个单独的数.比如{1,2,3.3,1,4.2},即找出4 #include <stdio.h> int find(int arr[], int len) ...
- 自己用h5写的转盘。写贴上来吧。
<!DOCTYPE html> <html> <head lang="en"> <meta charset="UTF-8&quo ...
- 中国还是和AMD走到一起了 但美国会高兴吗(网易科技 卢鑫)
文/ 网易科技 卢鑫 去年的这个时候,小编写下了一篇<易评:还给AMD一个公正!>——此文由AMD惨不忍睹的第一季度财报展开,谈到了该公司将全部资源押宝2016的现实.如今,2016第一季 ...
- 可执行程序的入口点在那里?(强化概念:程序真正的入口是mainCRTstartup)
今天终于有时间来研究一下一个很大很大的工程编译成一个exe和若干dll后,程序是如果执行它的第一条指令的?操作系统以什么规则来找到应该执行的第一条指令(或说如何找到第一个入口函数的)? 我们以前写wi ...