LCL: High-DPI ImageList: reload WS image lists on resolution handle destruction (TPageControl, TListView)

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

lcl/comctrls.pp

@@ -33,9 +33,9 @@ uses
   // LazUtils
   LazUTF8, LazUTF8Classes,
   // LCL
-  LCLStrConsts, LResources, LCLIntf, LCLType, LMessages, WSLCLClasses, LCLProc,
+  LCLStrConsts, LResources, LCLIntf, LCLType, LMessages, WSLCLClasses,
-  GraphType, Graphics, ImgList, ActnList, Themes, Menus, Controls, Forms,
+  WSReferences, LCLProc, GraphType, Graphics, ImgList, ActnList, Themes, Menus,
-  StdCtrls, ExtCtrls, ToolWin, Buttons;
+  Controls, Forms, StdCtrls, ExtCtrls, ToolWin, Buttons;
 
 type
   THitTest = (htAbove, htBelow, htNowhere, htOnItem, htOnButton, htOnIcon,
@@ -423,6 +423,9 @@ type
     procedure ShowCurrentPage;
     procedure UpdateAllDesignerFlags;
     procedure UpdateDesignerFlags(APageIndex: integer);
+    procedure DoImageListDestroyResolutionHandle(Sender: TCustomImageList;
+      AWidth: Integer; AReferenceHandle: TLCLHandle);
+    procedure SetImageListAsync(Data: PtrInt);
   protected
     PageClass: TCustomPageClass;
     function GetPageClass: TCustomPageClass; virtual;
@@ -1468,6 +1471,9 @@ type
     procedure CNNotify(var AMessage: TLMNotify); message CN_NOTIFY;
     procedure CNDrawItem(var Message: TLMDrawListItem); message CN_DRAWITEM;
     procedure InvalidateSelected;
+    procedure ImageResolutionHandleDestroyed(Sender: TCustomImageList;
+      AWidth: Integer; AReferenceHandle: TLCLHandle);
+    procedure SetImageListAsync(Data: PtrInt);
   private
     FOnCreateItemClass: TLVCreateItemClassEvent;
     FOnDrawItem: TLVDrawItemEvent;

lcl/imglist.pp

@@ -66,14 +66,20 @@ type
 
   TCustomImageList = class; //forward declaration
 
+  TDestroyResolutionHandleEvent = procedure(Sender: TCustomImageList; AWidth: Integer; AReferenceHandle: TLCLHandle) of object;
+
   TChangeLink = class(TObject)
   private
     FSender: TCustomImageList;
     FOnChange: TNotifyEvent;
+    FOnDestroyResolutionHandle: TDestroyResolutionHandleEvent;
+
+    procedure DoDestroyResolutionReference(const AWidth: Integer; AResolutionReference: TLCLHandle);
   public
     destructor Destroy; override;
     procedure Change; virtual;
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property OnDestroyResolutionHandle: TDestroyResolutionHandleEvent read FOnDestroyResolutionHandle write FOnDestroyResolutionHandle;
     property Sender: TCustomImageList read FSender write FSender;
   end;
 
@@ -137,11 +143,10 @@ type
     procedure WriteData(AStream: TStream);
     procedure ReadData(AStream: TStream);
   protected
-    property ImageList: TCustomImageList read FImageList;
-
     function  GetReferenceHandle: THandle; override;
     function  WSCreateReference(AParams: TCreateParams): PWSReference; override;
     class procedure WSRegisterClass; override;
+    procedure ReferenceDestroying; override;
   public
     destructor Destroy; override;
   public
@@ -167,9 +172,11 @@ type
     procedure DrawOverlay(ACanvas: TCanvas; AX, AY, AIndex: Integer; AOverlay: TOverlay; ADrawingStyle:
       TDrawingStyle; AImageType: TImageType; ADrawEffect: TGraphicsDrawEffect); overload;
 
+    property ImageList: TCustomImageList read FImageList;
     property Width: Integer read FWidth;
     property Height: Integer read FHeight;
     property Count: Integer read FCount;
+
     property AutoCreatedInDesignTime: Boolean read FAutoCreatedInDesignTime write FAutoCreatedInDesignTime;
 
     property Reference: TWSCustomImageListReference read GetReference;
@@ -255,6 +262,7 @@ type
     function GetResolutionByIndex(AIndex: Integer): TCustomImageListResolution;
     function GetResolutionCount: Integer;
     procedure CreateDefaultResolution;
+    procedure DoDestroyResolutionReference(const AWidth: Integer; AResolutionReference: TLCLHandle);
   protected
     function GetResolution(AImageWidth: Integer): TCustomImageListResolution;
     function GetResolutionClass: TCustomImageListResolutionClass; virtual;

lcl/include/customlistview.inc

@@ -127,6 +127,7 @@ begin
   begin
     FImageChangeLinks[lvil] := TChangeLink.Create;
     FImageChangeLinks[lvil].OnChange := @ImageChanged;
+    FImageChangeLinks[lvil].OnDestroyResolutionHandle := @ImageResolutionHandleDestroyed;
   end;
   FHoverTime := -1;
   TabStop := true;
@@ -536,7 +537,7 @@ begin
   for lvil := Low(TListViewImageList) to High(TListViewImageList) do
   begin
     if FImages[lvil] <> nil
-    then LVC.SetImageList(Self, lvil, FImages[lvil].ResolutionForPPI[FImagesWidth[lvil], Font.PixelsPerInch]);
+    then LVC.SetImageList(Self, lvil, FImages[lvil].ResolutionForPPI[FImagesWidth[lvil], Font.PixelsPerInch]); // xxx
   end;
   LVC.SetScrollBars(Self, FScrollBars);
   LVC.SetViewOrigin(Self, FViewOriginCache) ;
@@ -799,10 +800,13 @@ begin
 end;
 
 procedure TCustomListView.QueuedShowEditor(Data: PtrInt);
+begin
+  if fShowEditorQueued then
   begin
     fShowEditorQueued:=false;
     ShowEditor;
   end;
+end;
 
 procedure TCustomListView.DblClick;
 begin
@@ -1028,6 +1032,7 @@ destructor TCustomListView.Destroy;
 var
   lvil: TListViewImageList;
 begin
+  Application.RemoveAsyncCalls(Self);
   // Better destroy the wincontrol (=widget) first. So wo don't have to delete
   // all items/columns and we won't get notifications for each.
   FreeAndNil(FCanvas);
@@ -1149,7 +1154,7 @@ end;
 
 procedure TCustomListView.FinalizeWnd;
 begin
-  ShowEditorQueued:=false;
+  FShowEditorQueued:=false;
   // store origin
   FViewOriginCache := TWSCustomListViewClass(WidgetSetClass).GetViewOrigin(Self);
   if not OwnerData then
@@ -1583,6 +1588,11 @@ begin
   SetImageListWS(lvil);
 end;
 
+procedure TCustomListView.SetImageListAsync(Data: PtrInt);
+begin
+  SetImageListWS(TListViewImageList(Data));
+end;
+
 procedure TCustomListView.SetImageListWidth(const ALvilOrd: Integer;
   const AValue: Integer);
 var
@@ -1672,10 +1682,8 @@ procedure TCustomListView.SetShowEditorQueued(AValue: boolean);
 begin
   if FShowEditorQueued=AValue then Exit;
   FShowEditorQueued:=AValue;
-  if ShowEditorQueued then
+  if FShowEditorQueued then
-    Application.QueueAsyncCall(@QueuedShowEditor,0)
+    Application.QueueAsyncCall(@QueuedShowEditor,0);
-  else
-    Application.RemoveAsyncCalls(Self);
 end;
 
 procedure TCustomListView.SetOwnerData(const AValue: Boolean);
@@ -1725,6 +1733,19 @@ begin
 //  end;
 end;
 
+procedure TCustomListView.ImageResolutionHandleDestroyed(
+  Sender: TCustomImageList; AWidth: Integer; AReferenceHandle: TLCLHandle);
+var
+  lvil: TListViewImageList;
+begin
+  for lvil in TListViewImageList do
+    if Sender = FImages[lvil] then
+    begin
+      TWSCustomListViewClass(WidgetSetClass).SetImageList(Self, lvil, nil);
+      Application.QueueAsyncCall(@SetImageListAsync, Ord(lvil));
+    end;
+end;
+
 procedure TCustomListView.Loaded;
 begin
   // create interface columns if needed

lcl/include/customnotebook.inc

@@ -270,6 +270,7 @@ begin
 
   FImageListChangeLink := TChangeLink.Create;
   FImageListChangeLink.OnChange := @DoImageListChange;
+  FImageListChangeLink.OnDestroyResolutionHandle := @DoImageListDestroyResolutionHandle;
 
   FPageIndex := -1;
 
@@ -353,6 +354,7 @@ begin
   FImageListChangeLink.Free;
   Pages.Clear;
   FreeAndNil(FAccess);
+  Application.RemoveAsyncCalls(Self);
   inherited Destroy;
 end;
 
@@ -527,6 +529,11 @@ begin
   PageIndex := IndexOf(AValue); // -1 for unpaged
 end;
 
+procedure TCustomTabControl.SetImageListAsync(Data: PtrInt);
+begin
+  DoImageListChange(Self);
+end;
+
 procedure TCustomTabControl.SetImages(const AValue: TCustomImageList);
 begin
   if FImages = AValue then Exit;
@@ -1184,7 +1191,13 @@ end;
 procedure TCustomTabControl.DoImageListChange(Sender: TObject);
 begin
   if HandleAllocated then
-    TWSCustomTabControlClass(WidgetSetClass).SetImageList(Self, Images);
+    TWSCustomTabControlClass(WidgetSetClass).SetImageList(Self, Images.ResolutionForPPI[ImagesWidth, Font.PixelsPerInch]);
 end;
 
+procedure TCustomTabControl.DoImageListDestroyResolutionHandle(
+  Sender: TCustomImageList; AWidth: Integer; AReferenceHandle: TLCLHandle);
+begin
+  TWSCustomTabControlClass(WidgetSetClass).SetImageList(Self, nil);
+  Application.QueueAsyncCall(@SetImageListAsync, 0);
+end;
 

lcl/include/imglist.inc

@@ -766,6 +766,13 @@ begin
   end;
 end;
 
+procedure TCustomImageListResolution.ReferenceDestroying;
+begin
+  inherited ReferenceDestroying;
+
+  FImageList.DoDestroyResolutionReference(FWidth, Reference._Handle);
+end;
+
 procedure TCustomImageListResolution.StretchDraw(Canvas: TCanvas;
   Index: Integer; ARect: TRect; Enabled: Boolean);
 var
@@ -1319,6 +1326,18 @@ begin
   FreeThenNil(FChangeLinkList);
 end;
 
+procedure TCustomImageList.DoDestroyResolutionReference(const AWidth: Integer;
+  AResolutionReference: TLCLHandle);
+var
+  I: Integer;
+begin
+  if FChangeLinkList=nil then
+    Exit;
+  for I := 0 to FChangeLinkList.Count-1 do
+    if TChangeLink(FChangeLinkList[I]).Sender = Self then
+      TChangeLink(FChangeLinkList[I]).DoDestroyResolutionReference(AWidth, AResolutionReference);
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCustomImageList.Draw
   Params:  Canvas: the canvas to draw on
@@ -2279,4 +2298,11 @@ begin
   inherited Destroy;
 end;
 
+procedure TChangeLink.DoDestroyResolutionReference(const AWidth: Integer;
+  AResolutionReference: TLCLHandle);
+begin
+  if Assigned(FOnDestroyResolutionHandle) then
+    FOnDestroyResolutionHandle(FSender, AWidth, AResolutionReference);
+end;
+
 // included by imglist.pp

lcl/interfaces/win32/win32pagecontrol.inc

@@ -644,7 +644,7 @@ begin
 end;
 
 class procedure TWin32WSCustomTabControl.SetImageList(
-  const ATabControl: TCustomTabControl; const AImageList: TCustomImageList);
+  const ATabControl: TCustomTabControl; const AImageList: TCustomImageListResolution);
 begin
   if ATabControl is TTabControl then
     exit;
