image browser: load icons in separate thread

lazpaint/dialog/ubrowseimages.pas

@@ -10,9 +10,6 @@ uses
   BGRAAnimatedGif, UMySLV, LazPaintType, Masks, LCLType, UFileSystem,
   UImagePreview;
 
-const
-  MaxIconCacheCount = 512;
-
 type
 
   { TFBrowseImages }
@@ -87,6 +84,7 @@ type
     FChosenImage: TImageEntry;
     FPreview: TImagePreview;
     FComputeIconCurrentItem: integer;
+    FCacheComputeIconIndexes: array of integer;
     FPreviewFilename: string;
     FInShowPreview,FInHidePreview: boolean;
     FSavedDetailsViewWidth: integer;
@@ -174,10 +172,8 @@ uses BGRAThumbnail, BGRAPaintNet, BGRAOpenRaster, BGRAReadLzp,
     Types, UResourceStrings,
     UConfig, bgrareadjpeg, FPReadJPEG,
     UFileExtensions, BGRAUTF8, LazFileUtils,
-    UGraph, URaw, UDarkTheme, ShellCtrls;
-
-var
-  IconCache: TStringList;
+    UGraph, URaw, UDarkTheme, ShellCtrls,
+    UIconCache;
 
 { TFBrowseImages }
 
@@ -340,6 +336,9 @@ end;
 
 procedure TFBrowseImages.FormHide(Sender: TObject);
 begin
+  FCacheComputeIconIndexes := nil;
+  StopCaching(true);
+
   FLastBigIcon := (ShellListView1.ViewStyle = vsIcon);
   if not IsSaveDialog then FFilename:= FPreviewFilename;
   Timer1.Enabled := false;
@@ -491,6 +490,8 @@ end;
 procedure TFBrowseImages.ShellListView1OnSort(Sender: TObject);
 begin
   FComputeIconCurrentItem := 0;
