testfppdf.lpr 26 KB

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