@@ -653,7 +653,7 @@ begin
     Exit;
 
   if AImageList <> nil then
-    SendMessage(ATabControl.Handle, TCM_SETIMAGELIST, 0, AImageList.ReferenceForPPI[ATabControl.ImagesWidth, ATabControl.Font.PixelsPerInch]._Handle)
+    SendMessage(ATabControl.Handle, TCM_SETIMAGELIST, 0, AImageList.Reference._Handle)
   else
     SendMessage(ATabControl.Handle, TCM_SETIMAGELIST, 0, 0);
   // if you set big images like 32x32 then tabs will be big too => you need to

lcl/interfaces/win32/win32wscomctrls.pp

@@ -72,7 +72,7 @@ type
     class function GetCapabilities: TCTabControlCapabilities; override;
     class function GetDesignInteractive(const AWinControl: TWinControl; AClientPos: TPoint): Boolean; override;
     class procedure SetTabSize(const ATabControl: TCustomTabControl; const ATabWidth, ATabHeight: integer); override;
-    class procedure SetImageList(const ATabControl: TCustomTabControl; const AImageList: TCustomImageList); override;
+    class procedure SetImageList(const ATabControl: TCustomTabControl; const AImageList: TCustomImageListResolution); override;
     class procedure SetPageIndex(const ATabControl: TCustomTabControl; const AIndex: integer); override;
     class procedure SetTabPosition(const ATabControl: TCustomTabControl; const ATabPosition: TTabPosition); override;
     class procedure ShowTabs(const ATabControl: TCustomTabControl; AShowTabs: boolean); override;

