From fd3a23fd89b830f4562ce97b3197c96a6cf13941 Mon Sep 17 00:00:00 2001 From: paul Date: Sat, 17 Nov 2007 17:08:58 +0000 Subject: [PATCH] lcl: implement imagelist cache to reduce amount of imagelists for bitbtns and speedbuttons git-svn-id: trunk@12906 - --- .gitattributes | 1 + lcl/buttons.pp | 15 +- lcl/imagelistcache.pas | 329 ++++++++++++++++++++++++++++++++++++ lcl/include/buttonglyph.inc | 58 +++++-- 4 files changed, 389 insertions(+), 14 deletions(-) create mode 100644 lcl/imagelistcache.pas diff --git a/.gitattributes b/.gitattributes index 28a0b7a73b..5519b0cf92 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/lcl/buttons.pp b/lcl/buttons.pp index 912db262c4..c811c0f031 100644 --- a/lcl/buttons.pp +++ b/lcl/buttons.pp @@ -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; diff --git a/lcl/imagelistcache.pas b/lcl/imagelistcache.pas new file mode 100644 index 0000000000..6ca765dad2 --- /dev/null +++ b/lcl/imagelistcache.pas @@ -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. + diff --git a/lcl/include/buttonglyph.inc b/lcl/include/buttonglyph.inc index e4771cbb4b..ebfee0c164 100644 --- a/lcl/include/buttonglyph.inc +++ b/lcl/include/buttonglyph.inc @@ -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