ソースを参照

Fix cover assignment: avoid PNG handle creation by loading TLazIntfImage into TImage.Picture.Bitmap

- Replaced Png.Assign + Picture.Assign with Bitmap.LoadFromIntfImage\n- Addresses 'Failed to create handles' when applying covers on some systems
Codex CLI 4 ヶ月 前
コミット
89dd2ef1fa
4 ファイル変更77 行追加12 行削除
  1. 32 9
      src/book.pas
  2. 5 0
      src/bookcollection.pas
  3. 35 3
      src/main.pas
  4. 5 0
      src/unitCoverWorker.pas

+ 32 - 9
src/book.pas

@@ -53,7 +53,7 @@ procedure SetPdfCoverGenerationEnabled(AEnabled: Boolean);
 
 implementation
 
-uses UnitBookDialog, Forms, unitAppEvents;
+uses UnitBookDialog, Forms, unitAppEvents, unitLog;
 
 procedure TBook.OpenEditDialogAsync({%H-}Data: PtrInt);
 var
@@ -91,6 +91,15 @@ end;
 {------------------------------------------------------------------------------}
 procedure TBook.BookCoverPaint(Sender: TObject);
 begin
+  // Trace paints to diagnose missing covers
+  try
+    LogDebugFmt('CoverPaint: visible=%s size=%dx%d hasGraphic=%s fp="%s" img="%s"',
+      [BoolToStr(mCover.Visible, True), mCover.Width, mCover.Height,
+       BoolToStr(Assigned(mCover.Picture) and Assigned(mCover.Picture.Graphic) and (not mCover.Picture.Graphic.Empty), True),
+       mFilePath, mImagePath]);
+  except
+  end;
+
   if mIsSelected then
   begin
     mCover.Canvas.Brush.Style := bsClear;
@@ -156,7 +165,6 @@ var
   SrcImg: TLazIntfImage;
   Img : TLazIntfImage;
   Canvas: TLazCanvas;
-  Png : TPortableNetworkGraphic;
   dstW, dstH, offX, offY: Integer;
   scale: Double;
   W, H: Integer;
@@ -169,8 +177,8 @@ begin
   W := mCover.Width;  H := mCover.Height;
   if (W <= 0) or (H <= 0) then
   begin
-    // fallback: honor the common 130x250 default
-    W := 130; H := 250;
+    // fallback: match app default 130x200
+    W := 130; H := 200;
     mCover.Width := W; mCover.Height := H;
   end;
 
@@ -179,7 +187,6 @@ begin
     SrcImg := TLazIntfImage.Create(0, 0);
     Img := TLazIntfImage.Create(W, H);
     Canvas := TLazCanvas.Create(Img);
-    Png := TPortableNetworkGraphic.Create;
     try
       try
         SrcImg.LoadFromFile(AValue);
@@ -194,24 +201,31 @@ begin
           dstH := Round(SrcImg.Height * scale);
           offX := (W - dstW) div 2;
           offY := (H - dstH) div 2;
+          // BUGFIX: draw source image (not the destination buffer)
           Canvas.StretchDraw(offX, offY, dstW, dstH, SrcImg);
+          LogDebugFmt('SetImage: src=%dx%d scale=%.3f dst=%dx%d off=%dx%d',
+            [SrcImg.Width, SrcImg.Height, scale, dstW, dstH, offX, offY]);
         end;
 
         // No runtime scaling anymore; we drew at target size
         mCover.Stretch := False;
         mCover.Center  := False;
         mCover.AutoSize:= False;
-
-        Png.Assign(Img);
-        mCover.Picture.Assign(Png);
+        // Assign via Bitmap to avoid PNG handle creation issues
+        if Assigned(mCover.Picture) then
+        begin
+          mCover.Picture.Bitmap.SetSize(W, H);
+          mCover.Picture.Bitmap.LoadFromIntfImage(Img);
+        end;
         mImagePath := AValue;
         mScaledW := W; mScaledH := H;
+        LogInfoFmt('SetImage: applied image "%s" target=%dx%d', [mImagePath, W, H]);
         Exit;
       except
         // fall through to generic on any failure
+        on E: Exception do LogErrorFmt('SetImage: failed to load "%s": %s', [AValue, E.Message]);
       end;
     finally
-      Png.Free;
       Canvas.Free;
       Img.Free;
       SrcImg.Free;
@@ -221,6 +235,7 @@ begin
   // Generic fallback
   mCover.Stretch := True;
   mCover.Picture.LoadFromLazarusResource('generic_cover');
+  LogWarn('SetImage: using generic cover');
 end;
 
 {------------------------------------------------------------------------------}
@@ -229,7 +244,14 @@ end;
 procedure TBook.EnsureScaledToCoverSize;
 begin
   if (mImagePath <> '') and ((mScaledW <> mCover.Width) or (mScaledH <> mCover.Height)) then
+  begin
+    LogInfoFmt('EnsureScaledToCoverSize: rescaling from %dx%d to %dx%d for "%s"',
+      [mScaledW, mScaledH, mCover.Width, mCover.Height, mImagePath]);
     SetImage(mImagePath);
