testfppdf.lpr 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874
  1. { This program generates a multi-page PDF document and tests various
  2. functionality on each of the pages.
  3. You can also specify to generate single pages by using the -p <n>
  4. command line parameter.
  5. eg: testfppdf -p 1
  6. testfppdf -p 2
  7. Use -h to see more command line parameter options.
  8. }
  9. program testfppdf;
  10. {$mode objfpc}{$H+}
  11. {$codepage utf8}
  12. uses
  13. {$ifdef unix}cwstring,{$endif} // required for UnicodeString handling.
  14. classes,
  15. sysutils,
  16. custapp,
  17. fpimage,
  18. fpreadjpeg,
  19. fppdf,
  20. fpparsettf,
  21. fpttf,
  22. typinfo;
  23. type
  24. TPDFTestApp = class(TCustomApplication)
  25. private
  26. FPage: integer;
  27. FRawJPEG,
  28. FImageCompression,
  29. FTextCompression,
  30. FFontCompression: boolean;
  31. FNoFontEmbedding: boolean;
  32. FDoc: TPDFDocument;
  33. function SetUpDocument: TPDFDocument;
  34. procedure SaveDocument(D: TPDFDocument);
  35. procedure EmptyPage;
  36. procedure SimpleText(D: TPDFDocument; APage: integer);
  37. procedure SimpleLinesRaw(D: TPDFDocument; APage: integer);
  38. procedure SimpleLines(D: TPDFDocument; APage: integer);
  39. procedure SimpleImage(D: TPDFDocument; APage: integer);
  40. procedure SimpleShapes(D: TPDFDocument; APage: integer);
  41. procedure AdvancedShapes(D: TPDFDocument; APage: integer);
  42. procedure SampleMatrixTransform(D: TPDFDocument; APage: integer);
  43. procedure SampleLandscape(D: TPDFDocument; APage: integer);
  44. procedure TextInABox(const APage: TPDFPage; const AX, AY: TPDFFloat; const APointSize: integer; const ABoxColor: TARGBColor; const AFontName: string; const AText: UTF8String);
  45. protected
  46. procedure DoRun; override;
  47. public
  48. procedure WriteHelp;
  49. end;
  50. var
  51. Application: TPDFTestApp;
  52. const
  53. cPageCount: integer = 8;
  54. function TPDFTestApp.SetUpDocument: TPDFDocument;
  55. var
  56. P: TPDFPage;
  57. S: TPDFSection;
  58. i: integer;
  59. lPageCount: integer;
  60. lOpts: TPDFOptions;
  61. begin
  62. Result := TPDFDocument.Create(Nil);
  63. Result.Infos.Title := Application.Title;
  64. Result.Infos.Author := 'Graeme Geldenhuys';
  65. Result.Infos.Producer := 'fpGUI Toolkit 1.4.1';
  66. Result.Infos.ApplicationName := ApplicationName;
  67. Result.Infos.CreationDate := Now;
  68. lOpts := [poPageOriginAtTop];
  69. if FNoFontEmbedding then
  70. Include(lOpts, poNoEmbeddedFonts);
  71. if FFontCompression then
  72. Include(lOpts, poCompressFonts);
  73. if FTextCompression then
  74. Include(lOpts,poCompressText);
  75. if FImageCompression then
  76. Include(lOpts,poCompressImages);
  77. if FRawJPEG then
  78. Include(lOpts,poUseRawJPEG);
  79. Result.Options := lOpts;
  80. Result.StartDocument;
  81. S := Result.Sections.AddSection; // we always need at least one section
  82. lPageCount := cPageCount;
  83. if FPage <> -1 then
  84. lPageCount := 1;
  85. for i := 1 to lPageCount do
  86. begin
  87. P := Result.Pages.AddPage;
  88. P.PaperType := ptA4;
  89. P.UnitOfMeasure := uomMillimeters;
  90. S.AddPage(P); // Add the Page to the Section
  91. end;
  92. end;
  93. procedure TPDFTestApp.SaveDocument(D : TPDFDocument);
  94. var
  95. F: TFileStream;
  96. begin
  97. F := TFileStream.Create('test.pdf',fmCreate);
  98. try
  99. D.SaveToStream(F);
  100. Writeln('Document used ',D.ObjectCount,' PDF objects/commands');
  101. finally
  102. F.Free;
  103. end;
  104. end;
  105. procedure TPDFTestApp.EmptyPage;
  106. var
  107. D: TPDFDocument;
  108. begin
  109. D := SetupDocument;
  110. try
  111. SaveDocument(D);
  112. finally
  113. D.Free;
  114. end;
  115. end;
  116. { all units of measure are in millimeters }
  117. procedure TPDFTestApp.SimpleText(D: TPDFDocument; APage: integer);
  118. var
  119. P : TPDFPage;
  120. FtTitle, FtText1, FtText2, FtText3: integer;
  121. begin
  122. P := D.Pages[APage];
  123. // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
  124. FtTitle := D.AddFont('Helvetica');
  125. FtText1 := D.AddFont('FreeSans.ttf', 'FreeSans');
  126. FtText2 := D.AddFont('Times-BoldItalic');
  127. // FtText3 := D.AddFont('arial.ttf', 'Arial');
  128. FtText3 := FtText1; // to reduce font dependecies, but above works too if you have arial.ttf available
  129. { Page title }
  130. P.SetFont(FtTitle, 23);
  131. P.SetColor(clBlack, false);
  132. P.WriteText(25, 20, 'Sample Text');
  133. // -----------------------------------
  134. // Write text using PDF standard fonts
  135. P.SetFont(FtTitle, 12);
  136. P.SetColor(clBlue, false);
  137. P.WriteText(25, 50, '(25mm,50mm) Helvetica: The quick brown fox jumps over the lazy dog.');
  138. P.SetColor(clBlack, false);
  139. P.WriteText(25, 57, 'Click the URL: http://www.freepascal.org');
  140. P.AddExternalLink(54, 58, 49, 5, 'http://www.freepascal.org', false);
  141. // rotated text
  142. P.SetColor(clBlue, false);
  143. P.WriteText(25, 100, 'Rotated text at 30 degrees', 30);
  144. P.SetFont(ftText2,16);
  145. P.SetColor($C00000, false);
  146. P.WriteText(50, 100, '(50mm,100mm) Times-BoldItalic: Big text at absolute position');
  147. // -----------------------------------
  148. // TrueType testing purposes
  149. P.SetFont(ftText3, 13);
  150. P.SetColor(clBlack, false);
  151. P.WriteText(15, 120, 'Languages: English: Hello, World!');
  152. P.WriteText(40, 130, 'Greek: Γειά σου κόσμος');
  153. P.WriteText(40, 140, 'Polish: Witaj świecie');
  154. P.WriteText(40, 150, 'Portuguese: Olá mundo');
  155. P.WriteText(40, 160, 'Russian: Здравствуйте мир');
  156. P.WriteText(40, 170, 'Vietnamese: Xin chào thế giới');
  157. P.SetFont(ftText1, 13);
  158. P.WriteText(15, 185, 'Box Drawing: ╠ ╣ ╦ ╩ ├ ┤ ┬ ┴');
  159. P.WriteText(15, 200, 'Typography: “What’s wrong?”');
  160. P.WriteText(40, 210, '£17.99 vs £17·99');
  161. P.WriteText(40, 220, '€17.99 vs €17·99');
  162. P.WriteText(40, 230, 'OK then… (êçèûÎÐð£¢ß) \\//{}()#<>');
  163. P.WriteText(25, 280, 'B субботу двадцать третьего мая приезжает твоя любимая теща.');
  164. { draw a rectangle around the text }
  165. TextInABox(P, 25, 255, 23, clRed, 'FreeSans', '“Text in a Box gyj?”');
  166. { lets make a hyperlink more prominent }
  167. TextInABox(P, 100, 255, 12, clMagenta, 'FreeSans', 'http://www.freepascal.org');
  168. P.AddExternalLink(99, 255, 49, 5, 'http://www.freepascal.org', false);
  169. end;
  170. procedure TPDFTestApp.SimpleLinesRaw(D: TPDFDocument; APage: integer);
  171. var
  172. P: TPDFPage;
  173. FtTitle: integer;
  174. lPt1, lPt2: TPDFCoord;
  175. begin
  176. P:=D.Pages[APage];
  177. // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
  178. FtTitle := D.AddFont('Helvetica');
  179. { Page title }
  180. P.SetFont(FtTitle,23);
  181. P.SetColor(clBlack, False);
  182. P.WriteText(25, 20, 'Sample Line Drawing (DrawLine)');
  183. P.SetColor(clBlack, True);
  184. P.SetPenStyle(ppsSolid);
  185. lPt1.X := 30; lPt1.Y := 100;
  186. lPt2.X := 150; lPt2.Y := 150;
  187. P.DrawLine(lPt1, lPt2, 0.2);
  188. P.SetColor(clBlue, True);
  189. P.SetPenStyle(ppsDash);
  190. lPt1.X := 50; lPt1.Y := 70;
  191. lPt2.X := 180; lPt2.Y := 100;
  192. P.DrawLine(lPt1, lPt2, 0.1);
  193. { we can also use coordinates directly, without TPDFCoord variables }
  194. P.SetColor(clRed, True);
  195. P.SetPenStyle(ppsDashDot);
  196. P.DrawLine(40, 140, 160, 80, 1);
  197. P.SetColor(clBlack, True);
  198. P.SetPenStyle(ppsDashDotDot);
  199. P.DrawLine(60, 50, 60, 120, 1.5);
  200. P.SetColor(clBlack, True);
  201. P.SetPenStyle(ppsDot);
  202. P.DrawLine(10, 80, 130, 130, 0.5);
  203. end;
  204. procedure TPDFTestApp.SimpleLines(D: TPDFDocument; APage: integer);
  205. var
  206. P: TPDFPage;
  207. FtTitle: integer;
  208. TsThinBlack, TsThinBlue, TsThick, TsThinRed, TsThinBlackDot: Integer;
  209. lPt1, lPt2: TPDFCoord;
  210. begin
  211. P:=D.Pages[APage];
  212. // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
  213. FtTitle := D.AddFont('Helvetica');
  214. { Page title }
  215. P.SetFont(FtTitle,23);
  216. P.SetColor(clBlack, false);
  217. P.WriteText(25, 20, 'Sample Line Drawing (DrawLineStyle)');
  218. // write the text at position 100 mm from left and 120 mm from top
  219. TsThinBlack := D.AddLineStyleDef(0.2, clBlack, ppsSolid);
  220. TsThinBlue := D.AddLineStyleDef(0.1, clBlue, ppsDash);
  221. TsThinRed := D.AddLineStyleDef(1, clRed, ppsDashDot);
  222. TsThick := D.AddLineStyleDef(1.5, clBlack, ppsDashDotDot);
  223. TsThinBlackDot := D.AddLineStyleDef(0.5, clBlack, ppsDot);
  224. lPt1.X := 30; lPt1.Y := 100;
  225. lPt2.X := 150; lPt2.Y := 150;
  226. P.DrawLineStyle(lPt1, lPt2, tsThinBlack);
  227. lPt1.X := 50; lPt1.Y := 70;
  228. lPt2.X := 180; lPt2.Y := 100;
  229. P.DrawLineStyle(lPt1, lPt2, tsThinBlue);
  230. { we can also use coordinates directly, without TPDFCoord variables }
  231. P.DrawLineStyle(40, 140, 160, 80, tsThinRed);
  232. P.DrawLineStyle(60, 50, 60, 120, tsThick);
  233. P.DrawLineStyle(10, 80, 130, 130, tsThinBlackDot);
  234. end;
  235. procedure TPDFTestApp.SimpleImage(D: TPDFDocument; APage: integer);
  236. Var
  237. P: TPDFPage;
  238. FtTitle: integer;
  239. IDX: Integer;
  240. W, H: Integer;
  241. begin
  242. P := D.Pages[APage];
  243. // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
  244. FtTitle := D.AddFont('Helvetica');
  245. { Page title }
  246. P.SetFont(FtTitle,23);
  247. P.SetColor(clBlack, false);
  248. P.WriteText(25, 20, 'Sample Image Support');
  249. P.SetFont(FtTitle,10);
  250. P.SetColor(clBlack, false);
  251. IDX := D.Images.AddFromFile('poppy.jpg',False);
  252. W := D.Images[IDX].Width;
  253. H := D.Images[IDX].Height;
  254. { full size image }
  255. P.DrawImageRawSize(25, 130, W, H, IDX); // left-bottom coordinate of image
  256. P.WriteText(145, 90, '[Full size (defined in pixels)]');
  257. { quarter size image }
  258. P.DrawImageRawSize(25, 190, W shr 1, H shr 1, IDX); // could also have used: Integer(W div 2), Integer(H div 2)
  259. P.WriteText(85, 180, '[Quarter size (defined in pixels)]');
  260. { rotated image }
  261. P.DrawImageRawSize(150, 190, W shr 1, H shr 1, IDX, 30);
  262. { scalled image to 2x2 centimeters }
  263. P.DrawImage(25, 230, 20.0, 20.0, IDX); // left-bottom coordinate of image
  264. P.WriteText(50, 220, '[2x2 cm scaled image]');
  265. { rotatedd image }
  266. P.DrawImage(120, 230, 20.0, 20.0, IDX, 30);
  267. end;
  268. procedure TPDFTestApp.SimpleShapes(D: TPDFDocument; APage: integer);
  269. var
  270. P: TPDFPage;
  271. FtTitle: integer;
  272. lPt1: TPDFCoord;
  273. lPoints: array of TPDFCoord;
  274. i: integer;
  275. lLineWidth: TPDFFloat;
  276. begin
  277. P:=D.Pages[APage];
  278. // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
  279. FtTitle := D.AddFont('Helvetica');
  280. { Page title }
  281. P.SetFont(FtTitle,23);
  282. P.SetColor(clBlack);
  283. P.WriteText(25, 20, 'Basic Shapes');
  284. // ========== Rectangles ============
  285. { PDF origin coordinate is Bottom-Left. }
  286. lPt1.X := 30;
  287. lPt1.Y := 75;
  288. P.SetColor($c00000, true);
  289. P.SetColor(clLtGray, false);
  290. P.DrawRect(lPt1.X, lPt1.Y, 40, 20, 3, true, true);
  291. lPt1.X := 20;
  292. lPt1.Y := 65;
  293. P.SetColor(clBlue, true);
  294. P.SetColor($ffff80, false); // pastel yellow
  295. P.DrawRect(lPt1.X, lPt1.Y, 40, 20, 1, true, true);
  296. P.SetPenStyle(ppsDashDot);
  297. P.SetColor(clBlue, true);
  298. P.DrawRect(110, 75, 40, 20, 1, false, true);
  299. P.SetPenStyle(ppsDash);
  300. P.SetColor($37b344, true); // some green color
  301. P.DrawRect(100, 70, 40, 20, 2, false, true);
  302. P.SetPenStyle(ppsSolid);
  303. P.SetColor($c00000, true);
  304. P.DrawRect(90, 65, 40, 20, 4, false, true);
  305. P.SetPenStyle(ppsSolid);
  306. P.SetColor(clBlack, true);
  307. P.DrawRect(170, 75, 30, 15, 1, false, true, 30);
  308. // ========== Rounded Rectangle ===========
  309. lPt1.X := 30;
  310. lPt1.Y := 120;
  311. P.SetColor($c00000, true);
  312. P.SetColor(clLtGray, false);
  313. P.DrawRoundedRect(lPt1.X, lPt1.Y, 40, 20, 5, 2, true, true);
  314. lPt1.X := 20;
  315. lPt1.Y := 110;
  316. P.SetColor(clBlue, true);
  317. P.SetColor($ffff80, false); // pastel yellow
  318. P.DrawRoundedRect(lPt1.X, lPt1.Y, 40, 20, 2.4, 1, true, true);
  319. P.SetPenStyle(ppsDashDot);
  320. P.SetColor(clBlue, true);
  321. P.DrawRoundedRect(110, 120, 40, 20, 1.5, 1, false, true);
  322. P.SetPenStyle(ppsDash);
  323. P.SetColor($37b344, true); // some green color
  324. P.DrawRoundedRect(100, 115, 40, 20, 3, 2, false, true);
  325. P.SetPenStyle(ppsSolid);
  326. P.SetColor($c00000, true);
  327. P.DrawRoundedRect(90, 110, 40, 20, 5, 3, false, true);
  328. P.SetPenStyle(ppsSolid);
  329. P.SetColor(clBlack, true);
  330. P.DrawRoundedRect(170, 120, 30, 15, 5, 1, false, true, 30);
  331. // ========== Ellipses ============
  332. P.SetPenStyle(ppsSolid);
  333. P.SetColor($c00000, True);
  334. P.DrawEllipse(60, 150, -40, 20, 3, False, True);
  335. lPt1.X := 60;
  336. lPt1.Y := 150;
  337. P.SetColor(clBlue, true);
  338. P.SetColor($ffff80, false); // pastel yellow
  339. P.DrawEllipse(lPt1, 10, 10, 1, True, True);
  340. P.SetPenStyle(ppsDashDot);
  341. P.SetColor($b737b3, True);
  342. P.DrawEllipse(73, 150, 10, 20, 1, False, True);
  343. P.SetPenStyle(ppsSolid);
  344. P.SetColor(clBlack, True);
  345. P.DrawEllipse(170, 150, 30, 15, 1, False, True, 30);
  346. // ========== Lines Pen Styles ============
  347. lLineWidth := 1;
  348. P.SetPenStyle(ppsSolid, lLineWidth);
  349. P.SetColor(clBlack, True);
  350. P.DrawLine(30, 170, 70, 170, lLineWidth);
  351. P.SetPenStyle(ppsDash, lLineWidth);
  352. P.SetColor(clBlack, True);
  353. P.DrawLine(30, 175, 70, 175, lLineWidth);
  354. P.SetPenStyle(ppsDot, lLineWidth);
  355. P.SetColor(clBlack, True);
  356. P.DrawLine(30, 180, 70, 180, lLineWidth);
  357. P.SetPenStyle(ppsDashDot, lLineWidth);
  358. P.SetColor(clBlack, True);
  359. P.DrawLine(30, 185, 70, 185, lLineWidth);
  360. P.SetPenStyle(ppsDashDotDot, lLineWidth);
  361. P.SetColor(clBlack, True);
  362. P.DrawLine(30, 190, 70, 190, lLineWidth);
  363. // ========== Line Attribute ============
  364. P.SetPenStyle(ppsSolid);
  365. P.SetColor(clBlack, True);
  366. P.DrawLine(100, 170, 140, 170, 0.2);
  367. P.DrawLine(100, 175, 140, 175, 0.3);
  368. P.DrawLine(100, 180, 140, 180, 0.5);
  369. P.DrawLine(100, 185, 140, 185, 1);
  370. P.SetColor(clRed, True);
  371. P.DrawLine(100, 190, 140, 190, 2);
  372. P.SetColor($37b344, True);
  373. P.DrawLine(100, 195, 140, 195, 3);
  374. P.SetColor(clBlue, True);
  375. P.DrawLine(100, 200, 140, 200, 4);
  376. P.SetColor($b737b3, True);
  377. P.DrawLine(100, 205, 140, 205, 5);
  378. // ========== PolyLines and Polygons ============
  379. P.Matrix.SetYTranslation(70);
  380. P.Matrix.SetXTranslation(20);
  381. P.SetPenStyle(ppsSolid);
  382. P.SetColor(clBlack, true);
  383. P.DrawRect(0, 10, 50, -50, 1, false, true);
  384. P.SetColor($c00000, true);
  385. P.ResetPath;
  386. SetLength(lPoints, 10);
  387. for i := 0 to 9 do
  388. begin
  389. lPoints[i].X := Random(50);
  390. lPoints[i].Y := Random(50) + 10.5;
  391. end;
  392. P.DrawPolyLine(lPoints, 1);
  393. P.StrokePath;
  394. P.Matrix.SetXTranslation(80);
  395. P.SetPenStyle(ppsSolid);
  396. P.SetColor(clBlack, true);
  397. P.DrawRect(0, 10, 50, -50, 1, false, true);
  398. P.SetColor($ffff80, false); // pastel yellow
  399. P.SetColor(clBlue, true);
  400. P.ResetPath;
  401. P.DrawPolygon(lPoints, 1);
  402. P.FillStrokePath;
  403. p.SetPenStyle(ppsSolid);
  404. P.SetFont(FtTitle, 8);
  405. P.SetColor(clBlack, false);
  406. P.WriteText(0, 8, 'Fill using the nonzero winding number rule');
  407. P.Matrix.SetXTranslation(140);
  408. P.SetPenStyle(ppsSolid);
  409. P.SetColor(clBlack, true);
  410. P.DrawRect(0, 10, 50, -50, 1, false, true);
  411. P.SetColor($ffff80, false); // pastel yellow
  412. P.SetColor(clBlue, true);
  413. P.ResetPath;
  414. P.DrawPolygon(lPoints, 1);
  415. P.FillEvenOddStrokePath;
  416. p.SetPenStyle(ppsSolid);
  417. P.SetFont(FtTitle, 8);
  418. P.SetColor(clBlack, false);
  419. P.WriteText(0, 8, 'Fill using the even-odd rule');
  420. end;
  421. { Each curve uses the exact same four coordinates, just with different CubicCurveToXXX
  422. method calls. I also use the page Maxtix Y-Translation to adjust the coordinate
  423. system before I draw each curve. I could also refactor each curves drawing
  424. code into a single parametised procedure - simply to show that each of the
  425. curves really do use the same code and coordinates. }
  426. procedure TPDFTestApp.AdvancedShapes(D: TPDFDocument; APage: integer);
  427. var
  428. P: TPDFPage;
  429. FtTitle: integer;
  430. lPt1, lPt2, lPt3, lPt4: TPDFCoord;
  431. begin
  432. P:=D.Pages[APage];
  433. // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
  434. FtTitle := D.AddFont('Helvetica');
  435. { Page title }
  436. P.SetFont(FtTitle,23);
  437. P.SetColor(clBlack);
  438. P.WriteText(25, 20, 'Advanced Drawing');
  439. // ========== Cubic Bezier curve ===========
  440. // PDF c operator curve ===========
  441. lPt1 := PDFCoord(75, 70);
  442. lPt2 := PDFCoord(78, 40);
  443. lPt3 := PDFCoord(100, 35);
  444. lPt4 := PDFCoord(140, 60);
  445. p.SetColor(clBlack, true);
  446. p.SetPenStyle(ppsSolid);
  447. p.MoveTo(lPt1);
  448. p.CubicCurveTo(lPt2, lPt3, lPt4, 1);
  449. // for fun, lets draw the control points as well
  450. P.SetColor(clLtGray, True);
  451. P.SetColor(clLtGray, false);
  452. P.DrawEllipse(lPt2.X-0.5, lPt2.Y, 1, 1, 1, True, True);
  453. P.DrawEllipse(lPt3.X-0.8, lPt3.Y, 1, 1, 1, True, True);
  454. P.SetPenStyle(ppsDot);
  455. P.DrawLine(lPt1, lPt2, 1);
  456. P.DrawLine(lPt3, lPt4, 1);
  457. p.SetPenStyle(ppsSolid);
  458. P.SetFont(FtTitle, 8);
  459. P.SetColor(clBlack, false);
  460. P.WriteText(lPt1.X+1, lPt1.Y, '(current point)');
  461. p.WriteText(lPt2.X+1, lPt2.Y, '(x1, y1)');
  462. p.WriteText(lPt3.X+1, lPt3.Y, '(x2, y2)');
  463. p.WriteText(lPt4.X+1, lPt4.Y, '(xTo, yTo)');
  464. P.SetFont(FtTitle, 10);
  465. P.WriteText(20, 50, 'CubicCurveTo(...)');
  466. // PDF v operator curve ===========
  467. P.Matrix.SetYTranslation(220);
  468. p.SetColor(clBlack, true);
  469. p.SetPenStyle(ppsSolid);
  470. p.MoveTo(lPt1);
  471. p.CubicCurveToV(lPt3, lPt4, 1);
  472. // for fun, lets draw the control points as well
  473. P.SetColor(clLtGray, True);
  474. P.SetColor(clLtGray, false);
  475. P.DrawEllipse(lPt3.X-0.8, lPt3.Y, 1, 1, 1, True, True);
  476. P.SetPenStyle(ppsDot);
  477. P.DrawLine(lPt3, lPt4, 1);
  478. p.SetPenStyle(ppsSolid);
  479. P.SetFont(FtTitle,8);
  480. P.SetColor(clBlack, false);
  481. P.WriteText(lPt1.X+1, lPt1.Y, '(current point)');
  482. p.WriteText(lPt3.X+1, lPt3.Y, '(x2, y2)');
  483. p.WriteText(lPt4.X+1, lPt4.Y, '(xTo, yTo)');
  484. P.SetFont(FtTitle, 10);
  485. P.WriteText(20, 50, 'CubicCurveToV(...)');
  486. // PDF y operator curve ===========
  487. P.Matrix.SetYTranslation(140);
  488. p.SetColor(clBlack, true);
  489. p.SetPenStyle(ppsSolid);
  490. p.MoveTo(lPt1);
  491. p.CubicCurveToY(lPt2, lPt4, 1);
  492. // for fun, lets draw the control points as well
  493. P.SetColor(clLtGray, True);
  494. P.SetColor(clLtGray, false);
  495. P.DrawEllipse(lPt2.X-0.5, lPt2.Y, 1, 1, 1, True, True);
  496. P.SetPenStyle(ppsDot);
  497. P.DrawLine(lPt1, lPt2, 1);
  498. p.SetPenStyle(ppsSolid);
  499. P.SetFont(FtTitle,8);
  500. P.SetColor(clBlack, false);
  501. P.WriteText(lPt1.X+1, lPt1.Y, '(current point)');
  502. p.WriteText(lPt2.X+1, lPt2.Y, '(x1, y1)');
  503. p.WriteText(lPt4.X+1, lPt4.Y, '(xTo, yTo)');
  504. P.SetFont(FtTitle, 10);
  505. P.WriteText(20, 50, 'CubicCurveToY(...)');
  506. end;
  507. procedure TPDFTestApp.SampleMatrixTransform(D: TPDFDocument; APage: integer);
  508. var
  509. P: TPDFPage;
  510. FtTitle: integer;
  511. procedure OutputSample;
  512. var
  513. b: boolean;
  514. begin
  515. b := P.Matrix._11 = -1;
  516. P.SetFont(FtTitle, 10);
  517. P.WriteText(10, 10, 'Matrix transform: ' + BoolToStr(b, True));
  518. P.DrawLine(0, 0, 100, 100, 1);
  519. P.WriteText(100, 100, '(line end point)');
  520. end;
  521. begin
  522. P:=D.Pages[APage];
  523. // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
  524. FtTitle := D.AddFont('Helvetica');
  525. { Page title }
  526. P.SetFont(FtTitle,23);
  527. P.SetColor(clBlack);
  528. P.WriteText(75, 20, 'Matrix Transform');
  529. OutputSample;
  530. // enables Cartesian coordinate system for the page
  531. P.Matrix.SetYScalation(1);
  532. P.Matrix.SetYTranslation(0);
  533. OutputSample;
  534. end;
  535. procedure TPDFTestApp.SampleLandscape(D: TPDFDocument; APage: integer);
  536. var
  537. P: TPDFPage;
  538. FtTitle: integer;
  539. function PaperTypeToString(AEnum: TPDFPaperType): string;
  540. begin
  541. result := GetEnumName(TypeInfo(TPDFPaperType), Ord(AEnum));
  542. end;
  543. function PixelsToMM(AValue: integer): integer;
  544. begin
  545. Result := Round((AValue / 72) * 25.4);
  546. end;
  547. begin
  548. P:=D.Pages[APage];
  549. P.Orientation := ppoLandscape;
  550. // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
  551. FtTitle := D.AddFont('Helvetica');
  552. { Page title }
  553. P.SetFont(FtTitle,23);
  554. P.SetColor(clBlack);
  555. P.WriteText(25, 20, 'Landscape Page');
  556. P.SetFont(FtTitle, 12);
  557. P.WriteText(100, 80, 'Page PaperType:');
  558. P.WriteText(145, 80, PaperTypeToString(P.PaperType));
  559. P.WriteText(100, 90, 'Page Size:');
  560. P.WriteText(145, 90, Format('%d x %d (pixels)', [P.Paper.W, P.Paper.H]));
  561. P.WriteText(145, 95, Format('%d x %d (mm)', [PixelsToMM(P.Paper.W), PixelsToMM(P.Paper.H)]));
  562. end;
  563. procedure TPDFTestApp.TextInABox(const APage: TPDFPage; const AX, AY: TPDFFloat; const APointSize: integer;
  564. const ABoxColor: TARGBColor; const AFontName: string; const AText: UTF8String);
  565. var
  566. lFontIdx: integer;
  567. lFC: TFPFontCacheItem;
  568. lHeight: single;
  569. lTextHeightInMM: single;
  570. lWidth: single;
  571. lTextWidthInMM: single;
  572. lDescenderHeightInMM: single;
  573. i: integer;
  574. begin
  575. for i := 0 to APage.Document.Fonts.Count-1 do
  576. begin
  577. if APage.Document.Fonts[i].Name = AFontName then
  578. begin
  579. lFontIdx := i;
  580. break;
  581. end;
  582. end;
  583. APage.SetFont(lFontIdx, APointSize);
  584. APage.SetColor(clBlack, false);
  585. APage.WriteText(AX, AY, AText);
  586. lFC := gTTFontCache.Find(AFontName, False, False);
  587. if not Assigned(lFC) then
  588. raise Exception.Create(AFontName + ' font not found');
  589. { result is in pixels }
  590. lHeight := lFC.FontData.CapHeight * APointSize * gTTFontCache.DPI / (72 * lFC.FontData.Head.UnitsPerEm);
  591. { convert pixels to mm as our PDFPage.UnitOfMeasure is set to mm. }
  592. lTextHeightInMM := (lHeight * 25.4) / gTTFontCache.DPI;
  593. lWidth := lFC.TextWidth(AText, APointSize);
  594. { convert the Font Units to Millimeters }
  595. lTextWidthInMM := (lWidth * 25.4) / gTTFontCache.DPI;
  596. { result is in pixels }
  597. lHeight := Abs(lFC.FontData.Descender) * APointSize * gTTFontCache.DPI /
  598. (72 * lFC.FontData.Head.UnitsPerEm);
  599. { convert pixels to mm as you PDFPage.UnitOfMeasure is set to mm. }
  600. lDescenderHeightInMM := (lHeight * 25.4) / gTTFontCache.DPI;
  601. { adjust the Y coordinate for the font Descender, because
  602. WriteText() draws on the baseline. Also adjust the TextHeight
  603. because CapHeight doesn't take into account the Descender. }
  604. APage.SetColor(ABoxColor, true);
  605. APage.DrawRect(AX, AY+lDescenderHeightInMM, lTextWidthInMM,
  606. lTextHeightInMM+lDescenderHeightInMM, 1, false, true);
  607. end;
  608. { TPDFTestApp }
  609. procedure TPDFTestApp.DoRun;
  610. Function BoolFlag(C : Char;ADefault : Boolean) : Boolean;
  611. Var
  612. V : Integer;
  613. begin
  614. Result:=ADefault;
  615. if HasOption(C, '') then
  616. begin
  617. v := StrToIntDef(GetOptionValue(C,''),-1);
  618. if Not (V in [0,1]) then
  619. Raise Exception.Create('Error in -'+C+' parameter. Valid range is 0-1.');
  620. Result:=(v=1);
  621. end
  622. end;
  623. var
  624. ErrorMsg: String;
  625. begin
  626. StopOnException:=True;
  627. inherited DoRun;
  628. // quick check parameters
  629. ErrorMsg := CheckOptions('hp:f:t:i:j:n', '');
  630. if ErrorMsg <> '' then
  631. begin
  632. WriteLn('ERROR: ' + ErrorMsg);
  633. Writeln('');
  634. Terminate;
  635. Exit;
  636. end;
  637. // parse parameters
  638. if HasOption('h', '') then
  639. begin
  640. WriteHelp;
  641. Terminate;
  642. Exit;
  643. end;
  644. FPage := -1;
  645. if HasOption('p', '') then
  646. begin
  647. FPage := StrToInt(GetOptionValue('p', ''));
  648. if (FPage < 1) or (FPage > cPageCount) then
  649. begin
  650. Writeln(Format('Error in -p parameter. Valid range is 1-%d.', [cPageCount]));
  651. Writeln('');
  652. Terminate;
  653. Exit;
  654. end;
  655. end;
  656. FNoFontEmbedding := HasOption('n', '');
  657. FFontCompression := BoolFlag('f',true);
  658. FTextCompression := BoolFlag('t',False);
  659. FImageCompression := BoolFlag('i',False);
  660. FRawJPEG:=BoolFlag('j',False);
  661. gTTFontCache.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
  662. gTTFontCache.BuildFontCache;
  663. FDoc := SetupDocument;
  664. try
  665. FDoc.FontDirectory := 'fonts';
  666. if FPage = -1 then
  667. begin
  668. SimpleText(FDoc, 0);
  669. SimpleShapes(FDoc, 1);
  670. AdvancedShapes(FDoc, 2);
  671. SimpleLines(FDoc, 3);
  672. SimpleLinesRaw(FDoc, 4);
  673. SimpleImage(FDoc, 5);
  674. SampleMatrixTransform(FDoc, 6);
  675. SampleLandscape(FDoc, 7);
  676. end
  677. else
  678. begin
  679. case FPage of
  680. 1: SimpleText(FDoc, 0);
  681. 2: SimpleShapes(FDoc, 0);
  682. 3: AdvancedShapes(FDoc, 0);
  683. 4: SimpleLines(FDoc, 0);
  684. 5: SimpleLinesRaw(FDoc, 0);
  685. 6: SimpleImage(FDoc, 0);
  686. 7: SampleMatrixTransform(FDoc, 0);
  687. 8: SampleLandscape(FDoc, 0);
  688. end;
  689. end;
  690. SaveDocument(FDoc);
  691. finally
  692. FDoc.Free;
  693. end;
  694. // stop program loop
  695. Terminate;
  696. end;
  697. procedure TPDFTestApp.WriteHelp;
  698. begin
  699. writeln('Usage:');
  700. writeln(' -h Show this help.');
  701. writeln(Format(
  702. ' -p <n> Generate only one page. Valid range is 1-%d.' + LineEnding +
  703. ' If this option is not specified, then all %0:d pages are' + LineEnding +
  704. ' generated.', [cPageCount]));
  705. writeln(' -n If specified, no fonts will be embedded.');
  706. writeln(' -f <0|1> Toggle embedded font compression. A value of 0' + LineEnding +
  707. ' disables compression. A value of 1 enables compression.' + LineEnding +
  708. ' If -n is specified, this option is ignored.');
  709. writeln(' -t <0|1> Toggle text compression. A value of 0' + LineEnding +
  710. ' disables compression. A value of 1 enables compression.');
  711. writeln(' -i <0|1> Toggle image compression. A value of 0' + LineEnding +
  712. ' disables compression. A value of 1 enables compression.');
  713. writeln(' -j <0|1> Toggle use of JPEG. A value of 0' + LineEnding +
  714. ' disables use of JPEG images. A value of 1 writes jpeg file as-is');
  715. writeln('');
  716. end;
  717. begin
  718. Randomize;
  719. Application := TPDFTestApp.Create(nil);
  720. Application.Title := 'fpPDF Test Application';
  721. Application.Run;
  722. Application.Free;
  723. end.