{ $Id$} { ***************************************************************************** * Win32WSControls.pp * * ------------------ * * * * * ***************************************************************************** ***************************************************************************** This file is part of the Lazarus Component Library (LCL) See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** } unit Win32WSControls; {$mode objfpc}{$H+} {$I win32defines.inc} interface uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// CommCtrl, Windows, Classes, Controls, Graphics, //////////////////////////////////////////////////// WSControls, WSLCLClasses, SysUtils, Win32Proc, Win32Extra, WSProc, { LCL } InterfaceBase, LCLType, LCLIntf, LCLProc, LazUTF8, Themes, Forms; type { TWin32WSDragImageListResolution } TWin32WSDragImageListResolution = class(TWSDragImageListResolution) published class function BeginDrag(const ADragImageList: TDragImageListResolution; Window: HWND; AIndex, X, Y: Integer): Boolean; override; class function DragMove(const ADragImageList: TDragImageListResolution; X, Y: Integer): Boolean; override; class procedure EndDrag(const ADragImageList: TDragImageListResolution); override; class function HideDragImage(const ADragImageList: TDragImageListResolution; ALockedWindow: HWND; DoUnLock: Boolean): Boolean; override; class function ShowDragImage(const ADragImageList: TDragImageListResolution; ALockedWindow: HWND; X, Y: Integer; DoLock: Boolean): Boolean; override; end; { TWin32WSControl } TWin32WSControl = class(TWSControl) published end; { TWin32WSWinControl } TWin32WSWinControl = class(TWSWinControl) published class procedure AddControl(const AControl: TControl); override; class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override; class procedure SetBiDiMode(const AWinControl: TWinControl; UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar : Boolean); override; class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override; class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); override; class procedure SetChildZPosition(const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TFPList); override; class procedure SetColor(const AWinControl: TWinControl); override; class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override; class procedure SetText(const AWinControl: TWinControl; const AText: string); override; class procedure SetCursor(const AWinControl: TWinControl; const ACursor: HCursor); override; class procedure SetShape(const AWinControl: TWinControl; const AShape: HBITMAP); override; class procedure ConstraintsChange(const AWinControl: TWinControl); override; class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override; class procedure DestroyHandle(const AWinControl: TWinControl); override; class procedure Invalidate(const AWinControl: TWinControl); override; class procedure PaintTo(const AWinControl: TWinControl; ADC: HDC; X, Y: Integer); override; class procedure ShowHide(const AWinControl: TWinControl); override; class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override; end; { TWin32WSGraphicControl } TWin32WSGraphicControl = class(TWSGraphicControl) published end; { TWin32WSCustomControl } TWin32WSCustomControl = class(TWSCustomControl) published end; { TWin32WSImageList } TWin32WSImageList = class(TWSImageList) published end; type TCreateWindowExParams = record Buddy, Parent, Window: HWND; Left, Top, Height, Width: integer; WindowInfo, BuddyWindowInfo: PWin32WindowInfo; Flags, FlagsEx: dword; SubClassWndProc: pointer; StrCaption, WindowTitle: String; pClassName: PChar; pSubClassName: PChar; end; TNCCreateParams = record WinControl: TWinControl; DefWndProc: WNDPROC; Handled: Boolean; end; PNCCreateParams = ^TNCCreateParams; // TODO: better names? procedure PrepareCreateWindow(const AWinControl: TWinControl; const CreateParams: TCreateParams; out Params: TCreateWindowExParams); procedure FinishCreateWindow(const AWinControl: TWinControl; var Params: TCreateWindowExParams; const AlternateCreateWindow: boolean; SubClass: Boolean = False); procedure WindowCreateInitBuddy(const AWinControl: TWinControl; var Params: TCreateWindowExParams); // Must be in win32proc but TCreateWindowExParams declared here procedure SetStdBiDiModeParams(const AWinControl: TWinControl; var Params:TCreateWindowExParams); var // WindowPosChanging hack - see comment in TWin32WSWinControl.SetBounds LockWindowPosChanging: Boolean = False; LockWindowPosChangingXY: TPoint; implementation uses Win32Int; { Global helper routines } procedure PrepareCreateWindow(const AWinControl: TWinControl; const CreateParams: TCreateParams; out Params: TCreateWindowExParams); begin with Params do begin Window := HWND(nil); Buddy := HWND(nil); WindowTitle := ''; SubClassWndProc := @WindowProc; Flags := CreateParams.Style; FlagsEx := CreateParams.ExStyle; Parent := CreateParams.WndParent; StrCaption := CreateParams.Caption; Left := CreateParams.X; Top := CreateParams.Y; Width := CreateParams.Width; Height := CreateParams.Height; LCLBoundsToWin32Bounds(AWinControl, Left, Top); SetStdBiDiModeParams(AWinControl, Params); if not (csDesigning in AWinControl.ComponentState) and not AWinControl.IsEnabled then Flags := Flags or WS_DISABLED; {$IFDEF VerboseSizeMsg} DebugLn('PrepareCreateWindow ' + dbgsName(AWinControl) + ' ' + Format('%d, %d, %d, %d', [Left, Top, Width, Height])); {$ENDIF} end; end; procedure FinishCreateWindow(const AWinControl: TWinControl; var Params: TCreateWindowExParams; const AlternateCreateWindow: boolean; SubClass: Boolean = False); var lhFont: HFONT; AErrorCode: Cardinal; NCCreateParams: TNCCreateParams; WindowClassW, DummyClassW: WndClassW; begin NCCreateParams.DefWndProc := nil; NCCreateParams.WinControl := AWinControl; NCCreateParams.Handled := False; if not AlternateCreateWindow then begin with Params do begin if SubClass then begin if GetClassInfoW(System.HInstance, PWideChar(WideString(pClassName)), LPWNDCLASSW(@WindowClassW)) then begin NCCreateParams.DefWndProc := WndProc(WindowClassW.lpfnWndProc); if not GetClassInfoW(System.HInstance, PWideChar(WideString(pSubClassName)), LPWNDCLASSW(@DummyClassW)) then begin with WindowClassW do begin LPFnWndProc := SubClassWndProc; hInstance := System.HInstance; lpszClassName := PWideChar(WideString(pSubClassName)); end; Windows.RegisterClassW(LPWNDCLASSW(@WindowClassW)); end; pClassName := pSubClassName; end; end; Window := CreateWindowExW(FlagsEx, PWideChar(WideString(pClassName)), PWideChar(UTF8ToUTF16(WindowTitle)), Flags, Left, Top, Width, Height, Parent, 0, HInstance, @NCCreateParams); if Window = 0 then begin AErrorCode := GetLastError; DebugLn(['Failed to create win32 control, error: ', AErrorCode, ' : ', GetLastErrorText(AErrorCode)]); raise Exception.Create('Failed to create win32 control, error: ' + IntToStr(AErrorCode) + ' : ' + GetLastErrorText(AErrorCode)); end; end; { after creating a child window the following happens: 1) the previously bottom window is thrown to the top 2) the created window is added at the bottom undo this by throwing them both to the bottom again } { not needed anymore, tab order is handled entirely by LCL now Windows.SetWindowPos(Windows.GetTopWindow(Parent), HWND_BOTTOM, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); Windows.SetWindowPos(Window, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); } end; with Params do begin if Window <> 0 then begin // some controls (combobox) immediately send a message upon setting font if not NCCreateParams.Handled then begin WindowInfo := AllocWindowInfo(Window); WindowInfo^.needParentPaint := GetWin32WindowInfo(Parent)^.needParentPaint; WindowInfo^.WinControl := AWinControl; AWinControl.Handle := Window; if Assigned(SubClassWndProc) then WindowInfo^.DefWndProc := Windows.WNDPROC(SetWindowLongPtrW( Window, GWL_WNDPROC, PtrInt(SubClassWndProc))); // Set control ID to map WinControl. This is required for messages that sent to parent // to extract control from the passed ID. // In case of subclassing this ID will be set in WM_NCCREATE message handler // Important: do not store the object pointer here because GWL_ID can take only 32bit values // Windows Handles are always 32bit (also on 64bit system) so it is safe to store the Handle and find the WinControl from the Handle then // We set the WinControl property here in case InitializeWnd is too late SetProp(Window, 'WinControl', WindowInfo^.WinControl); SetWindowLongPtrW(Window, GWL_ID, PtrInt(Window)); end; if AWinControl.Font.IsDefault then lhFont := Win32WidgetSet.DefaultFont else lhFont := AWinControl.Font.Reference.Handle; Windows.SendMessage(Window, WM_SETFONT, WPARAM(lhFont), 0); end; end; end; procedure WindowCreateInitBuddy(const AWinControl: TWinControl; var Params: TCreateWindowExParams); var lhFont: HFONT; begin with Params do if Buddy <> HWND(Nil) then begin BuddyWindowInfo := AllocWindowInfo(Buddy); BuddyWindowInfo^.AWinControl := AWinControl; BuddyWindowInfo^.DefWndProc := Windows.WNDPROC(SetWindowLongPtrW( Buddy, GWL_WNDPROC, PtrInt(SubClassWndProc))); if AWinControl.Font.IsDefault then lhFont := Win32Widgetset.DefaultFont else lhFont := AWinControl.Font.Reference.Handle; Windows.SendMessage(Buddy, WM_SETFONT, WPARAM(lhFont), 0); end else BuddyWindowInfo := nil; end; procedure SetStdBiDiModeParams(const AWinControl: TWinControl; var Params:TCreateWindowExParams); begin with Params do begin //remove old bidimode ExFlags FlagsEx := FlagsEx and not(WS_EX_RTLREADING or WS_EX_RIGHT or WS_EX_LEFTSCROLLBAR); if AWinControl.UseRightToLeftAlignment then FlagsEx := FlagsEx or WS_EX_RIGHT; if AWinControl.UseRightToLeftScrollBar then FlagsEx := FlagsEx or WS_EX_LEFTSCROLLBAR; if AWinControl.UseRightToLeftReading then FlagsEx := FlagsEx or WS_EX_RTLREADING; end; end; { TWin32WSWinControl } class function TWin32WSWinControl.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; var Params: TCreateWindowExParams; begin // general initialization of Params PrepareCreateWindow(AWinControl, AParams, Params); // customization of Params with Params do begin pClassName := @ClsName[0]; SubClassWndProc := nil; end; // create window FinishCreateWindow(AWinControl, Params, false); Result := Params.Window; end; class procedure TWin32WSWinControl.AddControl(const AControl: TControl); var ParentHandle, ChildHandle: HWND; begin {$ifdef OldToolbar} if (AControl.Parent is TToolbar) then exit; {$endif} with TWinControl(AControl) do begin ParentHandle := Parent.Handle; ChildHandle := Handle; end; Windows.SetParent(ChildHandle, ParentHandle); end; class function TWin32WSWinControl.GetText(const AWinControl: TWinControl; var AText: String): Boolean; begin AText := ''; Result := false; end; class procedure TWin32WSWinControl.SetBiDiMode(const AWinControl : TWinControl; UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar : Boolean ); var FlagsEx: dword; begin if not WSCheckHandleAllocated(AWinControl, 'SetBiDiMode') then Exit; FlagsEx := GetWindowLong(AWinControl.Handle, GWL_EXSTYLE); FlagsEx := FlagsEx and not (WS_EX_RTLREADING or WS_EX_RIGHT or WS_EX_LEFTSCROLLBAR); if UseRightToLeftAlign then FlagsEx := FlagsEx or WS_EX_RIGHT; if UseRightToLeftReading then FlagsEx := FlagsEx or WS_EX_RTLREADING ; if UseRightToLeftScrollBar then FlagsEx := FlagsEx or WS_EX_LEFTSCROLLBAR; SetWindowLongPtrW(AWinControl.Handle, GWL_EXSTYLE, FlagsEx); end; class procedure TWin32WSWinControl.SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); begin RecreateWnd(AWinControl); if AWinControl.HandleObjectShouldBeVisible then AWinControl.HandleNeeded; end; class procedure TWin32WSWinControl.SetChildZPosition( const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TFPList); var AfterWnd: hWnd; n, StopPos: Integer; Child: TWinControl; WindowInfo: PWin32WindowInfo; begin if not WSCheckHandleAllocated(AWincontrol, 'SetChildZPosition') then Exit; if not WSCheckHandleAllocated(AChild, 'SetChildZPosition (child)') then Exit; if ANewPos = 0 // bottom then AfterWnd := HWND_BOTTOM else if ANewPos >= AChildren.Count - 1 then AfterWnd := HWND_TOP else begin // Search for the first child above us with a handle // the child list is reversed form the windows order. // So the first window is the top window and is the last child // if we don't find a allocated handle then we are effectively not moved AfterWnd := 0; if AOldPos > ANewPos then StopPos := AOldPos // The child is moved to the bottom, oldpos is on top of it else StopPos := AChildren.Count - 1; // the child is moved to the top for n := ANewPos + 1 to StopPos do begin Child := TWinControl(AChildren[n]); if Child.HandleAllocated then begin AfterWnd := Child.Handle; Break; end; end; if AfterWnd = 0 then Exit; // nothing to do end; WindowInfo := GetWin32WindowInfo(AChild.Handle); if WindowInfo^.UpDown <> 0 then begin Windows.SetWindowPos(WindowInfo^.UpDown, AfterWnd, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOOWNERZORDER or SWP_NOSIZE or SWP_NOSENDCHANGING or SWP_DEFERERASE); Windows.SetWindowPos(AChild.Handle, WindowInfo^.UpDown, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOOWNERZORDER or SWP_NOSIZE or SWP_NOSENDCHANGING or SWP_DEFERERASE); end else Windows.SetWindowPos(AChild.Handle, AfterWnd, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOOWNERZORDER or SWP_NOSIZE or SWP_NOSENDCHANGING or SWP_DEFERERASE); end; {------------------------------------------------------------------------------ Method: SetBounds Params: AWinControl - the object which invoked this function ALeft, ATop, AWidth, AHeight - new dimensions for the control Pre: AWinControl.HandleAllocated Returns: Nothing Resize a window ------------------------------------------------------------------------------} class procedure TWin32WSWinControl.SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); var IntfLeft, IntfTop, IntfWidth, IntfHeight: integer; suppressMove: boolean; Handle: HWND; WindowPlacement: TWINDOWPLACEMENT; Mon: HMONITOR; MonInfo: TMonitorInfo; begin IntfLeft := ALeft; IntfTop := ATop; IntfWidth := AWidth; IntfHeight := AHeight; LCLBoundsToWin32Bounds(AWinControl, IntfLeft, IntfTop); {$IFDEF VerboseSizeMsg} DebugLn('TWin32WSWinControl.ResizeWindow A ', dbgsName(AWinControl), ' LCL=',Format('%d, %d, %d, %d', [ALeft,ATop,AWidth,AHeight]), ' Win32=',Format('%d, %d, %d, %d', [IntfLeft,IntfTop,IntfWidth,IntfHeight]) ); {$ENDIF} suppressMove := False; AdaptBounds(AWinControl, IntfLeft, IntfTop, IntfWidth, IntfHeight, suppressMove); if not suppressMove then begin Handle := AWinControl.Handle; WindowPlacement.length := SizeOf(WindowPlacement); // Windows (at least Win 10) has the feature that SetWindowPos() forces dialogs with parent windows on the same screen // with the parent window - the position set with Windows.SetWindowPos() is ignored and instead the dialog // is centered with its parent window. // To prevent Windows from changing the position defined by the LCL, the LM_WINDOWPOSCHANGING is handled and the // new coordinates are re-assigned within the message handler with LockWindowPosChanging&LockWindowPosChangingXY // See issue #39479 for more description and demo application. LockWindowPosChanging := True; try LockWindowPosChangingXY := Point(IntfLeft, IntfTop); if IsIconic(Handle) and GetWindowPlacement(Handle, @WindowPlacement) then begin WindowPlacement.rcNormalPosition := Bounds(IntfLeft, IntfTop, IntfWidth, IntfHeight); // workarea coordinates must be used for top-level windows without WS_EX_TOOLWINDOW window style if (GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_TOOLWINDOW)=0 then begin Mon := MonitorFromRect(@WindowPlacement.rcNormalPosition, MONITOR_DEFAULTTOPRIMARY); MonInfo := Default(TMonitorInfo); MonInfo.cbSize := SizeOf(TMonitorInfo); if (Mon<>0) and GetMonitorInfo(Mon, @MonInfo) then WindowPlacement.rcNormalPosition.Offset(MonInfo.rcMonitor.Left-MonInfo.rcWork.Left, MonInfo.rcMonitor.Top-MonInfo.rcWork.Top); end; SetWindowPlacement(Handle, @WindowPlacement); end else Windows.SetWindowPos(Handle, 0, IntfLeft, IntfTop, IntfWidth, IntfHeight, SWP_NOZORDER or SWP_NOACTIVATE); finally LockWindowPosChanging := False; end; end; LCLControlSizeNeedsUpdate(AWinControl, True); // If this control is a child of an MDI form, then we need to update the MDI client bounds in // case this control has affected the client area if Assigned(Application.MainForm) and (AWinControl.Parent=Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) then Win32WidgetSet.UpdateMDIClientBounds; end; class procedure TWin32WSWinControl.SetColor(const AWinControl: TWinControl); begin // TODO: to be implemented, had no implementation in LM_SETCOLOR message end; class procedure TWin32WSWinControl.SetFont(const AWinControl: TWinControl; const AFont: TFont); begin if not WSCheckHandleAllocated(AWinControl, 'SetFont') then Exit; Windows.SendMessage(AWinControl.Handle, WM_SETFONT, Windows.WParam(AFont.Reference.Handle), 1); end; class procedure TWin32WSWinControl.SetText(const AWinControl: TWinControl; const AText: string); begin if not WSCheckHandleAllocated(AWincontrol, 'SetText') then Exit; SendMessageW(AWinControl.Handle, WM_SETTEXT, 0, LPARAM(PWideChar(UTF8ToUTF16(AText)))); end; class procedure TWin32WSWinControl.SetCursor(const AWinControl: TWinControl; const ACursor: HCursor); var CursorPos, P: TPoint; h: HWND; HitTestCode: LResult; begin // in win32 controls have no cursor property. they can change their cursor // by listening WM_SETCURSOR and adjusting global cursor if csDesigning in AWinControl.ComponentState then begin Windows.SetCursor(ACursor); Exit; end; if Screen.RealCursor <> crDefault then exit; Windows.GetCursorPos(CursorPos); h := AWinControl.Handle; P := CursorPos; Windows.ScreenToClient(h, @P); h := Windows.ChildWindowFromPointEx(h, Windows.POINT(P), CWP_SKIPINVISIBLE or CWP_SKIPDISABLED); HitTestCode := SendMessage(h, WM_NCHITTEST, 0, LParam((CursorPos.X and $FFFF) or (CursorPos.Y shl 16))); SendMessage(h, WM_SETCURSOR, WParam(h), Windows.MAKELONG(HitTestCode, WM_MOUSEMOVE)); end; class procedure TWin32WSWinControl.SetShape(const AWinControl: TWinControl; const AShape: HBITMAP); var Rgn: HRGN; begin if not WSCheckHandleAllocated(AWinControl, 'SetShape') then Exit; if AShape <> 0 then Rgn := BitmapToRegion(AShape) else Rgn := 0; Windows.SetWindowRgn(AWinControl.Handle, Rgn, True); if Rgn <> 0 then DeleteObject(Rgn); end; class procedure TWin32WSWinControl.ConstraintsChange(const AWinControl: TWinControl); begin // TODO: implement me! end; class procedure TWin32WSWinControl.DestroyHandle(const AWinControl: TWinControl); var Handle: HWND; begin Handle := AWinControl.Handle; {$ifdef RedirectDestroyMessages} SetWindowLongPtrW(Handle, GWL_WNDPROC, PtrInt(@DestroyWindowProc)); {$endif} // Instead of calling DestroyWindow directly, we need to call WM_MDIDESTROY for MDI children if Assigned(Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) and (AWinControl is TCustomForm) and (TCustomForm(AWinControl).FormStyle=fsMDIChild) then SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDIDESTROY, Handle, 0) else DestroyWindow(Handle); end; class procedure TWin32WSWinControl.Invalidate(const AWinControl: TWinControl); begin // lpRect = nil updates entire client area of window InvalidateRect(AWinControl.Handle, nil, True); end; class procedure TWin32WSWinControl.PaintTo(const AWinControl: TWinControl; ADC: HDC; X, Y: Integer); var SavedDC: Integer; begin SavedDC := SaveDC(ADC); MoveWindowOrgEx(ADC, X, Y); SendMessage(AWinControl.Handle, WM_PRINT, WParam(ADC), PRF_CHECKVISIBLE or PRF_CHILDREN or PRF_CLIENT or PRF_NONCLIENT or PRF_OWNED); RestoreDC(ADC, SavedDC); end; class procedure TWin32WSWinControl.ShowHide(const AWinControl: TWinControl); const VisibilityToFlag: array[Boolean] of UINT = (SWP_HIDEWINDOW, SWP_SHOWWINDOW); begin Windows.SetWindowPos(AWinControl.Handle, 0, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or VisibilityToFlag[AWinControl.HandleObjectShouldBeVisible]); // If this control is a child of an MDI form, then we need to update the MDI client bounds in // case altering this control's visibility has affected the client area if Assigned(Application.MainForm) and (AWinControl.Parent=Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) then Win32WidgetSet.UpdateMDIClientBounds; end; class procedure TWin32WSWinControl.ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); begin if AWinControl.HandleAllocated then ScrollWindowEx(AWinControl.Handle, DeltaX, DeltaY, nil, nil, 0, nil, SW_INVALIDATE or SW_ERASE or SW_SCROLLCHILDREN); end; { TWin32WSDragImageListResolution } class function TWin32WSDragImageListResolution.BeginDrag( const ADragImageList: TDragImageListResolution; Window: HWND; AIndex, X, Y: Integer): Boolean; begin // No check to Handle should be done, because if there is no handle (no needed) // we must create it here. This is normal for imagelist (we can never need handle) Result := ImageList_BeginDrag(ADragImageList.Reference.Handle, AIndex, X, Y); end; class function TWin32WSDragImageListResolution.DragMove(const ADragImageList: TDragImageListResolution; X, Y: Integer): Boolean; begin Result := ImageList_DragMove(X, Y); end; class procedure TWin32WSDragImageListResolution.EndDrag(const ADragImageList: TDragImageListResolution); begin ImageList_EndDrag; end; class function TWin32WSDragImageListResolution.HideDragImage(const ADragImageList: TDragImageListResolution; ALockedWindow: HWND; DoUnLock: Boolean): Boolean; begin if DoUnLock then Result := ImageList_DragLeave(ALockedWindow) else Result := ImageList_DragShowNolock(False); end; class function TWin32WSDragImageListResolution.ShowDragImage(const ADragImageList: TDragImageListResolution; ALockedWindow: HWND; X, Y: Integer; DoLock: Boolean): Boolean; begin if DoLock then Result := ImageList_DragEnter(ALockedWindow, X, Y) else Result := ImageList_DragShowNolock(True); end; end.