TControl = class(TComponent)
procedure WndProc(var Message: TMessage);
virtual;
function DesignWndProc(var Message: TMessage): Boolean;
dynamic;
TWinControl = class(TControl)
procedure WndProc(var Message:
TMessage); override;
procedure MainWndProc(var Message: TMessage);
property DefWndProc: Pointer read FDefWndProc write FDefWndProc;
TCustomForm = class(TScrollingWinControl)
procedure ClientWndProc(var
Message: TMessage);
procedure WndProc(var Message: TMessage);
override;
procedure TApplication.CreateHandle;
procedure TApplication.WndProc(var
Message: TMessage);
procedure TControl.WndProc(var Message: TMessage);
var
Form:
TCustomForm;
KeyState: TKeyboardState;
WheelMsg:
TCMMouseWheel;
begin
if (csDesigning in ComponentState) then
begin
Form := GetParentForm(Self);
if (Form <> nil) and
(Form.Designer <> nil) and
Form.Designer.IsDesignMsg(Self,
Message) then Exit
end;
if (Message.Msg >= WM_KEYFIRST) and
(Message.Msg <= WM_KEYLAST) then
begin
Form :=
GetParentForm(Self);
if (Form <> nil) and Form.WantChildKey(Self,
Message) then Exit;
end
else if (Message.Msg >= WM_MOUSEFIRST) and
(Message.Msg <= WM_MOUSELAST) then
begin
if not (csDoubleClicks
in ControlStyle) then
case Message.Msg of
WM_LBUTTONDBLCLK,
WM_RBUTTONDBLCLK, WM_MBUTTONDBLCLK:
Dec(Message.Msg,
WM_LBUTTONDBLCLK - WM_LBUTTONDOWN);
end;
case Message.Msg of
WM_MOUSEMOVE: Application.HintMouseMessage(Self, Message);
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
if FDragMode =
dmAutomatic then
begin
BeginAutoDrag;
Exit;
end;
Include(FControlState, csLButtonDown);
end;
WM_LBUTTONUP:
Exclude(FControlState,
csLButtonDown);
else
with Mouse do
if WheelPresent
and (RegWheelMessage <> 0) and
(Message.Msg =
RegWheelMessage) then
begin
GetKeyboardState(KeyState);
with WheelMsg do
begin
Msg := Message.Msg;
ShiftState :=
KeyboardStateToShiftState(KeyState);
WheelDelta :=
Message.WParam;
Pos := TSmallPoint(Message.LParam);
end;
MouseWheelHandler(TMessage(WheelMsg));
Exit;
end;
end;
end
else if Message.Msg = CM_VISIBLECHANGED
then
with Message do
SendDockNotification(Msg, WParam,
LParam);
Dispatch(Message);
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;
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 TCustomForm.WMSysCommand(var Message:
TWMSysCommand);
begin
with Message do
begin
if (CmdType and
$FFF0 = SC_MINIMIZE) and (Application.MainForm = Self) then
Application.WndProc(TMessage(Message))
else if (CmdType and $FFF0
<> SC_MOVE) or (csDesigning in ComponentState) or
(Align =
alNone) or (WindowState = wsMinimized) then
inherited;
if
((CmdType and $FFF0 = SC_MINIMIZE) or (CmdType and $FFF0 = SC_RESTORE)) and
not (csDesigning in ComponentState) and (Align <> alNone) then
RequestAlign;
end;
end;
procedure TCustomForm.CreateWnd;
var
ClientCreateStruct:
TClientCreateStruct;
begin
inherited CreateWnd;
if NewStyleControls
then
if BorderStyle <> bsDialog then
SendMessage(Handle,
WM_SETICON, 1, GetIconHandle) else
SendMessage(Handle, WM_SETICON, 1,
0);
if not (csDesigning in ComponentState) then
case FormStyle
of
fsMDIForm:
begin
with ClientCreateStruct
do
begin
idFirstChild := $FF00;
hWindowMenu := 0;
if FWindowMenu <> nil then hWindowMenu :=
FWindowMenu.Handle;
end;
FClientHandle :=
Windows.CreateWindowEx(WS_EX_CLIENTEDGE, ‘MDICLIENT‘,
nil,
WS_CHILD or WS_VISIBLE or WS_GROUP or WS_TABSTOP or
WS_CLIPCHILDREN or WS_HSCROLL or WS_VSCROLL or WS_CLIPSIBLINGS or
MDIS_ALLCHILDSTYLES, 0, 0, ClientWidth, ClientHeight, Handle, 0,
HInstance, @ClientCreateStruct);
FClientInstance := Classes.MakeObjectInstance(ClientWndProc);
FDefClientProc := Pointer(GetWindowLong(FClientHandle,
GWL_WNDPROC));
SetWindowLong(FClientHandle, GWL_WNDPROC,
Longint(FClientInstance));
end;
fsStayOnTop:
SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or
SWP_NOSIZE or SWP_NOACTIVATE);
end;
end;
procedure TApplication.WndProc(var Message: TMessage);
type
TInitTestLibrary = function(Size: DWord; PAutoClassInfo: Pointer): Boolean;
stdcall;
var
I: Integer;
SaveFocus, TopWindow: HWnd;
InitTestLibrary:
TInitTestLibrary;
procedure Default;
begin
with Message do
Result :=
DefWindowProc(FHandle, Msg, WParam, LParam);
end;
procedure DrawAppIcon;
var
DC: HDC;
PS:
TPaintStruct;
begin
with Message do
begin
DC :=
BeginPaint(FHandle, PS);
DrawIcon(DC, 0, 0, GetIconHandle);
EndPaint(FHandle, PS);
end;
end;
begin
try
Message.Result := 0;
for I := 0 to
FWindowHooks.Count - 1 do
if TWindowHook(FWindowHooks[I]^)(Message)
then Exit;
CheckIniChange(Message);
with Message do
case
Msg of
WM_SYSCOMMAND:
case WParam and $FFF0 of
SC_MINIMIZE: Minimize;
SC_RESTORE: Restore;
else
Default;
end;
WM_CLOSE:
if MainForm <> nil then MainForm.Close;
WM_PAINT:
if IsIconic(FHandle) then DrawAppIcon else Default;
WM_ERASEBKGND:
begin
Message.Msg :=
WM_ICONERASEBKGND;
Default;
end;
WM_QUERYDRAGICON:
Result := GetIconHandle;
WM_SETFOCUS:
begin
PostMessage(FHandle, CM_ENTER, 0,
0);
Default;
end;
WM_ACTIVATEAPP:
begin
Default;
FActive :=
TWMActivateApp(Message).Active;
if TWMActivateApp(Message).Active
then
begin
RestoreTopMosts;
PostMessage(FHandle, CM_ACTIVATE, 0, 0)
end
else
begin
NormalizeTopMosts;
PostMessage(FHandle, CM_DEACTIVATE, 0, 0);
end;
end;
WM_ENABLE:
if TWMEnable(Message).Enabled then
begin
RestoreTopMosts;
if FWindowList
<> nil then
begin
EnableTaskWindows(FWindowList);
FWindowList := nil;
end;
Default;
end else
begin
Default;
if FWindowList = nil then
FWindowList := DisableTaskWindows(Handle);
NormalizeAllTopMosts;
end;
WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
Result := SendMessage(LParam,
CN_BASE + Msg, WParam, LParam);
WM_ENDSESSION: if
TWMEndSession(Message).EndSession then FTerminate := True;
WM_COPYDATA:
if (PCopyDataStruct(Message.lParam)^.dwData =
DWORD($DE534454)) and
(FAllowTesting) then
if
FTestLib = 0 then
begin
{$IFDEF MSWINDOWS}
FTestLib := SafeLoadLibrary(‘vcltest3.dll‘);
{$ENDIF}
if
FTestLib <> 0 then
begin
Result :=
0;
@InitTestLibrary := GetProcAddress(FTestLib,
‘RegisterAutomation‘);
if @InitTestLibrary <> nil
then
InitTestLibrary(PCopyDataStruct(Message.lParam)^.cbData,
PCopyDataStruct(Message.lParam)^.lpData);
end
else
begin
Result := GetLastError;
FTestLib := 0;
end;
end
else
Result := 0;
CM_ACTIONEXECUTE,
CM_ACTIONUPDATE:
Message.Result := Ord(DispatchAction(Message.Msg,
TBasicAction(Message.LParam)));
CM_APPKEYDOWN:
if
IsShortCut(TWMKey(Message)) then Result := 1;
CM_APPSYSCOMMAND:
if MainForm <> nil then
with MainForm do
if (Handle <> 0) and IsWindowEnabled(Handle) and
IsWindowVisible(Handle) then
begin
FocusMessages := False;
SaveFocus := GetFocus;
Windows.SetFocus(Handle);
Perform(WM_SYSCOMMAND, WParam,
LParam);
Windows.SetFocus(SaveFocus);
FocusMessages := True;
Result := 1;
end;
CM_ACTIVATE:
if Assigned(FOnActivate) then
FOnActivate(Self);
CM_DEACTIVATE:
if
Assigned(FOnDeactivate) then FOnDeactivate(Self);
CM_ENTER:
if not IsIconic(FHandle) and (GetFocus = FHandle) then
begin
TopWindow := FindTopMostWindow(0);
if TopWindow
<> 0 then Windows.SetFocus(TopWindow);
end;
WM_HELP, // MessageBox(... MB_HELP)
CM_INVOKEHELP:
InvokeHelp(WParam, LParam);
CM_WINDOWHOOK:
if wParam = 0
then
HookMainWindow(TWindowHook(Pointer(LParam)^)) else
UnhookMainWindow(TWindowHook(Pointer(LParam)^));
CM_DIALOGHANDLE:
if wParam = 1 then
Result :=
FDialogHandle
else
FDialogHandle := lParam;
WM_SETTINGCHANGE:
begin
Mouse.SettingChanged(wParam);
SettingChange(TWMSettingChange(Message));
Default;
end;
WM_FONTCHANGE:
begin
Screen.ResetFonts;
Default;
end;
WM_THEMECHANGED:
if ThemeServices.ThemesEnabled then
ThemeServices.ApplyThemeChange;
WM_NULL:
CheckSynchronize;
else
Default;
end;
except
HandleException(Self);
end;
end;
procedure TApplication.CreateHandle;
var
TempClass:
TWndClass;
SysMenu: HMenu;
begin
if not FHandleCreated
and
not IsConsole then
begin
FObjectInstance :=
Classes.MakeObjectInstance(WndProc);
WindowClass.lpfnWndProc :=
@DefWindowProc;
if not GetClassInfo(HInstance, WindowClass.lpszClassName,
TempClass) then
begin
WindowClass.hInstance := HInstance;
if Windows.RegisterClass(WindowClass) = 0 then
raise
EOutOfResources.Create(SWindowClass);
end;
FHandle :=
CreateWindow(WindowClass.lpszClassName, PChar(FTitle),
WS_POPUP or
WS_CAPTION or WS_CLIPSIBLINGS or WS_SYSMENU
or WS_MINIMIZEBOX,
GetSystemMetrics(SM_CXSCREEN) div 2,
GetSystemMetrics(SM_CYSCREEN) div
2,
0, 0, 0, 0, HInstance, nil);
FTitle := ‘‘;
FHandleCreated := True;
SetWindowLong(FHandle, GWL_WNDPROC,
Longint(FObjectInstance));
if NewStyleControls then
begin
SendMessage(FHandle, WM_SETICON, 1, GetIconHandle);
SetClassLong(FHandle, GCL_HICON, GetIconHandle);
end;
SysMenu :=
GetSystemMenu(FHandle, False);
DeleteMenu(SysMenu, SC_MAXIMIZE,
MF_BYCOMMAND);
DeleteMenu(SysMenu, SC_SIZE, MF_BYCOMMAND);
if
NewStyleControls then DeleteMenu(SysMenu, SC_MOVE, MF_BYCOMMAND);
end;
end;
原文：http://www.cnblogs.com/findumars/p/3530599.html