lcl/widgetset/wscomctrls.pp

@@ -66,7 +66,7 @@ type
     class function GetTabRect(const ATabControl: TCustomTabControl; const AIndex: Integer): TRect; virtual;
     class function GetCapabilities: TCTabControlCapabilities; virtual;
     class procedure SetTabSize(const ATabControl: TCustomTabControl; const ATabWidth, ATabHeight: integer); virtual;
-    class procedure SetImageList(const ATabControl: TCustomTabControl; const AImageList: TCustomImageList); virtual;
+    class procedure SetImageList(const ATabControl: TCustomTabControl; const AImageList: TCustomImageListResolution); virtual;
     class procedure SetPageIndex(const ATabControl: TCustomTabControl; const AIndex: integer); virtual;
     class procedure SetTabCaption(const ATabControl: TCustomTabControl; const AChild: TCustomPage; const AText: string); virtual;
     class procedure SetTabPosition(const ATabControl: TCustomTabControl; const ATabPosition: TTabPosition); virtual;
@@ -367,7 +367,7 @@ begin
 end;
 
 class procedure TWSCustomTabControl.SetImageList(
-  const ATabControl: TCustomTabControl; const AImageList: TCustomImageList);
+  const ATabControl: TCustomTabControl; const AImageList: TCustomImageListResolution);
 begin
 end;