book.pas 9.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318
  1. unit Book;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils, Graphics, ExtCtrls, Controls, LCLIntf, LResources, Process,
  6. Math, IntfGraphics, FPImage, FPReadPNG, FPReadJPEG, GraphType, LazCanvas,
  7. FileUtil, LazJPG;
  8. type
  9. { TBook }
  10. TBook = class(TObject)
  11. private
  12. mTitle : String;
  13. mAuthors : String;
  14. mISBN : String;
  15. mFilePath : String;
  16. mImagePath : String; // original image path (or '')
  17. mCover : TImage;
  18. mIsSelected : Boolean;
  19. mScaledW : Integer; // last pre-scale width we rendered for
  20. mScaledH : Integer; // last pre-scale height we rendered for
  21. procedure SetFile(AValue: String);
  22. procedure SetImage(AValue: String);
  23. function TryGenerateCoverFromPDF(const PdfPath: String): String;
  24. public
  25. constructor Create(Parent: TComponent);
  26. destructor Destroy; override;
  27. procedure BookMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  28. procedure BookDoubleClick(Sender: TObject);
  29. procedure BookCoverPaint(Sender: TObject);
  30. // Call this after you change mCover.Width/Height (layout/resizes)
  31. procedure EnsureScaledToCoverSize;
  32. property Title : String read mTitle write mTitle;
  33. property Authors : String read mAuthors write mAuthors;
  34. property ISBN : String read mISBN write mISBN;
  35. property FilePath : String read mFilePath write SetFile;
  36. property ImagePath : String read mImagePath write SetImage;
  37. property Cover : TImage read mCover;
  38. property IsSelected: Boolean read mIsSelected write mIsSelected;
  39. end;
  40. // Allow main code to temporarily disable PDF cover extraction (e.g., during startup load)
  41. procedure SetPdfCoverGenerationEnabled(AEnabled: Boolean);
  42. implementation
  43. var
  44. gPdfCoverEnabled: Boolean = True;
  45. procedure SetPdfCoverGenerationEnabled(AEnabled: Boolean);
  46. begin
  47. gPdfCoverEnabled := AEnabled;
  48. end;
  49. {------------------------------------------------------------------------------}
  50. { Helper: try to render first page of a PDF into a PNG using Poppler }
  51. {------------------------------------------------------------------------------}
  52. function TBook.TryGenerateCoverFromPDF(const PdfPath: String): String;
  53. var
  54. Proc: TProcess;
  55. OutBase, Converter: String;
  56. SrcImg: TLazIntfImage;
  57. Img: TLazIntfImage;
  58. Canvas: TLazCanvas;
  59. Png: TPortableNetworkGraphic;
  60. scale: Double;
  61. dstW, dstH, offX, offY, W, H: Integer;
  62. begin
  63. Result := '';
  64. if not gPdfCoverEnabled then Exit;
  65. // look for pdftoppm in PATH (Poppler utilities)
  66. Converter := FindDefaultExecutablePath('pdftoppm');
  67. if Converter = '' then
  68. Exit; // tool not available, keep default behavior
  69. OutBase := ChangeFileExt(PdfPath, ''); // e.g., /path/book.pdf -> /path/book
  70. Proc := TProcess.Create(nil);
  71. try
  72. Proc.Executable := Converter;
  73. // pdftoppm -png -singlefile -f 1 -l 1 <pdf> <out_base>
  74. Proc.Parameters.Add('-png');
  75. Proc.Parameters.Add('-singlefile');
  76. Proc.Parameters.Add('-f'); Proc.Parameters.Add('1');
  77. Proc.Parameters.Add('-l'); Proc.Parameters.Add('1');
  78. Proc.Parameters.Add(PdfPath);
  79. Proc.Parameters.Add(OutBase);
  80. Proc.Options := [poWaitOnExit];
  81. Proc.ShowWindow := swoHIDE;
  82. Proc.Execute;
  83. finally
  84. Proc.Free;
  85. end;
  86. if FileExists(OutBase + '.png') then
  87. begin
  88. Result := OutBase + '.png';
  89. // Scale down to current cover size
  90. W := mCover.Width;
  91. H := mCover.Height;
  92. if (W > 0) and (H > 0) then
  93. begin
  94. SrcImg := TLazIntfImage.Create(0, 0);
  95. Img := TLazIntfImage.Create(W, H);
  96. Canvas := TLazCanvas.Create(Img);
  97. Png := TPortableNetworkGraphic.Create;
  98. try
  99. SrcImg.LoadFromFile(Result);
  100. Img.FillPixels(colTransparent);
  101. if (SrcImg.Width > 0) and (SrcImg.Height > 0) then
  102. begin
  103. scale := Min(W / SrcImg.Width, H / SrcImg.Height);
  104. if scale > 1 then scale := 1;
  105. dstW := Round(SrcImg.Width * scale);
  106. dstH := Round(SrcImg.Height * scale);
  107. offX := (W - dstW) div 2;
  108. offY := (H - dstH) div 2;
  109. Canvas.StretchDraw(offX, offY, dstW, dstH, SrcImg);
  110. end;
  111. Png.Assign(Img);
  112. Png.SaveToFile(Result);
  113. finally
  114. Png.Free;
  115. Canvas.Free;
  116. Img.Free;
  117. SrcImg.Free;
  118. end;
  119. end;
  120. end;
  121. end;
  122. {------------------------------------------------------------------------------}
  123. { Basic painting: selection outline }
  124. {------------------------------------------------------------------------------}
  125. procedure TBook.BookCoverPaint(Sender: TObject);
  126. begin
  127. if mIsSelected then
  128. begin
  129. mCover.Canvas.Brush.Style := bsClear;
  130. mCover.Canvas.Pen.Width := 4;
  131. mCover.Canvas.Pen.Color := clRed;
  132. mCover.Canvas.RoundRect(1, 1, mCover.Width - 1, mCover.Height - 1, 10, 10);
  133. end;
  134. end;
  135. {------------------------------------------------------------------------------}
  136. { Mouse handlers (hook up in constructor) }
  137. {------------------------------------------------------------------------------}
  138. procedure TBook.BookMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  139. begin
  140. // You likely toggle selection elsewhere; keep this stub or wire to a callback
  141. end;
  142. procedure TBook.BookDoubleClick(Sender: TObject);
  143. begin
  144. // Open file / details dialog etc. (your existing logic)
  145. end;
  146. {------------------------------------------------------------------------------}
  147. { Pre-scale loader: draw once into a bitmap matching the control size }
  148. {------------------------------------------------------------------------------}
  149. procedure TBook.SetImage(AValue: String);
  150. var
  151. SrcImg: TLazIntfImage;
  152. Img : TLazIntfImage;
  153. Canvas: TLazCanvas;
  154. Png : TPortableNetworkGraphic;
  155. dstW, dstH, offX, offY: Integer;
  156. scale: Double;
  157. W, H: Integer;
  158. begin
  159. // Default state
  160. mImagePath := '';
  161. mScaledW := 0; mScaledH := 0;
  162. // Ensure we have a sensible target size (layout usually sets this)
  163. W := mCover.Width; H := mCover.Height;
  164. if (W <= 0) or (H <= 0) then
  165. begin
  166. // fallback: honor the common 130x250 default
  167. W := 130; H := 250;
  168. mCover.Width := W; mCover.Height := H;
  169. end;
  170. if (AValue <> '') and FileExists(AValue) then
  171. begin
  172. SrcImg := TLazIntfImage.Create(0, 0);
  173. Img := TLazIntfImage.Create(W, H);
  174. Canvas := TLazCanvas.Create(Img);
  175. Png := TPortableNetworkGraphic.Create;
  176. try
  177. try
  178. SrcImg.LoadFromFile(AValue);
  179. Img.FillPixels(colTransparent);
  180. if (SrcImg.Width > 0) and (SrcImg.Height > 0) then
  181. begin
  182. scale := Min(W / SrcImg.Width, H / SrcImg.Height);
  183. if scale > 1 then scale := 1; // avoid upscale
  184. dstW := Round(SrcImg.Width * scale);
  185. dstH := Round(SrcImg.Height * scale);
  186. offX := (W - dstW) div 2;
  187. offY := (H - dstH) div 2;
  188. Canvas.StretchDraw(offX, offY, dstW, dstH, SrcImg);
  189. end;
  190. // No runtime scaling anymore; we drew at target size
  191. mCover.Stretch := False;
  192. mCover.Center := False;
  193. mCover.AutoSize:= False;
  194. Png.Assign(Img);
  195. mCover.Picture.Assign(Png);
  196. mImagePath := AValue;
  197. mScaledW := W; mScaledH := H;
  198. Exit;
  199. except
  200. // fall through to generic on any failure
  201. end;
  202. finally
  203. Png.Free;
  204. Canvas.Free;
  205. Img.Free;
  206. SrcImg.Free;
  207. end;
  208. end;
  209. // Generic fallback
  210. mCover.Stretch := True;
  211. mCover.Picture.LoadFromLazarusResource('generic_cover');
  212. end;
  213. {------------------------------------------------------------------------------}
  214. { EnsureScaledToCoverSize: re-render if size changed since last pre-scale }
  215. {------------------------------------------------------------------------------}
  216. procedure TBook.EnsureScaledToCoverSize;
  217. begin
  218. if (mImagePath <> '') and ((mScaledW <> mCover.Width) or (mScaledH <> mCover.Height)) then
  219. SetImage(mImagePath);
  220. end;
  221. {------------------------------------------------------------------------------}
  222. { File setter: try sibling .png/.jpg, then PDF first-page render if needed }
  223. {------------------------------------------------------------------------------}
  224. procedure TBook.SetFile(AValue: String);
  225. var
  226. ext, gen: String;
  227. begin
  228. if mFilePath = AValue then Exit;
  229. mFilePath := AValue;
  230. // first try sibling images
  231. SetImage(ChangeFileExt(AValue, '.png'));
  232. if mImagePath = '' then
  233. SetImage(ChangeFileExt(AValue, '.jpg'));
  234. // if still no image and it's a PDF, try to generate one
  235. ext := LowerCase(ExtractFileExt(AValue));
  236. if (mImagePath = '') and (ext = '.pdf') then
  237. begin
  238. gen := TryGenerateCoverFromPDF(AValue);
  239. if gen <> '' then
  240. SetImage(gen);
  241. end;
  242. end;
  243. {------------------------------------------------------------------------------}
  244. { Lifecycle }
  245. {------------------------------------------------------------------------------}
  246. constructor TBook.Create(Parent: TComponent);
  247. begin
  248. inherited Create;
  249. mTitle := '';
  250. mAuthors := '';
  251. mISBN := '';
  252. mFilePath := '';
  253. mImagePath := '';
  254. mIsSelected := False;
  255. mScaledW := 0;
  256. mScaledH := 0;
  257. mCover := TImage.Create(Parent);
  258. if Parent is TWinControl then
  259. mCover.Parent := TWinControl(Parent);
  260. // Desired default control size
  261. mCover.Width := 130;
  262. mCover.Height := 250;
  263. // Interactions & visuals
  264. mCover.Stretch := True;
  265. mCover.OnPaint := @BookCoverPaint;
  266. mCover.OnMouseDown := @BookMouseDown;
  267. mCover.OnDblClick := @BookDoubleClick;
  268. mCover.Cursor := crHandPoint;
  269. // default image
  270. mCover.Picture.LoadFromLazarusResource('generic_cover');
  271. end;
  272. destructor TBook.Destroy;
  273. begin
  274. FreeAndNil(mCover);
  275. inherited Destroy;
  276. end;
  277. end.