1
0

book.pas 9.6 KB

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