前提：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;
--------------------------------------------------------------------------------