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