testfppdf.lpr 25 KB

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