Jelajahi Sumber

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 bulan lalu
induk
melakukan
89dd2ef1fa
4 mengubah file dengan 77 tambahan dan 12 penghapusan
  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
 implementation
 
 
-uses UnitBookDialog, Forms, unitAppEvents;
+uses UnitBookDialog, Forms, unitAppEvents, unitLog;
 
 
 procedure TBook.OpenEditDialogAsync({%H-}Data: PtrInt);
 procedure TBook.OpenEditDialogAsync({%H-}Data: PtrInt);
 var
 var
@@ -91,6 +91,15 @@ end;
 {------------------------------------------------------------------------------}
 {------------------------------------------------------------------------------}
 procedure TBook.BookCoverPaint(Sender: TObject);
 procedure TBook.BookCoverPaint(Sender: TObject);
 begin
 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
   if mIsSelected then
   begin
   begin
     mCover.Canvas.Brush.Style := bsClear;
     mCover.Canvas.Brush.Style := bsClear;
@@ -156,7 +165,6 @@ var
   SrcImg: TLazIntfImage;
   SrcImg: TLazIntfImage;
   Img : TLazIntfImage;
   Img : TLazIntfImage;
   Canvas: TLazCanvas;
   Canvas: TLazCanvas;
-  Png : TPortableNetworkGraphic;
   dstW, dstH, offX, offY: Integer;
   dstW, dstH, offX, offY: Integer;
   scale: Double;
   scale: Double;
   W, H: Integer;
   W, H: Integer;
@@ -169,8 +177,8 @@ begin
   W := mCover.Width;  H := mCover.Height;
   W := mCover.Width;  H := mCover.Height;
   if (W <= 0) or (H <= 0) then
   if (W <= 0) or (H <= 0) then
   begin
   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;
     mCover.Width := W; mCover.Height := H;
   end;
   end;
 
 
@@ -179,7 +187,6 @@ begin
     SrcImg := TLazIntfImage.Create(0, 0);
     SrcImg := TLazIntfImage.Create(0, 0);
     Img := TLazIntfImage.Create(W, H);
     Img := TLazIntfImage.Create(W, H);
     Canvas := TLazCanvas.Create(Img);
     Canvas := TLazCanvas.Create(Img);
-    Png := TPortableNetworkGraphic.Create;
     try
     try
       try
       try
         SrcImg.LoadFromFile(AValue);
         SrcImg.LoadFromFile(AValue);
@@ -194,24 +201,31 @@ begin
           dstH := Round(SrcImg.Height * scale);
           dstH := Round(SrcImg.Height * scale);
           offX := (W - dstW) div 2;
           offX := (W - dstW) div 2;
           offY := (H - dstH) div 2;
           offY := (H - dstH) div 2;
+          // BUGFIX: draw source image (not the destination buffer)
           Canvas.StretchDraw(offX, offY, dstW, dstH, SrcImg);
           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;
         end;
 
 
         // No runtime scaling anymore; we drew at target size
         // No runtime scaling anymore; we drew at target size
         mCover.Stretch := False;
         mCover.Stretch := False;
         mCover.Center  := False;
         mCover.Center  := False;
         mCover.AutoSize:= 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;
         mImagePath := AValue;
         mScaledW := W; mScaledH := H;
         mScaledW := W; mScaledH := H;
+        LogInfoFmt('SetImage: applied image "%s" target=%dx%d', [mImagePath, W, H]);
         Exit;
         Exit;
       except
       except
         // fall through to generic on any failure
         // fall through to generic on any failure
+        on E: Exception do LogErrorFmt('SetImage: failed to load "%s": %s', [AValue, E.Message]);
       end;
       end;
     finally
     finally
-      Png.Free;
       Canvas.Free;
       Canvas.Free;
       Img.Free;
       Img.Free;
       SrcImg.Free;
       SrcImg.Free;
@@ -221,6 +235,7 @@ begin
   // Generic fallback
   // Generic fallback
   mCover.Stretch := True;
   mCover.Stretch := True;
   mCover.Picture.LoadFromLazarusResource('generic_cover');
   mCover.Picture.LoadFromLazarusResource('generic_cover');
+  LogWarn('SetImage: using generic cover');
 end;
 end;
 
 
 {------------------------------------------------------------------------------}
 {------------------------------------------------------------------------------}
@@ -229,7 +244,14 @@ end;
 procedure TBook.EnsureScaledToCoverSize;
 procedure TBook.EnsureScaledToCoverSize;
 begin
 begin
   if (mImagePath <> '') and ((mScaledW <> mCover.Width) or (mScaledH <> mCover.Height)) then
   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);
     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;
 end;
 
 
 {------------------------------------------------------------------------------}
 {------------------------------------------------------------------------------}
@@ -239,6 +261,7 @@ procedure TBook.SetFile(AValue: String);
 begin
 begin
   if mFilePath = AValue then Exit;
   if mFilePath = AValue then Exit;
   mFilePath := AValue;
   mFilePath := AValue;
+  LogInfoFmt('SetFile: "%s"', [AValue]);
 
 
   // If a cover image was already chosen (manually or previously set), don't override it
   // If a cover image was already chosen (manually or previously set), don't override it
   if Trim(mImagePath) <> '' then Exit;
   if Trim(mImagePath) <> '' then Exit;

+ 5 - 0
src/bookcollection.pas

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

+ 35 - 3
src/main.pas

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

+ 5 - 0
src/unitCoverWorker.pas

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