+  end
+  else
+    LogDebugFmt('EnsureScaledToCoverSize: no-op (scaled=%dx%d, cover=%dx%d, hasImage=%s)',
+      [mScaledW, mScaledH, mCover.Width, mCover.Height, BoolToStr(mImagePath<>'', True)]);
 end;
 
 {------------------------------------------------------------------------------}
@@ -239,6 +261,7 @@ procedure TBook.SetFile(AValue: String);
 begin
   if mFilePath = AValue then Exit;
   mFilePath := AValue;
+  LogInfoFmt('SetFile: "%s"', [AValue]);
 
   // If a cover image was already chosen (manually or previously set), don't override it
   if Trim(mImagePath) <> '' then Exit;

+ 5 - 0
src/bookcollection.pas

@@ -70,6 +70,11 @@ End;
 
 procedure TBookCollection.Remove(Book: TBook);
 begin
+  if book <> nil then
+  begin
+    CoverWorkerRemoveBook(book);
+    CoverWorkerUnregisterBook(book);
+  end;
   mList.Remove(book);
 end;
 

+ 35 - 3
src/main.pas

@@ -7,7 +7,7 @@ interface
 uses
   Classes, Sysutils, Fileutil, Forms, Controls, Graphics, Dialogs, ExtCtrls, LazFileUtils,
   Book, BookCollection, LCLIntf, LResources, StdCtrls, LCLType, IniFiles, unitSettingsDialog,
-  unitCoverWorker, unitStorageXML, unitMetadata, unitAppEvents, LazUTF8;
+  unitCoverWorker, unitStorageXML, unitMetadata, unitAppEvents, unitLog, LazUTF8;
 
 
 type
@@ -53,6 +53,8 @@ type
     procedure ApplyFilterAndLayout;
     function AppConfigPath: String;
     procedure SaveBooksNow;
+    procedure ScheduleSaveBooks; // debounced autosave
+    procedure SaveTimerTick(Sender: TObject);
   public
     { public declarations }
   end;
@@ -67,6 +69,7 @@ var
   coverWidth, coverHeight: Integer;
   optCopyBooks, optRenameBooks, optExtractMeta: Boolean;
   isClosing: Boolean = False;
+  SaveTimer: TTimer;
 
 
 
@@ -104,6 +107,26 @@ begin
   end;
 end;
 
+procedure TForm1.ScheduleSaveBooks;
+begin
+  if isClosing then Exit;
+  if SaveTimer = nil then
+  begin
+    SaveTimer := TTimer.Create(Self);
+    SaveTimer.Enabled := False;
+    SaveTimer.Interval := 400; // debounce writes
+    SaveTimer.OnTimer := @SaveTimerTick;
+  end;
+  SaveTimer.Enabled := False;
+  SaveTimer.Enabled := True;
+end;
+
+procedure TForm1.SaveTimerTick(Sender: TObject);
+begin
+  if SaveTimer <> nil then SaveTimer.Enabled := False;
+  SaveBooksNow;
+end;
+
 procedure TForm1.PanelBackgroundClick({%H-}Sender: TObject);
 begin
  ActiveControl:=PanelBackground;
@@ -135,6 +158,10 @@ procedure TForm1.PanelBackgroundPaint({%H-}Sender: TObject);
 var w,h:Integer;
     x,y:Integer;
 begin
+  // Trace tile painting (not cover drawing)
+  try
+    LogDebugFmt('PanelBackgroundPaint: canvas=%dx%d', [PanelBackground.Canvas.Width, PanelBackground.Canvas.Height]);
+  except end;
   // Safety: if no tile or invalid size, skip custom painting
   if (backgroundTile = nil) or (backgroundTile.Width <= 0) or (backgroundTile.Height <= 0) then
     Exit;
@@ -186,6 +213,7 @@ var
       end;
     end;
     countVisible := Length(visibleCovers);
+    LogInfoFmt('Layout: %d/%d covers visible', [countVisible, bookList.Count]);
   end;
 
   // Can we fit N items with at least minGap spacing including left+right margins?
@@ -251,6 +279,10 @@ begin
         cover := visibleCovers[k];
         cover.Left := Round(x);
         cover.Top  := curY;
+        try
+          LogDebugFmt('Layout place: idx=%d pos=(%d,%d) size=%dx%d visible=%s',
+            [k, cover.Left, cover.Top, cover.Width, cover.Height, BoolToStr(cover.Visible, True)]);
+        except end;
         x := x + coverWidth + gap;
       end;
 
@@ -564,8 +596,8 @@ begin
 
  bookList:=TBookCollection.Create;
 
-  // Register autosave callback for book edits
-  OnBooksChanged := @SaveBooksNow;
+  // Register autosave callback for book edits (debounced)
+  OnBooksChanged := @ScheduleSaveBooks;
 
   // speed up startup: we skipped synchronous PDF generation during load
   SetPdfCoverGenerationEnabled(False);

+ 5 - 0
src/unitCoverWorker.pas

@@ -387,5 +387,10 @@ finalization
     GPdfQueue.Free;
     GPdfQueue := nil;
   end;
+  if GAliveBooks <> nil then
+  begin
+    GAliveBooks.Free;
+    GAliveBooks := nil;
+  end;
 
 end.