1{ $Id$}
2{
3 *****************************************************************************
4 *                            Win32WSControls.pp                             *
5 *                            ------------------                             *
6 *                                                                           *
7 *                                                                           *
8 *****************************************************************************
9
10 *****************************************************************************
11  This file is part of the Lazarus Component Library (LCL)
12
13  See the file COPYING.modifiedLGPL.txt, included in this distribution,
14  for details about the license.
15 *****************************************************************************
16}
17unit Win32WSControls;
18
19{$mode objfpc}{$H+}
20{$I win32defines.inc}
21
22interface
23
24uses
25////////////////////////////////////////////////////
26// I M P O R T A N T
27////////////////////////////////////////////////////
28// To get as little as posible circles,
29// uncomment only when needed for registration
30////////////////////////////////////////////////////
31  CommCtrl, Windows, Classes, Controls, Graphics,
32////////////////////////////////////////////////////
33  WSControls, WSLCLClasses, SysUtils, Win32Proc, Win32Extra, WSProc,
34  { LCL }
35  InterfaceBase, LCLType, LCLIntf, LCLProc, LazUTF8, Themes, Forms;
36
37type
38  { TWin32WSDragImageListResolution }
39
40  TWin32WSDragImageListResolution = class(TWSDragImageListResolution)
41  published
42    class function BeginDrag(const ADragImageList: TDragImageListResolution; Window: HWND;
43      AIndex, X, Y: Integer): Boolean; override;
44    class function DragMove(const ADragImageList: TDragImageListResolution; X, Y: Integer): Boolean; override;
45    class procedure EndDrag(const ADragImageList: TDragImageListResolution); override;
46    class function HideDragImage(const ADragImageList: TDragImageListResolution;
47      ALockedWindow: HWND; DoUnLock: Boolean): Boolean; override;
48    class function ShowDragImage(const ADragImageList: TDragImageListResolution;
49      ALockedWindow: HWND; X, Y: Integer; DoLock: Boolean): Boolean; override;
50  end;
51
52  { TWin32WSControl }
53
54  TWin32WSControl = class(TWSControl)
55  published
56  end;
57
58  { TWin32WSWinControl }
59
60  TWin32WSWinControl = class(TWSWinControl)
61  published
62    class procedure AddControl(const AControl: TControl); override;
63
64    class function  GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
65    class procedure SetBiDiMode(const AWinControl: TWinControl; UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar : Boolean); override;
66    class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override;
67    class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); override;
68    class procedure SetChildZPosition(const AWinControl, AChild: TWinControl;
69                                      const AOldPos, ANewPos: Integer;
70                                      const AChildren: TFPList); override;
71    class procedure SetColor(const AWinControl: TWinControl); override;
72    class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
73    class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
74    class procedure SetCursor(const AWinControl: TWinControl; const ACursor: HCursor); override;
75    class procedure SetShape(const AWinControl: TWinControl; const AShape: HBITMAP); override;
76
77    class procedure ConstraintsChange(const AWinControl: TWinControl); override;
78    class function  CreateHandle(const AWinControl: TWinControl;
79          const AParams: TCreateParams): HWND; override;
80    class procedure DestroyHandle(const AWinControl: TWinControl); override;
81    class procedure Invalidate(const AWinControl: TWinControl); override;
82    class procedure PaintTo(const AWinControl: TWinControl; ADC: HDC; X, Y: Integer); override;
83    class procedure ShowHide(const AWinControl: TWinControl); override;
84    class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
85  end;
86
87  { TWin32WSGraphicControl }
88
89  TWin32WSGraphicControl = class(TWSGraphicControl)
90  published
91  end;
92
93  { TWin32WSCustomControl }
94
95  TWin32WSCustomControl = class(TWSCustomControl)
96  published
97  end;
98
99  { TWin32WSImageList }
100
101  TWin32WSImageList = class(TWSImageList)
102  published
103  end;
104
105type
106  TCreateWindowExParams = record
107    Buddy, Parent, Window: HWND;
108    Left, Top, Height, Width: integer;
109    WindowInfo, BuddyWindowInfo: PWin32WindowInfo;
110    Flags, FlagsEx: dword;
111    SubClassWndProc: pointer;
112    StrCaption, WindowTitle: String;
113    pClassName: PChar;
114    pSubClassName: PChar;
115  end;
116
117  TNCCreateParams = record
118    WinControl: TWinControl;
119    DefWndProc: WNDPROC;
120    Handled: Boolean;
121  end;
122  PNCCreateParams = ^TNCCreateParams;
123
124
125// TODO: better names?
126
127procedure PrepareCreateWindow(const AWinControl: TWinControl;
128  const CreateParams: TCreateParams; out Params: TCreateWindowExParams);
129procedure FinishCreateWindow(const AWinControl: TWinControl; var Params: TCreateWindowExParams;
130  const AlternateCreateWindow: boolean; SubClass: Boolean = False);
131procedure WindowCreateInitBuddy(const AWinControl: TWinControl;
132  var Params: TCreateWindowExParams);
133
134// Must be in win32proc but TCreateWindowExParams declared here
135procedure SetStdBiDiModeParams(const AWinControl: TWinControl; var Params:TCreateWindowExParams);
136
137implementation
138
139uses
140  Win32Int;
141
142{ Global helper routines }
143
144procedure PrepareCreateWindow(const AWinControl: TWinControl;
145  const CreateParams: TCreateParams; out Params: TCreateWindowExParams);
146begin
147  with Params do
148  begin
149    Window := HWND(nil);
150    Buddy := HWND(nil);
151    WindowTitle := '';
152    SubClassWndProc := @WindowProc;
153
154    Flags := CreateParams.Style;
155    FlagsEx := CreateParams.ExStyle;
156    Parent := CreateParams.WndParent;
157    StrCaption := CreateParams.Caption;
158
159    Left := CreateParams.X;
160    Top := CreateParams.Y;
161    Width := CreateParams.Width;
162    Height := CreateParams.Height;
163
164    LCLBoundsToWin32Bounds(AWinControl, Left, Top);
165    SetStdBiDiModeParams(AWinControl, Params);
166
167    if not (csDesigning in AWinControl.ComponentState) and not AWinControl.IsEnabled then
168      Flags := Flags or WS_DISABLED;
169
170    {$IFDEF VerboseSizeMsg}
171    DebugLn('PrepareCreateWindow ' + dbgsName(AWinControl) + ' ' +
172      Format('%d, %d, %d, %d', [Left, Top, Width, Height]));
173    {$ENDIF}
174  end;
175end;
176
177procedure FinishCreateWindow(const AWinControl: TWinControl; var Params: TCreateWindowExParams;
178  const AlternateCreateWindow: boolean; SubClass: Boolean = False);
179var
180  lhFont: HFONT;
181  AErrorCode: Cardinal;
182  NCCreateParams: TNCCreateParams;
183  WindowClassW, DummyClassW: WndClassW;
184begin
185  NCCreateParams.DefWndProc := nil;
186  NCCreateParams.WinControl := AWinControl;
187  NCCreateParams.Handled := False;
188
189  if not AlternateCreateWindow then
190  begin
191    with Params do
192    begin
193      if SubClass then
194      begin
195        if GetClassInfoW(System.HInstance, PWideChar(WideString(pClassName)), @WindowClassW) then
196        begin
197          NCCreateParams.DefWndProc := WndProc(WindowClassW.lpfnWndProc);
198          if not GetClassInfoW(System.HInstance, PWideChar(WideString(pSubClassName)), @DummyClassW) then
199          begin
200            with WindowClassW do
201            begin
202              LPFnWndProc := SubClassWndProc;
203              hInstance := System.HInstance;
204              lpszClassName := PWideChar(WideString(pSubClassName));
205            end;
206            Windows.RegisterClassW(@WindowClassW);
207          end;
208          pClassName := pSubClassName;
209        end;
210      end;
211
212      Window := CreateWindowExW(FlagsEx, PWideChar(WideString(pClassName)),
213        PWideChar(UTF8ToUTF16(WindowTitle)), Flags,
214        Left, Top, Width, Height, Parent, 0, HInstance, @NCCreateParams);
215
216      if Window = 0 then
217      begin
218        AErrorCode := GetLastError;
219        DebugLn(['Failed to create win32 control, error: ', AErrorCode, ' : ', GetLastErrorText(AErrorCode)]);
220        raise Exception.Create('Failed to create win32 control, error: ' + IntToStr(AErrorCode) + ' : ' + GetLastErrorText(AErrorCode));
221      end;
222    end;
223    { after creating a child window the following happens:
224      1) the previously bottom window is thrown to the top
225      2) the created window is added at the bottom
226      undo this by throwing them both to the bottom again }
227    { not needed anymore, tab order is handled entirely by LCL now
228    Windows.SetWindowPos(Windows.GetTopWindow(Parent), HWND_BOTTOM, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
229    Windows.SetWindowPos(Window, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
230    }
231  end;
232
233  with Params do
234  begin
235    if Window <> 0 then
236    begin
237      // some controls (combobox) immediately send a message upon setting font
238      if not NCCreateParams.Handled then
239      begin
240        WindowInfo := AllocWindowInfo(Window);
241        WindowInfo^.needParentPaint := GetWin32WindowInfo(Parent)^.needParentPaint;
242        WindowInfo^.WinControl := AWinControl;
243        AWinControl.Handle := Window;
244        if Assigned(SubClassWndProc) then
245          WindowInfo^.DefWndProc := Windows.WNDPROC(SetWindowLong(
246            Window, GWL_WNDPROC, PtrInt(SubClassWndProc)));
247        // Set control ID to map WinControl. This is required for messages that sent to parent
248        // to extract control from the passed ID.
249        // In case of subclassing this ID will be set in WM_NCCREATE message handler
250        SetWindowLong(Window, GWL_ID, PtrInt(AWinControl));
251      end;
252
253      if AWinControl.Font.IsDefault then
254        lhFont := Win32WidgetSet.DefaultFont
255      else
256        lhFont := AWinControl.Font.Reference.Handle;
257      Windows.SendMessage(Window, WM_SETFONT, WPARAM(lhFont), 0);
258    end;
259  end;
260end;
261
262procedure WindowCreateInitBuddy(const AWinControl: TWinControl;
263  var Params: TCreateWindowExParams);
264var
265  lhFont: HFONT;
266begin
267  with Params do
268    if Buddy <> HWND(Nil) then
269    begin
270      BuddyWindowInfo := AllocWindowInfo(Buddy);
271      BuddyWindowInfo^.AWinControl := AWinControl;
272      BuddyWindowInfo^.DefWndProc := Windows.WNDPROC(SetWindowLong(
273        Buddy, GWL_WNDPROC, PtrInt(SubClassWndProc)));
274      if AWinControl.Font.IsDefault then
275        lhFont := Win32Widgetset.DefaultFont
276      else
277        lhFont := AWinControl.Font.Reference.Handle;
278      Windows.SendMessage(Buddy, WM_SETFONT, WPARAM(lhFont), 0);
279    end
280    else
281      BuddyWindowInfo := nil;
282end;
283
284procedure SetStdBiDiModeParams(const AWinControl: TWinControl; var Params:TCreateWindowExParams);
285begin
286  with Params do
287  begin
288    //remove old bidimode ExFlags
289    FlagsEx := FlagsEx and not(WS_EX_RTLREADING or WS_EX_RIGHT or WS_EX_LEFTSCROLLBAR);
290
291    if AWinControl.UseRightToLeftAlignment then
292      FlagsEx := FlagsEx or WS_EX_RIGHT;
293    if AWinControl.UseRightToLeftScrollBar then
294      FlagsEx := FlagsEx or WS_EX_LEFTSCROLLBAR;
295    if AWinControl.UseRightToLeftReading then
296      FlagsEx := FlagsEx or WS_EX_RTLREADING;
297  end;
298end;
299
300{ TWin32WSWinControl }
301
302class function TWin32WSWinControl.CreateHandle(const AWinControl: TWinControl;
303  const AParams: TCreateParams): HWND;
304var
305  Params: TCreateWindowExParams;
306begin
307  // general initialization of Params
308  PrepareCreateWindow(AWinControl, AParams, Params);
309  // customization of Params
310  with Params do
311  begin
312    pClassName := @ClsName[0];
313    SubClassWndProc := nil;
314  end;
315  // create window
316  FinishCreateWindow(AWinControl, Params, false);
317  Result := Params.Window;
318end;
319
320class procedure TWin32WSWinControl.AddControl(const AControl: TControl);
321var
322  ParentHandle, ChildHandle: HWND;
323begin
324  {$ifdef OldToolbar}
325  if (AControl.Parent is TToolbar) then
326    exit;
327  {$endif}
328
329  with TWinControl(AControl) do
330  begin
331    ParentHandle := Parent.Handle;
332    ChildHandle := Handle;
333  end;
334
335  Windows.SetParent(ChildHandle, ParentHandle);
336end;
337
338class function  TWin32WSWinControl.GetText(const AWinControl: TWinControl; var AText: String): Boolean;
339begin
340  AText := '';
341  Result := false;
342end;
343
344class procedure TWin32WSWinControl.SetBiDiMode(const AWinControl : TWinControl;
345  UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar : Boolean
346  );
347var
348  FlagsEx: dword;
349begin
350  if not WSCheckHandleAllocated(AWinControl, 'SetBiDiMode') then
351    Exit;
352
353  FlagsEx := GetWindowLong(AWinControl.Handle, GWL_EXSTYLE);
354  FlagsEx := FlagsEx and not (WS_EX_RTLREADING or WS_EX_RIGHT or WS_EX_LEFTSCROLLBAR);
355  if UseRightToLeftAlign then
356    FlagsEx := FlagsEx or WS_EX_RIGHT;
357  if UseRightToLeftReading then
358    FlagsEx := FlagsEx or WS_EX_RTLREADING ;
359  if UseRightToLeftScrollBar then
360    FlagsEx := FlagsEx or WS_EX_LEFTSCROLLBAR;
361  SetWindowLong(AWinControl.Handle, GWL_EXSTYLE, FlagsEx);
362end;
363
364class procedure TWin32WSWinControl.SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle);
365begin
366  RecreateWnd(AWinControl);
367  if AWinControl.HandleObjectShouldBeVisible then
368    AWinControl.HandleNeeded;
369end;
370
371class procedure TWin32WSWinControl.SetChildZPosition(
372  const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer;
373  const AChildren: TFPList);
374var
375  AfterWnd: hWnd;
376  n, StopPos: Integer;
377  Child: TWinControl;
378  WindowInfo: PWin32WindowInfo;
379begin
380  if not WSCheckHandleAllocated(AWincontrol, 'SetChildZPosition')
381  then Exit;
382  if not WSCheckHandleAllocated(AChild, 'SetChildZPosition (child)')
383  then Exit;
384
385  if ANewPos = 0 // bottom
386  then AfterWnd := HWND_BOTTOM
387  else if ANewPos >= AChildren.Count - 1
388  then AfterWnd := HWND_TOP
389  else begin
390    // Search for the first child above us with a handle
391    // the child list is reversed form the windows order.
392    // So the first window is the top window and is the last child
393    // if we don't find a allocated handle then we are effectively not moved
394    AfterWnd := 0;
395    if AOldPos > ANewPos
396    then StopPos := AOldPos              // The child is moved to the bottom, oldpos is on top of it
397    else StopPos := AChildren.Count - 1; // the child is moved to the top
398
399    for n := ANewPos + 1 to StopPos do
400    begin
401      Child := TWinControl(AChildren[n]);
402      if Child.HandleAllocated
403      then begin
404        AfterWnd := Child.Handle;
405        Break;
406      end;
407    end;
408
409    if AfterWnd = 0 then Exit; // nothing to do
410  end;
411
412  WindowInfo := GetWin32WindowInfo(AChild.Handle);
413  if WindowInfo^.UpDown <> 0 then
414  begin
415    Windows.SetWindowPos(WindowInfo^.UpDown, AfterWnd, 0, 0, 0, 0,
416      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOOWNERZORDER or
417      SWP_NOSIZE or SWP_NOSENDCHANGING or SWP_DEFERERASE);
418    Windows.SetWindowPos(AChild.Handle, WindowInfo^.UpDown, 0, 0, 0, 0,
419      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOOWNERZORDER or
420      SWP_NOSIZE or SWP_NOSENDCHANGING or SWP_DEFERERASE);
421  end
422  else
423    Windows.SetWindowPos(AChild.Handle, AfterWnd, 0, 0, 0, 0,
424      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOOWNERZORDER or
425      SWP_NOSIZE or SWP_NOSENDCHANGING or SWP_DEFERERASE);
426end;
427
428{------------------------------------------------------------------------------
429  Method:  SetBounds
430  Params:  AWinControl                  - the object which invoked this function
431           ALeft, ATop, AWidth, AHeight - new dimensions for the control
432  Pre:     AWinControl.HandleAllocated
433  Returns: Nothing
434
435  Resize a window
436 ------------------------------------------------------------------------------}
437class procedure TWin32WSWinControl.SetBounds(const AWinControl: TWinControl;
438  const ALeft, ATop, AWidth, AHeight: Integer);
439var
440  IntfLeft, IntfTop, IntfWidth, IntfHeight: integer;
441  suppressMove: boolean;
442  Handle: HWND;
443  WindowPlacement: TWINDOWPLACEMENT;
444begin
445  IntfLeft := ALeft;
446  IntfTop := ATop;
447  IntfWidth := AWidth;
448  IntfHeight := AHeight;
449  LCLBoundsToWin32Bounds(AWinControl, IntfLeft, IntfTop);
450  {$IFDEF VerboseSizeMsg}
451  DebugLn('TWin32WSWinControl.ResizeWindow A ', dbgsName(AWinControl),
452    ' LCL=',Format('%d, %d, %d, %d', [ALeft,ATop,AWidth,AHeight]),
453    ' Win32=',Format('%d, %d, %d, %d', [IntfLeft,IntfTop,IntfWidth,IntfHeight])
454    );
455  {$ENDIF}
456  suppressMove := False;
457  AdaptBounds(AWinControl, IntfLeft, IntfTop, IntfWidth, IntfHeight, suppressMove);
458  if not suppressMove then
459  begin
460    Handle := AWinControl.Handle;
461    WindowPlacement.length := SizeOf(WindowPlacement);
462    if IsIconic(Handle) and GetWindowPlacement(Handle, @WindowPlacement) then
463    begin
464      WindowPlacement.rcNormalPosition := Bounds(IntfLeft, IntfTop, IntfWidth, IntfHeight);
465      SetWindowPlacement(Handle, @WindowPlacement);
466    end
467    else
468      Windows.SetWindowPos(Handle, 0, IntfLeft, IntfTop, IntfWidth, IntfHeight, SWP_NOZORDER or SWP_NOACTIVATE);
469  end;
470  LCLControlSizeNeedsUpdate(AWinControl, True);
471  // If this control is a child of an MDI form, then we need to update the MDI client bounds in
472  // case this control has affected the client area
473  if Assigned(Application.MainForm) and (AWinControl.Parent=Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) then
474    Win32WidgetSet.UpdateMDIClientBounds;
475end;
476
477class procedure TWin32WSWinControl.SetColor(const AWinControl: TWinControl);
478begin
479  // TODO: to be implemented, had no implementation in LM_SETCOLOR message
480end;
481
482class procedure TWin32WSWinControl.SetFont(const AWinControl: TWinControl; const AFont: TFont);
483begin
484  if not WSCheckHandleAllocated(AWinControl, 'SetFont')
485  then Exit;
486  Windows.SendMessage(AWinControl.Handle, WM_SETFONT, Windows.WParam(AFont.Reference.Handle), 1);
487end;
488
489class procedure TWin32WSWinControl.SetText(const AWinControl: TWinControl; const AText: string);
490begin
491  if not WSCheckHandleAllocated(AWincontrol, 'SetText') then Exit;
492  SendMessageW(AWinControl.Handle, WM_SETTEXT, 0, LPARAM(PWideChar(UTF8ToUTF16(AText))));
493end;
494
495class procedure TWin32WSWinControl.SetCursor(const AWinControl: TWinControl; const ACursor: HCursor);
496var
497  CursorPos, P: TPoint;
498  h: HWND;
499  HitTestCode: LResult;
500begin
501  // in win32 controls have no cursor property. they can change their cursor
502  // by listening WM_SETCURSOR and adjusting global cursor
503  if csDesigning in AWinControl.ComponentState then
504  begin
505    Windows.SetCursor(ACursor);
506    Exit;
507  end;
508
509  if Screen.RealCursor <> crDefault then exit;
510
511  Windows.GetCursorPos(CursorPos);
512
513  h := AWinControl.Handle;
514  P := CursorPos;
515  Windows.ScreenToClient(h, @P);
516  h := Windows.ChildWindowFromPointEx(h, Windows.POINT(P), CWP_SKIPINVISIBLE or CWP_SKIPDISABLED);
517
518  HitTestCode := SendMessage(h, WM_NCHITTEST, 0, LParam((CursorPos.X and $FFFF) or (CursorPos.Y shl 16)));
519  SendMessage(h, WM_SETCURSOR, WParam(h), Windows.MAKELONG(HitTestCode, WM_MOUSEMOVE));
520end;
521
522class procedure TWin32WSWinControl.SetShape(const AWinControl: TWinControl;
523  const AShape: HBITMAP);
524var
525  Rgn: HRGN;
526begin
527  if not WSCheckHandleAllocated(AWinControl, 'SetShape') then
528    Exit;
529
530  if AShape <> 0 then
531    Rgn := BitmapToRegion(AShape)
532  else
533    Rgn := 0;
534  Windows.SetWindowRgn(AWinControl.Handle, Rgn, True);
535  if Rgn <> 0 then
536    DeleteObject(Rgn);
537end;
538
539class procedure TWin32WSWinControl.ConstraintsChange(const AWinControl: TWinControl);
540begin
541  // TODO: implement me!
542end;
543
544class procedure TWin32WSWinControl.DestroyHandle(const AWinControl: TWinControl);
545var
546  Handle: HWND;
547begin
548  Handle := AWinControl.Handle;
549  {$ifdef RedirectDestroyMessages}
550  SetWindowLong(Handle, GWL_WNDPROC, PtrInt(@DestroyWindowProc));
551  {$endif}
552  // Instead of calling DestroyWindow directly, we need to call WM_MDIDESTROY for MDI children
553  if Assigned(Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) and
554    (AWinControl is TCustomForm) and (TCustomForm(AWinControl).FormStyle=fsMDIChild) then
555    SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDIDESTROY, Handle, 0)
556  else
557    DestroyWindow(Handle);
558end;
559
560class procedure TWin32WSWinControl.Invalidate(const AWinControl: TWinControl);
561begin
562  // lpRect = nil updates entire client area of window
563  InvalidateRect(AWinControl.Handle, nil, True);
564end;
565
566class procedure TWin32WSWinControl.PaintTo(const AWinControl: TWinControl;
567  ADC: HDC; X, Y: Integer);
568var
569  SavedDC: Integer;
570begin
571  SavedDC := SaveDC(ADC);
572  MoveWindowOrgEx(ADC, X, Y);
573  SendMessage(AWinControl.Handle, WM_PRINT, WParam(ADC),
574    PRF_CHECKVISIBLE or PRF_CHILDREN or PRF_CLIENT or PRF_NONCLIENT or PRF_OWNED);
575  RestoreDC(ADC, SavedDC);
576end;
577
578class procedure TWin32WSWinControl.ShowHide(const AWinControl: TWinControl);
579const
580  VisibilityToFlag: array[Boolean] of UINT = (SWP_HIDEWINDOW, SWP_SHOWWINDOW);
581begin
582  Windows.SetWindowPos(AWinControl.Handle, 0, 0, 0, 0, 0,
583    SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or VisibilityToFlag[AWinControl.HandleObjectShouldBeVisible]);
584  // If this control is a child of an MDI form, then we need to update the MDI client bounds in
585  // case altering this control's visibility has affected the client area
586  if Assigned(Application.MainForm) and (AWinControl.Parent=Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) then
587    Win32WidgetSet.UpdateMDIClientBounds;
588end;
589
590class procedure TWin32WSWinControl.ScrollBy(const AWinControl: TWinControl;
591  DeltaX, DeltaY: integer);
592begin
593  if AWinControl.HandleAllocated then
594    ScrollWindowEx(AWinControl.Handle, DeltaX, DeltaY, nil, nil, 0, nil,
595      SW_INVALIDATE or SW_ERASE or SW_SCROLLCHILDREN);
596end;
597
598{ TWin32WSDragImageListResolution }
599
600class function TWin32WSDragImageListResolution.BeginDrag(
601  const ADragImageList: TDragImageListResolution; Window: HWND; AIndex, X,
602  Y: Integer): Boolean;
603begin
604  // No check to Handle should be done, because if there is no handle (no needed)
605  // we must create it here. This is normal for imagelist (we can never need handle)
606  Result := ImageList_BeginDrag(ADragImageList.Reference.Handle, AIndex, X, Y);
607end;
608
609class function TWin32WSDragImageListResolution.DragMove(const ADragImageList: TDragImageListResolution;
610  X, Y: Integer): Boolean;
611begin
612  Result := ImageList_DragMove(X, Y);
613end;
614
615class procedure TWin32WSDragImageListResolution.EndDrag(const ADragImageList: TDragImageListResolution);
616begin
617  ImageList_EndDrag;
618end;
619
620class function TWin32WSDragImageListResolution.HideDragImage(const ADragImageList: TDragImageListResolution;
621  ALockedWindow: HWND; DoUnLock: Boolean): Boolean;
622begin
623  if DoUnLock then
624    Result := ImageList_DragLeave(ALockedWindow)
625  else
626    Result := ImageList_DragShowNolock(False);
627end;
628
629class function TWin32WSDragImageListResolution.ShowDragImage(const ADragImageList: TDragImageListResolution;
630  ALockedWindow: HWND; X, Y: Integer; DoLock: Boolean): Boolean;
631begin
632  if DoLock then
633    Result := ImageList_DragEnter(ALockedWindow, X, Y)
634  else
635    Result := ImageList_DragShowNolock(True);
636end;
637
638end.
639