12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018 |
- unit fppdf_test;
- {$mode objfpc}{$H+}
- {$codepage utf8}
- interface
- uses
- Classes, SysUtils
- {$ifdef fptest}
- ,TestFramework
- {$else}
- ,fpcunit, testregistry
- {$endif}
- ,fppdf
- ;
- type
- TBasePDFTest = class(TTestCase)
- private
- FPDF: TPDFDocument;
- FStream: TStringStream;
- procedure CreatePages(const ACount: integer);
- protected
- procedure SetUp; override;
- procedure TearDown; override;
- public
- property PDF: TPDFDocument read FPDF;
- property S: TStringStream read FStream;
- end;
- TGeneralPDFTests = class(TTestCase)
- published
- procedure TestPDFCoord;
- end;
- TTestPDFObject = class(TBasePDFTest)
- published
- procedure TestFloatStr;
- procedure TestWriteString;
- end;
- TTestTPDFDocumentObject = class(TBasePDFTest)
- published
- procedure TestSetWidth;
- end;
- TTestPDFBoolean = class(TBasePDFTest)
- published
- procedure TestWriteTrue;
- procedure TestWriteFalse;
- end;
- TTestPDFMoveTo = class(TBasePDFTest)
- published
- procedure TestCommandPDFFloat;
- procedure TestCommandPDFCoord;
- end;
- TTestPDFInteger = class(TBasePDFTest)
- published
- procedure TestWrite;
- end;
- TTestPDFReference = class(TBasePDFTest)
- published
- procedure TestWrite;
- end;
- TTestPDFName = class(TBasePDFTest)
- published
- procedure TestWrite;
- procedure TestValidNames1;
- procedure TestValidNames2;
- procedure TestValidNames3;
- end;
- TTestPDFAbstractString = class(TBasePDFTest)
- published
- procedure TestInsertEscape;
- end;
- TTestPDFString = class(TBasePDFTest)
- published
- procedure TestWrite;
- procedure TestWriteEscaped;
- procedure TestWriteEscaped2;
- end;
- TTestPDFUTF8String = class(TBasePDFTest)
- published
- procedure TestWrite;
- procedure TestWriteEscaped;
- end;
- TTestPDFArray = class(TBasePDFTest)
- published
- procedure TestWrite;
- end;
- TTestPDFStream = class(TBasePDFTest)
- published
- procedure TestWrite;
- end;
- TTestPDFEmbeddedFont = class(TBasePDFTest)
- published
- procedure TestWrite;
- procedure TestWriteEmbeddedFont;
- end;
- TTestPDFText = class(TBasePDFTest)
- published
- procedure TestWrite;
- end;
- TTestPDFLineSegment = class(TBasePDFTest)
- published
- procedure TestCommand;
- procedure TestWrite;
- end;
- TTestTPDFRectangle = class(TBasePDFTest)
- published
- procedure TestWrite_NoFill_NoStroke;
- procedure TestWrite_Fill_Stroke;
- procedure TestWrite_NoFill_Stroke;
- procedure TestWrite_Fill_NoStroke;
- end;
- TTestPDFCurveC = class(TBasePDFTest)
- published
- procedure TestCommand;
- procedure TestWrite_Stroke;
- procedure TestWrite_NoStroke;
- end;
- TTestPDFCurveV = class(TBasePDFTest)
- published
- procedure TestWrite_Stroke;
- procedure TestWrite_NoStroke;
- end;
- TTestPDFCurveY = class(TBasePDFTest)
- published
- procedure TestWrite_Stroke;
- procedure TestWrite_NoStroke;
- end;
- TTestPDFEllipse = class(TBasePDFTest)
- published
- procedure TestWrite_NoFill_NoStroke;
- procedure TestWrite_Fill_NoStroke;
- procedure TestWrite_NoFill_Stroke;
- procedure TestWrite_Fill_Stroke;
- end;
- TTestPDFSurface = class(TBasePDFTest)
- published
- procedure TestWrite;
- procedure TestWrite_noFill;
- procedure TestWrite_noClose;
- end;
- TTestPDFImage = class(TBasePDFTest)
- published
- procedure TestWrite;
- procedure TestPageDrawImage_Pixels;
- procedure TestPageDrawImage_UnitsOfMeasure;
- end;
- TTestPDFLineStyle = class(TBasePDFTest)
- published
- procedure TestWrite_ppsSolid;
- procedure TestWrite_ppsDash;
- procedure TestWrite_ppsDot;
- procedure TestWrite_ppsDashDot;
- procedure TestWrite_ppsDashDotDot;
- procedure TestLocalisationChanges;
- end;
- TTestPDFColor = class(TBasePDFTest)
- published
- procedure TestWrite_Stroke;
- procedure TestWrite_noStroke;
- end;
- TTestPDFDictionaryItem = class(TBasePDFTest)
- published
- procedure TestWrite;
- end;
- TTestPDFDictionary = class(TBasePDFTest)
- published
- procedure TestWrite;
- end;
- TTestPDFXRef = class(TBasePDFTest)
- published
- procedure TestWrite;
- end;
- TTestPDFPage = class(TBasePDFTest)
- published
- procedure TestPageDocument;
- procedure TestPageDefaultUnitOfMeasure;
- procedure TestMatrixOn;
- procedure TestMatrixOff;
- procedure TestUnitOfMeasure_MM;
- procedure TestUnitOfMeasure_Inches;
- procedure TestUnitOfMeasure_CM;
- end;
- TTestCompressionDecompression = class(TTestCase)
- private
- function GetTestString: string;
- published
- procedure TestStreamCompressionDecompression;
- procedure TestStringCompressionDecompression;
- end;
- TTestTPDFImageItem = class(TTestCase)
- published
- procedure TestCreateStreamedData_Compressed;
- procedure TestCreateStreamedData_Uncompressed;
- end;
- implementation
- uses
- FPImage;
- const
- cFont1 = 'fonts' + PathDelim + 'LiberationSans-Regular.ttf';
- type
- // so we can access Protected methods in the tests
- TMockPDFObject = class(TPDFObject);
- TMockPDFDocumentObject = class(TPDFDocumentObject);
- TMockPDFBoolean = class(TPDFBoolean);
- TMockPDFMoveTo = class(TPDFMoveTo);
- TMockPDFInteger = class(TPDFInteger);
- TMockPDFReference = class(TPDFReference);
- TMockPDFName = class(TPDFName);
- TMockPDFString = class(TPDFString);
- TMockPDFUTF8String = class(TPDFUTF8String);
- TMockPDFArray = class(TPDFArray);
- TMockPDFStream = class(TPDFStream);
- TMockPDFEmbeddedFont = class(TPDFEmbeddedFont);
- TMockPDFText = class(TPDFText);
- TMockPDFLineSegment = class(TPDFLineSegment);
- TMockPDFRectangle = class(TPDFRectangle);
- TMockPDFCurveC = class(TPDFCurveC);
- TMockPDFCurveV = class(TPDFCurveV);
- TMockPDFCurveY = class(TPDFCurveY);
- TMockPDFEllipse = class(TPDFEllipse);
- TMockPDFSurface = class(TPDFSurface);
- TMockPDFImage = class(TPDFImage);
- TMockPDFLineStyle = class(TPDFLineStyle);
- TMockPDFColor = class(TPDFColor);
- TMockPDFDictionaryItem = class(TPDFDictionaryItem);
- TMockPDFDictionary = class(TPDFDictionary);
- TMockPDFXRef = class(TPDFXRef);
- TMockPDFPage = class(TPDFPage);
- { TBasePDFTest }
- procedure TBasePDFTest.CreatePages(const ACount: integer);
- var
- page: TPDFPage;
- sec: TPDFSection;
- i: integer;
- begin
- if FPDF.Sections.Count = 0 then
- sec := FPDF.Sections.AddSection
- else
- sec := FPDF.Sections[0];
- for i := 1 to ACount do
- begin
- page := FPDF.Pages.AddPage;
- sec.AddPage(page);
- end;
- end;
- procedure TBasePDFTest.SetUp;
- begin
- inherited SetUp;
- FPDF := TPDFDocument.Create(nil);
- FStream := TStringStream.Create('');
- end;
- procedure TBasePDFTest.TearDown;
- begin
- FStream.Free;
- FPDF.Free;
- inherited TearDown;
- end;
- { TGeneralPDFTests }
- procedure TGeneralPDFTests.TestPDFCoord;
- var
- c: TPDFCoord;
- begin
- c.x := 0;
- c.y := 0;
- AssertEquals('Failed on 1', 0, c.x);
- AssertEquals('Failed on 2', 0, c.y);
- c := PDFCoord(10, 20);
- AssertEquals('Failed on 3', 10, c.x);
- AssertEquals('Failed on 4', 20, c.y);
- end;
- { TTestPDFObject }
- procedure TTestPDFObject.TestFloatStr;
- Var
- C : Char;
- begin
- AssertEquals('Failed on 1', '0.12', TMockPDFObject.FloatStr(TPDFFLoat(0.12)));
- AssertEquals('Failed on 2', '12', TMockPDFObject.FloatStr(TPDFFLoat(12.00)));
- AssertEquals('Failed on 3', '12.30', TMockPDFObject.FloatStr(TPDFFLoat(12.30)));
- AssertEquals('Failed on 4', '12.34', TMockPDFObject.FloatStr(TPDFFLoat(12.34)));
- AssertEquals('Failed on 5', '123.45', TMockPDFObject.FloatStr(TPDFFLoat(123.45)));
- AssertEquals('Failed on 6', '123.46', TMockPDFObject.FloatStr(TPDFFLoat(123.455)));
- AssertEquals('Failed on 7', '123.46', TMockPDFObject.FloatStr(TPDFFLoat(123.456)));
- AssertEquals('Failed on 8', '1234567.00', TMockPDFObject.FloatStr(TPDFFLoat(1234567)));
- // Set DecimalSeparator
- C:=FormatSettings.DecimalSeparator;
- FormatSettings.DecimalSeparator:=',';
- try
- AssertEquals('Failed on 9', '12.34', TMockPDFObject.FloatStr(TPDFFLoat(12.34)));
- finally
- FormatSettings.DecimalSeparator:=C;
- end;
- // Set ThousandSeparator
- C:=FormatSettings.ThousandSeparator;
- FormatSettings.ThousandSeparator:=' ';
- try
- AssertEquals('Failed on 10', '1234567.00', TMockPDFObject.FloatStr(TPDFFLoat(1234567)));
- finally
- FormatSettings.ThousandSeparator:=C;
- end;
- end;
- procedure TTestPDFObject.TestWriteString;
- var
- o: TMockPDFObject;
- begin
- o := TMockPDFObject.Create(PDF);
- try
- o.WriteString('Hello', S);
- AssertEquals('Failed on 1', 'Hello', s.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestTPDFDocumentObject }
- procedure TTestTPDFDocumentObject.TestSetWidth;
- var
- o: TMockPDFDocumentObject;
- begin
- o := TMockPDFDocumentObject.Create(PDF);
- try
- o.SetWidth(TPDFFloat(300.5), S);
- AssertEquals('Failed on 1',
- '1 J'+CRLF+
- '300.50 w'+CRLF, // line width
- s.DataString);
- // this shouldn't cause any change
- o.SetWidth(TPDFFloat(300.5), S);
- AssertEquals('Failed on 2',
- '1 J'+CRLF+
- '300.50 w'+CRLF, // line width
- s.DataString);
- // but this will
- o.SetWidth(TPDFFloat(123), S);
- AssertEquals('Failed on 3',
- '1 J'+CRLF+
- '300.50 w'+CRLF+ // line width 300.5
- '1 J'+CRLF+
- '123 w'+CRLF, // line width 123
- s.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFBoolean }
- procedure TTestPDFBoolean.TestWriteTrue;
- var
- o: TPDFBoolean;
- begin
- o := TPDFBoolean.Create(PDF, True);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFBoolean(o).Write(S);
- AssertEquals('Failed on 2', 'true', S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFBoolean.TestWriteFalse;
- var
- o: TPDFBoolean;
- begin
- o := TPDFBoolean.Create(PDF, False);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFBoolean(o).Write(S);
- AssertEquals('Failed on 2', 'false', S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFMoveTo }
- procedure TTestPDFMoveTo.TestCommandPDFFloat;
- var
- o: TPDFMoveTo;
- begin
- o := TPDFMoveTo.Create(PDF, 10, 20);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFMoveTo(o).Write(S);
- AssertEquals('Failed on 2', '10 20 m'+CRLF, S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFMoveTo.TestCommandPDFCoord;
- var
- c: TPDFCoord;
- o: TPDFMoveTo;
- begin
- c.X := 10;
- c.Y := 20;
- o := TPDFMoveTo.Create(PDF, c);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFMoveTo(o).Write(S);
- AssertEquals('Failed on 2', '10 20 m'+CRLF, S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFInteger }
- procedure TTestPDFInteger.TestWrite;
- var
- o: TPDFInteger;
- begin
- o := TPDFInteger.Create(PDF, 15);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFInteger(o).Write(S);
- AssertEquals('Failed on 2', '15', S.DataString);
- TMockPDFInteger(o).inc;
- TMockPDFInteger(o).Write(S);
- AssertEquals('Failed on 3', '1516', S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFReference }
- procedure TTestPDFReference.TestWrite;
- var
- o: TPDFReference;
- begin
- o := TPDFReference.Create(PDF, 10);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFReference(o).Write(S);
- AssertEquals('Failed on 2', '10 0 R', S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFName }
- procedure TTestPDFName.TestWrite;
- var
- o: TPDFName;
- begin
- o := TPDFName.Create(PDF, 'Test');
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFName(o).Write(S);
- AssertEquals('Failed on 2', '/Test', S.DataString);
- finally
- o.Free;
- end;
- { Length1 seems to be a special case? }
- o := TPDFName.Create(PDF, 'Length1');
- try
- TMockPDFName(o).Write(S);
- AssertEquals('Failed on 2', '/Test/Length1', S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFName.TestValidNames1;
- var
- o: TPDFName;
- begin
- o := TPDFName.Create(PDF, 'paired()parentheses');
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFName(o).Write(S);
- AssertEquals('Failed on 2', '/paired()parentheses', S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFName.TestValidNames2;
- var
- o: TPDFName;
- begin
- o := TPDFName.Create(PDF, 'Adobe Green');
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFName(o).Write(S);
- AssertEquals('Failed on 2', '/Adobe#20Green', S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFName.TestValidNames3;
- var
- o: TPDFName;
- begin
- o := TPDFName.Create(PDF, 'Adobe Green', False);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFName(o).Write(S);
- AssertEquals('Failed on 2', '/Adobe Green', S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFAbstractString }
- procedure TTestPDFAbstractString.TestInsertEscape;
- var
- o: TPDFAbstractString;
- begin
- o := TPDFAbstractString.Create(PDF);
- try
- AssertEquals('Failed on 1', 'abcdefg', TMockPDFString(o).InsertEscape('abcdefg'));
- AssertEquals('Failed on 2', 'a\\b/cdefg', TMockPDFString(o).InsertEscape('a\b/cdefg'));
- AssertEquals('Failed on 3', 'a\(b\)cdefg', TMockPDFString(o).InsertEscape('a(b)cdefg'));
- AssertEquals('Failed on 4', 'a\(b\)c\\def/g', TMockPDFString(o).InsertEscape('a(b)c\def/g'));
- finally
- o.Free;
- end;
- end;
- { TTestPDFString }
- procedure TTestPDFString.TestWrite;
- var
- o: TPDFString;
- begin
- PDF.Options := []; // disable all compression
- o := TPDFString.Create(PDF, 'Test');
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFString(o).Write(S);
- AssertEquals('Failed on 2', '(Test)', S.DataString);
- finally
- o.Free;
- end;
- S.Size := 0; // empty out the Stream data
- { Length1 seems to be a special case? }
- o := TPDFString.Create(PDF, #$C2#$A3+#$C2#$BB); // UTF-8 text of "£»"
- try
- TMockPDFString(o).Write(S); // write will convert UTF-8 to ANSI
- AssertEquals('Failed on 3', '('+#163#187+')', S.DataString);
- finally
- o.Free;
- end;
- end;
- { The symbols ( ) and \ get escaped before written to PDF }
- procedure TTestPDFString.TestWriteEscaped;
- var
- o: TPDFString;
- begin
- o := TPDFString.Create(PDF, 'a(b)c\def/g');
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFString(o).Write(S);
- AssertEquals('Failed on 2', '(a\(b\)c\\def/g)', S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFString.TestWriteEscaped2;
- var
- o: TPDFString;
- begin
- o := TPDFString.Create(PDF, 'Special characters (*!&}^% and so on).');
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFString(o).Write(S);
- AssertEquals('Failed on 2', '(Special characters \(*!&}^% and so on\).)', S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFUTF8String }
- procedure TTestPDFUTF8String.TestWrite;
- var
- o: TPDFUTF8String;
- fnt: integer;
- s8: UTF8String;
- begin
- PDF.Options := []; // disable all compression
- fnt := PDF.AddFont(cFont1, 'Liberation Sans');
- o := TPDFUTF8String.Create(PDF, 'TestT', fnt);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFUTF8String(o).Write(S);
- // T | e | s | t | T |
- AssertEquals('Failed on 2', '<00370048005600570037>', S.DataString);
- finally
- o.Free;
- end;
- S.Size := 0; // empty out the Stream data
- { Length1 seems to be a special case? }
- s8 := #$C2#$A3+#$C2#$BB;
- o := TPDFUTF8String.Create(PDF, s8, fnt); // UTF-8 text of "£»"
- try
- TMockPDFUTF8String(o).Write(S);
- // £ | » |
- AssertEquals('Failed on 3', '<0065007D>', S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFUTF8String.TestWriteEscaped;
- var
- o: TPDFUTF8String;
- fnt: integer;
- begin
- fnt := PDF.AddFont(cFont1, 'Liberation Sans');
- o := TPDFUTF8String.Create(PDF, 'a(b)c\def/g', fnt);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFUTF8String(o).Write(S);
- // a| ( | b | ) | c | \ | d | e | f | / | g |
- AssertEquals('Failed on 2', '<0044000B0045000C0046003F0047004800490012004A>', S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFArray }
- procedure TTestPDFArray.TestWrite;
- var
- o: TPDFArray;
- begin
- o := TPDFArray.Create(PDF);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFArray(o).AddIntArray('1 2 3 4'); // no trailing space in string
- TMockPDFArray(o).Write(S);
- AssertEquals('Failed on 2', '[1 2 3 4]', S.DataString);
- TMockPDFArray(o).AddIntArray('1 2 3 4 '); // now we have a trailing space
- TMockPDFArray(o).Write(S);
- AssertEquals('Failed on 3', '[1 2 3 4][1 2 3 4 1 2 3 4]', S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFStream }
- procedure TTestPDFStream.TestWrite;
- var
- o: TPDFStream;
- begin
- o := TPDFStream.Create(PDF, True);
- try
- TMockPDFStream(o).AddItem(TPDFString.Create(PDF, 'Hello World'));
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFStream(o).Write(S);
- AssertEquals('Failed on 2', '(Hello World)', S.DataString);
- TMockPDFStream(o).AddItem(TPDFString.Create(PDF, '12345'));
- TMockPDFStream(o).Write(S);
- AssertEquals('Failed on 3', '(Hello World)(Hello World)(12345)', S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFEmbeddedFont }
- procedure TTestPDFEmbeddedFont.TestWrite;
- var
- o: TPDFEmbeddedFont;
- p: TPDFPage;
- begin
- CreatePages(1);
- p := PDF.Pages[0];
- o := TPDFEmbeddedFont.Create(PDF, p, 1, '16');
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFEmbeddedFont(o).Write(S);
- AssertEquals('Failed on 2', '/F1 16 Tf'+CRLF, S.DataString); // DON't change CRLF to anything else
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFEmbeddedFont.TestWriteEmbeddedFont;
- var
- o: TPDFEmbeddedFont;
- lStream: TMemoryStream;
- str: String;
- p: TPDFPage;
- begin
- PDF.Options := []; // disable compressed fonts
- str := 'Hello World';
- CreatePages(1);
- p := PDF.Pages[0];
- o := TPDFEmbeddedFont.Create(PDF, p, 1, '16');
- try
- AssertEquals('Failed on 1', '', S.DataString);
- lStream := TMemoryStream.Create;
- lStream.Write(str[1], Length(str));
- TMockPDFEmbeddedFont(o).WriteEmbeddedFont(PDF, lStream, S);
- lStream.Free;
- // DON't change CRLF to anything else
- AssertEquals('Failed on 2', CRLF+'stream'+CRLF+'Hello World'+CRLF+'endstream', S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFText }
- procedure TTestPDFText.TestWrite;
- var
- o: TPDFText;
- x, y: TPDFFloat;
- begin
- x := 10.5;
- y := 20.0;
- o := TPDFText.Create(PDF, x, y, 'Hello World!', nil, 0, false, false);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFText(o).Write(S);
- AssertEquals('Failed on 2',
- 'BT'+CRLF+
- '10.50 20 TD'+CRLF+
- '(Hello World!) Tj'+CRLF+
- 'ET'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFLineSegment }
- procedure TTestPDFLineSegment.TestCommand;
- var
- pos: TPDFCoord;
- begin
- pos.X := 10.0;
- pos.Y := 55.5;
- AssertEquals('Failed on 1', '10 55.50 l'+CRLF, TPDFLineSegment.Command(pos));
- end;
- procedure TTestPDFLineSegment.TestWrite;
- var
- o: TPDFLineSegment;
- Width, X1,Y1, X2,Y2: TPDFFLoat;
- begin
- Width := 2.0;
- X1 := 10.0;
- Y1 := 15.5;
- X2 := 50.0;
- Y2 := 55.5;
- o := TPDFLineSegment.Create(PDF, Width, X1, Y1, X2, Y2);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- TMockPDFLineSegment(o).Write(S);
- AssertEquals('Failed on 2',
- '1 J'+CRLF+
- '2 w'+CRLF+ // line width
- '10 15.50 m'+CRLF+ // moveto command
- '50 55.50 l'+CRLF+ // line segment
- 'S'+CRLF, // end line segment
- S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestTPDFRectangle }
- procedure TTestTPDFRectangle.TestWrite_NoFill_NoStroke;
- var
- o: TMockPDFRectangle;
- lPosX, lPosY, lWidth, lHeight, lLineWidth: TPDFFLoat;
- begin
- lPosX := 10;
- lPosY := 11;
- lWidth := 100;
- lHeight := 200;
- lLineWidth := 1;
- o := TMockPDFRectangle.Create(PDF, lPosX, lPosY, lWidth, lHeight, lLineWidth, False, False);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '10 11 100 200 re'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestTPDFRectangle.TestWrite_Fill_Stroke;
- var
- o: TMockPDFRectangle;
- lPosX, lPosY, lWidth, lHeight, lLineWidth: TPDFFLoat;
- begin
- lPosX := 10;
- lPosY := 11;
- lWidth := 100;
- lHeight := 200;
- lLineWidth := 2;
- o := TMockPDFRectangle.Create(PDF, lPosX, lPosY, lWidth, lHeight, lLineWidth, True, True);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '1 J'+CRLF+
- '2 w'+CRLF+
- '10 11 100 200 re'+CRLF+
- 'b'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestTPDFRectangle.TestWrite_NoFill_Stroke;
- var
- o: TMockPDFRectangle;
- lPosX, lPosY, lWidth, lHeight, lLineWidth: TPDFFLoat;
- begin
- lPosX := 10;
- lPosY := 11;
- lWidth := 100;
- lHeight := 200;
- lLineWidth := 2;
- o := TMockPDFRectangle.Create(PDF, lPosX, lPosY, lWidth, lHeight, lLineWidth, False, True);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '1 J'+CRLF+
- '2 w'+CRLF+
- '10 11 100 200 re'+CRLF+
- 'S'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestTPDFRectangle.TestWrite_Fill_NoStroke;
- var
- o: TMockPDFRectangle;
- lPosX, lPosY, lWidth, lHeight, lLineWidth: TPDFFLoat;
- begin
- lPosX := 10;
- lPosY := 11;
- lWidth := 100;
- lHeight := 200;
- lLineWidth := 2;
- o := TMockPDFRectangle.Create(PDF, lPosX, lPosY, lWidth, lHeight, lLineWidth, True, False);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '10 11 100 200 re'+CRLF+
- 'f'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFCurveC }
- procedure TTestPDFCurveC.TestCommand;
- var
- X1,Y1: TPDFFloat;
- X2,Y2: TPDFFloat;
- X3,Y3: TPDFFloat;
- s1: string;
- begin
- X1 := 10;
- Y1 := 11;
- X2 := 100;
- Y2 := 9;
- X3 := 200;
- Y3 := 250;
- s1 := TMockPDFCurveC.Command(x1, y1, x2, y2, x3, y3);
- AssertEquals('Failed on 1', '10 11 100 9 200 250 c'+CRLF, s1);
- end;
- procedure TTestPDFCurveC.TestWrite_Stroke;
- var
- o: TMockPDFCurveC;
- X1,Y1: TPDFFloat;
- X2,Y2: TPDFFloat;
- X3,Y3: TPDFFloat;
- lLineWidth: TPDFFLoat;
- begin
- X1 := 10;
- Y1 := 11;
- X2 := 100;
- Y2 := 9;
- X3 := 200;
- Y3 := 250;
- lLineWidth := 2;
- o := TMockPDFCurveC.Create(PDF, x1, y1, x2, y2, x3, y3, lLineWidth, True);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '1 J'+CRLF+
- '2 w'+CRLF+
- '10 11 100 9 200 250 c'+CRLF+
- 'S'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFCurveC.TestWrite_NoStroke;
- var
- o: TMockPDFCurveC;
- X1,Y1: TPDFFloat;
- X2,Y2: TPDFFloat;
- X3,Y3: TPDFFloat;
- lLineWidth: TPDFFLoat;
- begin
- X1 := 10;
- Y1 := 11;
- X2 := 100;
- Y2 := 9;
- X3 := 200;
- Y3 := 250;
- lLineWidth := 2;
- o := TMockPDFCurveC.Create(PDF, x1, y1, x2, y2, x3, y3, lLineWidth, False);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '10 11 100 9 200 250 c'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFCurveV }
- procedure TTestPDFCurveV.TestWrite_Stroke;
- var
- o: TMockPDFCurveV;
- X2,Y2: TPDFFloat;
- X3,Y3: TPDFFloat;
- lLineWidth: TPDFFLoat;
- begin
- X2 := 100;
- Y2 := 9;
- X3 := 200;
- Y3 := 250;
- lLineWidth := 2;
- o := TMockPDFCurveV.Create(PDF, x2, y2, x3, y3, lLineWidth, True);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '1 J'+CRLF+
- '2 w'+CRLF+
- '100 9 200 250 v'+CRLF+
- 'S'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFCurveV.TestWrite_NoStroke;
- var
- o: TMockPDFCurveV;
- X2,Y2: TPDFFloat;
- X3,Y3: TPDFFloat;
- lLineWidth: TPDFFLoat;
- begin
- X2 := 100;
- Y2 := 9;
- X3 := 200;
- Y3 := 250;
- lLineWidth := 2;
- o := TMockPDFCurveV.Create(PDF, x2, y2, x3, y3, lLineWidth, False);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '100 9 200 250 v'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFCurveY }
- procedure TTestPDFCurveY.TestWrite_Stroke;
- var
- o: TMockPDFCurveY;
- X2,Y2: TPDFFloat;
- X3,Y3: TPDFFloat;
- lLineWidth: TPDFFLoat;
- begin
- X2 := 100;
- Y2 := 9;
- X3 := 200;
- Y3 := 250;
- lLineWidth := 2;
- o := TMockPDFCurveY.Create(PDF, x2, y2, x3, y3, lLineWidth, True);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '1 J'+CRLF+
- '2 w'+CRLF+
- '100 9 200 250 y'+CRLF+
- 'S'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFCurveY.TestWrite_NoStroke;
- var
- o: TMockPDFCurveY;
- X2,Y2: TPDFFloat;
- X3,Y3: TPDFFloat;
- lLineWidth: TPDFFLoat;
- begin
- X2 := 100;
- Y2 := 9;
- X3 := 200;
- Y3 := 250;
- lLineWidth := 2;
- o := TMockPDFCurveY.Create(PDF, x2, y2, x3, y3, lLineWidth, False);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '100 9 200 250 y'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFEllipse }
- procedure TTestPDFEllipse.TestWrite_NoFill_NoStroke;
- var
- o: TMockPDFEllipse;
- lPosX, lPosY, lWidth, lHeight, lLineWidth: TPDFFloat;
- begin
- lPosX := 10;
- lPosY := 20;
- lWidth := 200;
- lHeight := 250;
- lLineWidth := 2;
- o := TMockPDFEllipse.Create(PDF, lPosX, lPosY, lWidth, lHeight, lLineWidth, False, False);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- // move to
- '10 145 m'+CRLF+
- // curveC 1
- '10 75.96 54.77 20 110 20 c'+CRLF+
- // curveC 2
- '165.23 20 210 75.96 210 145 c'+CRLF+
- // curveC 3
- '210 214.04 165.23 270 110 270 c'+CRLF+
- // curveC 4
- '54.77 270 10 214.04 10 145 c'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFEllipse.TestWrite_Fill_NoStroke;
- var
- o: TMockPDFEllipse;
- lPosX, lPosY, lWidth, lHeight, lLineWidth: TPDFFloat;
- begin
- lPosX := 10;
- lPosY := 20;
- lWidth := 200;
- lHeight := 250;
- lLineWidth := 2;
- o := TMockPDFEllipse.Create(PDF, lPosX, lPosY, lWidth, lHeight, lLineWidth, True, False);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- // move to
- '10 145 m'+CRLF+
- // curveC 1
- '10 75.96 54.77 20 110 20 c'+CRLF+
- // curveC 2
- '165.23 20 210 75.96 210 145 c'+CRLF+
- // curveC 3
- '210 214.04 165.23 270 110 270 c'+CRLF+
- // curveC 4
- '54.77 270 10 214.04 10 145 c'+CRLF+
- 'f'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFEllipse.TestWrite_NoFill_Stroke;
- var
- o: TMockPDFEllipse;
- lPosX, lPosY, lWidth, lHeight, lLineWidth: TPDFFloat;
- begin
- lPosX := 10;
- lPosY := 20;
- lWidth := 200;
- lHeight := 250;
- lLineWidth := 2;
- o := TMockPDFEllipse.Create(PDF, lPosX, lPosY, lWidth, lHeight, lLineWidth, False, True);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '1 J'+CRLF+
- '2 w'+CRLF+
- // move to
- '10 145 m'+CRLF+
- // curveC 1
- '10 75.96 54.77 20 110 20 c'+CRLF+
- // curveC 2
- '165.23 20 210 75.96 210 145 c'+CRLF+
- // curveC 3
- '210 214.04 165.23 270 110 270 c'+CRLF+
- // curveC 4
- '54.77 270 10 214.04 10 145 c'+CRLF+
- 'S'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFEllipse.TestWrite_Fill_Stroke;
- var
- o: TMockPDFEllipse;
- lPosX, lPosY, lWidth, lHeight, lLineWidth: TPDFFloat;
- begin
- lPosX := 10;
- lPosY := 20;
- lWidth := 200;
- lHeight := 250;
- lLineWidth := 2;
- o := TMockPDFEllipse.Create(PDF, lPosX, lPosY, lWidth, lHeight, lLineWidth, True, True);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '1 J'+CRLF+
- '2 w'+CRLF+
- // move to
- '10 145 m'+CRLF+
- // curveC 1
- '10 75.96 54.77 20 110 20 c'+CRLF+
- // curveC 2
- '165.23 20 210 75.96 210 145 c'+CRLF+
- // curveC 3
- '210 214.04 165.23 270 110 270 c'+CRLF+
- // curveC 4
- '54.77 270 10 214.04 10 145 c'+CRLF+
- 'b'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFSurface }
- procedure TTestPDFSurface.TestWrite;
- var
- o: TMockPDFSurface;
- ar: TPDFCoordArray;
- p1, p2, p3: TPDFCoord;
- begin
- SetLength(ar, 3);
- p1.X := 10; p1.Y := 20;
- p2.X := 30; p2.Y := 40;
- p3.X := 50; p3.Y := 60;
- ar[0] := p1;
- ar[1] := p2;
- ar[2] := p3;
- o := TMockPDFSurface.Create(PDF, ar, True, True);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- // move to - p0
- '10 20 m'+CRLF+
- // line segment - p1
- '30 40 l'+CRLF+
- // line segment - p2
- '50 60 l'+CRLF+
- 'h'+CRLF+ // close
- 'f'+CRLF, // fill
- S.DataString);
- finally
- SetLength(ar, 0);
- o.Free;
- end;
- end;
- procedure TTestPDFSurface.TestWrite_noFill;
- var
- o: TMockPDFSurface;
- ar: TPDFCoordArray;
- p1, p2, p3: TPDFCoord;
- begin
- SetLength(ar, 3);
- p1.X := 10; p1.Y := 20;
- p2.X := 30; p2.Y := 40;
- p3.X := 50; p3.Y := 60;
- ar[0] := p1;
- ar[1] := p2;
- ar[2] := p3;
- o := TMockPDFSurface.Create(PDF, ar, True, False);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- // move to - p0
- '10 20 m'+CRLF+
- // line segment - p1
- '30 40 l'+CRLF+
- // line segment - p2
- '50 60 l'+CRLF+
- 'h'+CRLF, // close
- S.DataString);
- finally
- SetLength(ar, 0);
- o.Free;
- end;
- end;
- procedure TTestPDFSurface.TestWrite_noClose;
- var
- o: TMockPDFSurface;
- ar: TPDFCoordArray;
- p1, p2, p3: TPDFCoord;
- begin
- SetLength(ar, 3);
- p1.X := 10; p1.Y := 20;
- p2.X := 30; p2.Y := 40;
- p3.X := 50; p3.Y := 60;
- ar[0] := p1;
- ar[1] := p2;
- ar[2] := p3;
- o := TMockPDFSurface.Create(PDF, ar, False, True);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- // move to - p0
- '10 20 m'+CRLF+
- // line segment - p1
- '30 40 l'+CRLF+
- // line segment - p2
- '50 60 l'+CRLF+
- 'f'+CRLF, // fill
- S.DataString);
- finally
- SetLength(ar, 0);
- o.Free;
- end;
- end;
- { TTestPDFImage }
- procedure TTestPDFImage.TestWrite;
- var
- o: TMockPDFImage;
- x, y: TPDFFLoat;
- begin
- x := 100;
- y := 200;
- o := TMockPDFImage.Create(PDF, x, y, 150, 75, 1);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- // save graphics state
- 'q'+CRLF+
- '150 0 0 75 100 200 cm'+CRLF+
- '/I1 Do'+CRLF+
- // restore graphics state
- 'Q'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFImage.TestPageDrawImage_Pixels;
- var
- p: TPDFPage;
- img: TMockPDFImage;
- begin
- PDF.Options := [poPageOriginAtTop];
- p := PDF.Pages.AddPage;
- p.UnitOfMeasure := uomMillimeters;
- AssertEquals('Failed on 1', 0, p.ObjectCount);
- p.DrawImageRawSize(10, 20, 200, 100, 1);
- AssertEquals('Failed on 2', 1, p.ObjectCount);
- img := TMockPDFImage(p.Objects[0]);
- AssertTrue('Failed on 3', img <> nil);
- AssertEquals('Failed on 4', '', S.DataString);
- img.Write(S);
- AssertEquals('Failed on 5',
- // save graphics state
- 'q'+CRLF+
- '200 0 0 100 28.35 785.31 cm'+CRLF+
- '/I1 Do'+CRLF+
- // restore graphics state
- 'Q'+CRLF,
- S.DataString);
- S.Size := 0; // clear the stream data
- p := PDF.Pages.AddPage;
- p.UnitOfMeasure := uomCentimeters;
- AssertEquals('Failed on 6', 0, p.ObjectCount);
- p.DrawImageRawSize(10, 20, 200, 100, 1);
- AssertEquals('Failed on 7', 1, p.ObjectCount);
- img := TMockPDFImage(p.Objects[0]);
- AssertTrue('Failed on 8', img <> nil);
- AssertEquals('Failed on 9', '', S.DataString);
- img.Write(S);
- AssertEquals('Failed on 10',
- // save graphics state
- 'q'+CRLF+
- '200 0 0 100 283.46 275.07 cm'+CRLF+
- '/I1 Do'+CRLF+
- // restore graphics state
- 'Q'+CRLF,
- S.DataString);
- end;
- procedure TTestPDFImage.TestPageDrawImage_UnitsOfMeasure;
- var
- p: TPDFPage;
- img: TMockPDFImage;
- begin
- PDF.Options := [poPageOriginAtTop];
- p := PDF.Pages.AddPage;
- p.UnitOfMeasure := uomMillimeters;
- AssertEquals('Failed on 1', 0, p.ObjectCount);
- p.DrawImage(10, 20, 20.0, 10.0, 1);
- AssertEquals('Failed on 2', 1, p.ObjectCount);
- img := TMockPDFImage(p.Objects[0]);
- AssertTrue('Failed on 3', img <> nil);
- AssertEquals('Failed on 4', '', S.DataString);
- img.Write(S);
- AssertEquals('Failed on 5',
- // save graphics state
- 'q'+CRLF+
- '56.69 0 0 28.35 28.35 785.31 cm'+CRLF+
- '/I1 Do'+CRLF+
- // restore graphics state
- 'Q'+CRLF,
- S.DataString);
- S.Size := 0; // clear the stream data
- p := PDF.Pages.AddPage;
- p.UnitOfMeasure := uomCentimeters;
- AssertEquals('Failed on 6', 0, p.ObjectCount);
- p.DrawImage(10, 20, 20.0, 10.0, 1);
- AssertEquals('Failed on 7', 1, p.ObjectCount);
- img := TMockPDFImage(p.Objects[0]);
- AssertTrue('Failed on 8', img <> nil);
- AssertEquals('Failed on 9', '', S.DataString);
- img.Write(S);
- AssertEquals('Failed on 10',
- // save graphics state
- 'q'+CRLF+
- '566.93 0 0 283.46 283.46 275.07 cm'+CRLF+
- '/I1 Do'+CRLF+
- // restore graphics state
- 'Q'+CRLF,
- S.DataString);
- end;
- { TTestPDFLineStyle }
- procedure TTestPDFLineStyle.TestWrite_ppsSolid;
- var
- o: TMockPDFLineStyle;
- begin
- o := TMockPDFLineStyle.Create(PDF, ppsSolid, 1, 1);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '[] 1 d'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFLineStyle.TestWrite_ppsDash;
- var
- o: TMockPDFLineStyle;
- begin
- o := TMockPDFLineStyle.Create(PDF, ppsDash, 2, 1);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '[5 5] 2 d'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFLineStyle.TestWrite_ppsDot;
- var
- o: TMockPDFLineStyle;
- begin
- o := TMockPDFLineStyle.Create(PDF, ppsDot, 3, 1);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '[0.80 4] 3 d'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFLineStyle.TestWrite_ppsDashDot;
- var
- o: TMockPDFLineStyle;
- begin
- o := TMockPDFLineStyle.Create(PDF, ppsDashDot, 4, 1);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '[5 3 0.80 3] 4 d'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFLineStyle.TestWrite_ppsDashDotDot;
- var
- o: TMockPDFLineStyle;
- begin
- o := TMockPDFLineStyle.Create(PDF, ppsDashDotDot, 1, 1);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '[5 3 0.80 3 0.80 3] 1 d'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFLineStyle.TestLocalisationChanges;
- var
- o: TMockPDFLineStyle;
- d: char;
- begin
- d := DefaultFormatSettings.DecimalSeparator;
- DefaultFormatSettings.DecimalSeparator := Char('~');
- o := TMockPDFLineStyle.Create(PDF, ppsDashDotDot, 1, 1);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '[5 3 0.80 3 0.80 3] 1 d'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- DefaultFormatSettings.DecimalSeparator := d;
- end;
- { TTestPDFColor }
- procedure TTestPDFColor.TestWrite_Stroke;
- var
- o: TMockPDFColor;
- begin
- o := TMockPDFColor.Create(PDF, True, $AABBCC);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '0.66 0.73 0.80 RG'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- procedure TTestPDFColor.TestWrite_noStroke;
- var
- o: TMockPDFColor;
- begin
- o := TMockPDFColor.Create(PDF, False, $AABBCC);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '0.66 0.73 0.80 rg'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFDictionaryItem }
- procedure TTestPDFDictionaryItem.TestWrite;
- var
- o: TMockPDFDictionaryItem;
- v: TPDFString;
- begin
- v := TPDFString.Create(PDF, 'TestValue');
- o := TMockPDFDictionaryItem.Create(PDF, 'tv', v);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '/tv (TestValue)'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFDictionary }
- procedure TTestPDFDictionary.TestWrite;
- var
- o: TMockPDFDictionary;
- v: TPDFString;
- begin
- v := TPDFString.Create(PDF, 'TestValue');
- o := TMockPDFDictionary.Create(PDF);
- o.AddName('key1','value1');
- o.AddElement('key2', v);
- o.AddInteger('key3', 1234);
- o.AddString('key4', 'string4');
- o.AddReference('key5', 987);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '<<'+CRLF+
- '/key1 /value1'+CRLF+
- '/key2 (TestValue)'+CRLF+
- '/key3 1234'+CRLF+
- '/key4 (string4)'+CRLF+
- '/key5 987 0 R'+CRLF+
- '>>',
- S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFXRef }
- procedure TTestPDFXRef.TestWrite;
- var
- o: TMockPDFXRef;
- begin
- o := TMockPDFXRef.Create(PDF);
- try
- AssertEquals('Failed on 1', '', S.DataString);
- o.Write(S);
- AssertEquals('Failed on 2',
- '0000000000 00000 n'+CRLF,
- S.DataString);
- o.Offset := 234;
- o.Write(S);
- AssertEquals('Failed on 3',
- '0000000000 00000 n'+CRLF+
- '0000000234 00000 n'+CRLF,
- S.DataString);
- finally
- o.Free;
- end;
- end;
- { TTestPDFPage }
- procedure TTestPDFPage.TestPageDocument;
- var
- p: TPDFPage;
- begin
- p := PDF.Pages.AddPage;
- AssertTrue('Failed on 1', p.Document = PDF);
- AssertTrue('Failed on 2', p.UnitOfMeasure = uomMillimeters);
- end;
- procedure TTestPDFPage.TestPageDefaultUnitOfMeasure;
- var
- p: TPDFPage;
- begin
- p := PDF.Pages.AddPage;
- AssertTrue('Failed on 1', p.UnitOfMeasure = uomMillimeters);
- end;
- // (0,0) origin is at top-left of page
- procedure TTestPDFPage.TestMatrixOn;
- var
- p: TPDFPage;
- pt1, pt2: TPDFCoord;
- begin
- PDF.Options := [poPageOriginAtTop];
- p := PDF.Pages.AddPage;
- AssertTrue('Failed on 1', p.UnitOfMeasure = uomMillimeters);
- AssertEquals('Failed on 2', mmToPDF(p.Matrix._21), p.Paper.H);
- pt1.X := 10;
- pt1.Y := 20;
- pt2 := p.Matrix.Transform(pt1);
- AssertEquals('Failed on 3', 10, pt2.X);
- AssertEquals('Failed on 4', 297-20, pt2.Y, 0.1);
- pt1 := p.Matrix.ReverseTransform(pt2);
- AssertEquals('Failed on 5', 10, pt1.X);
- AssertEquals('Failed on 6', 20, pt1.Y, 0.1);
- end;
- // (0,0) origin is at bottom-left of page
- procedure TTestPDFPage.TestMatrixOff;
- var
- p: TPDFPage;
- pt1, pt2: TPDFCoord;
- begin
- PDF.Options := [];
- p := PDF.Pages.AddPage;
- AssertTrue('Failed on 1', p.UnitOfMeasure = uomMillimeters);
- AssertEquals('Failed on 2', mmToPDF(p.Matrix._21), 0);
- pt1.X := 10;
- pt1.Y := 20;
- pt2 := p.Matrix.Transform(pt1);
- AssertEquals('Failed on 3', 10, pt2.X);
- AssertEquals('Failed on 4', 20, pt2.Y, 0.1);
- pt1 := p.Matrix.ReverseTransform(pt2);
- AssertEquals('Failed on 5', 10, pt1.X);
- AssertEquals('Failed on 6', 20, pt1.Y, 0.1);
- end;
- procedure TTestPDFPage.TestUnitOfMeasure_MM;
- var
- p: TPDFPage;
- pt: TPDFCoord;
- begin
- p := PDF.Pages.AddPage;
- p.UnitOfMeasure := uomMillimeters;
- pt.X := 20;
- pt.Y := 35;
- TMockPDFPage(p).doUnitConversion(pt);
- AssertEquals('Failed on 1', 56.69, pt.X, 0.01);
- AssertEquals('Failed on 2', 99.21, pt.Y, 0.01);
- pt.X := 40;
- pt.Y := 20;
- TMockPDFPage(p).doUnitConversion(pt);
- AssertEquals('Failed on 3', 113.38, pt.X, 0.01);
- AssertEquals('Failed on 4', 56.69, pt.Y, 0.01);
- end;
- procedure TTestPDFPage.TestUnitOfMeasure_Inches;
- var
- p: TPDFPage;
- pt: TPDFCoord;
- begin
- p := PDF.Pages.AddPage;
- p.UnitOfMeasure := uomInches;
- pt.X := 1;
- pt.Y := 1.5;
- TMockPDFPage(p).doUnitConversion(pt);
- AssertEquals('Failed on 1', 72.0, pt.X, 0.01);
- AssertEquals('Failed on 2', 108.0, pt.Y, 0.01);
- pt.X := 2;
- pt.Y := 1;
- TMockPDFPage(p).doUnitConversion(pt);
- AssertEquals('Failed on 3', 144.0, pt.X, 0.01);
- AssertEquals('Failed on 4', 72.0, pt.Y, 0.01);
- end;
- procedure TTestPDFPage.TestUnitOfMeasure_CM;
- var
- p: TPDFPage;
- pt: TPDFCoord;
- begin
- p := PDF.Pages.AddPage;
- p.UnitOfMeasure := uomMillimeters;
- pt.X := 2.0;
- pt.Y := 3.5;
- TMockPDFPage(p).doUnitConversion(pt);
- AssertEquals('Failed on 1', 5.669, pt.X, 0.01);
- AssertEquals('Failed on 2', 9.921, pt.Y, 0.01);
- pt.X := 4.0;
- pt.Y := 2.0;
- TMockPDFPage(p).doUnitConversion(pt);
- AssertEquals('Failed on 3', 11.338, pt.X, 0.01);
- AssertEquals('Failed on 4', 5.669, pt.Y, 0.01);
- end;
- { TTestCompressionDecompression }
- function TTestCompressionDecompression.GetTestString: string;
- var
- i: integer;
- lsLine: string;
- begin
- result := '';
- lsLine := '';
- for i := 1 to 1000 do
- lsLine := lsLine + Chr(ord('A')+Random(ord('z')-ord('A')));
- for i := 1 to 200 do
- result := result + lsLine + LineEnding;
- Result := 'Hello World';
- end;
- procedure TTestCompressionDecompression.TestStreamCompressionDecompression;
- var
- lSBefore: TStringStream;
- lSAfter: TStringStream;
- lCompressed: TMemoryStream;
- lBefore: string;
- lAfter: string;
- begin
- lBefore := GetTestString;
- lSBefore := TStringStream.Create(lBefore);
- lCompressed := TMemoryStream.Create;
- CompressStream(lSBefore, lCompressed);
- try
- lSAfter := TStringStream.Create('');
- DecompressStream(lCompressed, lSAfter);
- lAfter := lSAfter.DataString;
- AssertTrue('Compression failed. Strings are not the same. ' +IntToStr(Length(lBefore)) + ' vs ' + IntToStr(Length(lAfter)), lBefore = lAfter);
- finally
- lSBefore.Free;
- lCompressed.Free;
- lSAfter.Free;
- end;
- end;
- procedure TTestCompressionDecompression.TestStringCompressionDecompression;
- var
- lBefore: string;
- lCompressed: string;
- lAfter: string;
- s: TStringStream;
- e: TStringStream;
- begin
- lBefore := GetTestString;
- lCompressed := '';
- CompressString(lBefore, lCompressed);
- s := TStringStream.Create(lCompressed);
- try
- e := TStringStream.Create('');
- s.Position := 0;
- DecompressStream(s, e);
- lAfter := e.DataString;
- finally
- e.Free;
- s.Free;
- end;
- AssertTrue('Compression failed. Strings are not the same. ' +IntToStr(Length(lBefore)) + ' vs ' + IntToStr(Length(lAfter)), lBefore = lAfter);
- end;
- { TTestTPDFImageItem }
- procedure TTestTPDFImageItem.TestCreateStreamedData_Compressed;
- var
- list: TPDFImages;
- itm: TPDFImageItem;
- img: TFPMemoryImage;
- b: TBytes;
- begin
- list := TPDFImages.Create(nil, TPDFImageItem);
- try
- itm := list.AddImageItem;
- try
- itm.OwnsImage := True;
- img := TFPMemoryImage.Create(5, 5);
- itm.Image := img;
- b := itm.StreamedData;
- AssertEquals('Failed on 1', 12, Length(b));
- finally
- itm.Free;
- end;
- itm := list.AddImageItem;
- try
- itm.OwnsImage := True;
- img := TFPMemoryImage.Create(10, 20);
- itm.Image := img;
- { this try..except is to prove that we had a bug before, but fixed it. }
- try
- b := itm.StreamedData;
- except
- Fail('Failed on 2 - itm.StreamedData raised an exception');
- end;
- AssertEquals('Failed on 3', 15, Length(b));
- finally
- itm.Free;
- end;
- finally
- list.Free;
- end;
- end;
- procedure TTestTPDFImageItem.TestCreateStreamedData_Uncompressed;
- var
- pdf: TPDFDocument;
- list: TPDFImages;
- itm: TPDFImageItem;
- img: TFPMemoryImage;
- b: TBytes;
- begin
- pdf := TPDFDocument.Create(nil);
- pdf.Options := []; // disables the default image compression
- list := TPDFImages.Create(pdf, TPDFImageItem);
- try
- itm := list.AddImageItem;
- try
- itm.OwnsImage := True;
- img := TFPMemoryImage.Create(5, 5);
- itm.Image := img;
- b := itm.StreamedData;
- AssertEquals('Failed on 1', 75 {5*5*3}, Length(b));
- finally
- itm.Free;
- end;
- itm := list.AddImageItem;
- try
- itm.OwnsImage := True;
- img := TFPMemoryImage.Create(10, 20);
- itm.Image := img;
- { this try..except is to prove that we had a bug before, but fixed it. }
- try
- b := itm.StreamedData;
- except
- Fail('Failed on 2 - itm.StreamedData raised an exception');
- end;
- AssertEquals('Failed on 3', 600 {10*20*3}, Length(b));
- finally
- itm.Free;
- end;
- finally
- pdf.Free;
- list.Free;
- end;
- end;
- initialization
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TGeneralPDFTests{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFObject{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestTPDFDocumentObject{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFBoolean{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFMoveTo{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFInteger{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFReference{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFName{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFAbstractString{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFString{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFUTF8String{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFArray{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFStream{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFEmbeddedFont{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFText{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFLineSegment{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestTPDFRectangle{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFCurveC{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFCurveV{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFCurveY{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFEllipse{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFSurface{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFImage{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFLineStyle{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFColor{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFDictionaryItem{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFDictionary{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFXRef{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFPage{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestCompressionDecompression{$ifdef fptest}.Suite{$endif});
- RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestTPDFImageItem{$ifdef fptest}.Suite{$endif});
- end.
|