mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-09 23:35:57 +02:00
lcl: implement imagelist cache to reduce amount of imagelists for bitbtns and speedbuttons
git-svn-id: trunk@12906 -
This commit is contained in:
paul
parent
65035435c1
commit
fd3a23fd89
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -2580,6 +2580,7 @@ lcl/graphmath.pp svneol=native#text/pascal
|
||||
lcl/graphtype.pp svneol=native#text/pascal
|
||||
lcl/grids.pas svneol=native#text/pascal
|
||||
lcl/helpintfs.pas svneol=native#text/plain
|
||||
lcl/imagelistcache.pas svneol=native#text/pascal
|
||||
lcl/images/README.txt svneol=native#text/plain
|
||||
lcl/images/btncalccancel.xpm -text svneol=native#image/x-xpixmap
|
||||
lcl/images/btncalcimg.xpm -text svneol=native#image/x-xpixmap
|
||||
|
||||
@ -40,7 +40,7 @@ interface
|
||||
uses
|
||||
Types, Classes, SysUtils, Math, LCLType, LCLProc, LCLIntf, LCLStrConsts,
|
||||
GraphType, Graphics, ImgList, ActnList, Controls, StdCtrls, LMessages, Forms,
|
||||
Themes, Menus{for ShortCut procedures}, LResources;
|
||||
Themes, Menus{for ShortCut procedures}, LResources, ImageListCache;
|
||||
|
||||
type
|
||||
{ TButton }
|
||||
@ -73,15 +73,26 @@ type
|
||||
|
||||
{ TButtonGlyph }
|
||||
|
||||
TButtonGlyph = class
|
||||
TButtonGlyph = class(TObject, IUnknown, IImageCacheListener)
|
||||
private
|
||||
FImageIndexes: array[TButtonState] of Integer;
|
||||
FImages: TCustomImageList;
|
||||
FOriginal: TBitmap;
|
||||
FNumGlyphs: TNumGlyphs;
|
||||
FOnChange: TNotifyEvent;
|
||||
FImagesCache: TImageListCache;
|
||||
procedure SetGlyph(Value: TBitmap);
|
||||
procedure SetNumGlyphs(Value: TNumGlyphs);
|
||||
protected
|
||||
// IUnknown
|
||||
function QueryInterface(const iid: tguid; out obj): longint; stdcall;
|
||||
function _AddRef: longint; stdcall;
|
||||
function _Release: longint; stdcall;
|
||||
|
||||
// IImageCacheListener
|
||||
procedure CacheSetImageList(AImageList: TCustomImageList);
|
||||
procedure CacheSetImageIndex(AIndex, AImageIndex: Integer);
|
||||
|
||||
procedure GlyphChanged(Sender: TObject);
|
||||
public
|
||||
constructor Create;
|
||||
|
||||
329
lcl/imagelistcache.pas
Normal file
329
lcl/imagelistcache.pas
Normal file
@ -0,0 +1,329 @@
|
||||
{
|
||||
/***************************************************************************
|
||||
ImageListCache.pp
|
||||
----------------
|
||||
Initial Revision : Sun Nov 18 00:04:00 GMT+07 2007
|
||||
|
||||
|
||||
***************************************************************************/
|
||||
|
||||
*****************************************************************************
|
||||
* *
|
||||
* This file is part of the Lazarus Component Library (LCL) *
|
||||
* *
|
||||
* See the file COPYING.modifiedLGPL, included in this distribution, *
|
||||
* for details about the copyright. *
|
||||
* *
|
||||
* This program is distributed in the hope that it will be useful, *
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
}
|
||||
|
||||
unit ImageListCache;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics, ImgList;
|
||||
|
||||
type
|
||||
// interface that cache user should have to listen for cache changes
|
||||
IImageCacheListener = interface
|
||||
procedure CacheSetImageList(AImageList: TCustomImageList);
|
||||
procedure CacheSetImageIndex(AIndex, AImageIndex: Integer);
|
||||
end;
|
||||
|
||||
// cache item
|
||||
TImageCacheItem = record
|
||||
FImageList: TCustomImageList; // link to imagelist
|
||||
FListener: IImageCacheListener; // link to listener
|
||||
FImageIndexes: array of Integer; // indexes of imagelist that listener reserved
|
||||
end;
|
||||
PImageCacheItem = ^TImageCacheItem;
|
||||
|
||||
{ TImageCacheItems }
|
||||
|
||||
TImageCacheItems = class(TList)
|
||||
private
|
||||
function GetItem(AIndex: Integer): PImageCacheItem;
|
||||
function GetItemForListener(AListener: IImageCacheListener): PImageCacheItem;
|
||||
procedure SetItem(AIndex: Integer; const AValue: PImageCacheItem);
|
||||
protected
|
||||
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
|
||||
public
|
||||
function GetNew: PImageCacheItem;
|
||||
property Items[AIndex: Integer]: PImageCacheItem read GetItem write SetItem; default;
|
||||
end;
|
||||
|
||||
{ TImageListCache }
|
||||
|
||||
TImageListCache = class
|
||||
private
|
||||
FItems: TImageCacheItems;
|
||||
FImages: TList;
|
||||
FListeners: TInterfaceList;
|
||||
FObsoletedCount: Integer;
|
||||
procedure CheckRebuildNeed;
|
||||
function GetImageListFor(AWidth, AHeight: Integer): TCustomImageList;
|
||||
|
||||
procedure UnregisterBitmaps(AListener: IImageCacheListener);
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
|
||||
function RegisterListener(AListener: IImageCacheListener): Integer;
|
||||
procedure UnregisterListener(AListener: IImageCacheListener);
|
||||
procedure RegisterBitmap(AListener: IImageCacheListener; ABitmap: TBitmap; ABitmapCount: Integer = 1);
|
||||
procedure Rebuild;
|
||||
end;
|
||||
|
||||
function GetImageListCache: TImageListCache;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
// number of cache changes that can happen w/o rebuild
|
||||
ImageListCacheRebuildThreashold = 1;
|
||||
|
||||
var
|
||||
FImageListCache: TImageListCache = nil;
|
||||
|
||||
function GetImageListCache: TImageListCache;
|
||||
begin
|
||||
if FImageListCache = nil then
|
||||
FImageListCache := TImageListCache.Create;
|
||||
Result := FImageListCache;
|
||||
end;
|
||||
|
||||
|
||||
{ TImageListCache }
|
||||
|
||||
procedure TImageListCache.CheckRebuildNeed;
|
||||
begin
|
||||
if FObsoletedCount >= ImageListCacheRebuildThreashold then
|
||||
Rebuild;
|
||||
end;
|
||||
|
||||
function TImageListCache.GetImageListFor(AWidth, AHeight: Integer): TCustomImageList;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i := 0 to FImages.Count - 1 do
|
||||
if (TCustomImageList(FImages[i]).Height = AHeight) and
|
||||
(TCustomImageList(FImages[i]).Width = AWidth) then
|
||||
begin
|
||||
Result := TCustomImageList(FImages[i]);
|
||||
exit;
|
||||
end;
|
||||
Result := TCustomImageList.Create(nil);
|
||||
FImages.Add(Result);
|
||||
with Result do
|
||||
begin
|
||||
Width := AWidth;
|
||||
Height := AHeight;
|
||||
//WriteLn('Creating new imagelist in cache for Width=',Width,' Height=', Height, ' Count = ', FImages.Count);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TImageListCache.UnregisterBitmaps(AListener: IImageCacheListener);
|
||||
var
|
||||
Item: PImageCacheItem;
|
||||
begin
|
||||
Item := FItems.GetItemForListener(AListener);
|
||||
|
||||
if (Item <> nil) then
|
||||
begin
|
||||
Item^.FListener := nil;
|
||||
inc(FObsoletedCount, Length(Item^.FImageIndexes));
|
||||
end;
|
||||
CheckRebuildNeed;
|
||||
end;
|
||||
|
||||
constructor TImageListCache.Create;
|
||||
begin
|
||||
FObsoletedCount := 0;
|
||||
FItems := TImageCacheItems.Create;
|
||||
FImages := TList.Create;
|
||||
FListeners := TInterfaceList.Create;
|
||||
end;
|
||||
|
||||
destructor TImageListCache.Destroy;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
FItems.Free;
|
||||
for i := 0 to FImages.Count - 1 do
|
||||
TObject(FImages[i]).Free;
|
||||
FImages.Free;
|
||||
FListeners.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TImageListCache.RegisterListener(AListener: IImageCacheListener): Integer;
|
||||
begin
|
||||
Result := FListeners.IndexOf(AListener);
|
||||
if Result = -1 then
|
||||
Result := FListeners.Add(AListener);
|
||||
end;
|
||||
|
||||
procedure TImageListCache.UnregisterListener(AListener: IImageCacheListener);
|
||||
var
|
||||
Index: Integer;
|
||||
begin
|
||||
Index := FListeners.IndexOf(AListener);
|
||||
if Index <> -1 then
|
||||
begin
|
||||
UnregisterBitmaps(AListener);
|
||||
FListeners.Remove(AListener);
|
||||
end;
|
||||
if FListeners.Count = 0 then
|
||||
Free;
|
||||
end;
|
||||
|
||||
procedure TImageListCache.RegisterBitmap(AListener: IImageCacheListener; ABitmap: TBitmap; ABitmapCount: Integer = 1);
|
||||
var
|
||||
i, AStart, OldLen: Integer;
|
||||
Item: PImageCacheItem;
|
||||
begin
|
||||
RegisterListener(AListener);
|
||||
Item := FItems.GetItemForListener(AListener);
|
||||
if Item = nil then
|
||||
begin
|
||||
Item := FItems.GetNew;
|
||||
Item^.FImageList := GetImageListFor(ABitmap.Width div ABitmapCount, ABitmap.Height);
|
||||
Item^.FListener := AListener;
|
||||
end;
|
||||
|
||||
AStart := Item^.FImageList.Add(ABitmap, nil);
|
||||
AListener.CacheSetImageList(Item^.FImageList);
|
||||
OldLen := Length(Item^.FImageIndexes);
|
||||
SetLength(Item^.FImageIndexes, OldLen + Item^.FImageList.Count - AStart);
|
||||
|
||||
for i := AStart to Item^.FImageList.Count - 1 do
|
||||
begin
|
||||
Item^.FImageIndexes[OldLen + i - AStart] := i;
|
||||
AListener.CacheSetImageIndex(OldLen + i - AStart, AStart);
|
||||
end;
|
||||
end;
|
||||
|
||||
// cache rebuild
|
||||
procedure TImageListCache.Rebuild;
|
||||
var
|
||||
i, j, k, ACount: integer;
|
||||
AListener: IImageCacheListener;
|
||||
ADeleted: TBits;
|
||||
AChanged: Boolean;
|
||||
AIndexes: array of Integer;
|
||||
AUpdates: TList;
|
||||
begin
|
||||
// 1. check what items to be deleted (their listerners are not assigned)
|
||||
// 2. delete no more needed images from imagelists
|
||||
// 3. notify listeners about new image indexes
|
||||
|
||||
// traverse all ImageLists
|
||||
for i := 0 to FImages.Count - 1 do
|
||||
begin
|
||||
ACount := TCustomImageList(FImages[i]).Count;
|
||||
ADeleted := TBits.Create(ACount);
|
||||
AChanged := False;
|
||||
AUpdates := TList.Create;
|
||||
// traverse for all items
|
||||
// if item is to be deleted then set flag in ADeleted, else add item to AUpdates array
|
||||
for j := FItems.Count - 1 downto 0 do
|
||||
if FItems[j]^.FImageList = TCustomImageList(FImages[i]) then
|
||||
begin
|
||||
for k := 0 to High(FItems[j]^.FImageIndexes) do
|
||||
ADeleted.Bits[FItems[j]^.FImageIndexes[k]] := FItems[j]^.FListener = nil;
|
||||
if FItems[j]^.FListener = nil then
|
||||
begin
|
||||
FItems.Delete(j);
|
||||
AChanged := True;
|
||||
end
|
||||
else
|
||||
AUpdates.Add(FItems[j]);
|
||||
end;
|
||||
// is something has been deleted from current imagelist then
|
||||
// we continue processing
|
||||
if AChanged then
|
||||
begin
|
||||
// AIndexes is our old=>new image indexes map
|
||||
// at first step we set old=old and at same moment clearing our imagelist
|
||||
SetLength(AIndexes, ACount);
|
||||
for j := High(AIndexes) downto 0 do
|
||||
begin
|
||||
AIndexes[j] := j;
|
||||
if ADeleted[j] then
|
||||
TCustomImageList(FImages[i]).Delete(j);
|
||||
end;
|
||||
// we traversing our indexes map and set new values for old values
|
||||
for j := 0 to High(AIndexes) do
|
||||
if ADeleted[j] then
|
||||
begin
|
||||
for k := j + 1 to High(AIndexes) do
|
||||
dec(AIndexes[k]);
|
||||
end;
|
||||
// all preparation done - we have old=>new map
|
||||
// process all Items that needs to be updated
|
||||
for j := 0 to AUpdates.Count - 1 do
|
||||
begin
|
||||
AListener := PImageCacheItem(AUpdates[j])^.FListener;
|
||||
for k := 0 to High(PImageCacheItem(AUpdates[j])^.FImageIndexes) do
|
||||
begin
|
||||
// update cache item and notify listener
|
||||
PImageCacheItem(AUpdates[j])^.FImageIndexes[k] := AIndexes[PImageCacheItem(AUpdates[j])^.FImageIndexes[k]];
|
||||
AListener.CacheSetImageIndex(k, PImageCacheItem(AUpdates[j])^.FImageIndexes[k]);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
AUpdates.Free;
|
||||
ADeleted.Free;
|
||||
SetLength(AIndexes, 0);
|
||||
end;
|
||||
|
||||
FObsoletedCount := 0;
|
||||
end;
|
||||
|
||||
{ TImageCacheItems }
|
||||
|
||||
function TImageCacheItems.GetItem(AIndex: Integer): PImageCacheItem;
|
||||
begin
|
||||
Result := inherited Get(AIndex)
|
||||
end;
|
||||
|
||||
procedure TImageCacheItems.SetItem(AIndex: Integer;
|
||||
const AValue: PImageCacheItem);
|
||||
begin
|
||||
inherited Put(AIndex, AValue);
|
||||
end;
|
||||
|
||||
procedure TImageCacheItems.Notify(Ptr: Pointer; Action: TListNotification);
|
||||
begin
|
||||
if (Action = lnDeleted) and (Ptr <> nil) then
|
||||
Dispose(PImageCacheItem(Ptr));
|
||||
end;
|
||||
|
||||
function TImageCacheItems.GetNew: PImageCacheItem;
|
||||
begin
|
||||
New(Result);
|
||||
Add(Result);
|
||||
end;
|
||||
|
||||
function TImageCacheItems.GetItemForListener(AListener: IImageCacheListener): PImageCacheItem;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result := nil;
|
||||
for i := 0 to Count - 1 do
|
||||
if Items[i]^.FListener = AListener then
|
||||
begin
|
||||
Result := Items[i];
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -22,7 +22,6 @@ constructor TButtonGlyph.Create;
|
||||
begin
|
||||
FOriginal := TBitmap.Create;
|
||||
FOriginal.OnChange := @GlyphChanged;
|
||||
FImages := TCustomImageList.Create(nil);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -30,38 +29,42 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
destructor TButtonGlyph.Destroy;
|
||||
begin
|
||||
if FImagesCache <> nil then
|
||||
FImagesCache.UnregisterListener(Self);
|
||||
FOriginal.Free;
|
||||
FOriginal := nil;
|
||||
FImages.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TButtonGlyph.GetImageIndexAndEffect(State: TButtonState;
|
||||
var AIndex: Integer; var AEffect: TGraphicsDrawEffect);
|
||||
var
|
||||
AStoredState: TButtonState;
|
||||
begin
|
||||
AIndex := 0;
|
||||
AStoredState := bsUp;
|
||||
AEffect := gdeNormal;
|
||||
case State of
|
||||
bsDisabled:
|
||||
begin
|
||||
if NumGlyphs > 1 then
|
||||
AIndex := 1
|
||||
AStoredState := State
|
||||
else
|
||||
AEffect := gdeDisabled;
|
||||
end;
|
||||
bsDown:
|
||||
begin
|
||||
if NumGlyphs > 2 then
|
||||
AIndex := 2
|
||||
AStoredState := State
|
||||
else
|
||||
AEffect := gdeShadowed;
|
||||
end;
|
||||
bsExclusive:
|
||||
if NumGlyphs > 3 then
|
||||
AIndex := 3
|
||||
AStoredState := State
|
||||
else
|
||||
AEffect := gdeHighlighted;
|
||||
end;
|
||||
AIndex := FImageIndexes[AStoredState];
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -94,12 +97,14 @@ end;
|
||||
|
||||
procedure TButtonGlyph.GlyphChanged(Sender: TObject);
|
||||
begin
|
||||
FImages.Clear;
|
||||
if FImagesCache <> nil then
|
||||
FImagesCache.UnregisterListener(Self);
|
||||
|
||||
if (FOriginal.Width > 0) and (FOriginal.Height > 0) then
|
||||
begin
|
||||
FImages.Width := FOriginal.Width div Max(1, FNumGlyphs);
|
||||
FImages.Height := FOriginal.Height;
|
||||
FImages.Add(FOriginal, nil);
|
||||
FImagesCache := GetImageListCache;
|
||||
FImagesCache.RegisterListener(Self);
|
||||
FImagesCache.RegisterBitmap(Self, FOriginal, Max(1, NumGlyphs));
|
||||
end;
|
||||
|
||||
if Sender = FOriginal then
|
||||
@ -121,7 +126,7 @@ var
|
||||
src_wh, dst_wh: Integer;
|
||||
AEffect: TGraphicsDrawEffect;
|
||||
begin
|
||||
Result:=Client;
|
||||
Result := Client;
|
||||
if (FOriginal = nil) then
|
||||
exit;
|
||||
|
||||
@ -163,7 +168,7 @@ begin
|
||||
FImages.Draw(Canvas, DestRect.Left, DestRect.Top, ImgID, AEffect);
|
||||
|
||||
// ToDo: VCL returns the text rectangle
|
||||
Result:=SrcRect;
|
||||
Result := SrcRect;
|
||||
end;
|
||||
|
||||
|
||||
@ -179,4 +184,33 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TButtonGlyph.QueryInterface(const iid: tguid; out obj): longint; stdcall;
|
||||
begin
|
||||
if GetInterface(iid, obj) then
|
||||
Result := 0
|
||||
else
|
||||
Result := E_NOINTERFACE;
|
||||
end;
|
||||
|
||||
function TButtonGlyph._AddRef: longint; stdcall;
|
||||
begin
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function TButtonGlyph._Release: longint; stdcall;
|
||||
begin
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
procedure TButtonGlyph.CacheSetImageList(AImageList: TCustomImageList);
|
||||
begin
|
||||
FImages := AImageList;
|
||||
end;
|
||||
|
||||
procedure TButtonGlyph.CacheSetImageIndex(AIndex, AImageIndex: Integer);
|
||||
begin
|
||||
if (AIndex >= ord(Low(TButtonState))) and (AIndex <= Ord(High(TButtonState))) then
|
||||
FImageIndexes[TButtonState(AIndex)] := AImageIndex;
|
||||
end;
|
||||
|
||||
// included by buttons.pp
|
||||
|
||||
Loading…
Reference in New Issue
Block a user