diff --git a/lcl/comctrls.pp b/lcl/comctrls.pp index aaa3260823..a7647804a8 100644 --- a/lcl/comctrls.pp +++ b/lcl/comctrls.pp @@ -33,9 +33,9 @@ uses // LazUtils LazUTF8, LazUTF8Classes, // LCL - LCLStrConsts, LResources, LCLIntf, LCLType, LMessages, WSLCLClasses, LCLProc, - GraphType, Graphics, ImgList, ActnList, Themes, Menus, Controls, Forms, - StdCtrls, ExtCtrls, ToolWin, Buttons; + LCLStrConsts, LResources, LCLIntf, LCLType, LMessages, WSLCLClasses, + WSReferences, LCLProc, GraphType, Graphics, ImgList, ActnList, Themes, Menus, + 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; diff --git a/lcl/imglist.pp b/lcl/imglist.pp index 2c15b95eb2..a6547ef993 100644 --- a/lcl/imglist.pp +++ b/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; diff --git a/lcl/include/customlistview.inc b/lcl/include/customlistview.inc index d5dbae9a58..c3db024dd7 100644 --- a/lcl/include/customlistview.inc +++ b/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) ; @@ -800,8 +801,11 @@ end; procedure TCustomListView.QueuedShowEditor(Data: PtrInt); begin - fShowEditorQueued:=false; - ShowEditor; + if fShowEditorQueued then + begin + fShowEditorQueued:=false; + ShowEditor; + end; end; procedure TCustomListView.DblClick; @@ -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 - Application.QueueAsyncCall(@QueuedShowEditor,0) - else - Application.RemoveAsyncCalls(Self); + if FShowEditorQueued then + Application.QueueAsyncCall(@QueuedShowEditor,0); 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 diff --git a/lcl/include/customnotebook.inc b/lcl/include/customnotebook.inc index 7aae0409df..f8e2fe6f50 100644 --- a/lcl/include/customnotebook.inc +++ b/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; diff --git a/lcl/include/imglist.inc b/lcl/include/imglist.inc index a50c857639..d54d2d28a9 100644 --- a/lcl/include/imglist.inc +++ b/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 diff --git a/lcl/interfaces/win32/win32pagecontrol.inc b/lcl/interfaces/win32/win32pagecontrol.inc index d084923bf0..c1d9b5b3c5 100644 --- a/lcl/interfaces/win32/win32pagecontrol.inc +++ b/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 diff --git a/lcl/interfaces/win32/win32wscomctrls.pp b/lcl/interfaces/win32/win32wscomctrls.pp index 5a25ac979d..e763ee40c9 100644 --- a/lcl/interfaces/win32/win32wscomctrls.pp +++ b/lcl/interfaces/win32/win32wscomctrls.pp @@ -69,10 +69,10 @@ type class function GetNotebookMinTabWidth(const AWinControl: TWinControl): integer; override; class function GetTabIndexAtPos(const ATabControl: TCustomTabControl; const AClientPos: TPoint): integer; override; class function GetTabRect(const ATabControl: TCustomTabControl; const AIndex: Integer): TRect; override; - class function GetCapabilities: TCTabControlCapabilities;override; + 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; diff --git a/lcl/widgetset/wscomctrls.pp b/lcl/widgetset/wscomctrls.pp index f7d5568e57..46c2a1fe78 100644 --- a/lcl/widgetset/wscomctrls.pp +++ b/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;