testfppdf.lpr 28 KB

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