1{%MainUnit win32int.pp}
2
3{
4 *****************************************************************************
5  This file is part of the Lazarus Component Library (LCL)
6
7  See the file COPYING.modifiedLGPL.txt, included in this distribution,
8  for details about the license.
9 *****************************************************************************
10}
11{$IFOPT C-}
12// Uncomment for local trace
13//  {$C+}
14//  {$DEFINE ASSERT_IS_ON}
15{$ENDIF}
16type
17  TWinControlAccess = class(TWinControl);
18{*************************************************************}
19{            callback routines                                }
20{*************************************************************}
21
22procedure PrepareSynchronize;
23begin
24  TWin32WidgetSet(WidgetSet).HandleWakeMainThread(nil);
25end;
26
27{-----------------------------------------------------------------------------
28  Function: PropEnumProc
29  Params: Window - The window with the property
30          Str    - The property name
31          Data   - The property value
32  Returns: Whether the enumeration should continue
33
34  Enumerates and removes properties for the target window
35 -----------------------------------------------------------------------------}
36function PropEnumProc(Window: Hwnd; Str: PChar; Data: Handle): LongBool; stdcall;
37begin
38  Result:=false;
39  if PtrUInt(Str) <= $FFFF then exit; // global atom handle
40  RemoveProp(Window, Str);
41  Result := True;
42end;
43
44{------------------------------------------------------------------------------
45 Function: CallDefaultWindowProc
46 Params: Window - The window that receives a message
47         Msg    - The message received
48         WParam - Word parameter
49         LParam - Long-integer parameter
50 Returns: 0 if Msg is handled; non-zero long-integer result otherwise
51
52 Passes message on to 'default' handler. This can be a control specific window
53 procedure or the default window procedure.
54 ------------------------------------------------------------------------------}
55function CallDefaultWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
56  LParam: Windows.LParam): LResult;
57
58  function IsComboboxAndHasEdit(Window: HWnd): Boolean;
59  var
60    Info: TComboboxInfo;
61  begin
62    Result := WndClassName(Window) = LCLComboboxClsName;
63    if not Result then
64      Exit;
65    Info.cbSize := SizeOf(Info);
66    Win32Extra.GetComboBoxInfo(Window, @Info);
67    Result := (Info.hwndItem <> 0) and GetWin32WindowInfo(Info.hwndItem)^.isComboEdit;
68  end;
69var
70  PrevWndProc: Windows.WNDPROC;
71{$if defined(MSG_DEBUG) or defined(DBG_SendPaintMessage)}
72  depthLen: integer;
73{$endif}
74  setComboWindow: boolean;
75  WindowInfo: PWin32WindowInfo;
76begin
77{$if defined(MSG_DEBUG) or defined(DBG_SendPaintMessage)}
78  depthLen := Length(MessageStackDepth);
79  if depthLen > 0 then
80    MessageStackDepth[depthLen] := '#';
81{$endif}
82  WindowInfo := GetWin32WindowInfo(Window);
83  PrevWndProc := WindowInfo^.DefWndProc;
84  if (PrevWndProc = nil) or (PrevWndProc = @WindowProc) // <- prevent recursion
85  then begin
86    if (WindowInfo^.WinControl is TCustomForm) and not (csDesigning in WindowInfo^.WinControl.ComponentState) then
87    begin
88      case TCustomForm(WindowInfo^.WinControl).FormStyle of
89        fsMDIForm:
90        begin
91          if Msg <> WM_COMMAND then
92            Result := Windows.DefFrameProcW(Window, Win32WidgetSet.MDIClientHandle, Msg, WParam, LParam)
93          else
94          if (LoWord(WParam)=SC_CLOSE) or
95             (LoWord(WParam)=SC_MAXIMIZE) or
96             (LoWord(WParam)=SC_MINIMIZE) or
97             (LoWord(WParam)=SC_RESTORE) or
98             (LoWord(WParam)=SC_NEXTWINDOW) or
99             (LoWord(WParam)=SC_PREVWINDOW)
100          then
101            Result := Windows.DefFrameProcW(Window, Win32WidgetSet.MDIClientHandle, Msg, WParam, LParam)
102          else
103            Result := Windows.DefWindowProcW(Window, Msg, WParam, LParam);
104        end;
105        fsMDIChild:
106          Result := Windows.DefMDIChildProcW(Window, Msg, WParam, LParam);
107      else
108        Result := Windows.DefWindowProcW(Window, Msg, WParam, LParam);
109      end;
110    end else
111      Result := Windows.DefWindowProcW(Window, Msg, WParam, LParam);
112  end
113  else begin
114    // combobox child edit weirdness: combobox handling WM_SIZE will compare text
115    // to list of strings, and if appears in there, will set the text, and select it
116    // WM_GETTEXTLENGTH, WM_GETTEXT, WM_SETTEXT, EM_SETSEL
117    // combobox sends WM_SIZE to itself indirectly, check recursion
118    setComboWindow :=
119        (Msg = WM_SIZE) and
120        (ComboBoxHandleSizeWindow = 0) and
121        IsComboboxAndHasEdit(Window);
122    if setComboWindow then
123      ComboBoxHandleSizeWindow := Window;
124    Result := Windows.CallWindowProcW(PrevWndProc, Window, Msg, WParam, LParam);
125    if setComboWindow then
126      ComboBoxHandleSizeWindow := 0;
127  end;
128{$if defined(MSG_DEBUG) or defined(DBG_SendPaintMessage)}
129  if depthLen > 0 then
130    MessageStackDepth[depthLen] := ' ';
131{$endif}
132end;
133
134procedure DrawParentBackground(Window: HWND; ControlDC: HDC);
135var
136  Parent: HWND;
137  P: TPoint;
138begin
139  if ThemeServices.ThemesEnabled then
140    ThemeServices.DrawParentBackground(Window, ControlDC, nil, False)
141  else
142  begin
143    Parent := Windows.GetParent(Window);
144    P.X := 0;
145    P.Y := 0;
146    Windows.MapWindowPoints(Window, Parent, P, 1);
147    Windows.OffsetViewportOrgEx(ControlDC, -P.X, -P.Y, P);
148    Windows.SendMessage(Parent, WM_ERASEBKGND, WParam(ControlDC), 0);
149    Windows.SendMessage(Parent, WM_PRINTCLIENT, WParam(ControlDC), PRF_CLIENT);
150    Windows.SetViewportExtEx(ControlDC, P.X, P.Y, nil);
151  end;
152end;
153
154type
155  TEraseBkgndCommand =
156  (
157    ecDefault,             // todo: add comments
158    ecDiscard,             //
159    ecDiscardNoRemove,     //
160    ecDoubleBufferNoRemove //
161  );
162const
163  EraseBkgndStackMask = $3;
164  EraseBkgndStackShift = 2;
165var
166  EraseBkgndStack: dword = 0;
167
168{$if defined(MSG_DEBUG) or defined(DBG_SendPaintMessage)}
169function EraseBkgndStackToString: string;
170var
171  I: dword;
172begin
173  SetLength(Result, 8);
174  for I := 0 to 7 do
175    Result[8-I] := char(ord('0') + ((EraseBkgndStack shr (I*2)) and $3));
176end;
177{$endif}
178
179procedure PushEraseBkgndCommand(Command: TEraseBkgndCommand);
180begin
181{$if defined(MSG_DEBUG) or defined(DBG_SendPaintMessage)}
182  case Command of
183    ecDiscard: DebugLn(MessageStackDepth,
184      ' *forcing next WM_ERASEBKGND to discard message');
185    ecDiscardNoRemove: DebugLn(MessageStackDepth,
186      ' *forcing next WM_ERASEBKGND to discard message, no remove');
187    ecDoubleBufferNoRemove: DebugLn(MessageStackDepth,
188      ' *forcing next WM_ERASEBKGND to use double buffer, after that, discard no remove');
189  end;
190  DebugLn(MessageStackDepth, ' *erasebkgndstack: ', EraseBkgndStackToString);
191{$endif}
192  EraseBkgndStack := (EraseBkgndStack shl EraseBkgndStackShift) or dword(Ord(Command));
193end;
194
195type
196  TDoubleBuffer = record
197    DC: HDC;
198    Bitmap: HBITMAP;
199    BitmapWidth: integer;
200    BitmapHeight: integer;
201  end;
202
203var
204  CurDoubleBuffer: TDoubleBuffer = (DC: 0; Bitmap: 0; BitmapWidth: 0; BitmapHeight: 0);
205  DisabledForms: TList = nil;
206  CurrentWindow: HWND = 0;
207
208function GetNeedParentPaint(AWindowInfo: PWin32WindowInfo; AWinControl: TWinControl): boolean;
209begin
210  Result := AWindowInfo^.needParentPaint
211    and ((AWinControl = nil) or not (csOpaque in AWinControl.ControlStyle));
212  if ThemeServices.ThemesEnabled then
213    Result := Result or (Assigned(AWinControl) and ([csParentBackground, csOpaque] * AWinControl.ControlStyle = [csParentBackground]));
214end;
215
216procedure DisposeComboEditWindowInfo(ComboBox: TCustomComboBox);
217var
218  Buddy: HWND;
219  Info: TComboboxInfo;
220begin
221  Info.cbSize := SizeOf(Info);
222  Win32Extra.GetComboBoxInfo(Combobox.Handle, @Info);
223  Buddy := Info.hwndItem;
224  if (Buddy <> Info.hwndCombo) and (Buddy <> 0) then
225    DisposeWindowInfo(Buddy);
226end;
227
228function GetLCLWindowFromPoint(BaseControl: TControl; const Point: TPoint): HWND;
229var
230  ParentForm: TCustomForm;
231  ParentRect: TRect;
232  TheControl: TControl;
233begin
234  Result := 0;
235  ParentForm := GetParentForm(BaseControl);
236  if ParentForm <> nil then
237  begin
238    TheControl := ParentForm.ControlAtPos(ParentForm.ScreenToClient(Point), [capfAllowDisabled, capfAllowWinControls,
239      capfRecursive, capfHasScrollOffset]);
240    if TheControl is TWinControl then
241      Result := TWinControlAccess(TheControl).WindowHandle;
242    if Result = 0 then
243    begin
244      ParentRect := Rect(ParentForm.Left, ParentForm.Top,
245        ParentForm.Left + ParentForm.Width, ParentForm.Top + ParentForm.Height);
246      if PtInRect(ParentRect, Point) then
247        Result := ParentForm.Handle;
248    end;
249  end;
250end;
251
252// Used by WindowProc :
253
254function GetMenuParent(ASearch, AParent: HMENU): HMENU;
255var
256  c, i: integer;
257  sub: HMENU;
258begin
259  c := GetMenuItemCount(AParent);
260  for i:= 0 to c - 1 do
261  begin
262    sub := GetSubMenu(AParent, i);
263    if sub = ASearch then
264      Exit(AParent);
265    Result := GetMenuParent(ASearch, sub);     // Recursive call
266    if Result <> 0 then Exit;
267  end;
268  Result := 0;
269end;
270
271function GetIsNativeControl(AWindow: HWND): Boolean;
272var
273  S: String;
274begin
275  S := WndClassName(AWindow);
276  Result := (S <> ClsName) and (S <> ClsHintName);
277end;
278
279procedure ClearSiblingRadioButtons(RadioButton: TRadioButton);
280var
281  Parent: TWinControl;
282  Sibling: TControl;
283  WinControl: TWinControlAccess absolute Sibling;
284  LParamFlag: LRESULT;
285  i: Integer;
286begin
287  Parent := RadioButton.Parent;
288  for i:= 0 to Parent.ControlCount - 1 do
289  begin
290    Sibling := Parent.Controls[i];
291    if (Sibling is TRadioButton) and (Sibling <> RadioButton) then
292    begin
293      // Pass previous state through LParam so the event handling can decide
294      // when to propagate LM_CHANGE (New State <> Previous State)
295      LParamFlag := Windows.SendMessage(WinControl.WindowHandle, BM_GETCHECK, 0, 0);
296      // Pass SKIP_LMCHANGE through LParam if previous state is already unchecked
297      if LParamFlag = BST_UNCHECKED then
298        LParamFlag := SKIP_LMCHANGE;
299      Windows.SendMessage(WinControl.WindowHandle, BM_SETCHECK,
300        Windows.WParam(BST_UNCHECKED), Windows.LParam(LParamFlag));
301    end;
302  end;
303end;
304
305// sets the text of the combobox,
306// because some events are risen, before the text is actually changed
307procedure UpdateComboBoxText(ComboBox: TCustomComboBox);
308var
309  Index: Integer;
310begin
311  Index := ComboBox.ItemIndex;
312  // Index might be -1, if current text is not in the list.
313  if (Index>=0) then
314    TWin32WSWinControl.SetText(ComboBox, ComboBox.Items[Index]);
315end;
316
317// A helper class for WindowProc to make it easier to split code into smaller pieces.
318// The original function was about 2400 lines.
319
320type
321  TAccessCustomEdit = class(TCustomEdit);
322
323  { TWindowProcHelper }
324
325  TWindowProcHelper = record
326  private
327    procedure SetlWinControl(AValue: TWinControl);
328  private
329    // WindowProc parameters
330    Window: HWnd;            // DWord / QWord
331    Msg: UInt;               // LongWord
332    WParam: Windows.WParam;  // PtrInt
333    LParam: Windows.LParam;  // PtrInt
334    // Other variables
335    LMessage: TLMessage;
336    PLMsg: PLMessage;
337    FlWinControl: TWinControl;
338    WinProcess: Boolean;
339    NotifyUserInput: Boolean;
340    WindowInfo: PWin32WindowInfo;
341    // Used by SendPaintMessage
342    BackupBuffer: TDoubleBuffer;
343    WindowWidth, WindowHeight: Integer;
344    PaintMsg: TLMPaint;
345    RTLLayout: Boolean;
346    // Structures for message handling
347    OrgCharCode: word; // used in WM_CHAR handling
348    LMScroll: TLMScroll; // used by WM_HSCROLL
349    LMKey: TLMKey; // used by WM_KEYDOWN WM_KEYUP
350    LMChar: TLMChar; // used by WM_CHAR
351    LMMouse: TLMMouse; // used by WM_LBUTTONDBLCLK
352    LMContextMenu: TLMContextMenu;
353    LMMouseMove: TLMMouseMove; // used by WM_MOUSEMOVE
354    LMMouseEvent: TLMMouseEvent; // used by WM_MOUSEWHEEL
355    LMMove: TLMMove; // used by WM_MOVE
356    LMNotify: TLMNotify; // used by WM_NOTIFY
357    DrawListItemStruct: TDrawListItemStruct; //used by WM_DRAWITEM
358    NMHdr: PNMHdr; // used by WM_NOTIFY
359
360    procedure CalcClipRgn(PaintRegion: HRGN);
361    function DoChildEdit(out WinResult: LResult): Boolean;
362    procedure DoCmdCheckBoxParam;
363    function DoCmdComboBoxParam: Boolean;
364    procedure DoMsgActivateApp;
365    procedure DoMsgChar(var WinResult: LResult);
366    procedure DoMsgColor(ChildWindowInfo: PWin32WindowInfo);
367    procedure DoMsgDrawItem;
368    procedure DoMsgEnable;
369    function DoMsgEraseBkgnd(var WinResult: LResult): Boolean;
370    procedure DoMsgKeyDownUp(aMsg: Cardinal; var WinResult: LResult);
371    procedure DoMsgMeasureItem;
372    procedure DoMsgMouseMove;
373    procedure DoMsgMouseDownUpClick(aButton: Byte; aIsDblClick: Boolean; aMouseDown: Boolean);
374    procedure DoMsgContextMenu;
375    function DoMsgMouseWheel(var WinResult: LResult; AHorz: Boolean): Boolean;
376    function DoMsgMove: Boolean;
377    procedure DoMsgNCLButtonDown;
378    function DoMsgNotify(var WinResult: LResult): Boolean;
379    procedure DoMsgShowWindow;
380    procedure DoMsgSize;
381    procedure DoMsgSysKey(aMsg: Cardinal);
382    procedure DoSysCmdKeyMenu;
383    procedure DoSysCmdMinimize;
384    procedure DoSysCmdRestore;
385    function GetPopMenuItemObject: TObject;
386    function GetMenuItemObject(ByPosition: Boolean): TObject;
387    function PrepareDoubleBuffer(out DoubleBufferBitmapOld: HBITMAP): Boolean;
388    procedure SetLMCharData(aMsg: Cardinal; UpdateKeyData: Boolean = False);
389    procedure SetLMKeyData(aMsg: Cardinal; UpdateKeyData: Boolean = False);
390    procedure SetLMessageAndParams(aMsg: Cardinal; ResetWinProcess: Boolean = False);
391    procedure SendPaintMessage(ControlDC: HDC);
392    procedure HandleScrollMessage(LMsg: integer);
393    procedure HandleSetCursor;
394    procedure HandleSysCommand;
395    function IsComboEditSelection: boolean;
396    procedure HandleBitBtnCustomDraw(ABitBtn: TCustomBitBtn);
397    procedure HandleDropFiles;
398    function HandleUnicodeChar(var AChar: WideChar): boolean;
399    procedure UpdateDrawItems;
400    procedure UpdateDrawListItem(aMsg: UInt);
401    procedure UpdateLMMovePos(X, Y: Smallint);
402    procedure UpdateUIState(CharCode: Word);
403    function DoWindowProc: LResult;    // Called from the actual WindowProc.
404    property lWinControl: TWinControl read FlWinControl write SetlWinControl;
405  end;
406  PWindowProcHelper = ^TWindowProcHelper;
407
408  { TWindProcNotificationReceiver }
409
410  TWindProcNotificationReceiver = class
411    procedure ReceiveDestroyNotify(Sender: TObject);
412  end;
413
414
415// Implementation of TWindowProcHelper
416
417procedure TWindowProcHelper.SetLMCharData(aMsg: Cardinal; UpdateKeyData: Boolean);
418begin
419  LMChar.Msg := aMsg;
420  LMChar.CharCode := Word(WParam);
421  if UpdateKeyData then
422    LMChar.KeyData := LParam;
423end;
424
425procedure TWindowProcHelper.SetLMKeyData(aMsg: Cardinal; UpdateKeyData: Boolean);
426begin
427  LMKey.Msg := aMsg;
428  LMKey.CharCode := Word(WParam);
429  if UpdateKeyData then
430    LMKey.KeyData := LParam;
431end;
432
433procedure TWindowProcHelper.SetLMessageAndParams(aMsg: Cardinal; ResetWinProcess: Boolean);
434begin
435  LMessage.Msg := aMsg;
436  LMessage.WParam := WParam;
437  LMessage.LParam := LParam;
438  if ResetWinProcess then
439    WinProcess := False;
440end;
441
442function TWindowProcHelper.GetPopMenuItemObject: TObject;
443var
444  MainMenuHandle: HMENU;
445  MenuInfo: MENUITEMINFO;
446begin
447  MenuInfo.cbSize := MMenuItemInfoSize;
448  MenuInfo.fMask := MIIM_DATA;
449
450  MainMenuHandle := GetMenuParent(HMENU(WParam), GetMenu(Window));
451  if GetMenuItemInfo(MainMenuHandle, LOWORD(LParam), true, @MenuInfo) then
452    Result := TObject(MenuInfo.dwItemData)
453  else
454    Result := nil;
455end;
456
457function TWindowProcHelper.GetMenuItemObject(ByPosition: Boolean): TObject;
458var
459  MenuInfo: MENUITEMINFO;
460  PopupMenu: TPopupMenu;
461  Menu: HMENU;
462begin
463  // first we have to decide if the command is from a popup menu
464  // or from the window main menu
465  // if the 'PopupMenu' property exists, there is a big probability
466  // that the command is from a popup menu
467
468  PopupMenu := WindowInfo^.PopupMenu;
469  if Assigned(PopupMenu) then
470  begin
471    Result := PopupMenu.FindItem(LOWORD(Integer(WParam)), fkCommand);
472    if Assigned(Result) then
473      Exit;
474  end;
475
476  // nothing found, process main menu
477  MenuInfo.cbSize := MMenuItemInfoSize;
478  MenuInfo.fMask := MIIM_DATA;
479
480  if ByPosition then
481    Menu := HMENU(LParam)
482  else
483    Menu := GetMenu(Window);
484  if GetMenuItemInfo(Menu, LOWORD(Integer(WParam)), ByPosition, @MenuInfo) then
485    Result := TObject(MenuInfo.dwItemData)
486  else
487    Result := nil;
488end;
489
490function TWindowProcHelper.PrepareDoubleBuffer(out DoubleBufferBitmapOld: HBITMAP): Boolean;
491// Returns True if BackupBuffer was saved.
492var
493  DC: HDC;
494begin
495  Result := CurDoubleBuffer.DC <> 0;
496  if Result then
497  begin
498    // we've been called from another paint handler. To prevent killing of
499    // not own DC and HBITMAP lets save then and restore on exit
500    BackupBuffer := CurDoubleBuffer;
501    FillChar(CurDoubleBuffer, SizeOf(CurDoubleBuffer), 0);
502  end;
503  CurDoubleBuffer.DC := Windows.CreateCompatibleDC(0);
504
505  GetWindowSize(Window, WindowWidth, WindowHeight);
506  if (CurDoubleBuffer.BitmapWidth < WindowWidth) or (CurDoubleBuffer.BitmapHeight < WindowHeight) then
507  begin
508    DC := Windows.GetDC(0);
509    if CurDoubleBuffer.Bitmap <> 0 then
510      Windows.DeleteObject(CurDoubleBuffer.Bitmap);
511    CurDoubleBuffer.BitmapWidth := WindowWidth;
512    CurDoubleBuffer.BitmapHeight := WindowHeight;
513    CurDoubleBuffer.Bitmap := Windows.CreateCompatibleBitmap(DC, WindowWidth, WindowHeight);
514    Windows.ReleaseDC(0, DC);
515    if RTLLayout then  // change the default layout - LTR - of memory DC
516      {if (GetLayout(vDC) and LAYOUT_BITMAPORIENTATIONPRESERVED) > 0 then  // GetLayout is not in win32extra
517        SetLayout(CurDoubleBuffer.DC, LAYOUT_RTL or LAYOUT_BITMAPORIENTATIONPRESERVED)
518      else //}
519        SetLayout(CurDoubleBuffer.DC, LAYOUT_RTL);
520  end;
521  DoubleBufferBitmapOld := Windows.SelectObject(CurDoubleBuffer.DC, CurDoubleBuffer.Bitmap);
522  PaintMsg.DC := CurDoubleBuffer.DC;
523  {$ifdef MSG_DEBUG}
524    DebugLn(MessageStackDepth, ' *double buffering on DC: ', IntToHex(CurDoubleBuffer.DC, sizeof(HDC)*2));
525  {$endif}
526end;
527
528procedure TWindowProcHelper.SetlWinControl(AValue: TWinControl);
529begin
530  if FlWinControl = AValue then Exit;
531  if FlWinControl <> nil then begin
532    FlWinControl.DecLCLRefCount;
533    FlWinControl.RemoveHandlerOnBeforeDestruction(@TWindProcNotificationReceiver(@Self).ReceiveDestroyNotify);
534  end;
535
536  FlWinControl := AValue;
537
538  if FlWinControl <> nil then begin
539    FlWinControl.AddHandlerOnBeforeDestruction(@TWindProcNotificationReceiver(@Self).ReceiveDestroyNotify);
540    FlWinControl.IncLCLRefCount;
541  end;
542end;
543
544procedure TWindowProcHelper.CalcClipRgn(PaintRegion: HRGN);
545var
546  nSize: DWORD;
547  RgnData: PRgnData;
548  WindowOrg: Windows.POINT;
549  XFRM: TXFORM;
550  MirroredPaintRgn: HRGN;
551begin
552  // winnt returns in screen coordinates
553  // win9x returns in window coordinates
554  if Win32Platform = VER_PLATFORM_WIN32_NT then
555  begin
556    WindowOrg.X := 0;
557    WindowOrg.Y := 0;
558    MapWindowPoints(Window, 0, WindowOrg, 1);
559    if RTLLayout then // We need the left side of the client area in screen coordinates
560      WindowOrg.X := WindowOrg.X - lWinControl.ClientWidth;
561    Windows.OffsetRgn(PaintRegion, -WindowOrg.X, -WindowOrg.Y);
562  end;
563
564  if RTLLayout then // Paint region needs to be mirrored before using it for clipping!
565  begin
566    {
567    //Method 1 - Switch Layout to LTR, Clip, Switch back to RTL
568    //Sometimes it's off by one or two pixels!!
569    SetLayout(CurDoubleBuffer.DC, LAYOUT_LTR);
570    Windows.SelectClipRgn(CurDoubleBuffer.DC, PaintRegion);
571    SetLayout(CurDoubleBuffer.DC, LAYOUT_RTL);//}
572
573    //Method 2 - Create a mirrored region based on the one we have
574    nSize := GetRegionData(PaintRegion, 0, nil);
575    RgnData := GetMem(nSize);
576    XFRM.eDx:=0;   XFRM.eDy:=0;
577    XFRM.eM11:=-1; XFRM.eM12:=0;
578    XFRM.eM21:=0;  XFRM.eM22:=1;
579
580    MirroredPaintRgn := ExtCreateRegion(@XFRM, nSize, RgnData^);
581    Windows.SelectClipRgn(CurDoubleBuffer.DC, MirroredPaintRgn);
582    Windows.DeleteObject(MirroredPaintRgn);
583    Freemem(RgnData);
584  end
585  else
586    Windows.SelectClipRgn(CurDoubleBuffer.DC, PaintRegion);
587end;
588
589procedure TWindowProcHelper.SendPaintMessage(ControlDC: HDC);
590var
591  DC: HDC;
592  PaintRegion: HRGN;
593  PS : TPaintStruct;
594  DoubleBufferBitmapOld: HBITMAP;
595  ORect: TRect;
596{$ifdef DEBUG_DOUBLEBUFFER}
597  ClipBox: Windows.RECT;
598{$endif}
599  ParentPaintWindow: HWND;
600  DCIndex: integer;
601  parLeft, parTop: integer;
602  BufferWasSaved: Boolean;
603  useDoubleBuffer: Boolean;
604  isNativeControl: Boolean;
605  needParentPaint: Boolean;
606begin
607  // note: ignores the received DC
608  // do not use default deliver message
609  if lWinControl = nil then
610  begin
611    lWinControl := GetWin32WindowInfo(Window)^.PWinControl;
612    if lWinControl = nil then exit;
613  end;
614
615  // create a paint message
616  isNativeControl := GetIsNativeControl(Window);
617  needParentPaint := GetNeedParentPaint(WindowInfo, lWinControl);
618  // if needParentPaint and not isTabPage then background will be drawn in
619  // WM_ERASEBKGND and WM_CTLCOLORSTATIC for native controls
620  // sent by default paint handler
621  if WindowInfo^.isTabPage or (needParentPaint and (not isNativeControl or (ControlDC <> 0))) then
622    ParentPaintWindow := Windows.GetParent(Window)
623  else
624    ParentPaintWindow := 0;
625{$IFDEF DBG_SendPaintMessage}
626  DebugLnEnter(['>>> SendPaintMessage for CtrlDC=', dbgs(ControlDC), ' Window=', dbgs(Window),
627     ' WinCtrl=',dbgs(PtrUInt(lWinControl)), ' ', DbgSName(lWinControl),
628     ' NativeCtrl=', dbgs(isNativeControl), ' ndParentPaint=', dbgs(needParentPaint),
629     ' isTab=', dbgs(WindowInfo^.isTabPage)    ]);
630  try
631{$ENDIF}
632
633  // if painting background of some control for tabpage, don't handle erase background
634  // in parent of tabpage
635  if WindowInfo^.isTabPage then
636    PushEraseBkgndCommand(ecDiscard);
637
638  // check if double buffering is requested
639  useDoubleBuffer := (ControlDC = 0) and (
640      ((csDesigning in lWinControl.ComponentState) and (GetSystemMetrics(SM_REMOTESESSION)=0)) // force double buffer in the designer
641    or TWSWinControlClass(TWinControl(lWinControl).WidgetSetClass).GetDoubleBuffered(lWinControl));
642
643  if useDoubleBuffer then
644    BufferWasSaved := PrepareDoubleBuffer(DoubleBufferBitmapOld)
645  else
646    BufferWasSaved := False;
647{$ifdef MSG_DEBUG}
648  if not useDoubleBuffer then
649    DebugLn(MessageStackDepth, ' *painting, but not double buffering');
650{$endif}
651  WinProcess := false;
652  try
653    if ControlDC = 0 then
654    begin
655      // ignore first erase background on themed control, paint will do everything
656      if ThemeServices.ThemesEnabled then
657        PushEraseBkgndCommand(ecDoubleBufferNoRemove);
658      DC := Windows.BeginPaint(Window, @PS);
659{$IFDEF DBG_SendPaintMessage}
660      if ThemeServices.ThemesEnabled then
661        DebugLn(['SendPaintMessage for CtrlDC=', dbgs(ControlDC), ' Remove one from EraseBkgndStack val=', (EraseBkgndStack and 3)]);
662{$ENDIF}
663      if ThemeServices.ThemesEnabled then
664        EraseBkgndStack := EraseBkgndStack shr EraseBkgndStackShift;
665      if useDoubleBuffer then
666      begin
667        RTLLayout := (GetWindowLong(Window, GWL_EXSTYLE) and WS_EX_LAYOUTRTL) = WS_EX_LAYOUTRTL;
668
669        ORect.Left := 0;
670        ORect.Top := 0;
671        ORect.Right := CurDoubleBuffer.BitmapWidth;
672        ORect.Bottom := CurDoubleBuffer.BitmapHeight;
673        Windows.FillRect(CurDoubleBuffer.DC, ORect, GetSysColorBrush(COLOR_BTNFACE));
674
675        PaintRegion := CreateRectRgn(0, 0, 1, 1);
676        if GetRandomRgn(DC, PaintRegion, SYSRGN) = 1 then
677          CalcClipRgn(PaintRegion);
678{$ifdef DEBUG_DOUBLEBUFFER}
679        Windows.GetClipBox(CurDoubleBuffer.DC, ClipBox);
680        DebugLn('Double buffering in DC ', IntToHex(CurDoubleBuffer.DC, sizeof(HDC)*2),
681          ' with clipping rect (',
682          IntToStr(ClipBox.Left), ',', IntToStr(ClipBox.Top), ';',
683          IntToStr(ClipBox.Right), ',', IntToStr(ClipBox.Bottom), ')');
684{$endif}
685        // a copy of the region is selected into the DC, so we
686        // can free our region immediately
687        Windows.DeleteObject(PaintRegion);
688      end;
689    end else begin
690      FillChar(PS, SizeOf(PS), 0);
691      PS.hdc := ControlDC;
692      Windows.GetUpdateRect(Window, @PS.rcPaint, False);
693      DC := ControlDC;
694      PaintRegion := 0;
695    end;
696
697    if ParentPaintWindow <> 0 then
698      GetWin32ControlPos(Window, ParentPaintWindow, parLeft, parTop);
699    //Is not necessary to check the result of GetLCLClientBoundsOffset since
700    //the false condition (lWincontrol = nil or lWincontrol <> TWinControl) is never met
701    //The rect is always initialized with 0
702    GetLCLClientBoundsOffset(lWinControl, ORect);
703    PaintMsg.Msg := LM_PAINT;
704    PaintMsg.PaintStruct := @PS;
705    if not useDoubleBuffer then
706      PaintMsg.DC := DC;
707    if not needParentPaint then
708    begin
709      // send through message to allow message override, moreover use SendMessage
710      // to allow subclass window proc override this message too
711{$IFDEF DBG_SendPaintMessage}
712      DebugLnEnter('> SendPaintMessage call WM_ERASEBKGND for CtrlDC=', dbgs(ControlDC), ' Window=', dbgs(Window), ' WinCtrl=',dbgs(PtrUInt(lWinControl)), ' ', DbgSName(lWinControl));
713{$ENDIF}
714      Include(TWinControlAccess(lWinControl).FWinControlFlags, wcfEraseBackground);
715      Windows.SendMessage(lWinControl.Handle, WM_ERASEBKGND, Windows.WPARAM(PaintMsg.DC), 0);
716      Exclude(TWinControlAccess(lWinControl).FWinControlFlags, wcfEraseBackground);
717{$IFDEF DBG_SendPaintMessage}
718      DebugLnExit('< SendPaintMessage back from WM_ERASEBKGND for CtrlDC=', dbgs(ControlDC), ' Window=', dbgs(Window), ' WinCtrl=',dbgs(PtrUInt(lWinControl)), ' ', DbgSName(lWinControl));
719{$ENDIF}
720    end;
721    if ParentPaintWindow <> 0 then
722    begin
723{$ifdef MSG_DEBUG}
724      DebugLn(MessageStackDepth, ' *painting background by sending paint message to parent window ',
725        IntToHex(ParentPaintWindow, 8));
726{$endif}
727      // tabpage parent and got a dc to draw in, divert paint to parent
728      DCIndex := Windows.SaveDC(PaintMsg.DC);
729      DrawParentBackground(Window, PaintMsg.DC);
730      Windows.RestoreDC(PaintMsg.DC, DCIndex);
731    end;
732    if (ControlDC = 0) or not needParentPaint then
733    begin
734      DCIndex := Windows.SaveDC(PaintMsg.DC);
735      MoveWindowOrgEx(PaintMsg.DC, ORect.Left, ORect.Top);
736{$ifdef DEBUG_DOUBLEBUFFER}
737      Windows.GetClipBox(PaintMsg.DC, ClipBox);
738      DebugLn('LCL Drawing in DC ', IntToHex(PaintMsg.DC, 8), ' with clipping rect (',
739        IntToStr(ClipBox.Left), ',', IntToStr(ClipBox.Top), ';',
740        IntToStr(ClipBox.Right), ',', IntToStr(ClipBox.Bottom), ')');
741{$endif}
742{$IFDEF DBG_SendPaintMessage}
743      DebugLnEnter('> SendPaintMessage call DeliverMessage for CtrlDC=', dbgs(ControlDC), ' Window=', dbgs(Window), ' WinCtrl=',dbgs(PtrUInt(lWinControl)), ' ', DbgSName(lWinControl));
744{$ENDIF}
745      DeliverMessage(lWinControl, PaintMsg);
746{$IFDEF DBG_SendPaintMessage}
747      DebugLnExit('< SendPaintMessage back from DeliverMessage Ufor CtrlDC=', dbgs(ControlDC), ' Window=', dbgs(Window), ' WinCtrl=',dbgs(PtrUInt(lWinControl)), ' ', DbgSName(lWinControl));
748{$ENDIF}
749      Windows.RestoreDC(PaintMsg.DC, DCIndex);
750    end;
751    if useDoubleBuffer then
752      Windows.BitBlt(DC, 0, 0, WindowWidth, WindowHeight, CurDoubleBuffer.DC, 0, 0, SRCCOPY);
753    if ControlDC = 0 then
754      Windows.EndPaint(Window, @PS);
755  finally
756    if useDoubleBuffer then
757    begin
758      SelectObject(CurDoubleBuffer.DC, DoubleBufferBitmapOld);
759      DeleteDC(CurDoubleBuffer.DC);
760      CurDoubleBuffer.DC := 0;
761      if BufferWasSaved then
762      begin
763        if CurDoubleBuffer.Bitmap <> 0 then
764          DeleteObject(CurDoubleBuffer.Bitmap);
765        CurDoubleBuffer := BackupBuffer;
766      end;
767{$ifdef DEBUG_DOUBLEBUFFER}
768      if CopyBitmapToClipboard then
769      begin
770//        Windows.OpenClipboard(0);
771//        Windows.EmptyClipboard;
772//        Windows.SetClipboardData(CF_BITMAP, DoubleBufferBitmap);
773//        Windows.CloseClipboard;
774        CopyBitmapToClipboard := false;
775      end;
776{$endif}
777    end;
778  end;
779{$IFDEF DBG_SendPaintMessage}
780  finally
781  DebugLnExit('<<< SendPaintMessage for CtrlDC=', dbgs(ControlDC), ' Window=', dbgs(Window), ' WinCtrl=',dbgs(PtrUInt(lWinControl)), ' ', DbgSName(lWinControl));
782  end;
783{$ENDIF}
784end;
785
786procedure TWindowProcHelper.HandleScrollMessage(LMsg: integer);
787var
788  ScrollInfo: TScrollInfo;
789begin
790  with LMScroll do
791  begin
792    Msg := LMsg;
793    ScrollCode := LOWORD(LongInt(WParam));
794    SmallPos := 0;
795    ScrollBar := HWND(LParam);
796    Pos := 0;
797  end;
798
799  if not (LOWORD(LongInt(WParam)) in [SB_THUMBTRACK, SB_THUMBPOSITION])
800  then begin
801    WindowInfo^.TrackValid := False;
802    Exit;
803  end;
804
805  // Note on thumb tracking
806  // When using the scrollwheel, windows sends SB_THUMBTRACK
807  // messages, but only when scroll.max < 32K. So in that case
808  // Hi(WParam) won't cycle.
809  // When ending scrollbar tracking we also get those
810  // messages. Now Hi(WParam) is cycling.
811  // To get the correct value you need to use GetScrollInfo.
812  //
813  // Now there is a problem. GetScrollInfo returns always the old
814  // position. So in case we get track messages, we'll keep the
815  // last trackposition.
816  // To get the correct position, we use the most significant
817  // part of the last known value (or the value returned by
818  // ScrollInfo). The missing least significant part is given
819  // by Hi(WParam), since it is cycling, the or of both will give
820  // the position
821  // This only works if the difference between the last pos and
822  // the new pos is < 64K, so it might fail if we don't get track
823  // messages
824  // MWE.
825
826  ScrollInfo.cbSize := SizeOf(ScrollInfo);
827  if LOWORD(LongInt(WParam)) = SB_THUMBTRACK
828  then begin
829    ScrollInfo.fMask := SIF_TRACKPOS;
830    // older windows versions may not support trackpos, so fill it with some default
831    if WindowInfo^.TrackValid
832    then ScrollInfo.nTrackPos := Integer(WindowInfo^.TrackPos and $FFFF0000) or HIWORD(LongInt(WParam))
833    else ScrollInfo.nTrackPos := HIWORD(LongInt(WParam));
834  end
835  else begin
836    ScrollInfo.fMask := SIF_POS;
837    ScrollInfo.nPos := HIWORD(LongInt(WParam));
838  end;
839
840  if LParam <> 0
841  then begin
842    // The message is send by a scrollbar
843    GetScrollInfo(HWND(LongInt(LParam)), SB_CTL, ScrollInfo);
844  end
845  else begin
846    // The message is send by a window's standard scrollbar
847    if LMsg = LM_HSCROLL
848    then GetScrollInfo(Window, SB_HORZ, ScrollInfo)
849    else GetScrollInfo(Window, SB_VERT, ScrollInfo);
850  end;
851
852  if LOWORD(LongInt(WParam)) = SB_THUMBTRACK
853  then begin
854    LMScroll.Pos := ScrollInfo.nTrackPos;
855    WindowInfo^.TrackPos := ScrollInfo.nTrackPos;
856    WindowInfo^.TrackValid := True;
857  end
858  else begin
859    if WindowInfo^.TrackValid
860    then LMScroll.Pos := LongInt(WindowInfo^.TrackPos and $FFFF0000) or HIWORD(LongInt(WParam))
861    else LMScroll.Pos := (ScrollInfo.nPos and $FFFF0000) or HIWORD(LongInt(WParam));
862  end;
863
864  if LMScroll.Pos < High(LMScroll.SmallPos)
865  then LMScroll.SmallPos := LMScroll.Pos
866  else LMScroll.SmallPos := High(LMScroll.SmallPos);
867
868  if (lWinControl is TCustomListbox) and (LMsg = LM_VSCROLL) then
869  begin
870    // WM_VSCROLL message carries only 16 bits of scroll box position data.
871    // This workaround is needed, to scroll higher than a position value of 65536.
872    WinProcess := False;
873    TCustomListBox(lWinControl).TopIndex := LMScroll.Pos;
874  end;
875end;
876
877// FlashWindowEx is not (yet) in FPC
878type
879  FLASHWINFO = record
880    cbSize: UINT;
881    hwnd: HWND;
882    dwFlags: DWORD;
883    uCount: UINT;
884    dwTimeout: DWORD;
885  end;
886  PFLASHWINFO = ^FLASHWINFO;
887
888function FlashWindowEx(pfwi:PFLASHWINFO):WINBOOL; stdcall; external 'user32' name 'FlashWindowEx';
889
890procedure TWindowProcHelper.HandleSetCursor;
891var
892  lControl: TControl;
893  BoundsOffset: TRect;
894  ACursor: TCursor;
895  MouseMessage: Word;
896  P: TPoint;
897  lWindow: HWND;
898  FlashInfo: FLASHWINFO;
899begin
900  if Assigned(lWinControl) then
901  begin
902    if not (csDesigning in lWinControl.ComponentState) and (LOWORD(LParam) = HTCLIENT) then
903    begin
904      ACursor := Screen.RealCursor;
905      if ACursor = crDefault then
906      begin
907        Windows.GetCursorPos(Windows.POINT(P));
908        Windows.ScreenToClient(Window, Windows.POINT(P));
909        if GetLCLClientBoundsOffset(lWinControl, BoundsOffset) then
910        begin
911          Dec(P.X, BoundsOffset.Left);
912          Dec(P.Y, BoundsOffset.Top);
913        end;
914        // TGraphicControl controls do not get WM_SETCURSOR messages...
915        lControl := lWinControl.ControlAtPos(P, [capfOnlyClientAreas,
916          capfAllowWinControls, capfHasScrollOffset, capfRecursive]);
917        if lControl = nil then
918          lControl := lWinControl;
919        ACursor := lControl.Cursor;
920      end;
921      if ACursor <> crDefault then
922      begin
923        // DebugLn('Set cursor. Control = ', LControl.Name, ' cur = ',ACursor);
924        Windows.SetCursor(Screen.Cursors[ACursor]);
925        LMessage.Result := 1;
926      end;
927    end
928    else
929    if (LOWORD(LParam) = Word(HTERROR)) then
930    begin
931      MouseMessage := HIWORD(LParam);
932      // a mouse click on a window
933      if ((MouseMessage = WM_LBUTTONDOWN) or
934          (MouseMessage = WM_RBUTTONDOWN) or
935          (MouseMessage = WM_MBUTTONDOWN) or
936          (MouseMessage = WM_XBUTTONDOWN))
937      and Assigned(Screen)
938      then
939      begin
940        // A mouse click is happen on our application window which is not active
941        // we need to active it ourself. This is needed only when click is happen
942        // on disabled window (e.g. ShowModal is called and non modal window is clicked)
943        // We also flash the modal window and beep (default windows behavior).
944
945        // search for modal window with GetLastActivePopup
946        if Application.MainFormOnTaskBar and (Application.MainFormHandle <> 0) then
947          lWindow := GetLastActivePopup(Application.MainFormHandle)
948        else
949          lWindow := GetLastActivePopup(Win32WidgetSet.AppHandle);
950
951        if lWindow <> 0 then // modal window found
952        begin
953          if lWindow <> GetActiveWindow then
954          begin
955            // Activate the application in case it is not active without beep+flash
956            Win32WidgetSet.AppBringToFront;
957            LMessage.Result := 1; // disable native beep+flash, we don't want it
958          end else
959          begin
960            // Simulate default MS Windows beep+flash
961            // because MS Windows is able to flash only modal windows if
962            // a disabled window from the same parent chain was clicked on.
963            // This code flashes the dialog if whatever disabled form was clicked on.
964            Beep;
965            FillChar(FlashInfo{%H-}, SizeOf(FlashInfo), 0);
966            FlashInfo.cbSize := SizeOf(FlashInfo);
967            FlashInfo.hwnd := lWindow;
968            FlashInfo.dwFlags := 1; // FLASHW_CAPTION
969            FlashInfo.uCount := 6;
970            FlashInfo.dwTimeout := 70;
971            FlashWindowEx(@flashinfo);
972            LMessage.Result := 1; // disable native beep+flash, we already beep+flashed
973          end;
974        end;
975      end;
976    end;
977  end;
978  if LMessage.Result = 0 then
979    SetLMessageAndParams(LM_SETCURSOR);
980  WinProcess := False;
981end;
982
983procedure TWindowProcHelper.DoSysCmdKeyMenu;
984var
985  ParentForm: TCustomForm;
986  TargetWindow, prevFocus: HWND;
987begin
988  ParentForm := GetParentForm(lWinControl);
989  if (ParentForm <> nil) and ((ParentForm.Menu = nil) or (csDesigning in ParentForm.ComponentState))
990  and (Application <> nil) and (Application.MainForm <> nil)
991  and (Application.MainForm <> ParentForm)
992  and Application.MainForm.HandleAllocated then
993  begin
994    TargetWindow := Application.MainFormHandle;
995    if IsWindowEnabled(TargetWindow) and IsWindowVisible(TargetWindow) then
996    begin
997      prevFocus := Windows.GetFocus;
998      Windows.SetFocus(targetWindow);
999      PLMsg^.Result := Windows.SendMessage(TargetWindow, WM_SYSCOMMAND, WParam, LParam);
1000      Windows.SetFocus(prevFocus);
1001      WinProcess := False;
1002    end;
1003  end;
1004end;
1005
1006procedure TWindowProcHelper.DoSysCmdMinimize;
1007begin
1008  if Assigned(lWinControl) and (Application.MainForm = lWinControl)
1009  and not Application.MainFormOnTaskBar then
1010    Window := Win32WidgetSet.AppHandle; //redirection
1011
1012  if (Window = Win32WidgetSet.AppHandle) and not Application.MainFormOnTaskBar then
1013  begin
1014    HidePopups(Win32WidgetSet.AppHandle);
1015    if Assigned(Application.MainForm) then
1016    begin
1017      Windows.SetWindowPos(Window, HWND_TOP,
1018        Application.MainForm.Left, Application.MainForm.Top,
1019        Application.MainForm.Width, 0, SWP_NOACTIVATE);
1020      if Application.MainForm.HandleAllocated then
1021        Windows.ShowWindow(Application.MainFormHandle, SW_HIDE);
1022    end;
1023    PLMsg^.Result := Windows.DefWindowProc(Window, WM_SYSCOMMAND, WParam, LParam);
1024    WinProcess := False;
1025    Application.IntfAppMinimize;
1026  end
1027  else
1028  if Assigned(lWinControl) and (lWinControl = Application.MainForm) then
1029  begin
1030    PLMsg^.Result := Windows.DefWindowProc(Window, WM_SYSCOMMAND, WParam, LParam);
1031    WinProcess := False;
1032    Application.IntfAppMinimize;
1033  end else
1034  if Assigned(lWinControl) and (fsModal in TCustomForm(lWinControl).FormState) then
1035  begin
1036    // issue #26463
1037    PLMsg^.Result := 1;
1038    WinProcess := False;
1039    Win32WidgetSet.AppMinimize;
1040  end;
1041end;
1042
1043procedure TWindowProcHelper.DoSysCmdRestore;
1044begin
1045  if (Window = Win32WidgetSet.AppHandle) and not Application.MainFormOnTaskBar then
1046  begin
1047    PLMsg^.Result := Windows.DefWindowProc(Window, WM_SYSCOMMAND, WParam, LParam);
1048    WinProcess := False;
1049    if Assigned(Application.MainForm) and Application.MainForm.HandleAllocated then
1050    begin
1051      if Application.MainForm.HandleObjectShouldBeVisible then
1052        Windows.ShowWindow(Application.MainFormHandle, SW_SHOWNA);
1053      RestorePopups;
1054    end;
1055    Application.IntfAppRestore;
1056  end
1057  else if Assigned(lWinControl) and (lWinControl = Application.MainForm) then
1058  begin
1059    Application.IntfAppRestore;
1060  end else
1061  if Assigned(lWinControl) and (fsModal in TCustomForm(lWinControl).FormState) then
1062  begin
1063    // issue #26463
1064    PLMsg^.Result := 1;
1065    Win32WidgetSet.AppRestore;
1066  end;
1067end;
1068
1069procedure TWindowProcHelper.HandleSysCommand;
1070begin
1071  // forward keystroke to show window menu, if parent form has no menu
1072  // if wparam contains SC_KEYMENU, lparam contains key pressed
1073  // keymenu+space should always bring up system menu
1074  case (WParam and $FFF0) of
1075    SC_KEYMENU:
1076      if (lWinControl <> nil) and (lParam <> VK_SPACE) then
1077        DoSysCmdKeyMenu;
1078    SC_MINIMIZE:
1079      if Assigned(Application) then
1080        DoSysCmdMinimize;
1081    SC_RESTORE:
1082      if Assigned(Application) then
1083        DoSysCmdRestore;
1084  end;
1085end;
1086
1087function TWindowProcHelper.IsComboEditSelection: boolean;
1088begin
1089  Result := WindowInfo^.isComboEdit and (ComboBoxHandleSizeWindow = Windows.GetParent(Window));
1090end;
1091
1092procedure TWindowProcHelper.HandleBitBtnCustomDraw(ABitBtn: TCustomBitBtn);
1093var
1094  DrawInfo: PNMCustomDraw;
1095  ARect: TRect;
1096  ShowFocus: Boolean;
1097begin
1098  DrawInfo := PNMCustomDraw(NMHdr);
1099  case DrawInfo^.dwDrawStage of
1100    CDDS_PREPAINT, CDDS_POSTPAINT:
1101    begin
1102      lmNotify.Result := CDRF_DODEFAULT or CDRF_NOTIFYPOSTPAINT;
1103      WinProcess := False;
1104      if ABitBtn.Focused then
1105      begin
1106        if WindowsVersion >= wv2000 then
1107          ShowFocus := (Windows.SendMessage(ABitBtn.Handle, WM_QUERYUISTATE, 0, 0) and UISF_HIDEFOCUS) = 0
1108        else
1109          ShowFocus := True;
1110        if ShowFocus then
1111        begin
1112          ARect := DrawInfo^.rc;
1113          InflateRect(ARect, -3, -3);
1114          if not IsRectEmpty(ARect) then
1115            Windows.DrawFocusRect(DrawInfo^.hdc, ARect);
1116        end;
1117      end;
1118    end;
1119  end;
1120end;
1121
1122procedure TWindowProcHelper.HandleDropFiles;
1123var
1124  Files: Array of String;
1125  Drop: HDROP;
1126  L: LongWord;
1127  I, C: Integer;
1128  DropForm: TWinControl;
1129  WideBuffer: WideString;
1130begin
1131  Drop := HDROP(WParam);
1132  try
1133    C := DragQueryFile(Drop, $FFFFFFFF, nil, 0); // get dropped files count
1134    if C <= 0 then Exit;
1135
1136    SetLength(Files, C);
1137    for I := 0 to C - 1 do
1138    begin
1139      L := DragQueryFileW(Drop, I, nil, 0); // get I. file name length
1140      SetLength(WideBuffer, L);
1141      L := DragQueryFileW(Drop, I, @WideBuffer[1], L + 1);
1142      SetLength(WideBuffer, L);
1143      Files[I] := UTF16ToUTF8(WideBuffer);
1144    end;
1145
1146    if Length(Files) > 0 then
1147    begin
1148      DropForm := lWinControl.IntfGetDropFilesTarget;
1149      if DropForm is TCustomForm then
1150        TCustomForm(DropForm).IntfDropFiles(Files);
1151      if Application <> nil then
1152        Application.IntfDropFiles(Files);
1153    end;
1154  finally
1155    DragFinish(Drop);
1156  end;
1157end;
1158
1159// returns false if the UnicodeChar is not handled
1160function TWindowProcHelper.HandleUnicodeChar(var AChar: WideChar): boolean;
1161var
1162  OldUTF8Char, UTF8Char: TUTF8Char;
1163  WS: WideString;
1164begin
1165  Result := False;
1166  UTF8Char := UTF16ToUTF8(WideString(AChar));
1167  OldUTF8Char := UTF8Char;
1168  if Assigned(lWinControl) then
1169  begin
1170    // if somewhere key is changed to '' then don't process this message
1171    WinProcess := not lWinControl.IntfUTF8KeyPress(UTF8Char, 1, False);
1172    // if somewhere key is changed then don't perform a regular keypress
1173    Result := not WinProcess or (UTF8Char <> OldUTF8Char);
1174    if Result then
1175    begin
1176      WS := UTF8ToUTF16(UTF8Char);
1177      if Length(WS) > 0 then
1178        AChar := WS[1]
1179      else
1180        AChar := #0;
1181    end;
1182  end;
1183end;
1184
1185procedure TWindowProcHelper.UpdateUIState(CharCode: Word);
1186// This piece of code is taken from ThemeMgr.pas of Mike Lischke
1187// Beginning with Windows 2000 the UI in an application may hide focus rectangles and accelerator key indication.
1188// We have to take care to show them if the user starts navigating using the keyboard.
1189
1190  function FindParentForm: TCustomForm; inline;
1191  begin
1192    if lWinControl <> nil then
1193      Result := GetParentForm(lWinControl)
1194    else
1195    if Application <> nil then
1196      Result := Application.MainForm
1197    else
1198      Result := nil;
1199  end;
1200
1201var
1202  ParentForm: TCustomForm;
1203begin
1204  case CharCode of
1205    VK_LEFT..VK_DOWN, VK_TAB:
1206      begin
1207        ParentForm := FindParentForm;
1208        if ParentForm <> nil then
1209          SendMessage(ParentForm.Handle, WM_CHANGEUISTATE, MakeLong(UIS_CLEAR, UISF_HIDEFOCUS), 0);
1210      end;
1211    VK_MENU:
1212      begin
1213        ParentForm := FindParentForm;
1214        if ParentForm <> nil then
1215          SendMessage(ParentForm.Handle, WM_CHANGEUISTATE, MakeLong(UIS_CLEAR, UISF_HIDEACCEL), 0);
1216      end;
1217  end;
1218end;
1219
1220function TWindowProcHelper.DoChildEdit(out WinResult: LResult): Boolean;
1221var
1222  Info: TComboboxInfo;
1223begin
1224  // combobox child edit weirdness
1225  // prevent combobox WM_SIZE message to get/set/compare text to list, to select text
1226  if IsComboEditSelection then
1227  begin
1228    case Msg of
1229      WM_GETTEXTLENGTH, EM_SETSEL:
1230      begin
1231        WinResult := 0;
1232        Exit(True);
1233      end;
1234      WM_GETTEXT:
1235      begin
1236        if WParam > 0 then
1237          PChar(LParam)^ := #0;
1238        WinResult := 0;
1239        Exit(True);
1240      end;
1241    end;
1242  end;
1243  lWinControl := WindowInfo^.AWinControl;
1244  {for ComboBox IME sends WM_IME_NOTIFY with WParam=WM_IME_ENDCOMPOSITION}
1245  if (Msg = WM_IME_NOTIFY) and (WPARAM=WM_IME_ENDCOMPOSITION) then
1246    WindowInfo^.IMEComposed:=True;
1247
1248  // filter messages we want to pass on to LCL
1249  if (Msg <> WM_KILLFOCUS) and (Msg <> WM_SETFOCUS)
1250    {$ifndef RedirectDestroyMessages}and (Msg <> WM_NCDESTROY){$endif}
1251    and not ((Msg >= WM_CUT) and (Msg <= WM_CLEAR))
1252    and ((Msg < WM_KEYFIRST) or (Msg > WM_KEYLAST))
1253    and ((Msg < WM_MOUSEFIRST) or (Msg > WM_MOUSELAST))
1254    and (Msg <> WM_CONTEXTMENU) then
1255  begin
1256    WinResult := CallDefaultWindowProc(Window, Msg, WParam, LParam);
1257    Exit(True);
1258  end
1259  else
1260  if (Msg = WM_KILLFOCUS) or (Msg = WM_SETFOCUS) then
1261  begin
1262    // if focus jumps inside combo then no need to notify LCL
1263    Info.cbSize := SizeOf(Info);
1264    Win32Extra.GetComboBoxInfo(lWinControl.Handle, @Info);
1265    if (HWND(WParam) = Info.hwndList) or
1266       (HWND(WParam) = Info.hwndItem) or
1267       (HWND(WParam) = Info.hwndCombo) then
1268    begin
1269      WinResult := CallDefaultWindowProc(Window, Msg, WParam, LParam);
1270      Exit(True);
1271    end;
1272  end;
1273  Result := False;
1274end;
1275
1276procedure TWindowProcHelper.DoMsgChar(var WinResult: LResult);
1277begin
1278  OrgCharCode := Word(WParam);
1279  // Process surrogate pairs later
1280  {$IF FPC_FULLVERSION>=30000}
1281  if TCharacter.IsSurrogate(WideChar(OrgCharCode)) then
1282  {$ELSE}
1283  if False then
1284  {$ENDIF}
1285    WinProcess := True
1286  // first send a IntfUTF8KeyPress to the LCL
1287  // if the key was not handled send a CN_CHAR for AnsiChar<=#127
1288  else if not HandleUnicodeChar(WideChar(OrgCharCode)) then
1289  begin
1290    PLMsg := @LMChar;
1291    with LMChar do
1292    begin
1293      Msg := CN_CHAR;
1294      KeyData := LParam;
1295      CharCode := Word(Char(WideChar(WParam)));
1296      OrgCharCode := CharCode;
1297      WinResult := 0;
1298    end;
1299    WinProcess := false;
1300  end
1301  else
1302    WParam := OrgCharCode;
1303end;
1304
1305procedure TWindowProcHelper.DoCmdCheckBoxParam;
1306var
1307  Flags: dword;
1308begin
1309  case HIWORD(WParam) of
1310    BN_CLICKED:
1311      begin
1312        // to allow cbGrayed state at the same time as not AllowGrayed
1313        // in checkboxes (needed by dbcheckbox for null fields) we need
1314        // to handle checkbox state ourselves, according to msdn state
1315        // sequence goes from checked->cleared->grayed etc.
1316        Flags := SendMessage(lWinControl.Handle, BM_GETCHECK, 0, 0);
1317        //do not update the check state if is TRadioButton and is already checked
1318        if (Flags <> BST_CHECKED) or not (lWinControl is TRadioButton) then
1319        begin
1320          if (Flags=BST_CHECKED) then
1321            Flags := BST_UNCHECKED
1322          else
1323          if (Flags=BST_UNCHECKED) and
1324             TCustomCheckbox(lWinControl).AllowGrayed then
1325            Flags := BST_INDETERMINATE
1326          else
1327            Flags := BST_CHECKED;
1328          //pass 0 through LParam to force sending LM_CHANGE
1329          Windows.SendMessage(lWinControl.Handle, BM_SETCHECK, Windows.WPARAM(Flags), 0);
1330        end;
1331        LMessage.Msg := LM_CLICKED;
1332      end;
1333    BN_KILLFOCUS:
1334      LMessage.Msg := LM_EXIT;
1335  end
1336end;
1337
1338function TWindowProcHelper.DoCmdComboBoxParam: Boolean;
1339begin
1340  case HIWORD(WParam) of
1341    CBN_DROPDOWN: TCustomCombobox(lWinControl).IntfGetItems;
1342    CBN_EDITCHANGE: LMessage.Msg := LM_CHANGED;
1343    { CBN_EDITCHANGE is only sent after the user changes the edit box.
1344      CBN_SELCHANGE is sent when the user changes the text by
1345      selecting in the list, but before text is actually changed.
1346      itemindex is updated, so set text manually }
1347    CBN_SELCHANGE:
1348    begin
1349      if TCustomComboBox(lWinControl).Style.HasEditBox then
1350        UpdateComboBoxText(TCustomComboBox(lWinControl));
1351      SendSimpleMessage(lWinControl, LM_CHANGED);
1352      LMessage.Msg := LM_SELCHANGE;
1353    end;
1354    CBN_CLOSEUP:
1355    begin
1356      // according to msdn CBN_CLOSEUP can happen before CBN_SELCHANGE and
1357      // unfortunately it is simple truth. but we need correct order in the LCL
1358      PostMessage(lWinControl.Handle, CN_COMMAND, WParam, LParam);
1359      Exit(True);
1360    end;
1361  end;
1362  Result := False;
1363end;
1364
1365procedure TWindowProcHelper.DoMsgColor(ChildWindowInfo: PWin32WindowInfo);
1366var
1367  WindowDC: HDC;
1368  WindowColor: TColor;
1369  ChildWinControl: TWinControl;
1370  EditFont: TFont;
1371begin
1372  WindowDC := HDC(WParam);
1373  ChildWinControl := ChildWindowInfo^.WinControl;
1374  if ChildWinControl = nil then
1375    ChildWinControl := ChildWindowInfo^.AWinControl;
1376
1377  case Msg of
1378    WM_CTLCOLORSTATIC,
1379    WM_CTLCOLORBTN: begin
1380      if GetNeedParentPaint(ChildWindowInfo, ChildWinControl) and
1381        not ChildWindowInfo^.ThemedCustomDraw then
1382      begin
1383        // need to draw transparently, draw background
1384        DrawParentBackground(HWND(LParam), WindowDC);
1385        LMessage.Result := GetStockObject(HOLLOW_BRUSH);
1386        SetBkMode(WindowDC, TRANSPARENT);
1387        WinProcess := false;
1388      end;
1389    end;
1390    WM_CTLCOLORSCROLLBAR: begin
1391      WinProcess := false;
1392    end;
1393  end;
1394
1395  if WinProcess then
1396  begin
1397    if ChildWinControl <> nil then
1398    begin
1399      if (ChildWinControl is TCustomEdit)
1400      and (TCustomEdit(ChildWinControl).EmulatedTextHintStatus = thsShowing) then
1401      begin
1402        EditFont := CreateEmulatedTextHintFont(ChildWinControl);
1403        try
1404          WindowColor := EditFont.Color;
1405        finally
1406          EditFont.Free;
1407        end;
1408      end else
1409        WindowColor := ChildWinControl.Font.Color;
1410      if WindowColor = clDefault then
1411        WindowColor := ChildWinControl.GetDefaultColor(dctFont);
1412      Windows.SetTextColor(WindowDC, ColorToRGB(WindowColor));
1413      WindowColor := ChildWinControl.Brush.Color;
1414      if WindowColor = clDefault then
1415        WindowColor := ChildWinControl.GetDefaultColor(dctBrush);
1416      Windows.SetBkColor(WindowDC, ColorToRGB(WindowColor));
1417      LMessage.Result := LResult(ChildWinControl.Brush.Reference.Handle);
1418      // Override default handling
1419      WinProcess := false;
1420    end;
1421  end;
1422end;
1423
1424procedure TWindowProcHelper.UpdateDrawListItem(aMsg: UInt);
1425var
1426  PDrawIS: PDrawItemStruct;
1427begin
1428  PDrawIS := PDrawItemStruct(LParam);
1429  if PDrawIS^.itemID <> dword(-1) then
1430  begin
1431    LMessage.Msg := aMsg;
1432    TLMDrawListItem(LMessage).DrawListItemStruct := @DrawListItemStruct;
1433    with DrawListItemStruct do
1434    begin
1435      ItemID := PDrawIS^.itemID;
1436      Area := PDrawIS^.rcItem;
1437      ItemState := TOwnerDrawState(PDrawIS^.itemState);
1438      DC := PDrawIS^._hDC;
1439    end;
1440    if (aMsg = LM_DRAWLISTITEM) and (WindowInfo <> @DefaultWindowInfo) then
1441    begin
1442      WindowInfo^.DrawItemIndex := PDrawIS^.itemID;
1443      WindowInfo^.DrawItemSelected := (PDrawIS^.itemState and ODS_SELECTED) = ODS_SELECTED;
1444    end;
1445    WinProcess := false;
1446  end;
1447end;
1448
1449procedure TWindowProcHelper.UpdateDrawItems;
1450begin
1451  with TLMDrawItems(LMessage) do
1452  begin
1453    Msg := LM_DRAWITEM;
1454    Ctl := 0;
1455    DrawItemStruct := PDrawItemStruct(LParam);
1456  end;
1457  WinProcess := false;
1458end;
1459
1460procedure TWindowProcHelper.DoMsgDrawItem;
1461var
1462  menuItem: TObject;
1463  PDrawIS: PDrawItemStruct;
1464  isDrawListItem: Boolean;
1465  DrawItemMsg: Integer;
1466begin
1467  PDrawIS := PDrawItemStruct(LParam);
1468  if (WParam = 0) and (PDrawIS^.ctlType = ODT_MENU) then
1469  begin
1470    menuItem := TObject(PDrawIS^.itemData);
1471    if menuItem is TMenuItem then
1472      DrawMenuItem(TMenuItem(menuItem),
1473        PDrawIS^._hDC, PDrawIS^.rcItem, PDrawIS^.itemAction, PDrawIS^.itemState);
1474    UpdateDrawItems;
1475  end
1476  else
1477  begin
1478    WindowInfo := GetWin32WindowInfo(PDrawIS^.hwndItem);
1479    if WindowInfo^.WinControl<>nil then
1480      lWinControl := WindowInfo^.WinControl;
1481    {$IFDEF MSG_DEBUG}
1482    debugln(format('Received WM_DRAWITEM type %d handle %x',
1483                   [PDrawIS^.ctlType, integer(PDrawIS^.hwndItem)]));
1484    {$ENDIF}
1485
1486    if (lWinControl<>nil) and
1487       (((lWinControl is TCustomListbox) and
1488          (TCustomListBox(lWinControl).Style <> lbStandard)) or
1489       ((lWinControl is TCustomCombobox) and
1490           TCustomCombobox(lWinControl).Style.IsOwnerDrawn))
1491    then
1492      UpdateDrawListItem(LM_DRAWLISTITEM)
1493    else if Assigned(WindowInfo^.DrawItemHandler) then begin
1494      DrawItemMsg := 0;
1495      isDrawListItem := False;
1496      WindowInfo^.DrawItemHandler(lWinControl, Window, Msg, WParam, PDrawIS^,
1497        DrawItemMsg, isDrawListItem);
1498      if isDrawListItem and (DrawItemMsg<>0) then
1499        UpdateDrawListItem(DrawItemMsg)
1500      else
1501        UpdateDrawItems;
1502    end else
1503      UpdateDrawItems;
1504  end;
1505end;
1506
1507procedure TWindowProcHelper.DoMsgEnable;
1508begin
1509  LMessage.Msg := LM_ENABLE;
1510  if Window = Win32WidgetSet.AppHandle then
1511    if WParam = 0 then
1512    begin
1513      RemoveStayOnTopFlags(Window);
1514      DisabledForms := Screen.DisableForms(nil, DisabledForms);
1515    end
1516    else begin
1517      RestoreStayOnTopFlags(Window);
1518      Screen.EnableForms(DisabledForms);
1519    end;
1520
1521  // When themes are not enabled, it is necessary to redraw the BitMap associated
1522  // with the TCustomBitBtn so Windows will reflect the new UI appearence.
1523  if not ThemeServices.ThemesEnabled and (lWinControl is TCustomBitBtn) then
1524    DrawBitBtnImage(TCustomBitBtn(lWinControl), TCustomBitBtn(lWinControl).Caption);
1525end;
1526
1527function TWindowProcHelper.DoMsgEraseBkgnd(var WinResult: LResult): Boolean;
1528var
1529  eraseBkgndCommand: TEraseBkgndCommand;
1530begin
1531  eraseBkgndCommand := TEraseBkgndCommand(EraseBkgndStack and EraseBkgndStackMask);
1532{$if defined(MSG_DEBUG) or defined(DBG_SendPaintMessage)}
1533  DebugLnEnter(['>>> Do WM_ERASEBKGND for WParam= ', WParam, ' LParam=',LParam,
1534      ' CurDbleBuffer.DC=', dbgs(CurDoubleBuffer.DC), ' Window=', dbgs(Window),
1535      ' WinCtrl=',PtrUInt(lWinControl), ' ', DbgSName(lWinControl),
1536      ' isTab=', dbgs(WindowInfo^.isTabPage)  ]);
1537  try
1538  case eraseBkgndCommand of
1539    ecDefault: DebugLn(MessageStackDepth, ' *command: default');
1540    ecDiscardNoRemove, ecDiscard: DebugLn(MessageStackDepth, ' *command: completely ignore');
1541    ecDoubleBufferNoRemove: DebugLn(MessageStackDepth, ' *command: use double buffer');
1542  end;
1543  DebugLn(MessageStackDepth, ' *erasebkgndstack: ', EraseBkgndStackToString);
1544{$endif}
1545  if eraseBkgndCommand = ecDoubleBufferNoRemove then
1546  begin
1547    if CurDoubleBuffer.DC <> 0 then
1548      WParam := Windows.WParam(CurDoubleBuffer.DC);
1549    if WindowInfo^.isTabPage then
1550      EraseBkgndStack := (EraseBkgndStack and not ((1 shl EraseBkgndStackShift)-1))
1551        or dword(ecDiscardNoRemove);
1552  end
1553  else
1554  if eraseBkgndCommand <> ecDiscardNoRemove then
1555    EraseBkgndStack := EraseBkgndStack shr EraseBkgndStackShift;
1556  if eraseBkgndCommand in [ecDiscard, ecDiscardNoRemove] then
1557  begin
1558    WinResult := 0;
1559    Exit(True);
1560  end;
1561  if not GetNeedParentPaint(WindowInfo, lWinControl) or (eraseBkgndCommand = ecDoubleBufferNoRemove) then
1562  begin
1563{$if defined(MSG_DEBUG) or defined(DBG_SendPaintMessage)}
1564    DebugLn(['WM_ERASEBKGND  *NO* ParentPaint for WParam= ', WParam, ' LParam=',LParam, ' Window=', dbgs(Window) ]);
1565{$endif}
1566    SetLMessageAndParams(LM_ERASEBKGND);
1567  end else
1568  begin
1569{$if defined(MSG_DEBUG) or defined(DBG_SendPaintMessage)}
1570    DebugLn(['WM_ERASEBKGND got NeedParentPaint for WParam= ', WParam, ' LParam=',LParam, ' Window=', dbgs(Window) ]);
1571{$endif}
1572    if not ThemeServices.ThemesEnabled then
1573      SendPaintMessage(HDC(WParam));
1574    LMessage.Result := 1;
1575  end;
1576  WinProcess := False;
1577{$if defined(MSG_DEBUG) or defined(DBG_SendPaintMessage)}
1578  finally
1579  DebugLnExit(['<<< Do WM_ERASEBKGND for WParam= ', WParam, ' LParam=',LParam,
1580      ' Window=', dbgs(Window), ' MsgStackDepth=', MessageStackDepth, ' *erasebkgndstack: ', EraseBkgndStackToString
1581       ]);
1582  end;
1583{$endif}
1584  Result := False;
1585end;
1586
1587procedure TWindowProcHelper.DoMsgKeyDownUp(aMsg: Cardinal; var WinResult: LResult);
1588begin
1589  NotifyUserInput := True;
1590  PLMsg := @LMKey;
1591  UpdateUIState(Word(WParam));
1592  SetLMKeyData(aMsg, True);
1593  WinResult := 0;
1594  WinProcess := false;
1595end;
1596
1597procedure TWindowProcHelper.DoMsgMouseDownUpClick(aButton: Byte;
1598  aIsDblClick: Boolean; aMouseDown: Boolean);
1599var
1600  MousePos: TPoint;
1601begin
1602  GetCursorPos(MousePos{%H-});
1603
1604  NotifyUserInput := True;
1605  PLMsg := @LMMouse;
1606  LMMouse.Msg := CheckMouseButtonDownUp(Window, lWinControl, LastMouse, MousePos, aButton, aMouseDown);
1607
1608  LMMouse.XPos := GET_X_LPARAM(LParam);
1609  LMMouse.YPos := GET_Y_LPARAM(LParam);
1610  LMMouse.Keys := WParam;
1611  if (lWinControl is TCustomListView) then // workaround #30234
1612    case Msg of
1613      WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP, WM_XBUTTONUP:
1614        LMMouse.Keys := LMMouse.Keys or ShiftStateToKeys(KeyboardStateToShiftState);
1615    end;
1616  case LastMouse.ClickCount of
1617    2: LMMouse.Keys := LMMouse.Keys or MK_DOUBLECLICK;
1618    3: LMMouse.Keys := LMMouse.Keys or MK_TRIPLECLICK;
1619    4: LMMouse.Keys := LMMouse.Keys or MK_QUADCLICK;
1620  end;
1621end;
1622
1623procedure TWindowProcHelper.DoMsgContextMenu;
1624begin
1625  WinProcess := False;
1626  NotifyUserInput := True;
1627  PLMsg := @LMContextMenu;
1628  with LMContextMenu do
1629  begin
1630    Msg := LM_CONTEXTMENU;
1631    XPos := GET_X_LPARAM(LParam);
1632    YPos := GET_Y_LPARAM(LParam);
1633    hWnd := Window;
1634  end;
1635end;
1636
1637procedure TWindowProcHelper.DoMsgMouseMove;
1638begin
1639  NotifyUserInput := True;
1640  PLMsg := @LMMouseMove;
1641  with LMMouseMove Do
1642  begin
1643    Msg := LM_MOUSEMOVE;
1644    XPos := GET_X_LPARAM(LParam);
1645    YPos := GET_Y_LPARAM(LParam);
1646    Keys := WParam;
1647    // check if this is a spurious WM_MOUSEMOVE message, pos not actually changed
1648    if (XPos = WindowInfo^.MouseX) and (YPos = WindowInfo^.MouseY) then
1649    begin
1650      // do not fire message after all (position not changed)
1651      Msg := LM_NULL;
1652      NotifyUserInput := false;
1653    end else
1654    if WindowInfo <> @DefaultWindowInfo then
1655    begin
1656      // position changed, update window info
1657      WindowInfo^.MouseX := XPos;
1658      WindowInfo^.MouseY := YPos;
1659    end;
1660  end;
1661end;
1662
1663function TWindowProcHelper.DoMsgMouseWheel(var WinResult: LResult; AHorz: Boolean): Boolean;
1664var
1665  NCode: integer;
1666  TargetWindow: HWND;
1667  P: TPoint;
1668begin
1669  if AHorz then
1670    NCode := WM_MOUSEHWHEEL
1671  else
1672    NCode := WM_MOUSEWHEEL;
1673  NotifyUserInput := True;
1674  PLMsg := @LMMouseEvent;
1675  with LMMouseEvent Do
1676  begin
1677    X := GET_X_LPARAM(LParam);
1678    Y := GET_Y_LPARAM(LParam);
1679    // check if mouse cursor within this window, otherwise send message to
1680    // window the mouse is hovering over
1681    P.X := X;
1682    P.Y := Y;
1683    TargetWindow := Win32WidgetSet.WindowFromPoint(P);
1684    //fallback to LCL function to get the actual window
1685    if TargetWindow = 0 then
1686      TargetWindow := GetLCLWindowFromPoint(lWinControl, P);
1687    if (TargetWindow = 0) or not IsWindowEnabled(TargetWindow) then
1688      Exit(True);
1689
1690    // check if the window is an edit control of a combobox, if so,
1691    // redirect it to the combobox, not the edit control
1692    if GetWin32WindowInfo(TargetWindow)^.isComboEdit then
1693      TargetWindow := Windows.GetParent(TargetWindow);
1694
1695    // check InMouseWheelRedirection to prevent recursion
1696    if not InMouseWheelRedirection and (TargetWindow <> Window) then
1697    begin
1698      InMouseWheelRedirection := true;
1699      WinResult := SendMessage(TargetWindow, NCode, WParam, LParam);
1700      InMouseWheelRedirection := false;
1701      Exit(True);
1702    end
1703    else if TargetWindow <> Window then
1704      Exit(True);
1705    // the mousewheel message is for us
1706    Msg := NCode;
1707    // important: LM_MOUSEWHEEL needs client coordinates (windows WM_MOUSEWHEEL are screen coordinates)
1708    Windows.ScreenToClient(TargetWindow, P);
1709    X := P.X;
1710    Y := P.Y;
1711    Button := LOWORD(Integer(WParam));
1712    WheelDelta := SmallInt(HIWORD(Integer(WParam)));
1713    State := KeysToShiftState(Button);
1714    WinResult := 0;
1715    UserData := Pointer(GetWindowLong(Window, GWL_USERDATA));
1716    WinProcess := false;
1717  end;
1718  Result := False;
1719end;
1720
1721procedure TWindowProcHelper.DoMsgNCLButtonDown;
1722begin
1723  SetLMessageAndParams(Msg);
1724  NotifyUserInput := True;
1725
1726  //Drag&Dock support TCustomForm => Start BeginDrag()
1727  if (lWinControl <> nil) and not (csDesigning in lWinControl.ComponentState) then
1728  begin
1729    if WParam = HTCAPTION  then
1730      if lWinControl is TCustomForm then
1731        if (TWinControlAccess(lWinControl).DragKind = dkDock)
1732        and (TWinControlAccess(lWinControl).DragMode = dmAutomatic) then
1733          lWinControl.BeginDrag(true);
1734  end;
1735  // I see no other way to prevent crash at moment. This message calls WM_CLOSE
1736  // which frees our form and we get a destructed lWinControl
1737  lWinControl := nil;
1738end;
1739
1740function TWindowProcHelper.DoMsgNotify(var WinResult: LResult): Boolean;
1741begin
1742  WindowInfo := GetWin32WindowInfo(PNMHdr(LParam)^.hwndFrom);
1743{$ifdef MSG_DEBUG}
1744  DebugLn([MessageStackDepth, 'Notify code: ', PNMHdr(LParam)^.code]);
1745{$endif}
1746  if Assigned(WindowInfo^.ParentMsgHandler) then
1747  begin
1748    LMNotify.Result := 0;
1749    if WindowInfo^.ParentMsgHandler(WindowInfo^.WinControl,
1750      Window, WM_NOTIFY, WParam, LParam, LMNotify.Result, WinProcess) then
1751    begin
1752      WinResult := LMNotify.Result;
1753      Exit(True);
1754    end;
1755  end;
1756  case PNMHdr(LParam)^.code of
1757    MCN_SELCHANGE:
1758    begin
1759      LMessage.Msg := LM_CHANGED;
1760      if WindowInfo^.WinControl <> nil then
1761        lWinControl := WindowInfo^.WinControl;
1762    end;
1763  else
1764    PLMsg:=@LMNotify;
1765    LMNotify.Msg := LM_NOTIFY;
1766    LMNotify.IDCtrl := WParam;
1767    LMNotify.NMHdr := PNMHDR(LParam);
1768    case LMNotify.NMHdr^.code of
1769      NM_CUSTOMDRAW:
1770      begin
1771        if WindowInfo^.WinControl is TCustomBitBtn then
1772          HandleBitBtnCustomDraw(TCustomBitBtn(WindowInfo^.WinControl))
1773        else
1774        if GetNeedParentPaint(WindowInfo, lWinControl) and WindowInfo^.ThemedCustomDraw then
1775        begin
1776          case PNMCustomDraw(LParam)^.dwDrawStage of
1777            CDDS_PREPAINT:
1778            begin
1779              WinResult := CDRF_NOTIFYITEMDRAW;
1780              WinProcess := false;
1781            end;
1782            CDDS_ITEMPREPAINT:
1783            begin
1784              WinResult := CDRF_DODEFAULT;
1785              WinProcess := false;
1786            end;
1787          end;
1788        end;
1789      end;
1790    end;
1791  end;
1792  Result := False;
1793end;
1794
1795procedure TWindowProcHelper.DoMsgShowWindow;
1796var
1797  Flags: dword;
1798begin
1799  with TLMShowWindow(LMessage) Do
1800  begin
1801    Msg := LM_SHOWWINDOW;
1802    Show := WParam <> 0;
1803    Status := LParam;
1804  end;
1805  if Assigned(lWinControl) and ((WParam <> 0) or not lWinControl.Visible) and
1806      ((WParam = 0) or lWinControl.Visible) and Assigned(Application) and
1807      (lWinControl = Application.MainForm) and not Application.MainFormOnTaskBar then
1808  begin
1809    if WParam=0 then
1810      Flags := SW_HIDE
1811    else
1812      Flags := SW_SHOWNOACTIVATE;
1813    Windows.ShowWindow(Win32WidgetSet.AppHandle, Flags);
1814  end
1815  else
1816  if Assigned(lWinControl) and (WParam <> 0) and not lWinControl.Visible then
1817    WinProcess := false;
1818end;
1819
1820procedure TWindowProcHelper.DoMsgSysKey(aMsg: Cardinal);
1821begin
1822  NotifyUserInput := True;
1823  PLMsg := @LMKey;
1824  SetLMKeyData(aMsg, True);
1825  WinProcess := false;
1826end;
1827
1828procedure TWindowProcHelper.DoMsgMeasureItem;
1829var
1830  menuItem: TObject;
1831  menuHDC: HDC;
1832  TmpSize: TSize; // used by WM_MEASUREITEM
1833begin
1834  case PMeasureItemStruct(LParam)^.CtlType of
1835    ODT_MENU:
1836      begin
1837        menuItem := TObject(PMeasureItemStruct(LParam)^.itemData);
1838        if menuItem is TMenuItem then
1839        begin
1840          menuHDC := GetDC(Window);
1841          TmpSize := MenuItemSize(TMenuItem(menuItem), menuHDC);
1842          PMeasureItemStruct(LParam)^.itemWidth := TmpSize.cx;
1843          PMeasureItemStruct(LParam)^.itemHeight := TmpSize.cy;
1844          ReleaseDC(Window, menuHDC);
1845          Winprocess := False;
1846        end
1847        {$ifdef MSG_DEBUG}
1848        else
1849          DebugLn('WM_MEASUREITEM for a menuitem catched but menuitem is not TmenuItem');
1850        {$endif}
1851      end;
1852    else
1853    if WParam <> 0 then
1854    begin
1855      lWinControl := TWinControl(WParam);
1856      //if Assigned(lWinControl) then   <- already tested
1857      SetLMessageAndParams(LM_MEASUREITEM, True);
1858    end;
1859  end;
1860end;
1861
1862procedure TWindowProcHelper.DoMsgActivateApp;
1863begin
1864  if Window = Win32WidgetSet.AppHandle then
1865  begin
1866    if WParam <> 0 then // activated
1867    begin
1868      //WriteLn('Restore');
1869      RestoreStayOnTopFlags(Window);
1870      if Assigned(Application) then
1871        Application.IntfAppActivate(True);
1872    end
1873    else begin // deactivated
1874      //WriteLn('Remove');
1875      RemoveStayOnTopFlags(Window);
1876      if Assigned(Application) then
1877        Application.IntfAppDeactivate(True);
1878    end;
1879  end;
1880end;
1881
1882procedure TWindowProcHelper.UpdateLMMovePos(X, Y: Smallint);
1883begin
1884  LMMove.XPos := X;
1885  LMMove.YPos := Y;
1886end;
1887
1888function TWindowProcHelper.DoMsgMove: Boolean;
1889var
1890  NewLeft, NewTop: integer;
1891  WindowPlacement: TWINDOWPLACEMENT;
1892  R: TRect;
1893begin
1894  PLMsg := @LMMove;
1895  LMMove.Msg := LM_MOVE;
1896  // MoveType := WParam;   WParam is not defined!
1897  LMMove.MoveType := Move_SourceIsInterface;
1898  if GetWindowLong(Window, GWL_STYLE) and WS_CHILD = 0 then
1899  begin
1900    WindowPlacement.length := SizeOf(WindowPlacement);
1901    if IsIconic(Window) and GetWindowPlacement(Window, @WindowPlacement) then
1902      UpdateLMMovePos(WindowPlacement.rcNormalPosition.Left,
1903                      WindowPlacement.rcNormalPosition.Top)
1904    else if Windows.GetWindowRect(Window, @R) then
1905      UpdateLMMovePos(R.Left, R.Top)
1906    else
1907      LMMove.Msg := LM_NULL;
1908  end else
1909  begin
1910    if GetWindowRelativePosition(Window, NewLeft, NewTop) then
1911      UpdateLMMovePos(NewLeft, NewTop)
1912    else
1913      LMMove.Msg := LM_NULL;
1914  end;
1915  if lWinControl <> nil then
1916  begin
1917    {$IFDEF VerboseSizeMsg}
1918  with LMMove Do begin
1919      DebugLn('Win32CallBack WM_MOVE ', dbgsName(lWinControl),
1920        ' NewPos=',dbgs(XPos),',',dbgs(YPos));
1921  end;
1922      {$ENDIF}
1923    if (lWinControl.Left = LMMove.XPos) and (lWinControl.Top = LMMove.YPos) then
1924      Exit(True);
1925  end;
1926  Result := False;
1927end;
1928
1929procedure TWindowProcHelper.DoMsgSize;
1930var
1931  NewWidth, NewHeight: integer;
1932  OverlayWindow: HWND;
1933{$IFDEF VerboseSizeMsg}
1934  R: TRect;
1935{$ENDIF}
1936begin
1937  with TLMSize(LMessage) do
1938  begin
1939    Msg := LM_SIZE;
1940    SizeType := WParam or Size_SourceIsInterface;
1941
1942    // this is needed since we don't minimize the main form window
1943    // we only hide and show it back on mimize and restore in case MainFormOnTaskbar = False
1944    if (Window = Win32WidgetSet.AppHandle) and
1945       Assigned(Application.MainForm) and Application.MainForm.HandleAllocated then
1946    begin
1947      lWinControl := Application.MainForm;
1948      Window := Application.MainFormHandle;
1949      // lie LCL about the window state
1950      if IsIconic(Win32WidgetSet.AppHandle) then
1951        SizeType := SIZE_MINIMIZED or Size_SourceIsInterface
1952      else
1953      if IsZoomed(Window) then
1954        SizeType := SIZE_MAXIMIZED or Size_SourceIsInterface
1955      else
1956        SizeType := SIZE_RESTORED or Size_SourceIsInterface;
1957    end;
1958
1959    GetWindowSize(Window, NewWidth, NewHeight);
1960    Width := NewWidth;
1961    Height := NewHeight;
1962    if Assigned(lWinControl) then
1963    begin
1964      {$IFDEF VerboseSizeMsg}
1965      GetClientRect(Window,R);
1966      DebugLn('Win32Callback: WM_SIZE '+ dbgsName(lWinControl)+
1967        ' NewSize=', dbgs(Width)+','+dbgs(Height)+
1968        ' HasVScroll='+dbgs((GetWindowLong(Window, GWL_STYLE) and WS_VSCROLL) <> 0)+
1969        ' HasHScroll='+dbgs((GetWindowLong(Window, GWL_STYLE) and WS_HSCROLL) <> 0)+
1970        ' OldClientSize='+dbgs(lWinControl.CachedClientWidth)+','+dbgs(lWinControl.CachedClientHeight)+
1971        ' NewClientSize='+dbgs(R.Right)+','+dbgs(R.Bottom));
1972      {$ENDIF}
1973      lWinControl.InvalidateClientRectCache(false);
1974    end;
1975    OverlayWindow := GetWin32WindowInfo(Window)^.Overlay;
1976    if OverlayWindow <> 0 then
1977      Windows.SetWindowPos(OverlayWindow, HWND_TOP, 0, 0, NewWidth, NewHeight, SWP_NOMOVE);
1978  end;
1979end;
1980
1981{ TWindProcNotificationReceiver }
1982
1983procedure TWindProcNotificationReceiver.ReceiveDestroyNotify(Sender: TObject);
1984begin
1985  assert(PWindowProcHelper(Self)^.FlWinControl = Sender, 'TWindProcNotificationReceiver.ReceiveDestroyNotify: PWindowProcHelper(Self)^.FlWinControl = Sender');
1986  PWindowProcHelper(Self)^.lWinControl := nil;
1987end;
1988
1989// This is called from the actual WindowProc.
1990
1991function TWindowProcHelper.DoWindowProc: LResult;
1992var
1993  ChildWindowInfo: PWin32WindowInfo;
1994  TargetObject: TObject;
1995  TargetWindow: HWND;
1996  WmSysCommandProcess: Boolean;
1997  CancelEndSession : Boolean; // used by WM_QUERYENDSESSION
1998  // used by WM_CHAR, WM_SYSCHAR and WM_KEYDOWN, WM_KEYUP, WM_SYSKEYDOWN, WM_SYSKEYUP
1999  CharCodeNotEmpty: boolean;
2000  R: TRect;
2001  ACtl: TWinControl;
2002  LMouseEvent: TTRACKMOUSEEVENT;
2003  MaximizedActiveChild: WINBOOL;
2004{$IF NOT DECLARED(WM_DPICHANGED)} // WM_DPICHANGED was added in FPC 3.1.1
2005const
2006  WM_DPICHANGED = $02E0;
2007{$ENDIF}
2008begin
2009  try
2010  FillChar(LMessage, SizeOf(LMessage), 0);
2011  PLMsg := @LMessage;
2012  WinProcess := True;
2013  NotifyUserInput := False;
2014
2015  WindowInfo := GetWin32WindowInfo(Window);
2016  if WindowInfo^.isChildEdit then
2017  begin
2018    if DoChildEdit(Result) then Exit;
2019  end else begin
2020    lWinControl := WindowInfo^.WinControl;
2021  end;
2022
2023  if (IgnoreNextCharWindow <> 0) and ((Msg = WM_CHAR) or (Msg = WM_SYSCHAR)) then
2024  begin
2025    if IgnoreNextCharWindow = Window then
2026    begin
2027      IgnoreNextCharWindow := 0;
2028      Result := 1;
2029      Exit;
2030    end;
2031    IgnoreNextCharWindow := 0;
2032  end;
2033  if IgnoreKeyUp and (Msg = WM_KEYUP) then
2034    Exit(1);
2035
2036  case Msg of
2037    WM_MOUSEFIRST..WM_MOUSELAST:
2038    if (LastMouseTracking<>lWinControl) then
2039    begin
2040      // register for WM_MOUSELEAVE
2041      FillChar(LMouseEvent, SizeOf(TTRACKMOUSEEVENT), 0);
2042      LMouseEvent.cbSize := SizeOf(TTRACKMOUSEEVENT);
2043      LMouseEvent.dwFlags := TME_LEAVE;
2044      LMouseEvent.hwndTrack := Window;
2045      LMouseEvent.dwHoverTime := HOVER_DEFAULT;
2046      _TrackMouseEvent(@LMouseEvent);
2047      LastMouseTracking := lWinControl;
2048    end;
2049  end;
2050
2051  case Msg of
2052    WM_NULL:
2053      if (Window = Win32WidgetSet.AppHandle) then
2054      begin
2055        CheckSynchronize;
2056        TWin32Widgetset(Widgetset).CheckPipeEvents;
2057      end;
2058    WM_ENTERIDLE: Application.Idle(False);
2059    WM_ACTIVATE:  SetLMessageAndParams(LM_ACTIVATE);
2060    WM_DPICHANGED: SetLMessageAndParams(LM_DPICHANGED);
2061    WM_IME_ENDCOMPOSITION:
2062    begin
2063      {IME Windows the composition has finished}
2064      WindowInfo^.IMEComposed:=True;
2065      SetLMessageAndParams(Msg);  //WinProcess := False;
2066    end;
2067    WM_CANCELMODE:     LMessage.Msg := LM_CANCELMODE;
2068    WM_CAPTURECHANGED: LMessage.Msg := LM_CAPTURECHANGED;
2069    WM_CHAR:           DoMsgChar(Result);
2070
2071    WM_MENUCHAR:
2072    begin
2073      PLMsg^.Result := FindMenuItemAccelerator(LOWORD(WParam), HMENU(LParam));
2074      WinProcess := false;
2075    end;
2076
2077    WM_CLOSE:
2078    begin
2079      if (Window = Win32WidgetSet.AppHandle) and Assigned(Application.MainForm) then
2080        Windows.SendMessage(Application.MainFormHandle, WM_CLOSE, 0, 0)
2081      else
2082        LMessage.Msg := LM_CLOSEQUERY;
2083      // default is to destroy window, inhibit
2084      WinProcess := false;
2085    end;
2086
2087    WM_INITMENUPOPUP:
2088    begin
2089      if HIWORD(lParam) = 0 then //if not system menu
2090      begin
2091        TargetObject := GetPopMenuItemObject;
2092        // Check if the menu was the maximized icon menu for an MDI child window and ignore it in that case
2093        if (LoWord(LParam)=0) and (lWinControl=Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) then
2094        begin
2095          MaximizedActiveChild := False;
2096          if SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDIGETACTIVE, 0, Windows.WPARAM(@MaximizedActiveChild)) <> 0 then
2097          begin
2098            if MaximizedActiveChild then
2099              TargetObject := nil;
2100          end;
2101        end;
2102        if TargetObject is TMenuItem then
2103        begin
2104          LMessage.Msg := LM_ACTIVATE;
2105          TargetObject.Dispatch(LMessage);
2106          lWinControl := nil;
2107        end;
2108      end;
2109    end;
2110
2111    WM_MENUSELECT:
2112    begin
2113      TargetObject := GetMenuItemObject((HIWORD(Integer(WParam)) and MF_POPUP) <> 0);
2114      // Check if the menu was the maximized icon menu for an MDI child window and ignore it in that case
2115      if (LoWord(Integer(WParam))=0) and (lWinControl=Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) then
2116      begin
2117        MaximizedActiveChild := False;
2118        if SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDIGETACTIVE, 0, Windows.WPARAM(@MaximizedActiveChild)) <> 0 then
2119        begin
2120          if MaximizedActiveChild then
2121            TargetObject := nil;
2122        end;
2123      end;
2124      if TargetObject is TMenuItem then
2125        TMenuItem(TargetObject).IntfDoSelect
2126      else
2127        Application.Hint := '';
2128    end;
2129
2130    WM_COMMAND:
2131    begin
2132      if LParam = 0 then
2133      begin
2134        {menuitem or shortcut}
2135        TargetObject := GetMenuItemObject(False);
2136        if TargetObject is TMenuItem then
2137        begin
2138          if (HIWORD(WParam) = 0) or (HIWORD(WParam) = 1) then
2139          begin
2140            LMessage.Msg := LM_ACTIVATE;
2141            TargetObject.Dispatch(LMessage);
2142          end;
2143          lWinControl := nil;
2144        end;
2145      end
2146      else begin
2147        ChildWindowInfo := GetWin32WindowInfo(HWND(LParam));
2148        lWinControl := ChildWindowInfo^.WinControl;
2149        // buddy controls use 'awincontrol' to designate associated wincontrol
2150        if lWinControl = nil then
2151          lWinControl := ChildWindowInfo^.AWinControl;
2152
2153        if Assigned(ChildWindowInfo^.ParentMsgHandler) then
2154        begin
2155          if ChildWindowInfo^.ParentMsgHandler(lWinControl,
2156            Window, WM_COMMAND, WParam, LParam, LMessage.Result, WinProcess) then Exit(LMessage.Result);
2157        end;
2158
2159        // TToggleBox is a TCustomCheckBox too, but we don't want to handle
2160        // state changes of TToggleBox ourselfves
2161        if (lWinControl is TCustomCheckBox) and not (lWinControl is TToggleBox) then
2162          DoCmdCheckBoxParam
2163        else if lWinControl is TButtonControl then
2164          case HIWORD(WParam) of
2165            BN_CLICKED:   LMessage.Msg := LM_CLICKED;
2166            BN_KILLFOCUS: LMessage.Msg := LM_EXIT;
2167          end
2168        else
2169        if (lWinControl is TCustomEdit) then
2170        begin
2171          if (lWinControl is TCustomMemo) then
2172          case HIWORD(WParam) of
2173            // multiline edit doesn't send EN_CHANGE, so use EN_UPDATE
2174            EN_UPDATE: LMessage.Msg := CM_TEXTCHANGED;
2175          end
2176          else
2177          case HIWORD(WParam) of
2178            EN_CHANGE: LMessage.Msg := CM_TEXTCHANGED;
2179          end;
2180        end
2181        else if (lWinControl is TCustomListBox) then
2182          case HIWORD(WParam) of
2183            LBN_SELCHANGE:  LMessage.Msg := LM_SELCHANGE;
2184          end
2185        else if lWinControl is TCustomCombobox then
2186          if DoCmdComboBoxParam then Exit;
2187      end;
2188
2189      // no specific message found? try send a general msg
2190      lWinControl.Perform(CN_COMMAND, WParam, LParam);
2191    end;
2192
2193    WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
2194    begin
2195      // it's needed for winxp themes where controls send the WM_ERASEBKGND
2196      // message to their parent to clear their background and then draw
2197      // transparently
2198      // only static and button controls have transparent parts
2199      // others need to erased with their window color
2200      // scrollbar also has buttons
2201      ChildWindowInfo := GetWin32WindowInfo(HWND(LParam));
2202      if Assigned(ChildWindowInfo^.ParentMsgHandler)
2203      and ChildWindowInfo^.ParentMsgHandler(lWinControl,
2204        Window, Msg, WParam, LParam, LMessage.Result, WinProcess) then Exit(LMessage.Result);
2205      DoMsgColor(ChildWindowInfo);
2206    end;
2207    WM_CLEAR:
2208    begin
2209      LMessage.Msg := LM_CLEAR;
2210      WinProcess := False;
2211    end;
2212    WM_COPY:
2213    begin
2214      LMessage.Msg := LM_COPY;
2215      WinProcess := False;
2216    end;
2217    WM_CUT:
2218    begin
2219      LMessage.Msg := LM_CUT;
2220      WinProcess := False;
2221    end;
2222    {$ifndef RedirectDestroyMessages}
2223    WM_DESTROY:
2224    begin
2225      if CurrentWindow=Window then
2226        CurrentWindow := 0;
2227      if lWinControl is TCustomComboBox then
2228        DisposeComboEditWindowInfo(TCustomComboBox(lWinControl));
2229      if WindowInfo^.Overlay<>HWND(nil) then
2230        Windows.DestroyWindow(WindowInfo^.Overlay);
2231      LMessage.Msg := LM_DESTROY;
2232    end;
2233    {$endif}
2234    WM_DESTROYCLIPBOARD:
2235    begin
2236      if assigned(OnClipBoardRequest) then begin
2237        {$IFDEF VerboseWin32Clipbrd}
2238        debugln('WM_DESTROYCLIPBOARD');
2239        {$ENDIF}
2240        OnClipBoardRequest(0, nil);
2241        OnClipBoardRequest := nil;
2242        LMessage.Result := 0;
2243      end;
2244    end;
2245    WM_DRAWITEM: DoMsgDrawItem;
2246    WM_ENABLE:   DoMsgEnable;
2247    WM_ERASEBKGND:
2248      if DoMsgEraseBkgnd(Result) then Exit;
2249    WM_EXITMENULOOP:
2250      // is it a popup menu
2251      if longbool(WPARAM) and Assigned(WindowInfo^.PopupMenu) then
2252        WindowInfo^.PopupMenu.Close;
2253    WM_GETDLGCODE:
2254    begin
2255      LMessage.Result := DLGC_WANTALLKEYS;
2256      WinProcess := False;
2257    end;
2258    WM_HELP:
2259      // Don't ask windows to process the message here. It will be processed
2260      // either by TCustomForm LM_HELP handler or passed to parent by DefaultHandler
2261      SetLMessageAndParams(LM_HELP, True);
2262    WM_HOTKEY:
2263      SetLMessageAndParams(WM_HOTKEY, True);
2264    WM_HSCROLL,
2265    WM_VSCROLL:
2266    begin
2267      PLMsg := @LMScroll;
2268      if LParam <> 0 then
2269      begin
2270        ChildWindowInfo := GetWin32WindowInfo(HWND(LParam));
2271        lWinControl := ChildWindowInfo^.WinControl;
2272        if Assigned(ChildWindowInfo^.ParentMsgHandler) then
2273          if ChildWindowInfo^.ParentMsgHandler(lWinControl,
2274            Window, Msg, WParam, LParam, PLMsg^.Result, WinProcess) then Exit(PLMsg^.Result);
2275      end;
2276      HandleScrollMessage(Msg);
2277    end;
2278    WM_KEYDOWN:
2279    begin
2280      DoMsgKeyDownUp(CN_KEYDOWN, Result);
2281      WindowInfo^.IMEComposed:=False;
2282      IgnoreNextCharWindow := Window;
2283      IgnoreKeyUp := False;
2284    end;
2285    WM_KEYUP:
2286    begin
2287      DoMsgKeyDownUp(CN_KEYUP, Result);
2288      if WindowInfo^.IMEComposed then
2289        LMKey.Msg:=LM_NULL;
2290    end;
2291    WM_KILLFOCUS:
2292    begin
2293{$ifdef DEBUG_CARET}
2294      DebugLn(['WM_KILLFOCUS received for window ', IntToHex(Window, 8), ' NewFocus = ', IntToHex(WParam, 8), ' Text = ', WndText(WParam)]);
2295{$endif}
2296      LMessage.Msg := LM_KILLFOCUS;
2297      LMessage.WParam := WParam;
2298    end;
2299    //TODO:LM_KILLCHAR,LM_KILLWORD,LM_KILLLINE
2300    WM_LBUTTONDBLCLK: DoMsgMouseDownUpClick(1, True, True);
2301    WM_LBUTTONDOWN:   DoMsgMouseDownUpClick(1, False, True);
2302    WM_LBUTTONUP:     DoMsgMouseDownUpClick(1, False, False);
2303    WM_RBUTTONDBLCLK: DoMsgMouseDownUpClick(2, True, True);
2304    WM_RBUTTONDOWN:   DoMsgMouseDownUpClick(2, False, True);
2305    WM_RBUTTONUP:
2306    begin
2307      DoMsgMouseDownUpClick(2, False, False);
2308      WinProcess := false;
2309      Result := 0;
2310    end;
2311    WM_MBUTTONDBLCLK: DoMsgMouseDownUpClick(3, True, True);
2312    WM_MBUTTONDOWN:   DoMsgMouseDownUpClick(3, False, True);
2313    WM_MBUTTONUP:     DoMsgMouseDownUpClick(3, False, False);
2314    WM_XBUTTONDBLCLK: DoMsgMouseDownUpClick(4, True, True);
2315    WM_XBUTTONDOWN:   DoMsgMouseDownUpClick(4, False, True);
2316    WM_XBUTTONUP:     DoMsgMouseDownUpClick(4, False, False);
2317    WM_MOUSEHOVER:
2318    begin
2319      NotifyUserInput := True;
2320      LMessage.Msg := LM_MOUSEENTER;
2321    end;
2322    WM_MOUSELEAVE:
2323    begin
2324      NotifyUserInput := True;
2325      LMessage.Msg := LM_MOUSELEAVE;
2326      if lWinControl=LastMouseTracking then
2327      begin
2328        Application.DoBeforeMouseMessage(nil);
2329        LastMouseTracking := nil;
2330      end;
2331    end;
2332    WM_MOUSEMOVE:  DoMsgMouseMove;
2333    WM_MOUSEWHEEL: if DoMsgMouseWheel(Result, False) then Exit;
2334    WM_MOUSEHWHEEL: if DoMsgMouseWheel(Result, True) then Exit;
2335    WM_DROPFILES:
2336      begin
2337        {$IFDEF EnableWMDropFiles}
2338        SetLMessageAndParams(LM_DROPFILES);
2339        {$ENDIF}
2340        HandleDropFiles;
2341      end;
2342    //TODO:LM_MOVEPAGE,LM_MOVETOROW,LM_MOVETOCOLUMN
2343    WM_NCHITTEST:     SetLMessageAndParams(LM_NCHITTEST);
2344    WM_NCLBUTTONDOWN: DoMsgNCLButtonDown;
2345
2346    WM_NCMOUSEMOVE,
2347    WM_NCMOUSEHOVER:
2348    begin
2349      SetLMessageAndParams(Msg);
2350      NotifyUserInput := True;
2351      Application.DoBeforeMouseMessage(nil);
2352    end;
2353    WM_NOTIFY: if DoMsgNotify(Result) then Exit;
2354    WM_PAINT: SendPaintMessage(HDC(WParam)); // SendPaintMessage sets winprocess to false
2355    WM_PRINTCLIENT:
2356      if ((LParam and PRF_CLIENT) = PRF_CLIENT) and (lWinControl <> nil) then
2357        SendPaintMessage(HDC(WParam));
2358    WM_PASTE:
2359    begin
2360      LMessage.Msg := LM_PASTE;
2361      WinProcess := False;
2362    end;
2363    WM_CONTEXTMENU:
2364    begin
2365      DoMsgContextMenu;
2366      Result := 0;
2367    end;
2368    WM_SETCURSOR:  HandleSetCursor;
2369    CM_ACTIVATE:
2370    begin
2371      if (Window = Win32WidgetSet.AppHandle) then
2372      begin
2373        // if application window is still focused then move the focus
2374        // to the next top window
2375        if not IsIconic(Window) and (GetFocus = Window) then
2376        begin
2377          TargetWindow := LookupTopWindow(Window);
2378
2379          if TargetWindow <> Window then
2380          begin
2381            // issues #26463, #29744
2382            if (Application.ModalLevel > 0) and IsIconic(TargetWindow) then
2383            begin
2384              ACtl := FindControl(TargetWindow);
2385              if (ACtl is TCustomForm) and (fsModal in TCustomForm(ACtl).FormState) then
2386                Win32WidgetSet.AppRestore;
2387            end;
2388            SetFocus(TargetWindow);
2389          end;
2390        end;
2391        Result := 0;
2392        Exit;
2393      end;
2394      WinProcess := False;
2395    end;
2396    WM_SETFOCUS:
2397    begin
2398{$ifdef DEBUG_CARET}
2399      DebugLn('WM_SETFOCUS received for window ', IntToHex(Window, 8));
2400{$endif}
2401      // move focus to another application window but process event first
2402      if (Window = Win32WidgetSet.AppHandle) then
2403        PostMessage(Window, CM_ACTIVATE, 0, 0);
2404      LMessage.Msg := LM_SETFOCUS;
2405    end;
2406    WM_SHOWWINDOW: DoMsgShowWindow;
2407    WM_SYSCHAR:
2408    begin
2409      PLMsg := @LMChar;
2410      SetLMCharData(CN_SYSCHAR, True);
2411      Result := 0;
2412      WinProcess := false;
2413    end;
2414    WM_SYSCOMMAND:
2415    begin
2416      HandleSysCommand;
2417      SetLMessageAndParams(Msg);
2418      WmSysCommandProcess := WinProcess;
2419      WinProcess := False;
2420    end;
2421    WM_SYSKEYDOWN:
2422    begin
2423      UpdateUIState(Word(WParam));
2424      DoMsgSysKey(CN_SYSKEYDOWN);
2425      Result := 0;
2426      IgnoreNextCharWindow := Window;
2427    end;
2428    WM_SYSKEYUP:
2429    begin
2430      DoMsgSysKey(CN_SYSKEYUP);
2431      Result := 0;
2432    end;
2433    WM_TIMER:  SetLMessageAndParams(LM_TIMER);
2434    WM_WINDOWPOSCHANGING:
2435    begin
2436      with TLMWindowPosMsg(LMessage) Do
2437      begin
2438        Msg := LM_WINDOWPOSCHANGING;
2439        Unused := WParam;
2440        WindowPos := PWindowPos(LParam);
2441      end;
2442    end;
2443    WM_WINDOWPOSCHANGED:
2444    begin
2445      with TLMWindowPosMsg(LMessage) Do
2446      begin
2447        Msg := LM_WINDOWPOSCHANGED;
2448        Unused := WParam;
2449        WindowPos := PWindowPos(LParam);
2450      end;
2451      // cross-interface compatible: complete invalidate on resize
2452      if (PWindowPos(LParam)^.flags and SWP_NOSIZE) = 0 then
2453        Windows.InvalidateRect(Window, nil, True);
2454    end;
2455    WM_MEASUREITEM:   DoMsgMeasureItem;
2456    WM_SETTINGCHANGE: Application.IntfSettingsChange;
2457    WM_THEMECHANGED:
2458      // winxp theme changed, recheck whether themes are enabled
2459      if Window = Win32WidgetSet.AppHandle then
2460      begin
2461        ThemeServices.UpdateThemes;
2462        Graphics.UpdateHandleObjects;
2463        ThemeServices.IntfDoOnThemeChange;
2464      end;
2465    WM_UPDATEUISTATE:
2466      if ThemeServices.ThemesEnabled then
2467        InvalidateRect(Window, nil, True);
2468
2469    { >= WM_USER }
2470
2471    WM_LCL_SOCK_ASYNC:
2472    begin
2473      if (Window = Win32WidgetSet.AppHandle) and
2474          Assigned(Win32WidgetSet.FOnAsyncSocketMsg) then
2475        Exit(Win32WidgetSet.FOnAsyncSocketMsg(WParam, LParam))
2476    end;
2477    WM_IME_COMPOSITION,
2478    WM_IME_COMPOSITIONFULL,
2479    WM_IME_CONTROL,
2480    //WM_IME_ENDCOMPOSITION,
2481    WM_IME_NOTIFY,
2482    WM_IME_REQUEST,
2483    WM_IME_SELECT,
2484    WM_IME_SETCONTEXT,
2485    WM_IME_STARTCOMPOSITION:
2486      SetLMessageAndParams(Msg, True);
2487    WM_ACTIVATEAPP:
2488    begin
2489      if (Application<>nil) and Application.MainFormOnTaskBar and not Win32WidgetSet.AppMinimizing then
2490        RestorePopups;
2491    end;
2492    WM_DISPLAYCHANGE:
2493    begin
2494      if Application.MainFormHandle = Window then
2495        Screen.UpdateMonitors;
2496    end;
2497  else
2498    // pass along user defined messages
2499    if Msg >= WM_USER then
2500      SetLMessageAndParams(Msg, True);
2501  end;  // case Msg of
2502
2503  // Update MDI form client bounds
2504  if WinProcess and (Msg=WM_SIZE) and Assigned(Application.MainForm)
2505  and (Application.MainForm.FormStyle=fsMDIForm)
2506  and Application.MainForm.HandleAllocated and (Window=Application.MainForm.Handle) then
2507  begin
2508    Win32WidgetSet.UpdateMDIClientBounds;
2509    WinProcess := False;
2510  end;
2511
2512  if WinProcess then
2513  begin
2514    PLMsg^.Result := CallDefaultWindowProc(Window, Msg, WParam, LParam);
2515    WinProcess := False;
2516  end;
2517
2518  case Msg of
2519    WM_ACTIVATEAPP: DoMsgActivateApp;
2520    WM_MOVE:        if DoMsgMove then Exit(0);
2521    WM_SIZE:        DoMsgSize;
2522    BM_SETCHECK:
2523    begin
2524      //LParam holds BST_CHECKED, BST_UNCHECKED or SKIP_LMCHANGE;
2525      if LParam <> SKIP_LMCHANGE then
2526        LMessage.Msg := LM_CHANGED;
2527      if lWinControl is TRadioButton then
2528      begin
2529        //Uncheck siblings
2530        if WParam = BST_CHECKED then
2531          ClearSiblingRadioButtons(TRadioButton(lWinControl));
2532      end;
2533    end;
2534    WM_ENDSESSION:
2535    begin
2536      if Assigned(Application) and (Win32WidgetSet.AppHandle = Window) and
2537         (WParam > 0) then
2538      begin
2539        // look at WM_QUERYENDSESSION about LParam
2540        LMessage.Msg := LM_NULL; // no need to go through delivermessage
2541        Application.IntfEndSession();
2542        LMessage.Result := 0;
2543      end;
2544    end;
2545
2546    WM_QUERYENDSESSION:
2547    begin
2548      if Assigned(Application) and (Win32WidgetSet.AppHandle = Window) then
2549      begin
2550        LMessage.Msg := LM_NULL; // no need to go through delivermessage
2551        CancelEndSession := LMessage.Result=0;
2552        // it is possible to pass whether user LogOff or Shutdonw through a flag
2553        // but seems there is no way to do this in a cross-platform way =>
2554        // skip it for now
2555        Application.IntfQueryEndSession(CancelEndSession);
2556        if CancelEndSession
2557          then LMessage.Result := 0
2558          else LMessage.Result := 1;
2559      end;
2560    end;
2561    WM_NCPAINT:
2562    begin
2563      if TWin32ThemeServices(ThemeServices).ThemesEnabled and
2564        (lWinControl is TCustomControl) and not (lWinControl is TCustomForm) then
2565      begin
2566        TWin32ThemeServices(ThemeServices).PaintBorder(lWinControl, True);
2567        LMessage.Result := 0;
2568      end;
2569    end;
2570  end;  // case Msg of
2571
2572  // convert from win32 client to lcl client pos.
2573  //
2574  // hack to prevent GetLCLClientBoundsOffset from changing mouse client
2575  // coordinates for TScrollingWinControls, this is required in
2576  // IsControlMouseMsg and ControlAtPos where unscrolled client coordinates
2577  // are expected.
2578  if (PLMsg = @LMMouseMove) and not (lWinControl is TScrollingWinControl) then
2579  begin
2580    if GetLCLClientBoundsOffset(lWinControl, R) then
2581    begin
2582      Dec(LMMouseMove.XPos, R.Left);
2583      Dec(LMMouseMove.YPos, R.Top);
2584    end;
2585  end else
2586  if (PLMsg = @LMMouse) and not (lWinControl is TScrollingWinControl) then
2587  begin
2588    if GetLCLClientBoundsOffset(lWinControl, R) then
2589    begin
2590      Dec(LMMouse.XPos, R.Left);
2591      Dec(LMMouse.YPos, R.Top);
2592    end;
2593  end;
2594
2595  // application processing
2596  if NotifyUserInput then
2597  begin
2598    CurrentWindow := Window;
2599    NotifyApplicationUserInput(lWinControl, PLMsg^.Msg);
2600    // Invalidate associated lWinControl if current window has been destroyed
2601    if CurrentWindow = 0 then
2602      lWinControl := nil;
2603  end;
2604
2605  if Assigned(lWinControl) and (PLMsg^.Msg <> LM_NULL) then
2606    DeliverMessage(lWinControl, PLMsg^);
2607
2608  // respond to result of LCL handling the message
2609  case PLMsg^.Msg of
2610    LM_ERASEBKGND, LM_SETCURSOR, LM_RBUTTONUP, LM_CONTEXTMENU:
2611      if PLMsg^.Result = 0 then
2612        WinProcess := True;
2613
2614    WM_SYSCOMMAND:
2615      WinProcess := WmSysCommandProcess;
2616
2617    CN_CHAR, CN_SYSCHAR:
2618    begin
2619      // if key not yet processed, let windows process it
2620      WinProcess := LMChar.Result = 0;
2621      // if charcode was modified by LCL, convert ansi char
2622      // to unicode char, if not change was made WParam has
2623      // the right unicode char so just use it.
2624      if (LMChar.Result = 1) or (OrgCharCode <> LMChar.CharCode) then
2625        WParam := Word(WideChar(LMChar.CharCode));
2626    end;
2627
2628    CN_KEYDOWN, CN_KEYUP, CN_SYSKEYDOWN, CN_SYSKEYUP:
2629    begin
2630      // if key not yet processed, let windows process it
2631      WinProcess := LMKey.Result = 0;
2632      WParam := LMKey.CharCode;
2633    end;
2634    WM_IME_COMPOSITION,
2635    WM_IME_COMPOSITIONFULL,
2636    WM_IME_CONTROL,
2637    WM_IME_ENDCOMPOSITION,
2638    WM_IME_NOTIFY,
2639    WM_IME_REQUEST,
2640    WM_IME_SELECT,
2641    WM_IME_SETCONTEXT,
2642    WM_IME_STARTCOMPOSITION,
2643    LM_CUT,
2644    LM_COPY,
2645    LM_PASTE,
2646    LM_CLEAR:
2647    begin
2648      WinProcess := LMessage.Result = 0;
2649    end;
2650  else
2651    case Msg of
2652      {$ifndef RedirectDestroyMessages}
2653      WM_NCDESTROY:
2654      begin
2655        // free our own data associated with window
2656        if DisposeWindowInfo(Window) then
2657          WindowInfo := nil;
2658        EnumProps(Window, @PropEnumProc);
2659      end;
2660      {$endif}
2661    end;
2662  end;
2663
2664  if WinProcess then
2665  begin
2666    if ((Msg=WM_CHAR) and ((WParam=VK_RETURN) or (WPARAM=VK_ESCAPE)) and
2667       ((lWinControl is TCustomCombobox) or
2668        ((lWinControl is TCustomEdit) and not (lWinControl is TCustomMemo ))
2669       ))
2670       or (Msg=WM_SYSCHAR)      // Windows message processing is postponed
2671    then
2672      // this thing will beep, don't call defaultWindowProc
2673    else
2674      PLMsg^.Result := CallDefaultWindowProc(Window, Msg, WParam, LParam);
2675
2676    case Msg of
2677      WM_CHAR, WM_KEYDOWN, WM_KEYUP,
2678      WM_SYSCHAR, WM_SYSKEYDOWN, WM_SYSKEYUP:
2679      begin
2680        PLMsg^.Result := 0;
2681        case Msg of
2682          WM_CHAR:
2683          begin
2684            // if want chars, then handled already
2685            PLMsg^.Result := CallDefaultWindowProc(Window, WM_GETDLGCODE, WParam, 0) and DLGC_WANTCHARS;
2686            SetLMCharData(LM_CHAR);
2687          end;
2688          WM_SYSCHAR:    SetLMCharData(LM_SYSCHAR);
2689          WM_KEYDOWN:    SetLMKeyData(LM_KEYDOWN);
2690          WM_KEYUP:      SetLMKeyData(LM_KEYUP);
2691          WM_SYSKEYDOWN: SetLMKeyData(LM_SYSKEYDOWN);
2692          WM_SYSKEYUP:   SetLMKeyData(LM_SYSKEYUP);
2693        end;
2694
2695        case Msg of
2696          WM_CHAR, WM_SYSCHAR:
2697            CharCodeNotEmpty := (LMChar.CharCode<>0);
2698          else
2699            CharCodeNotEmpty := (LMKey.CharCode<>0);
2700        end;
2701        // we cannot tell for sure windows didn't want the key
2702        // for WM_CHAR check WM_GETDLGCODE/DLGC_WANTCHARS
2703        // winapi too inconsistent about return value
2704        if (lWinControl <> nil) and (PLMsg^.Result = 0) and CharCodeNotEmpty then
2705          DeliverMessage(lWinControl, PLMsg^);
2706
2707        // Windows message processing for WM_SYSCHAR not processed (will get WM_MENUCHAR)
2708        if (Msg=WM_SYSCHAR) and (PLMsg^.Result = 0) and CharCodeNotEmpty then
2709          PLMsg^.Result := CallDefaultWindowProc(Window, Msg, WParam, LParam);
2710
2711        // handle Ctrl-A for edit controls
2712        if (PLMsg^.Result = 0) and (Msg = WM_KEYDOWN) and (WParam = Ord('A'))
2713          and (GetKeyState(VK_CONTROL) < 0) and (GetKeyState(VK_MENU) >= 0) then
2714        begin
2715          if WndClassName(Window) = EditClsName then
2716            Windows.SendMessage(Window, EM_SETSEL, 0, -1);  // select all
2717        end;
2718      end;
2719    end;
2720  end;
2721
2722  // ignore WM_(SYS)CHAR message if LCL handled WM_(SYS)KEYDOWN
2723  if ((Msg = WM_KEYDOWN) or (Msg = WM_SYSKEYDOWN)) then
2724    if (PLMsg^.Result = 0) then
2725      IgnoreNextCharWindow := 0;
2726
2727  { LMInsertText has no Result field }
2728
2729  if      PLMsg = @LMScroll     then Result := LMScroll.Result
2730  else if PLMsg = @LMKey        then Result := LMKey.Result
2731  else if PLMsg = @LMChar       then Result := LMChar.Result
2732  else if PLMsg = @LMMouse      then Result := LMMouse.Result
2733  else if PLMsg = @LMMouseMove  then Result := LMMouseMove.Result
2734  else if PLMsg = @LMMove       then Result := LMMove.Result
2735  else if PLMsg = @LMNotify     then Result := LMNotify.Result
2736  else if PLMsg = @LMMouseEvent then Result := LMMouseEvent.Result
2737  else                               Result := PLMsg^.Result;
2738
2739  finally
2740    lWinControl := nil;
2741  end;
2742end;
2743
2744{------------------------------------------------------------------------------
2745 Function: WindowProc
2746 Params: Window - The window that receives a message
2747         Msg    - The message received
2748         WParam - Word parameter
2749         LParam - Long-integer parameter
2750  Returns: 0 if Msg is handled; non-zero long-integer result otherwise
2751
2752  Handles the messages sent to the specified window, in parameter Window, by
2753  Windows or other applications
2754 ------------------------------------------------------------------------------}
2755function
2756{$ifdef MSG_DEBUG}
2757  RealWindowProc
2758{$else}
2759  WindowProc
2760{$endif}
2761  (Window: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall;
2762var
2763  Helper: TWindowProcHelper;
2764begin
2765  FillChar(Helper, SizeOf(TWindowProcHelper), 0);
2766  Helper.Window := Window;
2767  Helper.Msg := Msg;
2768  Helper.WParam := WParam;
2769  Helper.LParam := LParam;
2770  Helper.NMHdr := PNMHdr(LParam);
2771  Result := Helper.DoWindowProc;
2772  Helper.lWinControl := nil;
2773end;
2774
2775{$ifdef MSG_DEBUG}
2776
2777function WindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
2778    LParam: Windows.LParam): LResult; stdcall;
2779begin
2780  DebugLn(MessageStackDepth, 'WindowProc called for window=', IntToHex(Window, 8),' msg=',
2781    WM_To_String(msg),' wparam=', IntToHex(WParam, sizeof(WParam)*2), ' lparam=', IntToHex(lparam, sizeof(lparam)*2));
2782  MessageStackDepth := MessageStackDepth + ' ';
2783
2784  Result := RealWindowProc(Window, Msg, WParam, LParam);
2785
2786  setlength(MessageStackDepth, length(MessageStackDepth)-1);
2787end;
2788
2789{$endif}
2790
2791{------------------------------------------------------------------------------
2792 Function: OverlayWindowProc
2793 Params: Window - The window that receives a message
2794         Msg    - The message received
2795         WParam - Word parameter
2796         LParam - Long-integer parameter
2797  Returns: 0 if Msg is handled; non-zero long-integer result otherwise
2798
2799  Handles messages specifically for the window used by GetDesignerDC
2800 ------------------------------------------------------------------------------}
2801function OverlayWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
2802    LParam: Windows.LParam): LResult; stdcall;
2803var
2804  Parent: HWND;
2805  Owner: TWinControl;
2806  Control: TControl;
2807  P: TPoint;
2808  LRect: Windows.RECT;
2809begin
2810  case Msg of
2811    WM_ERASEBKGND:
2812    begin
2813      Result := 1;
2814    end;
2815    WM_NCHITTEST:
2816    begin
2817      // By default overlay window handle all mouse messages
2818      Result := HTCLIENT;
2819
2820      // Check if overlayed control want to handle mouse messages
2821      Parent := Windows.GetParent(Window);
2822      Owner := GetWin32WindowInfo(Parent)^.WinControl;
2823      P.x := GET_X_LPARAM(lParam);
2824      P.y := GET_Y_LPARAM(lParam);
2825      Windows.ScreenToClient(Parent, P);
2826      if (Owner is TCustomForm) then
2827      begin
2828        // ask form about control under mouse. we need TWinControl
2829        Control := Owner.ControlAtPos(P, [capfAllowWinControls, capfRecursive]);
2830        if (Control <> nil) and not (Control is TWinControl) then
2831          Control := Control.Parent;
2832      end
2833      else
2834        Control := nil;
2835      if (Control <> nil) then
2836      begin
2837        // Now ask control is it needs mouse messages
2838        MapWindowPoints(Parent, TWinControl(Control).Handle, P, 1);
2839        if TWSWinControlClass(TWinControl(Control).WidgetSetClass).GetDesignInteractive(TWinControl(Control), P) then
2840          Result := HTTRANSPARENT
2841      end;
2842    end;
2843    WM_KEYFIRST..WM_KEYLAST, WM_MOUSEFIRST..WM_MOUSELAST:
2844    begin
2845      // parent of overlay is the form
2846      Result := Windows.SendMessage(Windows.GetParent(Window), Msg, WParam, LParam);
2847    end;
2848    WM_NCDESTROY:
2849    begin
2850      // free our own data associated with window
2851      DisposeWindowInfo(Window);
2852      Result := 0;
2853    end;
2854    WM_MOVE:
2855    begin
2856      if (Int16(LoWord(LParam)) <> 0) or (Int16(HiWord(LParam)) <> 0) then
2857      begin
2858        Parent := Windows.GetParent(Window);
2859        Windows.GetClientRect(Parent, LRect);
2860        Windows.SetWindowPos(Window, HWND_TOP, 0, 0, LRect.Right, LRect.Bottom, 0);
2861      end;
2862    end;
2863  else
2864    Result := Windows.DefWindowProcW(Window, Msg, WParam, LParam)
2865  end;
2866end;
2867
2868{$ifdef RedirectDestroyMessages}
2869{------------------------------------------------------------------------------
2870 Function: DestroyWindowProc
2871 Params: Window - The window that receives a message
2872         Msg    - The message received
2873         WParam - Word parameter
2874         LParam - Long-integer parameter
2875  Returns: 0 if Msg is handled; non-zero long-integer result otherwise
2876
2877  Handles messages after handle is destroyed
2878 ------------------------------------------------------------------------------}
2879
2880function DestroyWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
2881    LParam: Windows.LParam): LResult; stdcall;
2882var
2883  LMessage: TLMessage;
2884  WindowInfo: PWin32WindowInfo;
2885  lWinControl: TWinControl;
2886begin
2887  CallDefaultWindowProc(Window, Msg, WParam, LParam);
2888  case Msg of
2889    WM_DESTROY:
2890    begin
2891      WindowInfo := GetWin32WindowInfo(Window);
2892      if WindowInfo^.isChildEdit then
2893        lWinControl := WindowInfo^.AWinControl
2894      else
2895        lWinControl := WindowInfo^.WinControl;
2896      if CurrentWindow = Window then
2897        CurrentWindow := 0;
2898      if lWinControl is TCustomComboBox then
2899        DisposeComboEditWindowInfo(TCustomComboBox(lWinControl));
2900      if WindowInfo^.Overlay<>HWND(nil) then
2901        Windows.DestroyWindow(WindowInfo^.Overlay);
2902      if lWinControl <> nil then
2903      begin
2904        FillChar(LMessage, SizeOf(LMessage), 0);
2905        LMessage.Msg := LM_DESTROY;
2906        DeliverMessage(lWinControl, LMessage);
2907      end;
2908    end;
2909    WM_NCDESTROY:
2910    begin
2911      // free our own data associated with window
2912      DisposeWindowInfo(Window);
2913      EnumProps(Window, @PropEnumProc);
2914    end;
2915  end;
2916end;
2917{$endif}
2918
2919{------------------------------------------------------------------------------
2920 Procedure: TimerCallBackProc
2921 Params: window_hnd - handle of window for timer message, not set in this implementation
2922         msg        - WM_TIMER message
2923         idEvent    - timer identifier
2924         dwTime     - current system time
2925
2926 Calls the timerfunction in the Timer Object in the LCL
2927 ------------------------------------------------------------------------------}
2928procedure TimerCallBackProc(window_hwnd : hwnd; msg : DWORD; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
2929Var
2930  TimerInfo: PWin32TimerInfo;
2931  n: Integer;
2932begin
2933  if Assigned(Application) and Application.Terminated then exit;
2934  n := FTimerData.Count;
2935  while (n>0) do begin
2936    dec(n);
2937    TimerInfo := FTimerData[n];
2938    if TimerInfo^.TimerID=idEvent then begin
2939      TimerInfo^.TimerFunc;
2940      break;
2941    end;
2942  end;
2943end;
2944
2945{$IFDEF ASSERT_IS_ON}
2946  {$UNDEF ASSERT_IS_ON}
2947  {$C-}
2948{$ENDIF}
2949
2950