fppdf_test.pas 39 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700
  1. unit fppdf_test;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils
  6. {$ifdef fptest}
  7. ,TestFramework
  8. {$else}
  9. ,fpcunit, testutils, testregistry
  10. {$endif}
  11. ,fppdf
  12. ;
  13. type
  14. TBasePDFTest = class(TTestCase)
  15. private
  16. FPDF: TPDFDocument;
  17. FStream: TStringStream;
  18. protected
  19. procedure SetUp; override;
  20. procedure TearDown; override;
  21. public
  22. property PDF: TPDFDocument read FPDF;
  23. property S: TStringStream read FStream;
  24. end;
  25. TTestPDFObject = class(TBasePDFTest)
  26. published
  27. procedure TestFloatStr;
  28. procedure TestWriteString;
  29. end;
  30. TTestTPDFDocumentObject = class(TBasePDFTest)
  31. published
  32. procedure TestSetWidth;
  33. end;
  34. TTestPDFBoolean = class(TBasePDFTest)
  35. published
  36. procedure TestWriteTrue;
  37. procedure TestWriteFalse;
  38. end;
  39. TTestPDFMoveTo = class(TBasePDFTest)
  40. published
  41. procedure TestCommandPDFFloat;
  42. procedure TestCommandPDFCoord;
  43. end;
  44. TTestPDFInteger = class(TBasePDFTest)
  45. published
  46. procedure TestWrite;
  47. end;
  48. TTestPDFReference = class(TBasePDFTest)
  49. published
  50. procedure TestWrite;
  51. end;
  52. TTestPDFName = class(TBasePDFTest)
  53. published
  54. procedure TestWrite;
  55. procedure TestValidNames1;
  56. procedure TestValidNames2;
  57. end;
  58. TTestPDFAbstractString = class(TBasePDFTest)
  59. published
  60. procedure TestInsertEscape;
  61. end;
  62. TTestPDFString = class(TBasePDFTest)
  63. published
  64. procedure TestWrite;
  65. procedure TestWriteEscaped;
  66. procedure TestWriteEscaped2;
  67. end;
  68. TTestPDFArray = class(TBasePDFTest)
  69. published
  70. procedure TestWrite;
  71. end;
  72. TTestPDFStream = class(TBasePDFTest)
  73. published
  74. procedure TestWrite;
  75. end;
  76. TTestPDFEmbeddedFont = class(TBasePDFTest)
  77. published
  78. procedure TestWrite;
  79. procedure TestWriteEmbeddedFont;
  80. end;
  81. TTestPDFText = class(TBasePDFTest)
  82. published
  83. procedure TestWrite;
  84. end;
  85. TTestPDFLineSegment = class(TBasePDFTest)
  86. published
  87. procedure TestCommand;
  88. procedure TestWrite;
  89. end;
  90. TTestTPDFRectangle = class(TBasePDFTest)
  91. published
  92. procedure TestWrite_NoFill_NoStroke;
  93. procedure TestWrite_Fill_Stroke;
  94. procedure TestWrite_NoFill_Stroke;
  95. procedure TestWrite_Fill_NoStroke;
  96. end;
  97. TTestPDFCurveC = class(TBasePDFTest)
  98. published
  99. procedure TestCommand;
  100. procedure TestWrite_Stroke;
  101. procedure TestWrite_NoStroke;
  102. end;
  103. TTestPDFCurveV = class(TBasePDFTest)
  104. published
  105. procedure TestWrite_Stroke;
  106. procedure TestWrite_NoStroke;
  107. end;
  108. TTestPDFCurveY = class(TBasePDFTest)
  109. published
  110. procedure TestWrite_Stroke;
  111. procedure TestWrite_NoStroke;
  112. end;
  113. TTestPDFEllipse = class(TBasePDFTest)
  114. published
  115. procedure TestWrite_NoFill_NoStroke;
  116. procedure TestWrite_Fill_NoStroke;
  117. procedure TestWrite_NoFill_Stroke;
  118. procedure TestWrite_Fill_Stroke;
  119. end;
  120. TTestPDFSurface = class(TBasePDFTest)
  121. published
  122. procedure TestWrite;
  123. procedure TestWrite_noFill;
  124. procedure TestWrite_noClose;
  125. end;
  126. TTestPDFImage = class(TBasePDFTest)
  127. published
  128. procedure TestWrite;
  129. end;
  130. TTestPDFLineStyle = class(TBasePDFTest)
  131. published
  132. procedure TestWrite_ppsSolid;
  133. procedure TestWrite_ppsDash;
  134. procedure TestWrite_ppsDot;
  135. procedure TestWrite_ppsDashDot;
  136. procedure TestWrite_ppsDashDotDot;
  137. end;
  138. TTestPDFColor = class(TBasePDFTest)
  139. published
  140. procedure TestWrite_Stroke;
  141. procedure TestWrite_noStroke;
  142. end;
  143. TTestPDFDictionaryItem = class(TBasePDFTest)
  144. published
  145. procedure TestWrite;
  146. end;
  147. TTestPDFDictionary = class(TBasePDFTest)
  148. published
  149. procedure TestWrite;
  150. end;
  151. TTestPDFXRef = class(TBasePDFTest)
  152. published
  153. procedure TestWrite;
  154. end;
  155. TTestPDFPage = class(TBasePDFTest)
  156. published
  157. procedure TestPageDocument;
  158. procedure TestPageDefaultUnitOfMeasure;
  159. procedure TestMatrix;
  160. procedure TestUnitOfMeasure_MM;
  161. procedure TestUnitOfMeasure_Inches;
  162. procedure TestUnitOfMeasure_CM;
  163. end;
  164. TTestCompressionDecompression = class(TTestCase)
  165. private
  166. function GetTestString: string;
  167. published
  168. procedure TestStreamCompressionDecompression;
  169. procedure TestStringCompressionDecompression;
  170. end;
  171. TTestTPDFImageItem = class(TTestCase)
  172. published
  173. procedure TestCreateStreamedData;
  174. end;
  175. implementation
  176. uses
  177. FPImage;
  178. type
  179. // so we can access Protected methods in the tests
  180. TMockPDFObject = class(TPDFObject);
  181. TMockPDFDocumentObject = class(TPDFDocumentObject);
  182. TMockPDFBoolean = class(TPDFBoolean);
  183. TMockPDFMoveTo = class(TPDFMoveTo);
  184. TMockPDFInteger = class(TPDFInteger);
  185. TMockPDFReference = class(TPDFReference);
  186. TMockPDFName = class(TPDFName);
  187. TMockPDFString = class(TPDFString);
  188. TMockPDFArray = class(TPDFArray);
  189. TMockPDFStream = class(TPDFStream);
  190. TMockPDFEmbeddedFont = class(TPDFEmbeddedFont);
  191. TMockPDFText = class(TPDFText);
  192. TMockPDFLineSegment = class(TPDFLineSegment);
  193. TMockPDFRectangle = class(TPDFRectangle);
  194. TMockPDFCurveC = class(TPDFCurveC);
  195. TMockPDFCurveV = class(TPDFCurveV);
  196. TMockPDFCurveY = class(TPDFCurveY);
  197. TMockPDFEllipse = class(TPDFEllipse);
  198. TMockPDFSurface = class(TPDFSurface);
  199. TMockPDFImage = class(TPDFImage);
  200. TMockPDFLineStyle = class(TPDFLineStyle);
  201. TMockPDFColor = class(TPDFColor);
  202. TMockPDFDictionaryItem = class(TPDFDictionaryItem);
  203. TMockPDFDictionary = class(TPDFDictionary);
  204. TMockPDFXRef = class(TPDFXRef);
  205. TMockPDFPage = class(TPDFPage);
  206. { TBasePDFTest }
  207. procedure TBasePDFTest.SetUp;
  208. begin
  209. inherited SetUp;
  210. FPDF := TPDFDocument.Create(nil);
  211. FStream := TStringStream.Create('');
  212. end;
  213. procedure TBasePDFTest.TearDown;
  214. begin
  215. FStream.Free;
  216. FPDF.Free;
  217. inherited TearDown;
  218. end;
  219. { TTestPDFObject }
  220. procedure TTestPDFObject.TestFloatStr;
  221. Var
  222. C : Char;
  223. begin
  224. AssertEquals('Failed on 1', '0.12', TMockPDFObject.FloatStr(TPDFFLoat(0.12)));
  225. AssertEquals('Failed on 2', ' 12', TMockPDFObject.FloatStr(TPDFFLoat(12.00)));
  226. AssertEquals('Failed on 3', '12.30', TMockPDFObject.FloatStr(TPDFFLoat(12.30)));
  227. AssertEquals('Failed on 4', '12.34', TMockPDFObject.FloatStr(TPDFFLoat(12.34)));
  228. AssertEquals('Failed on 5', '123.45', TMockPDFObject.FloatStr(TPDFFLoat(123.45)));
  229. AssertEquals('Failed on 6', '123.46', TMockPDFObject.FloatStr(TPDFFLoat(123.455)));
  230. AssertEquals('Failed on 7', '123.46', TMockPDFObject.FloatStr(TPDFFLoat(123.456)));
  231. AssertEquals('Failed on 8', '1234567.00', TMockPDFObject.FloatStr(TPDFFLoat(1234567)));
  232. // Set DecimalSeparator
  233. C:=FormatSettings.DecimalSeparator;
  234. FormatSettings.DecimalSeparator:=',';
  235. try
  236. AssertEquals('Failed on 9', '12.34', TMockPDFObject.FloatStr(TPDFFLoat(12.34)));
  237. finally
  238. FormatSettings.DecimalSeparator:=C;
  239. end;
  240. // Set ThousandSeparator
  241. C:=FormatSettings.ThousandSeparator;
  242. FormatSettings.ThousandSeparator:=' ';
  243. try
  244. AssertEquals('Failed on 10', '1234567.00', TMockPDFObject.FloatStr(TPDFFLoat(1234567)));
  245. finally
  246. FormatSettings.ThousandSeparator:=C;
  247. end;
  248. end;
  249. procedure TTestPDFObject.TestWriteString;
  250. var
  251. o: TMockPDFObject;
  252. begin
  253. o := TMockPDFObject.Create(PDF);
  254. try
  255. o.WriteString('Hello', S);
  256. AssertEquals('Failed on 1', 'Hello', s.DataString);
  257. finally
  258. o.Free;
  259. end;
  260. end;
  261. { TTestTPDFDocumentObject }
  262. procedure TTestTPDFDocumentObject.TestSetWidth;
  263. var
  264. o: TMockPDFDocumentObject;
  265. begin
  266. o := TMockPDFDocumentObject.Create(PDF);
  267. try
  268. o.SetWidth(TPDFFloat(300.5), S);
  269. AssertEquals('Failed on 1',
  270. '1 J'+CRLF+
  271. '300.50 w'+CRLF, // line width
  272. s.DataString);
  273. // this shouldn't cause any change
  274. o.SetWidth(TPDFFloat(300.5), S);
  275. AssertEquals('Failed on 2',
  276. '1 J'+CRLF+
  277. '300.50 w'+CRLF, // line width
  278. s.DataString);
  279. // but this will
  280. o.SetWidth(TPDFFloat(123), S);
  281. AssertEquals('Failed on 3',
  282. '1 J'+CRLF+
  283. '300.50 w'+CRLF+ // line width 300.5
  284. '1 J'+CRLF+
  285. ' 123 w'+CRLF, // line width 123
  286. s.DataString);
  287. finally
  288. o.Free;
  289. end;
  290. end;
  291. { TTestPDFBoolean }
  292. procedure TTestPDFBoolean.TestWriteTrue;
  293. var
  294. o: TPDFBoolean;
  295. begin
  296. o := TPDFBoolean.Create(PDF, True);
  297. try
  298. AssertEquals('Failed on 1', '', S.DataString);
  299. TMockPDFBoolean(o).Write(S);
  300. AssertEquals('Failed on 2', 'true', S.DataString);
  301. finally
  302. o.Free;
  303. end;
  304. end;
  305. procedure TTestPDFBoolean.TestWriteFalse;
  306. var
  307. o: TPDFBoolean;
  308. begin
  309. o := TPDFBoolean.Create(PDF, False);
  310. try
  311. AssertEquals('Failed on 1', '', S.DataString);
  312. TMockPDFBoolean(o).Write(S);
  313. AssertEquals('Failed on 2', 'false', S.DataString);
  314. finally
  315. o.Free;
  316. end;
  317. end;
  318. { TTestPDFMoveTo }
  319. procedure TTestPDFMoveTo.TestCommandPDFFloat;
  320. var
  321. o: TPDFMoveTo;
  322. begin
  323. o := TPDFMoveTo.Create(PDF, 10, 20);
  324. try
  325. AssertEquals('Failed on 1', '', S.DataString);
  326. TMockPDFMoveTo(o).Write(S);
  327. AssertEquals('Failed on 2', ' 10 20 m'+CRLF, S.DataString);
  328. finally
  329. o.Free;
  330. end;
  331. end;
  332. procedure TTestPDFMoveTo.TestCommandPDFCoord;
  333. var
  334. c: TPDFCoord;
  335. o: TPDFMoveTo;
  336. begin
  337. c.X := 10;
  338. c.Y := 20;
  339. o := TPDFMoveTo.Create(PDF, c);
  340. try
  341. AssertEquals('Failed on 1', '', S.DataString);
  342. TMockPDFMoveTo(o).Write(S);
  343. AssertEquals('Failed on 2', ' 10 20 m'+CRLF, S.DataString);
  344. finally
  345. o.Free;
  346. end;
  347. end;
  348. { TTestPDFInteger }
  349. procedure TTestPDFInteger.TestWrite;
  350. var
  351. o: TPDFInteger;
  352. begin
  353. o := TPDFInteger.Create(PDF, 15);
  354. try
  355. AssertEquals('Failed on 1', '', S.DataString);
  356. TMockPDFInteger(o).Write(S);
  357. AssertEquals('Failed on 2', '15', S.DataString);
  358. TMockPDFInteger(o).inc;
  359. TMockPDFInteger(o).Write(S);
  360. AssertEquals('Failed on 3', '1516', S.DataString);
  361. finally
  362. o.Free;
  363. end;
  364. end;
  365. { TTestPDFReference }
  366. procedure TTestPDFReference.TestWrite;
  367. var
  368. o: TPDFReference;
  369. begin
  370. o := TPDFReference.Create(PDF, 10);
  371. try
  372. AssertEquals('Failed on 1', '', S.DataString);
  373. TMockPDFReference(o).Write(S);
  374. AssertEquals('Failed on 2', '10 0 R', S.DataString);
  375. finally
  376. o.Free;
  377. end;
  378. end;
  379. { TTestPDFName }
  380. procedure TTestPDFName.TestWrite;
  381. var
  382. o: TPDFName;
  383. begin
  384. o := TPDFName.Create(PDF, 'Test');
  385. try
  386. AssertEquals('Failed on 1', '', S.DataString);
  387. TMockPDFName(o).Write(S);
  388. AssertEquals('Failed on 2', '/Test', S.DataString);
  389. finally
  390. o.Free;
  391. end;
  392. { Length1 seems to be a special case? }
  393. o := TPDFName.Create(PDF, 'Length1');
  394. try
  395. TMockPDFName(o).Write(S);
  396. AssertEquals('Failed on 2', '/Test/Length1', S.DataString);
  397. finally
  398. o.Free;
  399. end;
  400. end;
  401. procedure TTestPDFName.TestValidNames1;
  402. var
  403. o: TPDFName;
  404. begin
  405. o := TPDFName.Create(PDF, 'paired()parentheses');
  406. try
  407. AssertEquals('Failed on 1', '', S.DataString);
  408. TMockPDFName(o).Write(S);
  409. AssertEquals('Failed on 2', '/paired()parentheses', S.DataString);
  410. finally
  411. o.Free;
  412. end;
  413. end;
  414. procedure TTestPDFName.TestValidNames2;
  415. var
  416. o: TPDFName;
  417. begin
  418. o := TPDFName.Create(PDF, 'Adobe Green');
  419. try
  420. AssertEquals('Failed on 1', '', S.DataString);
  421. TMockPDFName(o).Write(S);
  422. AssertEquals('Failed on 2', '/Adobe Green', S.DataString);
  423. finally
  424. o.Free;
  425. end;
  426. end;
  427. { TTestPDFAbstractString }
  428. procedure TTestPDFAbstractString.TestInsertEscape;
  429. var
  430. o: TPDFAbstractString;
  431. begin
  432. o := TPDFAbstractString.Create(PDF);
  433. try
  434. AssertEquals('Failed on 1', 'abcdefg', TMockPDFString(o).InsertEscape('abcdefg'));
  435. AssertEquals('Failed on 2', 'a\\b/cdefg', TMockPDFString(o).InsertEscape('a\b/cdefg'));
  436. AssertEquals('Failed on 3', 'a\(b\)cdefg', TMockPDFString(o).InsertEscape('a(b)cdefg'));
  437. AssertEquals('Failed on 4', 'a\(b\)c\\def/g', TMockPDFString(o).InsertEscape('a(b)c\def/g'));
  438. finally
  439. o.Free;
  440. end;
  441. end;
  442. { TTestPDFString }
  443. procedure TTestPDFString.TestWrite;
  444. var
  445. o: TPDFString;
  446. begin
  447. PDF.Options := []; // disable all compression
  448. o := TPDFString.Create(PDF, 'Test');
  449. try
  450. AssertEquals('Failed on 1', '', S.DataString);
  451. TMockPDFString(o).Write(S);
  452. AssertEquals('Failed on 2', '(Test)', S.DataString);
  453. finally
  454. o.Free;
  455. end;
  456. { Length1 seems to be a special case? }
  457. o := TPDFString.Create(PDF, #$C2#$A3+#$C2#$BB); // UTF-8 text of "£»"
  458. try
  459. TMockPDFString(o).Write(S); // write will convert UTF-8 to ANSI
  460. AssertEquals('Failed on 3', '(Test)('+#163#187+')', S.DataString);
  461. finally
  462. o.Free;
  463. end;
  464. end;
  465. { The symbols ( ) and \ get escaped before written to PDF }
  466. procedure TTestPDFString.TestWriteEscaped;
  467. var
  468. o: TPDFString;
  469. begin
  470. o := TPDFString.Create(PDF, 'a(b)c\def/g');
  471. try
  472. AssertEquals('Failed on 1', '', S.DataString);
  473. TMockPDFString(o).Write(S);
  474. AssertEquals('Failed on 2', '(a\(b\)c\\def/g)', S.DataString);
  475. finally
  476. o.Free;
  477. end;
  478. end;
  479. procedure TTestPDFString.TestWriteEscaped2;
  480. var
  481. o: TPDFString;
  482. begin
  483. o := TPDFString.Create(PDF, 'Special characters (*!&}^% and so on).');
  484. try
  485. AssertEquals('Failed on 1', '', S.DataString);
  486. TMockPDFString(o).Write(S);
  487. AssertEquals('Failed on 2', '(Special characters \(*!&}^% and so on\).)', S.DataString);
  488. finally
  489. o.Free;
  490. end;
  491. end;
  492. { TTestPDFArray }
  493. procedure TTestPDFArray.TestWrite;
  494. var
  495. o: TPDFArray;
  496. begin
  497. o := TPDFArray.Create(PDF);
  498. try
  499. AssertEquals('Failed on 1', '', S.DataString);
  500. TMockPDFArray(o).AddIntArray('1 2 3 4'); // no trailing space in string
  501. TMockPDFArray(o).Write(S);
  502. AssertEquals('Failed on 2', '[1 2 3 4]', S.DataString);
  503. TMockPDFArray(o).AddIntArray('1 2 3 4 '); // now we have a trailing space
  504. TMockPDFArray(o).Write(S);
  505. AssertEquals('Failed on 3', '[1 2 3 4][1 2 3 4 1 2 3 4]', S.DataString);
  506. finally
  507. o.Free;
  508. end;
  509. end;
  510. { TTestPDFStream }
  511. procedure TTestPDFStream.TestWrite;
  512. var
  513. o: TPDFStream;
  514. begin
  515. o := TPDFStream.Create(PDF, True);
  516. try
  517. TMockPDFStream(o).AddItem(TPDFString.Create(PDF, 'Hello World'));
  518. AssertEquals('Failed on 1', '', S.DataString);
  519. TMockPDFStream(o).Write(S);
  520. AssertEquals('Failed on 2', '(Hello World)', S.DataString);
  521. TMockPDFStream(o).AddItem(TPDFString.Create(PDF, '12345'));
  522. TMockPDFStream(o).Write(S);
  523. AssertEquals('Failed on 3', '(Hello World)(Hello World)(12345)', S.DataString);
  524. finally
  525. o.Free;
  526. end;
  527. end;
  528. { TTestPDFEmbeddedFont }
  529. procedure TTestPDFEmbeddedFont.TestWrite;
  530. var
  531. o: TPDFEmbeddedFont;
  532. begin
  533. o := TPDFEmbeddedFont.Create(PDF, 1, '16');
  534. try
  535. AssertEquals('Failed on 1', '', S.DataString);
  536. TMockPDFEmbeddedFont(o).Write(S);
  537. AssertEquals('Failed on 2', '/F1 16 Tf'+CRLF, S.DataString); // DON't change CRLF to anything else
  538. finally
  539. o.Free;
  540. end;
  541. end;
  542. procedure TTestPDFEmbeddedFont.TestWriteEmbeddedFont;
  543. var
  544. o: TPDFEmbeddedFont;
  545. lStream: TMemoryStream;
  546. str: String;
  547. begin
  548. PDF.Options := []; // disable compressed fonts
  549. str := 'Hello World';
  550. o := TPDFEmbeddedFont.Create(PDF, 1, '16');
  551. try
  552. AssertEquals('Failed on 1', '', S.DataString);
  553. lStream := TMemoryStream.Create;
  554. lStream.Write(str[1], Length(str));
  555. TMockPDFEmbeddedFont(o).WriteEmbeddedFont(PDF, lStream, S);
  556. lStream.Free;
  557. // DON't change CRLF to anything else
  558. AssertEquals('Failed on 2', CRLF+'stream'+CRLF+'Hello World'+CRLF+'endstream', S.DataString);
  559. finally
  560. o.Free;
  561. end;
  562. end;
  563. { TTestPDFText }
  564. procedure TTestPDFText.TestWrite;
  565. var
  566. o: TPDFText;
  567. x, y: TPDFFloat;
  568. begin
  569. x := 10.5;
  570. y := 20.0;
  571. o := TPDFText.Create(PDF, x, y, 'Hello World!');
  572. try
  573. AssertEquals('Failed on 1', '', S.DataString);
  574. TMockPDFText(o).Write(S);
  575. AssertEquals('Failed on 2',
  576. 'BT'+CRLF+
  577. '10.50 20 TD'+CRLF+
  578. '(Hello World!) Tj'+CRLF+
  579. 'ET'+CRLF,
  580. S.DataString);
  581. finally
  582. o.Free;
  583. end;
  584. end;
  585. { TTestPDFLineSegment }
  586. procedure TTestPDFLineSegment.TestCommand;
  587. var
  588. pos: TPDFCoord;
  589. begin
  590. pos.X := 10.0;
  591. pos.Y := 55.5;
  592. AssertEquals('Failed on 1', ' 10 55.50 l'+CRLF, TPDFLineSegment.Command(pos));
  593. end;
  594. procedure TTestPDFLineSegment.TestWrite;
  595. var
  596. o: TPDFLineSegment;
  597. Width, X1,Y1, X2,Y2: TPDFFLoat;
  598. begin
  599. Width := 2.0;
  600. X1 := 10.0;
  601. Y1 := 15.5;
  602. X2 := 50.0;
  603. Y2 := 55.5;
  604. o := TPDFLineSegment.Create(PDF, Width, X1, Y1, X2, Y2);
  605. try
  606. AssertEquals('Failed on 1', '', S.DataString);
  607. TMockPDFLineSegment(o).Write(S);
  608. AssertEquals('Failed on 2',
  609. '1 J'+CRLF+
  610. ' 2 w'+CRLF+ // line width
  611. ' 10 15.50 m'+CRLF+ // moveto command
  612. ' 50 55.50 l'+CRLF+ // line segment
  613. 'S'+CRLF, // end line segment
  614. S.DataString);
  615. finally
  616. o.Free;
  617. end;
  618. end;
  619. { TTestTPDFRectangle }
  620. procedure TTestTPDFRectangle.TestWrite_NoFill_NoStroke;
  621. var
  622. o: TMockPDFRectangle;
  623. lPosX, lPosY, lWidth, lHeight, lLineWidth: TPDFFLoat;
  624. begin
  625. lPosX := 10;
  626. lPosY := 11;
  627. lWidth := 100;
  628. lHeight := 200;
  629. lLineWidth := 1;
  630. o := TMockPDFRectangle.Create(PDF, lPosX, lPosY, lWidth, lHeight, lLineWidth, False, False);
  631. try
  632. AssertEquals('Failed on 1', '', S.DataString);
  633. o.Write(S);
  634. AssertEquals('Failed on 2',
  635. ' 10 11 100 200 re'+CRLF,
  636. S.DataString);
  637. finally
  638. o.Free;
  639. end;
  640. end;
  641. procedure TTestTPDFRectangle.TestWrite_Fill_Stroke;
  642. var
  643. o: TMockPDFRectangle;
  644. lPosX, lPosY, lWidth, lHeight, lLineWidth: TPDFFLoat;
  645. begin
  646. lPosX := 10;
  647. lPosY := 11;
  648. lWidth := 100;
  649. lHeight := 200;
  650. lLineWidth := 2;
  651. o := TMockPDFRectangle.Create(PDF, lPosX, lPosY, lWidth, lHeight, lLineWidth, True, True);
  652. try
  653. AssertEquals('Failed on 1', '', S.DataString);
  654. o.Write(S);
  655. AssertEquals('Failed on 2',
  656. '1 J'+CRLF+
  657. ' 2 w'+CRLF+
  658. ' 10 11 100 200 re'+CRLF+
  659. 'b'+CRLF,
  660. S.DataString);
  661. finally
  662. o.Free;
  663. end;
  664. end;
  665. procedure TTestTPDFRectangle.TestWrite_NoFill_Stroke;
  666. var
  667. o: TMockPDFRectangle;
  668. lPosX, lPosY, lWidth, lHeight, lLineWidth: TPDFFLoat;
  669. begin
  670. lPosX := 10;
  671. lPosY := 11;
  672. lWidth := 100;
  673. lHeight := 200;
  674. lLineWidth := 2;
  675. o := TMockPDFRectangle.Create(PDF, lPosX, lPosY, lWidth, lHeight, lLineWidth, False, True);
  676. try
  677. AssertEquals('Failed on 1', '', S.DataString);
  678. o.Write(S);
  679. AssertEquals('Failed on 2',
  680. '1 J'+CRLF+
  681. ' 2 w'+CRLF+
  682. ' 10 11 100 200 re'+CRLF+
  683. 'S'+CRLF,
  684. S.DataString);
  685. finally
  686. o.Free;
  687. end;
  688. end;
  689. procedure TTestTPDFRectangle.TestWrite_Fill_NoStroke;
  690. var
  691. o: TMockPDFRectangle;
  692. lPosX, lPosY, lWidth, lHeight, lLineWidth: TPDFFLoat;
  693. begin
  694. lPosX := 10;
  695. lPosY := 11;
  696. lWidth := 100;
  697. lHeight := 200;
  698. lLineWidth := 2;
  699. o := TMockPDFRectangle.Create(PDF, lPosX, lPosY, lWidth, lHeight, lLineWidth, True, False);
  700. try
  701. AssertEquals('Failed on 1', '', S.DataString);
  702. o.Write(S);
  703. AssertEquals('Failed on 2',
  704. ' 10 11 100 200 re'+CRLF+
  705. 'f'+CRLF,
  706. S.DataString);
  707. finally
  708. o.Free;
  709. end;
  710. end;
  711. { TTestPDFCurveC }
  712. procedure TTestPDFCurveC.TestCommand;
  713. var
  714. X1,Y1: TPDFFloat;
  715. X2,Y2: TPDFFloat;
  716. X3,Y3: TPDFFloat;
  717. s1: string;
  718. begin
  719. X1 := 10;
  720. Y1 := 11;
  721. X2 := 100;
  722. Y2 := 9;
  723. X3 := 200;
  724. Y3 := 250;
  725. s1 := TMockPDFCurveC.Command(x1, y1, x2, y2, x3, y3);
  726. AssertEquals('Failed on 1', ' 10 11 100 9 200 250 c'+CRLF, s1);
  727. end;
  728. procedure TTestPDFCurveC.TestWrite_Stroke;
  729. var
  730. o: TMockPDFCurveC;
  731. X1,Y1: TPDFFloat;
  732. X2,Y2: TPDFFloat;
  733. X3,Y3: TPDFFloat;
  734. lLineWidth: TPDFFLoat;
  735. begin
  736. X1 := 10;
  737. Y1 := 11;
  738. X2 := 100;
  739. Y2 := 9;
  740. X3 := 200;
  741. Y3 := 250;
  742. lLineWidth := 2;
  743. o := TMockPDFCurveC.Create(PDF, x1, y1, x2, y2, x3, y3, lLineWidth, True);
  744. try
  745. AssertEquals('Failed on 1', '', S.DataString);
  746. o.Write(S);
  747. AssertEquals('Failed on 2',
  748. '1 J'+CRLF+
  749. ' 2 w'+CRLF+
  750. ' 10 11 100 9 200 250 c'+CRLF+
  751. 'S'+CRLF,
  752. S.DataString);
  753. finally
  754. o.Free;
  755. end;
  756. end;
  757. procedure TTestPDFCurveC.TestWrite_NoStroke;
  758. var
  759. o: TMockPDFCurveC;
  760. X1,Y1: TPDFFloat;
  761. X2,Y2: TPDFFloat;
  762. X3,Y3: TPDFFloat;
  763. lLineWidth: TPDFFLoat;
  764. begin
  765. X1 := 10;
  766. Y1 := 11;
  767. X2 := 100;
  768. Y2 := 9;
  769. X3 := 200;
  770. Y3 := 250;
  771. lLineWidth := 2;
  772. o := TMockPDFCurveC.Create(PDF, x1, y1, x2, y2, x3, y3, lLineWidth, False);
  773. try
  774. AssertEquals('Failed on 1', '', S.DataString);
  775. o.Write(S);
  776. AssertEquals('Failed on 2',
  777. ' 10 11 100 9 200 250 c'+CRLF,
  778. S.DataString);
  779. finally
  780. o.Free;
  781. end;
  782. end;
  783. { TTestPDFCurveV }
  784. procedure TTestPDFCurveV.TestWrite_Stroke;
  785. var
  786. o: TMockPDFCurveV;
  787. X2,Y2: TPDFFloat;
  788. X3,Y3: TPDFFloat;
  789. lLineWidth: TPDFFLoat;
  790. begin
  791. X2 := 100;
  792. Y2 := 9;
  793. X3 := 200;
  794. Y3 := 250;
  795. lLineWidth := 2;
  796. o := TMockPDFCurveV.Create(PDF, x2, y2, x3, y3, lLineWidth, True);
  797. try
  798. AssertEquals('Failed on 1', '', S.DataString);
  799. o.Write(S);
  800. AssertEquals('Failed on 2',
  801. '1 J'+CRLF+
  802. ' 2 w'+CRLF+
  803. ' 100 9 200 250 v'+CRLF+
  804. 'S'+CRLF,
  805. S.DataString);
  806. finally
  807. o.Free;
  808. end;
  809. end;
  810. procedure TTestPDFCurveV.TestWrite_NoStroke;
  811. var
  812. o: TMockPDFCurveV;
  813. X2,Y2: TPDFFloat;
  814. X3,Y3: TPDFFloat;
  815. lLineWidth: TPDFFLoat;
  816. begin
  817. X2 := 100;
  818. Y2 := 9;
  819. X3 := 200;
  820. Y3 := 250;
  821. lLineWidth := 2;
  822. o := TMockPDFCurveV.Create(PDF, x2, y2, x3, y3, lLineWidth, False);
  823. try
  824. AssertEquals('Failed on 1', '', S.DataString);
  825. o.Write(S);
  826. AssertEquals('Failed on 2',
  827. ' 100 9 200 250 v'+CRLF,
  828. S.DataString);
  829. finally
  830. o.Free;
  831. end;
  832. end;
  833. { TTestPDFCurveY }
  834. procedure TTestPDFCurveY.TestWrite_Stroke;
  835. var
  836. o: TMockPDFCurveY;
  837. X2,Y2: TPDFFloat;
  838. X3,Y3: TPDFFloat;
  839. lLineWidth: TPDFFLoat;
  840. begin
  841. X2 := 100;
  842. Y2 := 9;
  843. X3 := 200;
  844. Y3 := 250;
  845. lLineWidth := 2;
  846. o := TMockPDFCurveY.Create(PDF, x2, y2, x3, y3, lLineWidth, True);
  847. try
  848. AssertEquals('Failed on 1', '', S.DataString);
  849. o.Write(S);
  850. AssertEquals('Failed on 2',
  851. '1 J'+CRLF+
  852. ' 2 w'+CRLF+
  853. ' 100 9 200 250 y'+CRLF+
  854. 'S'+CRLF,
  855. S.DataString);
  856. finally
  857. o.Free;
  858. end;
  859. end;
  860. procedure TTestPDFCurveY.TestWrite_NoStroke;
  861. var
  862. o: TMockPDFCurveY;
  863. X2,Y2: TPDFFloat;
  864. X3,Y3: TPDFFloat;
  865. lLineWidth: TPDFFLoat;
  866. begin
  867. X2 := 100;
  868. Y2 := 9;
  869. X3 := 200;
  870. Y3 := 250;
  871. lLineWidth := 2;
  872. o := TMockPDFCurveY.Create(PDF, x2, y2, x3, y3, lLineWidth, False);
  873. try
  874. AssertEquals('Failed on 1', '', S.DataString);
  875. o.Write(S);
  876. AssertEquals('Failed on 2',
  877. ' 100 9 200 250 y'+CRLF,
  878. S.DataString);
  879. finally
  880. o.Free;
  881. end;
  882. end;
  883. { TTestPDFEllipse }
  884. procedure TTestPDFEllipse.TestWrite_NoFill_NoStroke;
  885. var
  886. o: TMockPDFEllipse;
  887. lPosX, lPosY, lWidth, lHeight, lLineWidth: TPDFFloat;
  888. begin
  889. lPosX := 10;
  890. lPosY := 20;
  891. lWidth := 200;
  892. lHeight := 250;
  893. lLineWidth := 2;
  894. o := TMockPDFEllipse.Create(PDF, lPosX, lPosY, lWidth, lHeight, lLineWidth, False, False);
  895. try
  896. AssertEquals('Failed on 1', '', S.DataString);
  897. o.Write(S);
  898. AssertEquals('Failed on 2',
  899. // move to
  900. ' 10 145 m'+CRLF+
  901. // curveC 1
  902. ' 10 76.25 55 20 110 20 c'+CRLF+
  903. // curveC 2
  904. ' 165 20 210 76.25 210 145 c'+CRLF+
  905. // curveC 3
  906. ' 210 213.75 165 270 110 270 c'+CRLF+
  907. // curveC 4
  908. ' 55 270 10 213.75 10 145 c'+CRLF,
  909. S.DataString);
  910. finally
  911. o.Free;
  912. end;
  913. end;
  914. procedure TTestPDFEllipse.TestWrite_Fill_NoStroke;
  915. var
  916. o: TMockPDFEllipse;
  917. lPosX, lPosY, lWidth, lHeight, lLineWidth: TPDFFloat;
  918. begin
  919. lPosX := 10;
  920. lPosY := 20;
  921. lWidth := 200;
  922. lHeight := 250;
  923. lLineWidth := 2;
  924. o := TMockPDFEllipse.Create(PDF, lPosX, lPosY, lWidth, lHeight, lLineWidth, True, False);
  925. try
  926. AssertEquals('Failed on 1', '', S.DataString);
  927. o.Write(S);
  928. AssertEquals('Failed on 2',
  929. // move to
  930. ' 10 145 m'+CRLF+
  931. // curveC 1
  932. ' 10 76.25 55 20 110 20 c'+CRLF+
  933. // curveC 2
  934. ' 165 20 210 76.25 210 145 c'+CRLF+
  935. // curveC 3
  936. ' 210 213.75 165 270 110 270 c'+CRLF+
  937. // curveC 4
  938. ' 55 270 10 213.75 10 145 c'+CRLF+
  939. 'f'+CRLF,
  940. S.DataString);
  941. finally
  942. o.Free;
  943. end;
  944. end;
  945. procedure TTestPDFEllipse.TestWrite_NoFill_Stroke;
  946. var
  947. o: TMockPDFEllipse;
  948. lPosX, lPosY, lWidth, lHeight, lLineWidth: TPDFFloat;
  949. begin
  950. lPosX := 10;
  951. lPosY := 20;
  952. lWidth := 200;
  953. lHeight := 250;
  954. lLineWidth := 2;
  955. o := TMockPDFEllipse.Create(PDF, lPosX, lPosY, lWidth, lHeight, lLineWidth, False, True);
  956. try
  957. AssertEquals('Failed on 1', '', S.DataString);
  958. o.Write(S);
  959. AssertEquals('Failed on 2',
  960. '1 J'+CRLF+
  961. ' 2 w'+CRLF+
  962. // move to
  963. ' 10 145 m'+CRLF+
  964. // curveC 1
  965. ' 10 76.25 55 20 110 20 c'+CRLF+
  966. // curveC 2
  967. ' 165 20 210 76.25 210 145 c'+CRLF+
  968. // curveC 3
  969. ' 210 213.75 165 270 110 270 c'+CRLF+
  970. // curveC 4
  971. ' 55 270 10 213.75 10 145 c'+CRLF+
  972. 'S'+CRLF,
  973. S.DataString);
  974. finally
  975. o.Free;
  976. end;
  977. end;
  978. procedure TTestPDFEllipse.TestWrite_Fill_Stroke;
  979. var
  980. o: TMockPDFEllipse;
  981. lPosX, lPosY, lWidth, lHeight, lLineWidth: TPDFFloat;
  982. begin
  983. lPosX := 10;
  984. lPosY := 20;
  985. lWidth := 200;
  986. lHeight := 250;
  987. lLineWidth := 2;
  988. o := TMockPDFEllipse.Create(PDF, lPosX, lPosY, lWidth, lHeight, lLineWidth, True, True);
  989. try
  990. AssertEquals('Failed on 1', '', S.DataString);
  991. o.Write(S);
  992. AssertEquals('Failed on 2',
  993. '1 J'+CRLF+
  994. ' 2 w'+CRLF+
  995. // move to
  996. ' 10 145 m'+CRLF+
  997. // curveC 1
  998. ' 10 76.25 55 20 110 20 c'+CRLF+
  999. // curveC 2
  1000. ' 165 20 210 76.25 210 145 c'+CRLF+
  1001. // curveC 3
  1002. ' 210 213.75 165 270 110 270 c'+CRLF+
  1003. // curveC 4
  1004. ' 55 270 10 213.75 10 145 c'+CRLF+
  1005. 'b'+CRLF,
  1006. S.DataString);
  1007. finally
  1008. o.Free;
  1009. end;
  1010. end;
  1011. { TTestPDFSurface }
  1012. procedure TTestPDFSurface.TestWrite;
  1013. var
  1014. o: TMockPDFSurface;
  1015. ar: TPDFCoordArray;
  1016. p1, p2, p3: TPDFCoord;
  1017. begin
  1018. SetLength(ar, 3);
  1019. p1.X := 10; p1.Y := 20;
  1020. p2.X := 30; p2.Y := 40;
  1021. p3.X := 50; p3.Y := 60;
  1022. ar[0] := p1;
  1023. ar[1] := p2;
  1024. ar[2] := p3;
  1025. o := TMockPDFSurface.Create(PDF, ar, True, True);
  1026. try
  1027. AssertEquals('Failed on 1', '', S.DataString);
  1028. o.Write(S);
  1029. AssertEquals('Failed on 2',
  1030. // move to - p0
  1031. ' 10 20 m'+CRLF+
  1032. // line segment - p1
  1033. ' 30 40 l'+CRLF+
  1034. // line segment - p2
  1035. ' 50 60 l'+CRLF+
  1036. 'h'+CRLF+ // close
  1037. 'f'+CRLF, // fill
  1038. S.DataString);
  1039. finally
  1040. SetLength(ar, 0);
  1041. o.Free;
  1042. end;
  1043. end;
  1044. procedure TTestPDFSurface.TestWrite_noFill;
  1045. var
  1046. o: TMockPDFSurface;
  1047. ar: TPDFCoordArray;
  1048. p1, p2, p3: TPDFCoord;
  1049. begin
  1050. SetLength(ar, 3);
  1051. p1.X := 10; p1.Y := 20;
  1052. p2.X := 30; p2.Y := 40;
  1053. p3.X := 50; p3.Y := 60;
  1054. ar[0] := p1;
  1055. ar[1] := p2;
  1056. ar[2] := p3;
  1057. o := TMockPDFSurface.Create(PDF, ar, True, False);
  1058. try
  1059. AssertEquals('Failed on 1', '', S.DataString);
  1060. o.Write(S);
  1061. AssertEquals('Failed on 2',
  1062. // move to - p0
  1063. ' 10 20 m'+CRLF+
  1064. // line segment - p1
  1065. ' 30 40 l'+CRLF+
  1066. // line segment - p2
  1067. ' 50 60 l'+CRLF+
  1068. 'h'+CRLF, // close
  1069. S.DataString);
  1070. finally
  1071. SetLength(ar, 0);
  1072. o.Free;
  1073. end;
  1074. end;
  1075. procedure TTestPDFSurface.TestWrite_noClose;
  1076. var
  1077. o: TMockPDFSurface;
  1078. ar: TPDFCoordArray;
  1079. p1, p2, p3: TPDFCoord;
  1080. begin
  1081. SetLength(ar, 3);
  1082. p1.X := 10; p1.Y := 20;
  1083. p2.X := 30; p2.Y := 40;
  1084. p3.X := 50; p3.Y := 60;
  1085. ar[0] := p1;
  1086. ar[1] := p2;
  1087. ar[2] := p3;
  1088. o := TMockPDFSurface.Create(PDF, ar, False, True);
  1089. try
  1090. AssertEquals('Failed on 1', '', S.DataString);
  1091. o.Write(S);
  1092. AssertEquals('Failed on 2',
  1093. // move to - p0
  1094. ' 10 20 m'+CRLF+
  1095. // line segment - p1
  1096. ' 30 40 l'+CRLF+
  1097. // line segment - p2
  1098. ' 50 60 l'+CRLF+
  1099. 'f'+CRLF, // fill
  1100. S.DataString);
  1101. finally
  1102. SetLength(ar, 0);
  1103. o.Free;
  1104. end;
  1105. end;
  1106. { TTestPDFImage }
  1107. procedure TTestPDFImage.TestWrite;
  1108. var
  1109. o: TMockPDFImage;
  1110. x, y: TPDFFLoat;
  1111. begin
  1112. x := 100;
  1113. y := 200;
  1114. o := TMockPDFImage.Create(PDF, x, y, 150, 75, 1);
  1115. try
  1116. AssertEquals('Failed on 1', '', S.DataString);
  1117. o.Write(S);
  1118. AssertEquals('Failed on 2',
  1119. // save graphics state
  1120. 'q'+CRLF+
  1121. '150 0 0 75 100 200 cm'+CRLF+
  1122. '/I1 Do'+CRLF+
  1123. // restore graphics state
  1124. 'Q'+CRLF,
  1125. S.DataString);
  1126. finally
  1127. o.Free;
  1128. end;
  1129. end;
  1130. { TTestPDFLineStyle }
  1131. procedure TTestPDFLineStyle.TestWrite_ppsSolid;
  1132. var
  1133. o: TMockPDFLineStyle;
  1134. begin
  1135. o := TMockPDFLineStyle.Create(PDF, ppsSolid, 1);
  1136. try
  1137. AssertEquals('Failed on 1', '', S.DataString);
  1138. o.Write(S);
  1139. AssertEquals('Failed on 2',
  1140. '[] 1 d'+CRLF,
  1141. S.DataString);
  1142. finally
  1143. o.Free;
  1144. end;
  1145. end;
  1146. procedure TTestPDFLineStyle.TestWrite_ppsDash;
  1147. var
  1148. o: TMockPDFLineStyle;
  1149. begin
  1150. o := TMockPDFLineStyle.Create(PDF, ppsDash, 2);
  1151. try
  1152. AssertEquals('Failed on 1', '', S.DataString);
  1153. o.Write(S);
  1154. AssertEquals('Failed on 2',
  1155. '[5 3] 2 d'+CRLF,
  1156. S.DataString);
  1157. finally
  1158. o.Free;
  1159. end;
  1160. end;
  1161. procedure TTestPDFLineStyle.TestWrite_ppsDot;
  1162. var
  1163. o: TMockPDFLineStyle;
  1164. begin
  1165. o := TMockPDFLineStyle.Create(PDF, ppsDot, 3);
  1166. try
  1167. AssertEquals('Failed on 1', '', S.DataString);
  1168. o.Write(S);
  1169. AssertEquals('Failed on 2',
  1170. '[1 3] 3 d'+CRLF,
  1171. S.DataString);
  1172. finally
  1173. o.Free;
  1174. end;
  1175. end;
  1176. procedure TTestPDFLineStyle.TestWrite_ppsDashDot;
  1177. var
  1178. o: TMockPDFLineStyle;
  1179. begin
  1180. o := TMockPDFLineStyle.Create(PDF, ppsDashDot, 4);
  1181. try
  1182. AssertEquals('Failed on 1', '', S.DataString);
  1183. o.Write(S);
  1184. AssertEquals('Failed on 2',
  1185. '[5 3 1 3] 4 d'+CRLF,
  1186. S.DataString);
  1187. finally
  1188. o.Free;
  1189. end;
  1190. end;
  1191. procedure TTestPDFLineStyle.TestWrite_ppsDashDotDot;
  1192. var
  1193. o: TMockPDFLineStyle;
  1194. begin
  1195. o := TMockPDFLineStyle.Create(PDF, ppsDashDotDot, 1);
  1196. try
  1197. AssertEquals('Failed on 1', '', S.DataString);
  1198. o.Write(S);
  1199. AssertEquals('Failed on 2',
  1200. '[5 3 1 3 1 3] 1 d'+CRLF,
  1201. S.DataString);
  1202. finally
  1203. o.Free;
  1204. end;
  1205. end;
  1206. { TTestPDFColor }
  1207. procedure TTestPDFColor.TestWrite_Stroke;
  1208. var
  1209. o: TMockPDFColor;
  1210. begin
  1211. o := TMockPDFColor.Create(PDF, True, $AABBCC);
  1212. try
  1213. AssertEquals('Failed on 1', '', S.DataString);
  1214. o.Write(S);
  1215. AssertEquals('Failed on 2',
  1216. '0.66 0.73 0.80 RG'+CRLF,
  1217. S.DataString);
  1218. finally
  1219. o.Free;
  1220. end;
  1221. end;
  1222. procedure TTestPDFColor.TestWrite_noStroke;
  1223. var
  1224. o: TMockPDFColor;
  1225. begin
  1226. o := TMockPDFColor.Create(PDF, False, $AABBCC);
  1227. try
  1228. AssertEquals('Failed on 1', '', S.DataString);
  1229. o.Write(S);
  1230. AssertEquals('Failed on 2',
  1231. '0.66 0.73 0.80 rg'+CRLF,
  1232. S.DataString);
  1233. finally
  1234. o.Free;
  1235. end;
  1236. end;
  1237. { TTestPDFDictionaryItem }
  1238. procedure TTestPDFDictionaryItem.TestWrite;
  1239. var
  1240. o: TMockPDFDictionaryItem;
  1241. v: TPDFString;
  1242. begin
  1243. v := TPDFString.Create(PDF, 'TestValue');
  1244. o := TMockPDFDictionaryItem.Create(PDF, 'tv', v);
  1245. try
  1246. AssertEquals('Failed on 1', '', S.DataString);
  1247. o.Write(S);
  1248. AssertEquals('Failed on 2',
  1249. '/tv (TestValue)'+CRLF,
  1250. S.DataString);
  1251. finally
  1252. o.Free;
  1253. end;
  1254. end;
  1255. { TTestPDFDictionary }
  1256. procedure TTestPDFDictionary.TestWrite;
  1257. var
  1258. o: TMockPDFDictionary;
  1259. v: TPDFString;
  1260. begin
  1261. v := TPDFString.Create(PDF, 'TestValue');
  1262. o := TMockPDFDictionary.Create(PDF);
  1263. o.AddName('key1','value1');
  1264. o.AddElement('key2', v);
  1265. o.AddInteger('key3', 1234);
  1266. o.AddString('key4', 'string4');
  1267. o.AddReference('key5', 987);
  1268. try
  1269. AssertEquals('Failed on 1', '', S.DataString);
  1270. o.Write(S);
  1271. AssertEquals('Failed on 2',
  1272. '<<'+CRLF+
  1273. '/key1 /value1'+CRLF+
  1274. '/key2 (TestValue)'+CRLF+
  1275. '/key3 1234'+CRLF+
  1276. '/key4 (string4)'+CRLF+
  1277. '/key5 987 0 R'+CRLF+
  1278. '>>',
  1279. S.DataString);
  1280. finally
  1281. o.Free;
  1282. end;
  1283. end;
  1284. { TTestPDFXRef }
  1285. procedure TTestPDFXRef.TestWrite;
  1286. var
  1287. o: TMockPDFXRef;
  1288. begin
  1289. o := TMockPDFXRef.Create(PDF);
  1290. try
  1291. AssertEquals('Failed on 1', '', S.DataString);
  1292. o.Write(S);
  1293. AssertEquals('Failed on 2',
  1294. '0000000000 00000 n'+CRLF,
  1295. S.DataString);
  1296. o.Offset := 234;
  1297. o.Write(S);
  1298. AssertEquals('Failed on 3',
  1299. '0000000000 00000 n'+CRLF+
  1300. '0000000234 00000 n'+CRLF,
  1301. S.DataString);
  1302. finally
  1303. o.Free;
  1304. end;
  1305. end;
  1306. { TTestPDFPage }
  1307. procedure TTestPDFPage.TestPageDocument;
  1308. var
  1309. p: TPDFPage;
  1310. begin
  1311. p := PDF.Pages.AddPage;
  1312. AssertTrue('Failed on 1', p.Document = PDF);
  1313. AssertTrue('Failed on 2', p.UnitOfMeasure = uomMillimeters);
  1314. end;
  1315. procedure TTestPDFPage.TestPageDefaultUnitOfMeasure;
  1316. var
  1317. p: TPDFPage;
  1318. begin
  1319. p := PDF.Pages.AddPage;
  1320. AssertTrue('Failed on 1', p.UnitOfMeasure = uomMillimeters);
  1321. end;
  1322. procedure TTestPDFPage.TestMatrix;
  1323. var
  1324. p: TPDFPage;
  1325. pt1, pt2: TPDFCoord;
  1326. begin
  1327. p := PDF.Pages.AddPage;
  1328. AssertTrue('Failed on 1', p.UnitOfMeasure = uomMillimeters);
  1329. AssertEquals('Failed on 2', mmToPDF(p.Matrix._21), p.Paper.H);
  1330. pt1.X := 10;
  1331. pt1.Y := 20;
  1332. pt2 := p.Matrix.Transform(pt1);
  1333. AssertEquals('Failed on 3', 10, pt2.X);
  1334. AssertEquals('Failed on 4', 297-20, pt2.Y, 0.1);
  1335. pt1 := p.Matrix.ReverseTransform(pt2);
  1336. AssertEquals('Failed on 5', 10, pt1.X);
  1337. AssertEquals('Failed on 6', 20, pt1.Y, 0.1);
  1338. end;
  1339. procedure TTestPDFPage.TestUnitOfMeasure_MM;
  1340. var
  1341. p: TPDFPage;
  1342. pt: TPDFCoord;
  1343. begin
  1344. p := PDF.Pages.AddPage;
  1345. p.UnitOfMeasure := uomMillimeters;
  1346. pt.X := 20;
  1347. pt.Y := 35;
  1348. TMockPDFPage(p).doUnitConversion(pt);
  1349. AssertEquals('Failed on 1', 56.69, pt.X, 0.01);
  1350. AssertEquals('Failed on 2', 99.21, pt.Y, 0.01);
  1351. pt.X := 40;
  1352. pt.Y := 20;
  1353. TMockPDFPage(p).doUnitConversion(pt);
  1354. AssertEquals('Failed on 3', 113.38, pt.X, 0.01);
  1355. AssertEquals('Failed on 4', 56.69, pt.Y, 0.01);
  1356. end;
  1357. procedure TTestPDFPage.TestUnitOfMeasure_Inches;
  1358. var
  1359. p: TPDFPage;
  1360. pt: TPDFCoord;
  1361. begin
  1362. p := PDF.Pages.AddPage;
  1363. p.UnitOfMeasure := uomInches;
  1364. pt.X := 1;
  1365. pt.Y := 1.5;
  1366. TMockPDFPage(p).doUnitConversion(pt);
  1367. AssertEquals('Failed on 1', 72.0, pt.X, 0.01);
  1368. AssertEquals('Failed on 2', 108.0, pt.Y, 0.01);
  1369. pt.X := 2;
  1370. pt.Y := 1;
  1371. TMockPDFPage(p).doUnitConversion(pt);
  1372. AssertEquals('Failed on 3', 144.0, pt.X, 0.01);
  1373. AssertEquals('Failed on 4', 72.0, pt.Y, 0.01);
  1374. end;
  1375. procedure TTestPDFPage.TestUnitOfMeasure_CM;
  1376. var
  1377. p: TPDFPage;
  1378. pt: TPDFCoord;
  1379. begin
  1380. p := PDF.Pages.AddPage;
  1381. p.UnitOfMeasure := uomMillimeters;
  1382. pt.X := 2.0;
  1383. pt.Y := 3.5;
  1384. TMockPDFPage(p).doUnitConversion(pt);
  1385. AssertEquals('Failed on 1', 5.669, pt.X, 0.01);
  1386. AssertEquals('Failed on 2', 9.921, pt.Y, 0.01);
  1387. pt.X := 4.0;
  1388. pt.Y := 2.0;
  1389. TMockPDFPage(p).doUnitConversion(pt);
  1390. AssertEquals('Failed on 3', 11.338, pt.X, 0.01);
  1391. AssertEquals('Failed on 4', 5.669, pt.Y, 0.01);
  1392. end;
  1393. { TTestCompressionDecompression }
  1394. function TTestCompressionDecompression.GetTestString: string;
  1395. var
  1396. i: integer;
  1397. lsLine: string;
  1398. begin
  1399. result := '';
  1400. lsLine := '';
  1401. for i := 1 to 1000 do
  1402. lsLine := lsLine + Chr(ord('A')+Random(ord('z')-ord('A')));
  1403. for i := 1 to 200 do
  1404. result := result + lsLine + LineEnding;
  1405. Result := 'Hello World';
  1406. end;
  1407. procedure TTestCompressionDecompression.TestStreamCompressionDecompression;
  1408. var
  1409. lSBefore: TStringStream;
  1410. lSAfter: TStringStream;
  1411. lCompressed: TMemoryStream;
  1412. lBefore: string;
  1413. lAfter: string;
  1414. begin
  1415. lBefore := GetTestString;
  1416. lSBefore := TStringStream.Create(lBefore);
  1417. lCompressed := TMemoryStream.Create;
  1418. CompressStream(lSBefore, lCompressed);
  1419. try
  1420. lSAfter := TStringStream.Create('');
  1421. DecompressStream(lCompressed, lSAfter);
  1422. lAfter := lSAfter.DataString;
  1423. AssertTrue('Compression failed. Strings are not the same. ' +IntToStr(Length(lBefore)) + ' vs ' + IntToStr(Length(lAfter)), lBefore = lAfter);
  1424. finally
  1425. lSBefore.Free;
  1426. lCompressed.Free;
  1427. lSAfter.Free;
  1428. end;
  1429. end;
  1430. procedure TTestCompressionDecompression.TestStringCompressionDecompression;
  1431. var
  1432. lBefore: string;
  1433. lCompressed: string;
  1434. lAfter: string;
  1435. s: TStringStream;
  1436. e: TStringStream;
  1437. begin
  1438. lBefore := GetTestString;
  1439. lCompressed := '';
  1440. CompressString(lBefore, lCompressed);
  1441. s := TStringStream.Create(lCompressed);
  1442. try
  1443. e := TStringStream.Create('');
  1444. s.Position := 0;
  1445. DecompressStream(s, e);
  1446. lAfter := e.DataString;
  1447. finally
  1448. e.Free;
  1449. s.Free;
  1450. end;
  1451. AssertTrue('Compression failed. Strings are not the same. ' +IntToStr(Length(lBefore)) + ' vs ' + IntToStr(Length(lAfter)), lBefore = lAfter);
  1452. end;
  1453. { TTestTPDFImageItem }
  1454. procedure TTestTPDFImageItem.TestCreateStreamedData;
  1455. var
  1456. itm: TPDFImageItem;
  1457. img: TFPMemoryImage;
  1458. b: TBytes;
  1459. begin
  1460. itm := TPDFImageItem.Create(nil);
  1461. try
  1462. itm.OwnsImage := True;
  1463. img := TFPMemoryImage.Create(5, 5);
  1464. itm.Image := img;
  1465. b := itm.StreamedData;
  1466. AssertEquals('Failed on 1', 75 {5*5*3}, Length(b));
  1467. finally
  1468. itm.Free;
  1469. end;
  1470. itm := TPDFImageItem.Create(nil);
  1471. try
  1472. itm.OwnsImage := True;
  1473. img := TFPMemoryImage.Create(10, 20);
  1474. itm.Image := img;
  1475. { this try..except as to prove that we had a bug before we fixed it. }
  1476. try
  1477. b := itm.StreamedData;
  1478. except
  1479. Fail('Failed on 2 - itm.StreamedData raised an exception');
  1480. end;
  1481. AssertEquals('Failed on 3', 600 {10*20*3}, Length(b));
  1482. finally
  1483. itm.Free;
  1484. end;
  1485. end;
  1486. initialization
  1487. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFObject{$ifdef fptest}.Suite{$endif});
  1488. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestTPDFDocumentObject{$ifdef fptest}.Suite{$endif});
  1489. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFBoolean{$ifdef fptest}.Suite{$endif});
  1490. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFMoveTo{$ifdef fptest}.Suite{$endif});
  1491. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFInteger{$ifdef fptest}.Suite{$endif});
  1492. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFReference{$ifdef fptest}.Suite{$endif});
  1493. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFName{$ifdef fptest}.Suite{$endif});
  1494. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFAbstractString{$ifdef fptest}.Suite{$endif});
  1495. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFString{$ifdef fptest}.Suite{$endif});
  1496. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFArray{$ifdef fptest}.Suite{$endif});
  1497. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFStream{$ifdef fptest}.Suite{$endif});
  1498. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFEmbeddedFont{$ifdef fptest}.Suite{$endif});
  1499. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFText{$ifdef fptest}.Suite{$endif});
  1500. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFLineSegment{$ifdef fptest}.Suite{$endif});
  1501. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestTPDFRectangle{$ifdef fptest}.Suite{$endif});
  1502. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFCurveC{$ifdef fptest}.Suite{$endif});
  1503. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFCurveV{$ifdef fptest}.Suite{$endif});
  1504. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFCurveY{$ifdef fptest}.Suite{$endif});
  1505. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFEllipse{$ifdef fptest}.Suite{$endif});
  1506. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFSurface{$ifdef fptest}.Suite{$endif});
  1507. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFImage{$ifdef fptest}.Suite{$endif});
  1508. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFLineStyle{$ifdef fptest}.Suite{$endif});
  1509. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFColor{$ifdef fptest}.Suite{$endif});
  1510. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFDictionaryItem{$ifdef fptest}.Suite{$endif});
  1511. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFDictionary{$ifdef fptest}.Suite{$endif});
  1512. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFXRef{$ifdef fptest}.Suite{$endif});
  1513. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFPage{$ifdef fptest}.Suite{$endif});
  1514. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestCompressionDecompression{$ifdef fptest}.Suite{$endif});
  1515. RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestTPDFImageItem{$ifdef fptest}.Suite{$endif});
  1516. end.