LCL: High-DPI ImageList: fix TDragImageList HotSpot

git-svn-id: branches/HiDPIImageList@57047 -

lcl/controls.pp

@@ -341,6 +341,7 @@ type
   TDragImageListResolution = class(TCustomImageListResolution)
   private
     FDragging: Boolean;
+    FDragHotspot: TPoint;
     FOldCursor: TCursor;
     FLastDragPos: TPoint;
     FLockedWindow: HWND;// window where drag started and locked via DragLock, invalid=NoLockedWindow=High(PtrInt)
@@ -353,6 +354,7 @@ type
   public
     constructor Create(TheOwner: TComponent); override;
 
+    function GetHotSpot: TPoint; override;
     function BeginDrag(Window: HWND; X, Y: Integer): Boolean;
     function DragLock(Window: HWND; XPos, YPos: Integer): Boolean;
     function DragMove(X, Y: Integer): Boolean;
@@ -361,13 +363,13 @@ type
     procedure HideDragImage;
     procedure ShowDragImage;
 
+    property DragHotspot: TPoint read FDragHotspot write FDragHotspot;
     property Dragging: Boolean read FDragging;
   end;
 
   TDragImageList = class(TCustomImageList)
   private
     FDragCursor: TCursor;
-    FDragHotspot: TPoint;
     FImageIndex: Integer;
     procedure SetDragCursor(const AValue: TCursor);
     function GetResolution(AImageWidth: Integer): TDragImageListResolution;
@@ -375,6 +377,8 @@ type
       APPI: Integer): TDragImageListResolution;
     function GetDragging: Boolean;
     function GetDraggingResolution: TDragImageListResolution;
+    function GetDragHotspot: TPoint;
+    procedure SetDragHotspot(const aDragHotspot: TPoint);
   protected
     function GetResolutionClass: TCustomImageListResolutionClass; override;
     procedure Initialize; override;
@@ -384,12 +388,11 @@ type
     function DragMove(X, Y: Integer): Boolean;
     procedure DragUnlock;
     function EndDrag: Boolean;
-    function GetHotSpot: TPoint; override;
     procedure HideDragImage;
     function SetDragImage(Index, HotSpotX, HotSpotY: Integer): Boolean;
     procedure ShowDragImage;
     property DragCursor: TCursor read FDragCursor write SetDragCursor;
-    property DragHotspot: TPoint read FDragHotspot write FDragHotspot;
+    property DragHotspot: TPoint read GetDragHotspot write SetDragHotspot;
     property Dragging: Boolean read GetDragging;
     property DraggingResolution: TDragImageListResolution read GetDraggingResolution;
     property Resolution[AImageWidth: Integer]: TDragImageListResolution read GetResolution;

lcl/imglist.pp

@@ -144,6 +144,7 @@ type
   public
     destructor Destroy; override;
   public
+    function GetHotSpot: TPoint; virtual;
     procedure FillDescription(out ADesc: TRawImageDescription);
     procedure GetBitmap(Index: Integer; Image: TCustomBitmap); overload;
     procedure GetBitmap(Index: Integer; Image: TCustomBitmap; AEffect: TGraphicsDrawEffect); overload;
@@ -302,7 +303,7 @@ type
     procedure GetIcon(Index: Integer; Image: TIcon; AEffect: TGraphicsDrawEffect); overload;
     procedure GetIcon(Index: Integer; Image: TIcon); overload;
     procedure GetRawImage(Index: Integer; out Image: TRawImage);
-    function GetHotSpot: TPoint; virtual;
+    function GetHotSpot: TPoint;
 
     procedure Insert(AIndex: Integer; AImage, AMask: TCustomBitmap);
     procedure InsertIcon(AIndex: Integer; AIcon: TCustomIcon);

lcl/include/dragimagelist.inc

@@ -30,6 +30,17 @@ begin
     WidgetSet.SetCursor(Screen.Cursors[DragCursor]);
 end;
 
+procedure TDragImageList.SetDragHotspot(const aDragHotspot: TPoint);
+var
+  R: TCustomImageListResolution;
+begin
+  Resolution[Width]; // create default resolution if needed
+  for R in Resolutions do
+    TDragImageListResolution(R).DragHotspot := Point(
+      MulDiv(aDragHotspot.X, R.Width, Width),
+      MulDiv(aDragHotspot.Y, R.Width, Width));
+end;
+
 {
   TDragImageList.Initialize
   set default values for properties
@@ -38,7 +49,6 @@ procedure TDragImageList.Initialize;
 begin
   inherited Initialize;
   FDragCursor := crNone;
-  FDragHotspot := Point(0, 0);
   FImageIndex := 0;
 end;
 
@@ -104,13 +114,9 @@ begin
   Result := nil;
 end;
 
-{
-  TDragImageList.GetHotSpot
-  Returns HotSpot
-}
-function TDragImageList.GetHotSpot: TPoint;
+function TDragImageList.GetDragHotspot: TPoint;
 begin
-  Result := FDragHotSpot;
+  Result := GetResolution(Width).DragHotspot;
 end;
 
 function TDragImageList.GetResolution(
@@ -150,14 +156,15 @@ var
   R: TDragImageListResolution;
 begin
   Result := True;
-  if (FImageIndex <> Index) or (FDragHotSpot.X <> HotSpotX) or
-     (FDragHotSpot.Y <> HotSpotY) then
+  R := GetDraggingResolution;
+  if R<>nil then
   begin
-    FImageIndex := Index;
-    FDragHotSpot := Point(HotSpotX, HotSpotY);
-    R := GetDraggingResolution;
-    if R<>nil then
+    if (FImageIndex <> Index) or (R.DragHotSpot.X <> HotSpotX) or
+       (R.DragHotSpot.Y <> HotSpotY) then
     begin
+      FImageIndex := Index;
+      R.DragHotSpot := Point(HotSpotX, HotSpotY);
+
       // restart dragging with new params
       CurLockedWindow := R.FLockedWindow;
       CurDragPos := R.FLastDragPos;
@@ -191,7 +198,7 @@ function TDragImageListResolution.BeginDrag(Window: HWND; X,
   Y: Integer): Boolean;
 begin
   Result := TWSDragImageListResolutionClass(WidgetSetClass).BeginDrag(Self, Window,
-    ImageList.FImageIndex, ImageList.FDragHotspot.X, ImageList.FDragHotspot.Y);
+    ImageList.FImageIndex, FDragHotspot.X, FDragHotspot.Y);
   FDragging := Result;
   if Result then
   begin
@@ -252,6 +259,11 @@ begin
   WidgetSet.SetCursor(Screen.Cursors[FOldCursor])
 end;
 
+function TDragImageListResolution.GetHotSpot: TPoint;
+begin
+  Result := FDragHotspot;
+end;
+
 function TDragImageListResolution.GetImageList: TDragImageList;
 begin
   Result := TDragImageList(inherited ImageList);

lcl/include/imglist.inc

@@ -383,6 +383,11 @@ begin
   Image.Data := PByte(FData);
 end;
 
+function TCustomImageListResolution.GetHotSpot: TPoint;
+begin
+  Result := Point(0, 0);
+end;
+
 procedure TCustomImageListResolution.GetIcon(Index: Integer; Image: TIcon);
 begin
   GetIcon(Index, Image, gdeNormal);
@@ -1540,7 +1545,7 @@ end;
  ------------------------------------------------------------------------------}
 function TCustomImageList.GetHotSpot: TPoint;
 begin
-  Result := Point(0, 0);
+  Result := GetResolution(FWidth).GetHotSpot;
 end;
 
 {------------------------------------------------------------------------------