Merge pull request #150 from bgrabitmap/dev-lazpaint

Dev lazpaint

lazpaint/dialog/ubrowseimages.pas

@@ -10,9 +10,6 @@ interface
   BGRAAnimatedGif, UMySLV, LazPaintType, Masks, LCLType, UFileSystem,
   UImagePreview;
 
-const
-  MaxIconCacheCount = 512;
-
 type
 
   { TFBrowseImages }
@@ -87,6 +84,7 @@   TFBrowseImages = class(TForm)
     FChosenImage: TImageEntry;
     FPreview: TImagePreview;
     FComputeIconCurrentItem: integer;
+    FCacheComputeIconIndexes: array of integer;
     FPreviewFilename: string;
     FInShowPreview,FInHidePreview: boolean;
     FSavedDetailsViewWidth: integer;
@@ -174,10 +172,8 @@ implementation
     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 @@ procedure TFBrowseImages.FormDestroy(Sender: TObject);
 
 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 @@ procedure TFBrowseImages.ShellListView1SelectItem(Sender: TObject; Item: integer
 procedure TFBrowseImages.ShellListView1OnSort(Sender: TObject);
 begin
   FComputeIconCurrentItem := 0;
+  FCacheComputeIconIndexes := nil;
+  StopCaching;
 end;
 
 procedure TFBrowseImages.ShellListView1OnFormatType(Sender: Tobject;
@@ -512,98 +513,83 @@ procedure TFBrowseImages.ShellListView1OnFormatType(Sender: Tobject;
 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 @@ procedure TFBrowseImages.StartThumbnails;
         ShellListView1.SetItemImage(i,FImageFileNotChecked,false);
     end;
   FComputeIconCurrentItem := 0;
+  FCacheComputeIconIndexes := nil;
+  StopCaching;
 end;
 
 procedure TFBrowseImages.SelectCurrentDir;
@@ -1248,15 +1236,5 @@ procedure TFBrowseImages.FreeChosenImage;
   FreeAndNil(FChosenImage.bmp);
 end;
 
-initialization
-
-IconCache := TStringList.Create;
-IconCache.CaseSensitive := true;
-IconCache.OwnsObjects := true;
-
-finalization
-
-IconCache.Free;
-
 end.
 

lazpaint/image/uimage.pas

@@ -464,7 +464,7 @@ function TLazPaintImage.AbleToSaveAsUTF8(AFilename: string): boolean;
   begin
     if (Width > 256) or (Height > 256) then
     begin
-      ShowMessage(rsNotReasonableFormat);
+      ShowMessage(rsNotReasonableFormat + ' (> 256x256)');
       result := false;
     end;
   end;

lazpaint/lazpaint.lpi

@@ -24,9 +24,9 @@
       <UseVersionInfo Value="True"/>
       <MajorVersionNr Value="7"/>
       <MinorVersionNr Value="1"/>
+      <RevisionNr Value="2"/>
       <CharSet Value="04B0"/>
       <StringTable CompanyName="http://sourceforge.net/projects/lazpaint/" ProductName="LazPaint" InternalName="lazpaint" OriginalFilename="lazpaint.exe"/>
-      <RevisionNr Value="1"/>
     </VersionInfo>
     <BuildModes Count="8">
       <Item1 Name="Debug" Default="True"/>
@@ -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 @@
   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/lazpaintembeddedpack.lpk

@@ -26,7 +26,7 @@
         </Debugging>
       </Linking>
     </CompilerOptions>
-    <Version Major="7" Minor="1" Release="1"/>
+    <Version Major="7" Minor="1" Release="2"/>
     <Files Count="94">
       <Item1>
         <Filename Value="lazpaintinstance.pas"/>

lazpaint/lazpaintmainform.pas

@@ -947,7 +947,12 @@ procedure TFMain.FormCreate(Sender: TObject);
   btnLeftDown := false;
   btnRightDown := false;
   btnMiddleDown:= false;
-  FTablet := TLazTablet.Create(self);
+  try
+    FTablet := TLazTablet.Create(self);
+  except
+    on ex: exception do
+      FTablet := nil;
+  end;
   spacePressed:= false;
   altPressed:= false;
   snapPressed:= false;

lazpaint/lazpainttype.pas

@@ -10,7 +10,7 @@ interface
   {$IFDEF LINUX}, InterfaceBase{$ENDIF};
 
 const
-  LazPaintVersion = 7010100;
+  LazPaintVersion = 7010200;
 
   function LazPaintVersionStr: string;
 

lazpaint/release/changelog

@@ -186,3 +186,17 @@ lazpaint (7.1) stable; urgency=low
 
 -- circular <circular@operamail.com>  Fri, 10 Apr 2020 12:07:00 +0100
 
+lazpaint (7.1.2) stable; urgency=low
+
+  * installer: add scripts on Windows
+  * installer: add new extensions on Windows (oXo, cur, jpeg, tif, tga, webp, xpm)
+  * rendering: phong shape undo
+  * rendering: vector layer with selection and transform
+  * rendering: add font kerning for text shape
+  * file browser: load thumbnails in separate thread to prevent freeze
+  * file browser: generate less file extensions to avoid slowdown
+  * crash fixes: skip when matrix transform is invalid
+  * crash fixes: catch tablet initialization error
+
+-- circular <circular@operamail.com>  Fri, 24 Apr 2020 14:19:00 +0100
+

lazpaint/release/debian/linux32/DEBIAN/changelog

@@ -186,3 +186,17 @@ lazpaint (7.1) stable; urgency=low
 
 -- circular <circular@operamail.com>  Fri, 10 Apr 2020 12:07:00 +0100
 
+lazpaint (7.1.2) stable; urgency=low
+
+  * installer: add scripts on Windows
+  * installer: add new extensions on Windows (oXo, cur, jpeg, tif, tga, webp, xpm)
+  * rendering: phong shape undo
+  * rendering: vector layer with selection and transform
+  * rendering: add font kerning for text shape
+  * file browser: load thumbnails in separate thread to prevent freeze
+  * file browser: generate less file extensions to avoid slowdown
+  * crash fixes: skip when matrix transform is invalid
+  * crash fixes: catch tablet initialization error
+
+-- circular <circular@operamail.com>  Fri, 24 Apr 2020 14:19:00 +0100
+

lazpaint/release/debian/linux32/DEBIAN/control

@@ -1,5 +1,5 @@
 Package: lazpaint
-Version: 7.1.1
+Version: 7.1.2
 Section: base
 Priority: optional
 Architecture: i386

lazpaint/release/debian/linux64/DEBIAN/changelog

@@ -186,3 +186,17 @@ lazpaint (7.1) stable; urgency=low
 
 -- circular <circular@operamail.com>  Fri, 10 Apr 2020 12:07:00 +0100
 
+lazpaint (7.1.2) stable; urgency=low
+
+  * installer: add scripts on Windows
+  * installer: add new extensions on Windows (oXo, cur, jpeg, tif, tga, webp, xpm)
+  * rendering: phong shape undo
+  * rendering: vector layer with selection and transform
+  * rendering: add font kerning for text shape
+  * file browser: load thumbnails in separate thread to prevent freeze
+  * file browser: generate less file extensions to avoid slowdown
+  * crash fixes: skip when matrix transform is invalid
+  * crash fixes: catch tablet initialization error
+
+-- circular <circular@operamail.com>  Fri, 24 Apr 2020 14:19:00 +0100
+

lazpaint/release/debian/linux64/DEBIAN/control

@@ -1,5 +1,5 @@
 Package: lazpaint
-Version: 7.1.1
+Version: 7.1.2
 Section: base
 Priority: optional
 Architecture: amd64

lazpaint/release/macOS/LazPaint.app/Contents/Info.plist

@@ -19,9 +19,9 @@
     <key>CFBundleSignature</key>
     <string>lazp</string>
     <key>CFBundleShortVersionString</key>
-    <string>7.1.1</string>
+    <string>7.1.2</string>
     <key>CFBundleVersion</key>
-    <string>7.1.1</string>
+    <string>7.1.2</string>
     <key>CSResourcesFileMapped</key>
     <true/>
     <key>CFBundleDocumentTypes</key>