+  FCacheComputeIconIndexes := nil;
+  StopCaching;
 end;
 
 procedure TFBrowseImages.ShellListView1OnFormatType(Sender: Tobject;
@@ -512,98 +513,83 @@ begin
 end;
 
 procedure TFBrowseImages.Timer1Timer(Sender: TObject);
-var i: integer;
-  iconRect,shellRect:TRect;
-  endDate: TDateTime;
-
-  function DetermineIcon(i: integer): boolean;
-  var itemPath,cacheName,dummyCaption: string;
-    cacheIndex: integer;
-    found: boolean;
-    mem: TMemoryStream;
-    s: TStream;
+const MaxCacheComputeCount = 10;
+var
+  bmpIcon: TBGRABitmap;
+  iconRect, shellRect:TRect;
+  i,j,cacheComputeCount: Integer;
+  newFilenames: array of string;
+  newLastModifications: array of TDateTime;
+begin
+  Timer1.Enabled:= false;
+  if FPreview.Filename <> FPreviewFilename then
+    UpdatePreview
+  else
+    FPreview.HandleTimer;
+
+  if not IsCacheBusy and (length(FCacheComputeIconIndexes) > 0) then
   begin
-    result := false;
-    if ShellListView1.GetItemImage(i) = FImageFileNotChecked then
+    //retrieve computed icons
+    for i := 0 to high(FCacheComputeIconIndexes) do
     begin
-      if ShellListView1.ItemIsFolder[i] then
-        ShellListView1.SetItemImage(i,FImageFolder,false)
-      else
+      j := FCacheComputeIconIndexes[i];
+      if ShellListView1.GetItemImage(j) = FImageFileNotChecked then
       begin
-        itemPath := ShellListView1.ItemFullName[i];
-        cacheName := itemPath+':'+FloatToStr(ShellListView1.ItemLastModification[i]);
-        cacheIndex := IconCache.IndexOf(cacheName);
-        if not Assigned(FBmpIcon) then FBmpIcon := TBGRABitmap.Create;
-        if cacheIndex <> -1 then
-        begin
-          TStream(IconCache.Objects[cacheIndex]).Position:= 0;
-          TBGRAReaderLazPaint.LoadRLEImage(TStream(IconCache.Objects[cacheIndex]),FBmpIcon,dummyCaption);
-          found := true;
-        end
+        bmpIcon := GetCachedIcon(ShellListView1.ItemFullName[j],
+                                 ShellListView1.ItemLastModification[j],
+                                 FImageFileUnkown);
+        if Assigned(bmpIcon) then
+          ShellListView1.SetItemImage(j, bmpIcon, bmpIcon <> FImageFileUnkown)
         else
-        begin
-          try
-            s := FileManager.CreateFileStream(itemPath, fmOpenRead or fmShareDenyWrite);
-            try
-              if IsRawFilename(itemPath) then
-              begin
-                found := GetRawStreamThumbnail(s,ShellListView1.LargeIconSize,ShellListView1.LargeIconSize, BGRAPixelTransparent, True, FBmpIcon) <> nil;
-              end else
-                found := GetStreamThumbnail(s,ShellListView1.LargeIconSize,ShellListView1.LargeIconSize, BGRAPixelTransparent, True, ExtractFileExt(itemPath), FBmpIcon) <> nil;
-            finally
-              s.Free;
-            end;
-          except
-            found := false;
-          end;
-          if found then
-          begin
-            if IconCache.Count >= MaxIconCacheCount then IconCache.Delete(0);
-            mem := TMemoryStream.Create;
-            TBGRAWriterLazPaint.WriteRLEImage(mem,FBmpIcon);
-            IconCache.AddObject(cacheName,mem);
-          end;
-        end;
-        if found then
-        begin
-          ShellListView1.SetItemImage(i,FBmpIcon.Duplicate as TBGRABitmap,True);
-        end else
-          ShellListView1.SetItemImage(i,FImageFileUnkown,False);
+          if j <  FComputeIconCurrentItem then
+            FComputeIconCurrentItem := j;
       end;
-      result := true;
     end;
+    FCacheComputeIconIndexes := nil;
   end;
 
-var someIconDone: boolean;
-
-begin
-  Timer1.Enabled:= false;
-  EndDate := Now + 50 / MSecsPerDay;
-  if FPreview.Filename <> FPreviewFilename then
-    UpdatePreview
-  else
-    FPreview.HandleTimer;
-  if FComputeIconCurrentItem < ShellListView1.ItemCount then
+  if not IsCacheBusy and (FComputeIconCurrentItem < ShellListView1.ItemCount) then
   begin
-    vsList.Cursor := crAppStart;
+    //queue icons to compute
+    setlength(FCacheComputeIconIndexes, MaxCacheComputeCount);
+    cacheComputeCount := 0;
+
+    //compute icons for visible items
     shellRect := rect(0,0,ShellListView1.Width,ShellListView1.Height);
-    someIconDone := false;
     for i := FComputeIconCurrentItem to ShellListView1.ItemCount-1 do
     if ShellListView1.GetItemImage(i) = FImageFileNotChecked then
-    If Now >= EndDate then break else
     begin
       iconRect := ShellListView1.ItemDisplayRect[i];
-      if IntersectRect(iconRect,iconRect,shellRect) then
-        if DetermineIcon(i) then someIconDone := true;
+      if IntersectRect(iconRect, iconRect, shellRect) then
+      begin
+        FCacheComputeIconIndexes[cacheComputeCount] := i;
+        inc(cacheComputeCount);
+        if cacheComputeCount = MaxCacheComputeCount then break;
+      end;
     end;
-    if not someIconDone then EndDate := Now + 50 / MSecsPerDay;
-    for i := FComputeIconCurrentItem to ShellListView1.ItemCount-1 do
-    If Now >= EndDate then break else
+
+    //compute icons in current display order
+    while (FComputeIconCurrentItem < ShellListView1.ItemCount-1)
+      and (cacheComputeCount < MaxCacheComputeCount) do
+    begin
+      if ShellListView1.GetItemImage(FComputeIconCurrentItem) = FImageFileNotChecked then
+      begin
+        FCacheComputeIconIndexes[cacheComputeCount] := FComputeIconCurrentItem;
+        inc(cacheComputeCount);
+      end;
+      inc(FComputeIconCurrentItem);
+    end;
+
+    setlength(FCacheComputeIconIndexes, cacheComputeCount);
+    setlength(newFilenames, cacheComputeCount);
+    setlength(newLastModifications, cacheComputeCount);
+    for i := 0 to cacheComputeCount-1 do
     begin
-      FComputeIconCurrentItem := i+1;
-      DetermineIcon(i);
+      j := FCacheComputeIconIndexes[i];
+      newFilenames[i] := ShellListView1.ItemFullName[j];
+      newLastModifications[i] := ShellListView1.ItemLastModification[j];
     end;
-    vsList.Cursor := crDefault;
+    AddToCache(newFilenames, newLastModifications, ShellListView1.LargeIconSize);
   end;
   vsList.SetBounds(vsList.Left, vsList.Top, Panel2.Width, Panel2.Height-Panel3.Height);
   ShellListView1.Update;
@@ -916,6 +902,8 @@ begin
         ShellListView1.SetItemImage(i,FImageFileNotChecked,false);
     end;
   FComputeIconCurrentItem := 0;
+  FCacheComputeIconIndexes := nil;
+  StopCaching;
 end;
 
 procedure TFBrowseImages.SelectCurrentDir;
@@ -1248,15 +1236,5 @@ begin
   FreeAndNil(FChosenImage.bmp);
 end;
 
-initialization
-
-IconCache := TStringList.Create;
-IconCache.CaseSensitive := true;
-IconCache.OwnsObjects := true;
-
-finalization
-
-IconCache.Free;
-
 end.
 

lazpaint/lazpaint.lpi

@@ -350,7 +350,7 @@
         <PackageName Value="LCL"/>
       </Item5>
     </RequiredPackages>
-    <Units Count="105">
+    <Units Count="106">
       <Unit0>
         <Filename Value="lazpaint.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -968,6 +968,11 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="UImageBackup"/>
       </Unit104>
+      <Unit105>
+        <Filename Value="uiconcache.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="UIconCache"/>
+      </Unit105>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

lazpaint/lazpaint.lpr

@@ -40,7 +40,7 @@ uses
   URainType, UFormRain, UPaletteToolbar, uselectionhighlight,
   UImagePreview, UPreviewDialog, UQuestion, UTiff, UImageView,
   UDarkTheme, URaw, UProcessAuto, UPython, UImageBackup, ULayerStackInterface,
-  UChooseColorInterface;
+  UChooseColorInterface, UIconCache;
 
 //sometimes LResources disappear in the uses clause
 

lazpaint/uiconcache.pas

@@ -0,0 +1,170 @@
+unit UIconCache;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, BGRABitmap;
+
+procedure AddToCache(AFilenames: array of string; ALastModifications: array of TDateTime;
+          AIconSize: integer);
+function GetCachedIcon(AFilename: string; ALastModification: TDateTime; AInvalidIcon: TBGRABitmap): TBGRABitmap;
+procedure StopCaching(AWait: boolean = false);
+function IsCacheBusy: boolean;
+
+implementation
+
+uses URaw, BGRAThumbnail, UFileSystem, BGRAReadLzp, BGRABitmapTypes, BGRAWriteLzp;
+
+const
+  MaxIconCacheCount = 512;
+
+type
+
+  { TIconCacheThread }
+
+  TIconCacheThread = class(TThread)
+  private
+    FFilenames: array of string;
+    FLastModifications: array of TDateTime;
+    FIconSize: integer;
+  public
+    constructor Create(AFilenames: array of string;
+      ALastModifications: array of TDateTime; AIconSize: integer);
+    procedure Execute; override;
+  end;
+
+var
+  IconCache: TStringList;
+  IconCacheInvalid: TStringList;
+  CacheThread: TIconCacheThread;
+
+procedure AddToCache(AFilenames: array of string;
+  ALastModifications: array of TDateTime; AIconSize: integer);
+begin
+  if IsCacheBusy then
+    raise exception.Create('Cache is busy');
+  FreeAndNil(CacheThread);
+  CacheThread := TIconCacheThread.Create(AFilenames, ALastModifications, AIconSize);
+end;
+
+function GetCachedIcon(AFilename: string; ALastModification: TDateTime; AInvalidIcon: TBGRABitmap): TBGRABitmap;
+var
+  cacheName, dummyCaption: String;
+  cacheIndex: Integer;
+begin
+  if IsCacheBusy then exit(nil);
+  cacheName := AFilename+':'+FloatToStr(ALastModification);
+  cacheIndex := IconCache.IndexOf(cacheName);
+  if cacheIndex <> -1 then
+  begin
+    TStream(IconCache.Objects[cacheIndex]).Position:= 0;
+    result := TBGRABitmap.Create;
+    TBGRAReaderLazPaint.LoadRLEImage(TStream(IconCache.Objects[cacheIndex]), result, dummyCaption);
+    exit;
+  end else
+  if IconCacheInvalid.IndexOf(cacheName) <> -1 then
+    exit(AInvalidIcon)
+  else
+    exit(nil);
+end;
+
+procedure StopCaching(AWait: boolean);
+begin
+  if Assigned(CacheThread) then
+  begin
+    CacheThread.Terminate;
+    if AWait then CacheThread.WaitFor;
+  end;
+end;
+
+function IsCacheBusy: boolean;
+begin
+  result := Assigned(CacheThread) and not CacheThread.Finished;
+end;
+
+{ TIconCacheThread }
+
+constructor TIconCacheThread.Create(AFilenames: array of string;
+  ALastModifications: array of TDateTime; AIconSize: integer);
+var
+  i: Integer;
+begin
+  if length(AFilenames)<>length(ALastModifications) then
+    raise exception.Create('Array size mismatch');
+  setlength(FFilenames, length(AFilenames));
+  setlength(FLastModifications, length(FFilenames));
+  for i := 0 to high(FFilenames) do
+  begin
+    FFilenames[i] := AFilenames[i];
+    FLastModifications[i] := ALastModifications[i];
+  end;
+  FIconSize := AIconSize;
+
+  inherited Create(False);
+end;
+
+procedure TIconCacheThread.Execute;
+var
+  i, cacheIndex: Integer;
+  cacheName: String;
+  bmpIcon: TBGRABitmap;
+  found: Boolean;
+  s: TStream;
+  mem: TMemoryStream;
+  endTime: TDateTime;
+begin
+  bmpIcon := TBGRABitmap.Create;
+  endTime := Now + 150/MSecsPerDay;
+  for i := 0 to high(FFilenames) do
+  begin
+    if Terminated or (Now > endTime) then break;
+    cacheName := FFilenames[i] + ':' + FloatToStr(FLastModifications[i]);
+    cacheIndex := IconCache.IndexOf(cacheName);
+    if cacheIndex <> -1 then Continue;
+    try
+      s := FileManager.CreateFileStream(FFilenames[i], fmOpenRead or fmShareDenyWrite);
+      try
+        if IsRawFilename(FFilenames[i]) then
+        begin
+          found := GetRawStreamThumbnail(s, FIconSize, FIconSize, BGRAPixelTransparent,
+                                         True, bmpIcon) <> nil;
+        end else
+          found := GetStreamThumbnail(s, FIconSize, FIconSize, BGRAPixelTransparent,
+                                         True, ExtractFileExt(FFilenames[i]), bmpIcon) <> nil;
+      finally
+        s.Free;
+      end;
+    except
+      found := false;
+    end;
+    if found then
+    begin
+      if IconCache.Count >= MaxIconCacheCount then IconCache.Delete(0);
+      mem := TMemoryStream.Create;
+      TBGRAWriterLazPaint.WriteRLEImage(mem, bmpIcon);
+      IconCache.AddObject(cacheName, mem); //mem owned by IconCache
+    end else
+      IconCacheInvalid.Add(cacheName);
+  end;
+  bmpIcon.Free;
+end;
+
+
+initialization
+
+  IconCache := TStringList.Create;
+  IconCache.CaseSensitive := true;
+  IconCache.OwnsObjects := true;
+  IconCacheInvalid := TStringList.Create;
+  IconCacheInvalid.CaseSensitive := true;
+
+finalization
+
+  StopCaching(true);
+  CacheThread.Free;
+  IconCacheInvalid.Free;
+  IconCache.Free;
+
+end.

lazpaint/uraw.pas

@@ -58,6 +58,9 @@ implementation
 
 uses process, BGRAThumbnail, UResourceStrings, UFileSystem, Forms, LazFileUtils;
 
+var
+  RawCriticalSection: TRTLCriticalSection;
+
 function GetAllRawExtensions: string;
 var
   i: Integer;
@@ -83,12 +86,18 @@ begin
   tempName := '';
   p := nil;
   try
-    tempName := GetTempFileName;
-    s := TFileStream.Create(tempName, fmCreate);
+
+    EnterCriticalsection(RawCriticalSection);
     try
-      s.CopyFrom(AInputStream, AInputStream.Size);
+      tempName := GetTempFileName;
+      s := TFileStream.Create(tempName, fmCreate);
+      try
+        s.CopyFrom(AInputStream, AInputStream.Size);
+      finally
+        s.Free;
+      end;
     finally
-      s.Free;
+      LeaveCriticalsection(RawCriticalSection);
     end;
 
     p := TProcess.Create(nil);
@@ -218,6 +227,11 @@ end;
 initialization
 
   AllRawExtensions := GetAllRawExtensions;
+  InitCriticalSection(RawCriticalSection);
+
+finalization
+
+  DoneCriticalsection(RawCriticalSection);
 
 end.