tcbasereport.pp 99 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708
  1. unit tcbasereport;
  2. {$mode objfpc}{$H+}
  3. {.$define gdebug}
  4. interface
  5. uses
  6. Classes,
  7. SysUtils,
  8. fpcunit,
  9. testregistry,
  10. fpexprpars,
  11. fpCanvas,
  12. fpReport;
  13. type
  14. TMyFPReportComponent = class(TFPReportComponent)
  15. public
  16. procedure StartLayout; override;
  17. procedure EndLayout; override;
  18. procedure StartRender; override;
  19. procedure EndRender; override;
  20. end;
  21. TMyFPReportElement = class(TFPReportElement)
  22. private
  23. FChangedCalled: integer;
  24. public
  25. procedure CallChange;
  26. procedure ResetChanged;
  27. procedure DoChanged; override;
  28. property ChangedCalled: integer read FChangedCalled;
  29. end;
  30. TMyFPReportElementWithChildren = class(TFPReportElementWithChildren)
  31. private
  32. FChangedCalled: integer;
  33. public
  34. procedure CallChange;
  35. procedure ResetChanged;
  36. procedure DoChanged; override;
  37. property ChangedCalled: integer read FChangedCalled;
  38. end;
  39. TMyFPReportPageSize = class(TFPReportPageSize)
  40. private
  41. FChangedCalled: integer;
  42. public
  43. procedure ResetChanged;
  44. procedure Changed; override;
  45. property ChangedCalled: integer read FChangedCalled;
  46. end;
  47. TMyFPReportPage = class(TFPReportPage)
  48. private
  49. FChangedCalled: integer;
  50. FPrepareObjectsCalled: integer;
  51. procedure SetupPage;
  52. protected
  53. procedure PrepareObjects(aRTParent: TFPReportElement); override;
  54. public
  55. constructor Create(AOwner: TComponent); override;
  56. procedure ResetChanged;
  57. procedure DoChanged; override;
  58. property ChangedCalled: integer read FChangedCalled;
  59. end;
  60. TMyReportTitleBand = class(TFPReportCustomTitleBand)
  61. private
  62. FPrepareObjectsCalled: integer;
  63. protected
  64. procedure PrepareObjects(aRTParent: TFPReportElement); override;
  65. public
  66. constructor Create(AOwner: TComponent); override;
  67. end;
  68. TMyDataBand = class(TFPReportDataBand)
  69. private
  70. FPrepareObjectsCalled: integer;
  71. protected
  72. procedure PrepareObjects(aRTParent: TFPReportElement); override;
  73. public
  74. constructor Create(AOwner: TComponent); override;
  75. end;
  76. TMyCustomReport = class(TFPReport)
  77. end;
  78. TMyFPReportData = class(TFPReportData)
  79. private
  80. FCC: integer;
  81. FDFC: integer;
  82. FEC: integer;
  83. FFC: integer;
  84. FNC: integer;
  85. FOC: integer;
  86. FOE: boolean;
  87. FReportEOF: boolean;
  88. public
  89. procedure ResetCounts;
  90. procedure DoInitDataFields; override;
  91. procedure DoOpen; override;
  92. procedure DoFirst; override;
  93. procedure DoNext; override;
  94. procedure DoClose; override;
  95. function DoEOF: boolean; override;
  96. property InitDataFieldsCount: integer read FDFC;
  97. property OpenCount: integer read FOC;
  98. property FirstCount: integer read FFC;
  99. property NextCount: integer read FNC;
  100. property CloseCount: integer read FCC;
  101. property EOFCount: integer read FEC;
  102. property ReportEOF: boolean read FReportEOF write FReportEOF;
  103. property OldEOF: boolean read FOE;
  104. property Datafields;
  105. end;
  106. TTestFPPageSize = class(TTestCase)
  107. published
  108. procedure TestCreate;
  109. end;
  110. TTestFPPapers = class(TTestCase)
  111. protected
  112. FM: TFPReportPaperManager;
  113. procedure Setup; override;
  114. procedure TearDown; override;
  115. procedure RegisterPapers(ACount: integer; Local: boolean = True);
  116. end;
  117. TTestFPPaperManager = class(TTestFPPapers)
  118. private
  119. FAccess: integer;
  120. procedure TestAccess;
  121. protected
  122. procedure Setup; override;
  123. published
  124. procedure TestCreate;
  125. procedure TestRegister1;
  126. procedure TestRegister2;
  127. procedure TestRegister3;
  128. procedure TestRegisterDuplicate;
  129. procedure TestClear;
  130. procedure TestFind1;
  131. procedure TestFind2;
  132. procedure TestFind3;
  133. procedure IllegalAccess1;
  134. procedure IllegalAccess2;
  135. procedure IllegalAccess3;
  136. procedure IllegalAccess4;
  137. procedure IllegalAccess5;
  138. procedure IllegalAccess6;
  139. procedure IllegalAccess7;
  140. procedure IllegalAccess8;
  141. procedure TestWidth;
  142. procedure TestHeight;
  143. end;
  144. TTestFPReportPageSize = class(TTestFPPapers)
  145. private
  146. FP: TMyFPReportPageSize;
  147. protected
  148. procedure Setup; override;
  149. procedure TearDown; override;
  150. published
  151. procedure TestCreate;
  152. procedure TestCreateWithPage;
  153. procedure TestCreateByPage;
  154. procedure TestChanged1;
  155. procedure TestChanged2;
  156. procedure TestChanged3;
  157. procedure TestPaperName1;
  158. procedure TestPaperName2;
  159. procedure TestAssign;
  160. end;
  161. TBaseReportComponentTest = class(TTestCase)
  162. private
  163. FC: TMyFPReportComponent;
  164. procedure ExpectState(const aExpected: TFPReportState);
  165. protected
  166. procedure AssertEquals(Msg: string; const aExpected, AActual: TFPReportState); overload;
  167. procedure SetUp; override;
  168. procedure TearDown; override;
  169. end;
  170. TTestReportComponent = class(TBaseReportComponentTest)
  171. published
  172. procedure TestCreate;
  173. procedure TestLayoutState;
  174. procedure TestRenderState;
  175. end;
  176. TBaseReportElementTest = class(TTestCase)
  177. private
  178. FC: TMyFPReportElement;
  179. protected
  180. procedure SetUp; override;
  181. procedure TearDown; override;
  182. end;
  183. TReportElementTest = class(TBaseReportElementTest)
  184. published
  185. procedure TestCreate;
  186. procedure TestDoChange;
  187. procedure TestChangeCount;
  188. procedure TestChangeCountNested;
  189. procedure TestChangeCountNested2;
  190. procedure TestVisibleChanges;
  191. procedure TestLayoutChanges;
  192. procedure TestFrameChanges;
  193. procedure TestAssign;
  194. procedure TestEquals1;
  195. procedure TestEquals2;
  196. procedure TestEquals3;
  197. procedure TestEquals4;
  198. procedure TestEquals5;
  199. end;
  200. TTestReportChildren = class(TTestCase)
  201. private
  202. FC: TMyFPReportElementWithChildren;
  203. FChild: TFPReportElement;
  204. protected
  205. procedure SetUp; override;
  206. procedure TearDown; override;
  207. procedure WrongParent;
  208. published
  209. procedure TestCreate;
  210. procedure TestSetParent1;
  211. procedure TestSetParent2;
  212. procedure TestSetParent3;
  213. procedure TestSetParent4;
  214. procedure TestSetParent5;
  215. procedure TestSetParent6;
  216. end;
  217. TTestReportFrame = class(TBaseReportElementTest)
  218. published
  219. procedure TestCreate;
  220. procedure TestWidthChange;
  221. procedure TestColorChange;
  222. procedure TestPenStyleChange;
  223. procedure TestShapeChange;
  224. procedure TestLinesChange;
  225. procedure TestAssign;
  226. procedure TestEquals1;
  227. procedure TestEquals2;
  228. procedure TestEquals3;
  229. procedure TestEquals4;
  230. procedure TestEquals5;
  231. procedure TestEquals6;
  232. procedure TestEquals7;
  233. end;
  234. TTestReportLayout = class(TBaseReportElementTest)
  235. published
  236. procedure TestCreate;
  237. procedure TestTopChange;
  238. procedure TestLeftChange;
  239. procedure TestWidthChange;
  240. procedure TestHeightChange;
  241. procedure TestAssign;
  242. procedure TestEquals1;
  243. procedure TestEquals2;
  244. procedure TestEquals3;
  245. procedure TestEquals4;
  246. procedure TestEquals5;
  247. procedure TestEquals6;
  248. end;
  249. TTestCaseWithData = class(TTestCase)
  250. private
  251. FData: TFPReportUserData;
  252. FSL: TStringList;
  253. procedure InitializeData(const ACount: integer);
  254. procedure SetReportData(const ADataCount: Byte);
  255. procedure DoGetDataValue(Sender: TObject; const AValueName: string; var AValue: variant);
  256. procedure DoGetDataEOF(Sender: TObject; var IsEOF: boolean);
  257. protected
  258. procedure SetUp; override;
  259. procedure TearDown; override;
  260. public
  261. property Data: TFPReportUserData read FData write FData;
  262. end;
  263. TTestCaseWithDataAndReport = class(TTestCaseWithData)
  264. private
  265. FReport: TMyCustomReport;
  266. protected
  267. procedure SetUp; override;
  268. procedure TearDown; override;
  269. public
  270. property Report: TMyCustomReport read FReport write FReport;
  271. end;
  272. TTestReportPage = class(TTestCase)
  273. private
  274. FP: TMyFPReportPage;
  275. protected
  276. procedure Setup; override;
  277. procedure TearDown; override;
  278. published
  279. procedure TestCreate1;
  280. procedure TestCreate2;
  281. procedure TestCreate3;
  282. procedure TestPageSize1;
  283. procedure TestPageSize2;
  284. procedure TestPageSize3;
  285. procedure TestBand1;
  286. procedure TestBand2;
  287. procedure TestData;
  288. procedure TestAssign;
  289. procedure TestFindBand;
  290. end;
  291. TTestReportData = class(TTestCase)
  292. private
  293. FD: TMyFPReportData;
  294. FHandler: boolean;
  295. procedure AssertField(Prefix: string; F: TFPReportDataField; AFieldName: string;
  296. AFieldKind: TFPReportFieldKind; ADisplayWidth: integer = 0);
  297. protected
  298. procedure DoOpen(Sender: TObject);
  299. procedure DoNext(Sender: TObject);
  300. procedure Setup; override;
  301. procedure TearDown; override;
  302. procedure CreateFields;
  303. procedure DoFieldByName;
  304. published
  305. procedure TestCreate;
  306. procedure TestOpen1;
  307. procedure TestNext;
  308. procedure TestInitFieldDefs;
  309. procedure TestInitFieldDefs_OnlyAllowedOnce;
  310. procedure TestEOF1;
  311. procedure TestAddDatafield;
  312. procedure TestDatafieldAdd;
  313. procedure TestCreateFields;
  314. procedure TestDatafieldIndexOf1;
  315. procedure TestDatafieldIndexOf2;
  316. procedure TestFindField1;
  317. procedure TestFindField2;
  318. procedure TestFindByName1;
  319. procedure TestFindByName2;
  320. procedure TestFieldAssign;
  321. procedure TestGetValue;
  322. procedure TestEasyAccessProperties;
  323. end;
  324. { Testing UserData by pulling data from a DataField }
  325. TTestUserReportData = class(TTestCase)
  326. private
  327. FD: TFPReportUserData;
  328. FExpectName: string;
  329. FReturnValue: variant;
  330. procedure DoValue(Sender: TObject; const AValueName: string; var AValue: variant);
  331. protected
  332. procedure Setup; override;
  333. procedure TearDown; override;
  334. published
  335. procedure TestGetValue;
  336. end;
  337. { Testing UserData by pulling data from a StringList }
  338. TTestUserReportData2 = class(TTestCase)
  339. private
  340. FData: TFPReportUserData;
  341. FSL: TStringList;
  342. procedure DoGetValue(Sender: TObject; const AValueName: string; var AValue: variant);
  343. procedure DoGetEOF(Sender: TObject; var IsEOF: boolean);
  344. protected
  345. procedure Setup; override;
  346. procedure TearDown; override;
  347. published
  348. procedure TestGetValue;
  349. procedure TestOnGetEOF1;
  350. procedure TestOnGetEOF2;
  351. end;
  352. TTestDataBand = class(TTestCaseWithDataAndReport)
  353. private
  354. FDataBand: TFPReportDataBand;
  355. protected
  356. procedure Setup; override;
  357. procedure TearDown; override;
  358. published
  359. procedure TestData;
  360. procedure TestDataPropertyAutoSet;
  361. end;
  362. TTestCustomReport = class(TTestCase)
  363. private
  364. FRpt: TMyCustomReport;
  365. FBeginReportCount: integer;
  366. FEndReportCount: integer;
  367. FSL: TStringList;
  368. FData: TFPReportUserData;
  369. procedure HandleOnBeginReport;
  370. procedure HandleOnEndReport;
  371. procedure InitializeData(const ACount: integer);
  372. procedure SetReportData(const ADataCount: Byte);
  373. procedure DoGetDataValue(Sender: TObject; const AValueName: string; var AValue: variant);
  374. procedure DoGetDataEOF(Sender: TObject; var IsEOF: boolean);
  375. procedure DoGetDataFieldNames(Sender: TObject; List: TStrings);
  376. protected
  377. procedure Setup; override;
  378. procedure TearDown; override;
  379. public
  380. property Data: TFPReportUserData read FData;
  381. property Report: TMyCustomReport read FRpt write FRpt;
  382. published
  383. procedure TestBeginReportEvent;
  384. procedure TestEndReportEvent;
  385. procedure TestPagePrepareObjects;
  386. procedure TestBandPrepareObjects;
  387. procedure TestRTObjects1;
  388. procedure TestRTObjects2;
  389. procedure TestRTObjects3;
  390. procedure TestRTObjects4_OneDataItem;
  391. procedure TestRTObjects5_TwoDataItems;
  392. procedure TestInternalFunction_Page;
  393. procedure TestInternalFunction_Page_with_text;
  394. procedure TestInternalFunction_RecNo;
  395. procedure TestInternalFunction_Today;
  396. procedure TestInternalFunction_Today_with_text;
  397. procedure TestInternalFunction_Author;
  398. procedure TestInternalFunction_Author_with_text;
  399. procedure TestInternalFunction_Title;
  400. procedure TestInternalFunction_Title_with_text;
  401. end;
  402. TTestReportMemo = class(TTestCase)
  403. private
  404. FMemo: TFPReportMemo;
  405. procedure CauseFontNotFoundException;
  406. protected
  407. procedure SetUp; override;
  408. procedure TearDown; override;
  409. published
  410. procedure TestCreate;
  411. procedure TestPrepareTextBlocks;
  412. procedure TestPrepareTextBlocks_multiline_data;
  413. procedure TestPrepareTextBlocks_multiline_wraptext;
  414. procedure TestRGBToReportColor;
  415. procedure TestHTMLColorToReportColor_length7;
  416. procedure TestHTMLColorToReportColor_length6;
  417. procedure TestHTMLColorToReportColor_length3;
  418. procedure TestCreateTestBlock;
  419. procedure TestCreateTestBlock_IsURL;
  420. procedure TestSubStr;
  421. procedure TestTokenCount;
  422. procedure TestToken;
  423. end;
  424. TTestBandList = class(TTestCase)
  425. private
  426. FList: TBandList;
  427. b1: TFPReportPageHeaderBand;
  428. b2: TFPReportTitleBand;
  429. b3: TFPReportDataBand;
  430. procedure CreateBands;
  431. procedure AddAllBandsToList;
  432. protected
  433. procedure SetUp; override;
  434. procedure TearDown; override;
  435. published
  436. procedure TestAdd;
  437. procedure TestItems;
  438. procedure TestClear;
  439. procedure TestDelete;
  440. procedure TestFind1;
  441. procedure TestFind2;
  442. end;
  443. { TTestVariableBase }
  444. TTestVariableBase = Class(TTestCase)
  445. Public
  446. Class procedure AssertEquals(Const Msg : String; AExpected,AActual : TResultType); overload;
  447. end;
  448. { TTestVariable }
  449. TTestVariable = Class(TTestVariableBase)
  450. private
  451. FVar: TFPReportVariable;
  452. Protected
  453. Procedure SetUp; override;
  454. Procedure TearDown; override;
  455. Property Variable : TFPReportVariable Read FVar;
  456. Published
  457. Procedure TestEmpty;
  458. Procedure TestName;
  459. Procedure TestBoolean;
  460. Procedure TestInteger;
  461. Procedure TestDateTime;
  462. Procedure TestFloat;
  463. Procedure TestString;
  464. Procedure TestExpressionResult;
  465. end;
  466. { TTestVariables }
  467. TTestVariables = Class(TTestVariableBase)
  468. private
  469. FVar: TFPReportVariables;
  470. FV : Array[0..2] of TFPReportVariable;
  471. procedure AddThree;
  472. Protected
  473. Procedure SetUp; override;
  474. Procedure TearDown; override;
  475. Property Variables : TFPReportVariables Read FVar;
  476. Published
  477. Procedure TestEmpty;
  478. Procedure TestAdd;
  479. Procedure TestIndexOf;
  480. Procedure TestFind;
  481. end;
  482. implementation
  483. uses
  484. TypInfo,
  485. DateUtils,
  486. fpTTF;
  487. type
  488. TMemoFriend = class(TFPReportMemo);
  489. { TTestVariables }
  490. procedure TTestVariables.SetUp;
  491. begin
  492. inherited SetUp;
  493. FVar:=TFPReportVariables.Create(Nil,TFPReportVariable);
  494. end;
  495. procedure TTestVariables.TearDown;
  496. begin
  497. FreeAndNil(FVar);
  498. inherited TearDown;
  499. end;
  500. procedure TTestVariables.TestEmpty;
  501. begin
  502. AssertNotNull('Have variables',Variables);
  503. AssertEquals('Variable count',0,Variables.Count);
  504. AssertTrue('Variable class',Variables.ItemClass.InheritsFrom(TFPReportVariable));
  505. end;
  506. procedure TTestVariables.TestAdd;
  507. Var
  508. V : TFPReportVariable;
  509. begin
  510. V:=Variables.addVariable('aName');
  511. AssertNotNull('Have result',V);
  512. AssertEquals('Correct name','aName',V.Name);
  513. AssertEquals('Correct type',rtString,V.DataType);
  514. AssertEquals('Correct value','',V.AsString);
  515. AssertEquals('Added to collection',1,Variables.Count);
  516. AssertSame('In array',V,Variables[0]);
  517. ExpectException('Cannot add twice',EReportError);
  518. V:=Variables.addVariable('aName');
  519. end;
  520. procedure TTestVariables.AddThree;
  521. Var
  522. I: integer;
  523. begin
  524. For I:=0 to 2 do
  525. FV[I]:=Variables.Addvariable('aName'+IntToStr(i+1));
  526. end;
  527. procedure TTestVariables.TestIndexOf;
  528. begin
  529. AddThree;
  530. AssertEquals('First',0,Variables.IndexOfVariable('aName1'));
  531. AssertEquals('Second',1,Variables.IndexOfVariable('aName2'));
  532. AssertEquals('Third',2,Variables.IndexOfVariable('aName3'));
  533. AssertEquals('NonExisting',-1,Variables.IndexOfVariable('aName4'));
  534. end;
  535. procedure TTestVariables.TestFind;
  536. begin
  537. AddThree;
  538. AssertSame('First',FV[0],Variables.FindVariable('aName1'));
  539. AssertSame('Second',FV[1],Variables.FindVariable('aName2'));
  540. AssertSame('Third',FV[2],Variables.FindVariable('aName3'));
  541. AssertNull('NonExisting',Variables.FindVariable('aName4'));
  542. end;
  543. { TTestVariableBase }
  544. class procedure TTestVariableBase.AssertEquals(const Msg: String; AExpected,
  545. AActual: TResultType);
  546. begin
  547. AssertEquals(Msg,GetEnumName(TypeInfo(TResultType),Ord(AExpected)),GetEnumName(TypeInfo(TResultType),Ord(AActual)))
  548. end;
  549. { TTestVariable }
  550. procedure TTestVariable.SetUp;
  551. begin
  552. inherited SetUp;
  553. FVar:=TFPReportVariable.Create(Nil);
  554. end;
  555. procedure TTestVariable.TearDown;
  556. begin
  557. FreeandNil(FVar);
  558. inherited TearDown;
  559. end;
  560. procedure TTestVariable.TestEmpty;
  561. begin
  562. AssertNotNull('Have variable', Variable);
  563. AssertEquals('Boolean type',rtBoolean,Variable.DataType);
  564. AssertFalse('Boolean default value',Variable.AsBoolean);
  565. end;
  566. procedure TTestVariable.TestName;
  567. begin
  568. Variable.Name:='me'; // OK
  569. Variable.Name:='me.me'; // OK
  570. ExpectException('Name must be identifier',EReportError);
  571. Variable.Name:='me me'; // not OK
  572. end;
  573. procedure TTestVariable.TestBoolean;
  574. Var
  575. R : TFPExpressionResult;
  576. begin
  577. Variable.DataType:=rtBoolean;
  578. AssertEquals('Boolean type remains',rtBoolean,Variable.DataType);
  579. AssertFalse('Boolean default value',Variable.AsBoolean);
  580. AssertEquals('Boolean as string','False',Variable.Value);
  581. Variable.DataType:=rtFloat;
  582. Variable.AsBoolean:=true;
  583. AssertEquals('Boolean type remains',rtBoolean,Variable.DataType);
  584. AssertEquals('Boolean as string','True',Variable.Value);
  585. AssertTrue('Boolean value',Variable.AsBoolean);
  586. R:=Variable.AsExpressionResult;
  587. AssertEquals('Correct result',rtBoolean,r.resulttype);
  588. AssertEquals('Correct value',True,r.resBoolean);
  589. ExpectException('Cannot fetch as other type',EConvertError);
  590. Variable.AsString;
  591. end;
  592. procedure TTestVariable.TestInteger;
  593. Var
  594. R : TFPExpressionResult;
  595. begin
  596. Variable.DataType:=rtInteger;
  597. AssertEquals('Integer type remains',rtInteger,Variable.DataType);
  598. AssertEquals('Integer default value',0,Variable.AsInteger);
  599. AssertEquals('Integer as string','0',Variable.Value);
  600. Variable.DataType:=rtFloat;
  601. Variable.AsInteger:=123;
  602. AssertEquals('Integer type remains',rtInteger,Variable.DataType);
  603. AssertEquals('Integer as string','123',Variable.Value);
  604. AssertEquals('Integer value',123,Variable.AsInteger);
  605. R:=Variable.AsExpressionResult;
  606. AssertEquals('Correct result',rtInteger,r.resulttype);
  607. AssertEquals('Correct value',123,r.resInteger);
  608. ExpectException('Cannot fetch as other type',EConvertError);
  609. Variable.AsString;
  610. end;
  611. procedure TTestVariable.TestDateTime;
  612. Var
  613. R : TFPExpressionResult;
  614. begin
  615. Variable.DataType:=rtDateTime;
  616. AssertEquals('DateTime type remains',rtDateTime,Variable.DataType);
  617. AssertEquals('DateTime default value',0.0,Variable.AsDateTime);
  618. AssertEquals('DateTime as string','00000000T000000',Variable.Value);
  619. Variable.DataType:=rtDateTime;
  620. Variable.AsDateTime:=Date;
  621. AssertEquals('DateTime type remains',rtDateTime,Variable.DataType);
  622. AssertEquals('DateTime as string',FormatDateTime('yyyymmdd"T"000000',Date),Variable.Value);
  623. AssertEquals('DateTime value',Date,Variable.AsDateTime);
  624. R:=Variable.AsExpressionResult;
  625. AssertEquals('Correct result',rtDateTime,r.resulttype);
  626. AssertEquals('Correct value',Date,r.resDateTime);
  627. ExpectException('Cannot fetch as other type',EConvertError);
  628. Variable.AsString;
  629. end;
  630. procedure TTestVariable.TestFloat;
  631. Var
  632. R : TFPExpressionResult;
  633. begin
  634. Variable.DataType:=rtFloat;
  635. AssertEquals('Float type remains',rtFloat,Variable.DataType);
  636. AssertEquals('Float default value',0.0,Variable.AsFloat);
  637. AssertEquals('Float as string',0.0,StrToFloat(Variable.Value));
  638. Variable.DataType:=rtBoolean;
  639. Variable.AsFloat:=1.23;
  640. AssertEquals('Float type remains',rtFloat,Variable.DataType);
  641. AssertEquals('Float as string',1.23,StrToFloat(Variable.Value));
  642. AssertEquals('Float value',1.23,Variable.AsFloat);
  643. R:=Variable.AsExpressionResult;
  644. AssertEquals('Correct result',rtFloat,r.resulttype);
  645. AssertEquals('Correct value',1.23,r.resFloat);
  646. ExpectException('Cannot fetch as other type',EConvertError);
  647. Variable.AsString;
  648. end;
  649. procedure TTestVariable.TestString;
  650. Var
  651. R : TFPExpressionResult;
  652. begin
  653. Variable.DataType:=rtString;
  654. AssertEquals('String type remains',rtString,Variable.DataType);
  655. AssertEquals('String default value','',Variable.AsString);
  656. AssertEquals('String as string','',Variable.Value);
  657. Variable.DataType:=rtBoolean;
  658. Variable.AsString:='abc';
  659. AssertEquals('String type remains',rtString,Variable.DataType);
  660. AssertEquals('String as string','abc',Variable.Value);
  661. AssertEquals('String value','abc',Variable.AsString);
  662. R:=Variable.AsExpressionResult;
  663. AssertEquals('Correct result',rtString,r.resulttype);
  664. AssertEquals('Correct value','abc',r.resString);
  665. ExpectException('Cannot fetch as other type',EConvertError);
  666. Variable.AsFloat;
  667. end;
  668. procedure TTestVariable.TestExpressionResult;
  669. Var
  670. R : TFPExpressionResult;
  671. begin
  672. R.ResultType:=rtFloat;
  673. R.ResFloat:=1.23;
  674. Variable.AsExpressionResult:=R;
  675. AssertEquals('Correct type ',rtFloat,Variable.DataType);
  676. AssertEquals('Correct value',1.23,Variable.AsFloat);
  677. R.ResultType:=rtBoolean;
  678. R.ResBoolean:=True;
  679. Variable.AsExpressionResult:=R;
  680. AssertEquals('Correct type ',rtBoolean,Variable.DataType);
  681. AssertEquals('Correct value',True,Variable.AsBoolean);
  682. R.ResultType:=rtString;
  683. R.ResString:='me';
  684. Variable.AsExpressionResult:=R;
  685. AssertEquals('Correct type ',rtString,Variable.DataType);
  686. AssertEquals('Correct value','me',Variable.AsString);
  687. R.ResultType:=rtDateTime;
  688. R.ResDateTime:=Date;
  689. Variable.AsExpressionResult:=R;
  690. AssertEquals('Correct type ',rtDateTime,Variable.DataType);
  691. AssertEquals('Correct value',Date,Variable.AsDateTime);
  692. R.ResultType:=rtinteger;
  693. R.ResInteger:=1234;
  694. Variable.AsExpressionResult:=R;
  695. AssertEquals('Correct type ',rtinteger,Variable.DataType);
  696. AssertEquals('Correct value',1234,Variable.AsInteger);
  697. end;
  698. { TTestCaseWithData }
  699. procedure TTestCaseWithData.InitializeData(const ACount: Integer);
  700. var
  701. i: integer;
  702. begin
  703. // data is coming from the stringlist this time
  704. FSL := TStringList.Create;
  705. if ACount < 1 then
  706. Exit;
  707. for i := 1 to ACount do
  708. FSL.Add('Item ' + IntToStr(i));
  709. end;
  710. procedure TTestCaseWithData.SetReportData(const ADataCount: Byte);
  711. begin
  712. if ADataCount < 1 then
  713. Exit;
  714. InitializeData(ADataCount);
  715. FData := TFPReportUserData.Create(nil);
  716. FData.OnGetValue := @DoGetDataValue;
  717. FData.OnGetEOF := @DoGetDataEOF;
  718. end;
  719. procedure TTestCaseWithData.DoGetDataValue(Sender: TObject; const AValueName: string; var AValue: variant);
  720. begin
  721. if AValueName = 'element' then
  722. AValue := FSL[FData.RecNo - 1];
  723. end;
  724. procedure TTestCaseWithData.DoGetDataEOF(Sender: TObject; var IsEOF: boolean);
  725. begin
  726. if FData.RecNo > FSL.Count then
  727. IsEOF := True
  728. else
  729. IsEOF := False;
  730. end;
  731. procedure TTestCaseWithData.SetUp;
  732. begin
  733. inherited SetUp;
  734. end;
  735. procedure TTestCaseWithData.TearDown;
  736. begin
  737. FreeAndNil(FData);
  738. FreeAndNil(FSL);
  739. inherited TearDown;
  740. end;
  741. { TTestCaseWithDataAndReport }
  742. procedure TTestCaseWithDataAndReport.SetUp;
  743. begin
  744. inherited SetUp;
  745. FReport := TMyCustomReport.Create(nil);
  746. end;
  747. procedure TTestCaseWithDataAndReport.TearDown;
  748. begin
  749. inherited TearDown;
  750. FreeAndNil(FReport);
  751. end;
  752. { TBaseReportComponentTest }
  753. procedure TBaseReportComponentTest.ExpectState(const aExpected: TFPReportState);
  754. begin
  755. AssertEquals('ReportComponent.ReportState: ', AExpected, FC.ReportState);
  756. end;
  757. procedure TBaseReportComponentTest.AssertEquals(Msg: string; const aExpected, AActual: TFPReportState);
  758. begin
  759. AssertEquals(Msg, GetEnumName(TypeInfo(TFPReportState), Ord(AExpected)),
  760. GetEnumName(TypeInfo(TFPReportState), Ord(AActual)));
  761. end;
  762. procedure TBaseReportComponentTest.SetUp;
  763. begin
  764. FC := TMyFPReportComponent.Create(nil);
  765. end;
  766. procedure TBaseReportComponentTest.TearDown;
  767. begin
  768. FreeAndNil(FC);
  769. end;
  770. { TTestReportComponent }
  771. procedure TTestReportComponent.TestCreate;
  772. begin
  773. ExpectState(rsDesign);
  774. end;
  775. procedure TTestReportComponent.TestLayoutState;
  776. begin
  777. FC.StartLayout;
  778. ExpectState(rsLayout);
  779. FC.EndLayout;
  780. ExpectState(rsDesign);
  781. end;
  782. procedure TTestReportComponent.TestRenderState;
  783. begin
  784. FC.StartRender;
  785. ExpectState(rsRender);
  786. FC.EndRender;
  787. ExpectState(rsDesign);
  788. end;
  789. { TMyFPReportComponent }
  790. procedure TMyFPReportComponent.StartLayout;
  791. begin
  792. inherited StartLayout;
  793. end;
  794. procedure TMyFPReportComponent.EndLayout;
  795. begin
  796. inherited EndLayout;
  797. end;
  798. procedure TMyFPReportComponent.StartRender;
  799. begin
  800. inherited StartRender;
  801. end;
  802. procedure TMyFPReportComponent.EndRender;
  803. begin
  804. inherited EndRender;
  805. end;
  806. { TMyFPReportElement }
  807. procedure TMyFPReportElement.CallChange;
  808. begin
  809. Changed;
  810. end;
  811. procedure TMyFPReportElement.ResetChanged;
  812. begin
  813. FChangedCalled := 0;
  814. end;
  815. procedure TMyFPReportElement.DoChanged;
  816. begin
  817. inherited DoChanged;
  818. Inc(FChangedCalled);
  819. end;
  820. { TBaseReportElementTest }
  821. procedure TBaseReportElementTest.SetUp;
  822. begin
  823. inherited SetUp;
  824. FC := TMyFPReportElement.Create(nil);
  825. end;
  826. procedure TBaseReportElementTest.TearDown;
  827. begin
  828. FreeAndNil(FC);
  829. inherited TearDown;
  830. end;
  831. { TReportElementTest }
  832. procedure TReportElementTest.TestCreate;
  833. begin
  834. AssertEquals('Create does not invoke changed', 0, FC.ChangedCalled);
  835. AssertNotNull('Create creates frame', FC.Frame);
  836. AssertEquals('Create creates frame of correct class', TFPReportFrame, FC.Frame.Classtype);
  837. AssertNotNull('Create creates layout', FC.Layout);
  838. AssertEquals('Create creates layout of correct class ', TFPReportLayout, FC.Layout.Classtype);
  839. AssertEquals('Created element is visible', True, FC.Visible);
  840. AssertNull('No parent at create', FC.Parent);
  841. end;
  842. procedure TReportElementTest.TestDoChange;
  843. begin
  844. FC.CallChange;
  845. AssertEquals('Change calls dochange', 1, FC.ChangedCalled);
  846. end;
  847. procedure TReportElementTest.TestChangeCount;
  848. begin
  849. FC.BeginUpdate;
  850. try
  851. FC.CallChange;
  852. AssertEquals('First Change does notcall dochange', 0, FC.ChangedCalled);
  853. FC.CallChange;
  854. AssertEquals('Second Change does not call dochange', 0, FC.ChangedCalled);
  855. finally
  856. FC.EndUpdate;
  857. end;
  858. AssertEquals('EndUpdate calls dochange once', 1, FC.ChangedCalled);
  859. end;
  860. procedure TReportElementTest.TestChangeCountNested;
  861. begin
  862. FC.BeginUpdate;
  863. try
  864. FC.CallChange;
  865. AssertEquals('First Change does notcall dochange', 0, FC.ChangedCalled);
  866. FC.BeginUpdate;
  867. try
  868. FC.CallChange;
  869. AssertEquals('Second Change does not call dochange', 0, FC.ChangedCalled);
  870. finally
  871. FC.EndUpdate;
  872. AssertEquals('First endupdate does not call dochange', 0, FC.ChangedCalled);
  873. end;
  874. finally
  875. FC.EndUpdate;
  876. end;
  877. AssertEquals('Second EndUpdate calls dochange once', 1, FC.ChangedCalled);
  878. end;
  879. procedure TReportElementTest.TestChangeCountNested2;
  880. begin
  881. FC.BeginUpdate;
  882. try
  883. FC.CallChange;
  884. AssertEquals('First Change does notcall dochange', 0, FC.ChangedCalled);
  885. FC.BeginUpdate;
  886. try
  887. FC.CallChange;
  888. AssertEquals('Second Change does not call dochange', 0, FC.ChangedCalled);
  889. FC.CallChange;
  890. AssertEquals('Third Change does not call dochange', 0, FC.ChangedCalled);
  891. finally
  892. FC.EndUpdate;
  893. AssertEquals('First endupdate does not call dochange', 0, FC.ChangedCalled);
  894. end;
  895. finally
  896. FC.EndUpdate;
  897. end;
  898. AssertEquals('Second EndUpdate calls dochange once', 1, FC.ChangedCalled);
  899. end;
  900. procedure TReportElementTest.TestVisibleChanges;
  901. begin
  902. FC.ResetChanged;
  903. FC.Visible := False;
  904. AssertEquals('Setting visible calls change', 1, FC.ChangedCalled);
  905. end;
  906. procedure TReportElementTest.TestLayoutChanges;
  907. var
  908. L: TFPreportLayout;
  909. begin
  910. L := TFPreportLayout.Create(nil);
  911. try
  912. FC.Layout := L;
  913. AssertEquals('Setting layout calls change', 1, FC.ChangedCalled);
  914. finally
  915. L.Free;
  916. end;
  917. end;
  918. procedure TReportElementTest.TestFrameChanges;
  919. var
  920. F: TFPreportFrame;
  921. begin
  922. F := TFPreportFrame.Create(nil);
  923. try
  924. FC.Frame := F;
  925. AssertEquals('Setting frame calls change', 1, FC.ChangedCalled);
  926. finally
  927. F.Free;
  928. end;
  929. end;
  930. procedure TReportElementTest.TestAssign;
  931. var
  932. E: TFPReportElement;
  933. begin
  934. E := TMyFPReportElement.Create(nil);
  935. try
  936. FC.Layout.Top := 1;
  937. FC.Frame.Width := 2;
  938. E.Assign(FC);
  939. AssertEquals('Assigned frame equal', True, FC.Frame.Equals(E.Frame));
  940. AssertEquals('Assigned layout equal', True, FC.Layout.Equals(FC.Layout));
  941. finally
  942. E.Free;
  943. end;
  944. end;
  945. procedure TReportElementTest.TestEquals1;
  946. begin
  947. AssertEquals('Self always returns equal', True, FC.Equals(FC));
  948. end;
  949. procedure TReportElementTest.TestEquals2;
  950. var
  951. E: TFPReportElement;
  952. begin
  953. E := TMyFPReportElement.Create(nil);
  954. try
  955. E.Assign(FC);
  956. AssertEquals('Assigned element returns equal', True, FC.Equals(E));
  957. AssertEquals('Assigned element returns equal', True, E.Equals(FC));
  958. finally
  959. E.Free;
  960. end;
  961. end;
  962. procedure TReportElementTest.TestEquals3;
  963. var
  964. E: TFPReportElement;
  965. begin
  966. E := TFPReportElement.Create(nil);
  967. try
  968. E.Assign(FC);
  969. AssertEquals('Different class makes unequal', True, FC.Equals(E));
  970. AssertEquals('Different class makes unequal', True, E.Equals(FC));
  971. finally
  972. E.Free;
  973. end;
  974. end;
  975. procedure TReportElementTest.TestEquals4;
  976. var
  977. E: TFPReportElement;
  978. begin
  979. E := TMyFPReportElement.Create(nil);
  980. try
  981. FC.Layout.Top := 1;
  982. E.Assign(FC);
  983. E.Layout.Top := 2;
  984. AssertEquals('Changed layout makes unequal', False, FC.Equals(E));
  985. AssertEquals('Changed layout makes unequal', False, E.Equals(FC));
  986. finally
  987. E.Free;
  988. end;
  989. end;
  990. procedure TReportElementTest.TestEquals5;
  991. var
  992. E: TFPReportElement;
  993. begin
  994. E := TMyFPReportElement.Create(nil);
  995. try
  996. FC.Layout.Top := 1;
  997. E.Assign(FC);
  998. E.Frame.Lines := [flLeft];
  999. AssertEquals('Changed frame makes unequal', False, FC.Equals(E));
  1000. AssertEquals('Changed frame makes unequal', False, E.Equals(FC));
  1001. finally
  1002. E.Free;
  1003. end;
  1004. end;
  1005. { TTestReportFrame }
  1006. procedure TTestReportFrame.TestCreate;
  1007. begin
  1008. AssertEquals('Failed on 1', 1, FC.Frame.Width);
  1009. AssertEquals('Failed on 2',
  1010. GetEnumName(TYpeInfo(TFPPenStyle), Ord(psSolid)),
  1011. GetEnumName(TYpeInfo(TFPPenStyle), Ord(FC.Frame.Pen)));
  1012. if not (FC.Frame.Lines = []) then
  1013. Fail('Failed on 3');
  1014. AssertEquals('Failed on 4',
  1015. GetEnumName(TypeInfo(TFPReportFrameShape), Ord(fsNone)),
  1016. GetEnumName(TypeInfo(TFPReportFrameShape), Ord(FC.Frame.Shape)));
  1017. end;
  1018. procedure TTestReportFrame.TestWidthChange;
  1019. begin
  1020. FC.Frame.Width := 2;
  1021. AssertEquals('Setting Width calls onChange', 1, FC.ChangedCalled);
  1022. end;
  1023. procedure TTestReportFrame.TestColorChange;
  1024. begin
  1025. FC.Frame.Color := 3;
  1026. AssertEquals('Setting Solor calls onChange', 1, FC.ChangedCalled);
  1027. end;
  1028. procedure TTestReportFrame.TestPenStyleChange;
  1029. begin
  1030. FC.Frame.Pen := psDot;
  1031. AssertEquals('Setting pen calls onChange', 1, FC.ChangedCalled);
  1032. end;
  1033. procedure TTestReportFrame.TestShapeChange;
  1034. begin
  1035. FC.Frame.Shape := fsRoundedRect;
  1036. AssertEquals('Setting pen calls onChange', 1, FC.ChangedCalled);
  1037. end;
  1038. procedure TTestReportFrame.TestLinesChange;
  1039. begin
  1040. FC.Frame.Lines := [flBottom];
  1041. AssertEquals('Setting pen calls onChange', 1, FC.ChangedCalled);
  1042. end;
  1043. procedure TTestReportFrame.TestAssign;
  1044. var
  1045. F: TFPReportFrame;
  1046. begin
  1047. F := TFPReportFrame.Create(nil);
  1048. try
  1049. F.Width := 3;
  1050. F.Lines := [flBottom, flTop];
  1051. F.Color := 4;
  1052. F.Pen := psDot;
  1053. F.Shape := fsRoundedRect;
  1054. FC.Frame.Assign(F);
  1055. AssertSame('ReportElement not copied', FC, FC.Frame.ReportElement);
  1056. AssertEquals('Assert calls changed', 1, FC.ChangedCalled);
  1057. AssertEquals('Frame width equals 3', F.Width, FC.Frame.Width);
  1058. AssertEquals('Frame penstyle equals psDot',
  1059. GetEnumName(TYpeInfo(TFPPenStyle), Ord(F.Pen)),
  1060. GetEnumName(TYpeInfo(TFPPenStyle), Ord(FC.Frame.Pen)));
  1061. if not (FC.Frame.Lines = F.Lines) then
  1062. Fail('Frame lines not copied correctly');
  1063. AssertEquals('Frame shape correctly copied',
  1064. GetEnumName(TypeInfo(TFPReportFrameShape), Ord(F.Shape)),
  1065. GetEnumName(TypeInfo(TFPReportFrameShape), Ord(FC.Frame.Shape)));
  1066. finally
  1067. F.Free;
  1068. end;
  1069. end;
  1070. procedure TTestReportFrame.TestEquals1;
  1071. var
  1072. F: TFPReportFrame;
  1073. begin
  1074. F := TFPReportFrame.Create(nil);
  1075. try
  1076. FC.Frame.Width := 3;
  1077. FC.Frame.Lines := [flBottom, flTop];
  1078. FC.Frame.Color := 4;
  1079. FC.Frame.Pen := psDot;
  1080. FC.Frame.Shape := fsRoundedRect;
  1081. F.Assign(FC.Frame);
  1082. F.Width := 2;
  1083. AssertEquals('Width changed makes unequal', False, FC.Frame.Equals(F));
  1084. AssertEquals('Width changed makes unequal', False, F.Equals(FC.Frame));
  1085. finally
  1086. F.Free;
  1087. end;
  1088. end;
  1089. procedure TTestReportFrame.TestEquals2;
  1090. var
  1091. F: TFPReportFrame;
  1092. begin
  1093. F := TFPReportFrame.Create(nil);
  1094. try
  1095. FC.Frame.Width := 3;
  1096. FC.Frame.Lines := [flBottom, flTop];
  1097. FC.Frame.Color := 4;
  1098. FC.Frame.Pen := psDot;
  1099. FC.Frame.Shape := fsRoundedRect;
  1100. F.Assign(FC.Frame);
  1101. F.Color := 2;
  1102. AssertEquals('Color changed makes unequal', False, FC.Frame.Equals(F));
  1103. AssertEquals('Color changed makes unequal', False, F.Equals(FC.Frame));
  1104. finally
  1105. F.Free;
  1106. end;
  1107. end;
  1108. procedure TTestReportFrame.TestEquals3;
  1109. var
  1110. F: TFPReportFrame;
  1111. begin
  1112. F := TFPReportFrame.Create(nil);
  1113. try
  1114. FC.Frame.Width := 3;
  1115. FC.Frame.Lines := [flBottom, flTop];
  1116. FC.Frame.Color := 4;
  1117. FC.Frame.Pen := psDot;
  1118. FC.Frame.Shape := fsRoundedRect;
  1119. F.Assign(FC.Frame);
  1120. F.Pen := psDash;
  1121. AssertEquals('Pen changed makes unequal', False, FC.Frame.Equals(F));
  1122. AssertEquals('Pen changed makes unequal', False, F.Equals(FC.Frame));
  1123. finally
  1124. F.Free;
  1125. end;
  1126. end;
  1127. procedure TTestReportFrame.TestEquals4;
  1128. var
  1129. F: TFPReportFrame;
  1130. begin
  1131. F := TFPReportFrame.Create(nil);
  1132. try
  1133. FC.Frame.Width := 3;
  1134. FC.Frame.Lines := [flBottom, flTop];
  1135. FC.Frame.Color := 4;
  1136. FC.Frame.Pen := psDot;
  1137. FC.Frame.Shape := fsRoundedRect;
  1138. F.Assign(FC.Frame);
  1139. F.Shape := fsShadow;
  1140. AssertEquals('Shape changed makes unequal', False, FC.Frame.Equals(F));
  1141. AssertEquals('Shape changed makes unequal', False, F.Equals(FC.Frame));
  1142. finally
  1143. F.Free;
  1144. end;
  1145. end;
  1146. procedure TTestReportFrame.TestEquals5;
  1147. var
  1148. F: TFPReportFrame;
  1149. begin
  1150. F := TFPReportFrame.Create(nil);
  1151. try
  1152. FC.Frame.Width := 3;
  1153. FC.Frame.Lines := [flBottom, flTop];
  1154. FC.Frame.Color := 4;
  1155. FC.Frame.Pen := psDot;
  1156. FC.Frame.Shape := fsRoundedRect;
  1157. F.Assign(FC.Frame);
  1158. F.Lines := [flLeft, flRight];
  1159. AssertEquals('Lines changed makes unequal', False, FC.Frame.Equals(F));
  1160. AssertEquals('Lines changed makes unequal', False, F.Equals(FC.Frame));
  1161. finally
  1162. F.Free;
  1163. end;
  1164. end;
  1165. procedure TTestReportFrame.TestEquals6;
  1166. begin
  1167. AssertEquals('Same frame always equals', True, FC.Frame.Equals(FC.Frame));
  1168. end;
  1169. procedure TTestReportFrame.TestEquals7;
  1170. var
  1171. F: TFPReportFrame;
  1172. begin
  1173. F := TFPReportFrame.Create(nil);
  1174. try
  1175. FC.Frame.Width := 3;
  1176. FC.Frame.Lines := [flBottom, flTop];
  1177. FC.Frame.Color := 4;
  1178. FC.Frame.Pen := psDot;
  1179. FC.Frame.Shape := fsRoundedRect;
  1180. F.Assign(FC.Frame);
  1181. AssertEquals('Equals after assign', True, FC.Frame.Equals(F));
  1182. AssertEquals('Equals after assign', True, F.Equals(FC.Frame));
  1183. finally
  1184. F.Free;
  1185. end;
  1186. end;
  1187. { TTestReportLayout }
  1188. procedure TTestReportLayout.TestCreate;
  1189. begin
  1190. AssertEquals('Top is zero', 0, FC.Layout.top);
  1191. AssertEquals('Left is zero', 0, FC.Layout.Left);
  1192. AssertEquals('Width is zero', 0, FC.Layout.Width);
  1193. AssertEquals('Height is zero', 0, FC.Layout.Width);
  1194. end;
  1195. procedure TTestReportLayout.TestTopChange;
  1196. begin
  1197. FC.Layout.Top := 2;
  1198. AssertEquals('Setting top calls onChange', 1, FC.ChangedCalled);
  1199. end;
  1200. procedure TTestReportLayout.TestLeftChange;
  1201. begin
  1202. FC.Layout.Left := 2;
  1203. AssertEquals('Setting left calls onChange', 1, FC.ChangedCalled);
  1204. end;
  1205. procedure TTestReportLayout.TestWidthChange;
  1206. begin
  1207. FC.Layout.Width := 2;
  1208. AssertEquals('Setting width calls onChange', 1, FC.ChangedCalled);
  1209. end;
  1210. procedure TTestReportLayout.TestHeightChange;
  1211. begin
  1212. FC.Layout.Height := 2;
  1213. AssertEquals('Setting Height calls onChange', 1, FC.ChangedCalled);
  1214. end;
  1215. procedure TTestReportLayout.TestAssign;
  1216. var
  1217. L: TFPReportLayout;
  1218. begin
  1219. L := TFPReportlayout.Create(nil);
  1220. try
  1221. FC.Layout.Top := 1;
  1222. FC.Layout.Left := 1;
  1223. FC.Layout.Width := 10;
  1224. FC.Layout.Height := 10;
  1225. L.Assign(FC.Layout);
  1226. AssertEquals('Top correct', FC.Layout.Top, L.Top);
  1227. AssertEquals('Left correct', FC.Layout.Left, L.Left);
  1228. AssertEquals('Width correct', FC.Layout.Width, L.Width);
  1229. AssertEquals('Height correct', FC.Layout.Height, L.Height);
  1230. finally
  1231. L.Free;
  1232. end;
  1233. end;
  1234. procedure TTestReportLayout.TestEquals1;
  1235. var
  1236. L: TFPReportLayout;
  1237. begin
  1238. L := TFPReportlayout.Create(nil);
  1239. try
  1240. FC.Layout.Top := 1;
  1241. FC.Layout.Left := 1;
  1242. FC.Layout.Width := 10;
  1243. FC.Layout.Height := 10;
  1244. L.Assign(FC.Layout);
  1245. FC.Layout.Top := 2;
  1246. AssertEquals('Top changed makes unequal', False, FC.Layout.Equals(L));
  1247. AssertEquals('Top changed makes unequal', False, L.Equals(FC.Layout));
  1248. finally
  1249. L.Free;
  1250. end;
  1251. end;
  1252. procedure TTestReportLayout.TestEquals2;
  1253. var
  1254. L: TFPReportLayout;
  1255. begin
  1256. L := TFPReportlayout.Create(nil);
  1257. try
  1258. FC.Layout.Top := 1;
  1259. FC.Layout.Left := 1;
  1260. FC.Layout.Width := 10;
  1261. FC.Layout.Height := 10;
  1262. L.Assign(FC.Layout);
  1263. FC.Layout.Left := 2;
  1264. AssertEquals('Left changed makes unequal', False, FC.Layout.Equals(L));
  1265. AssertEquals('Left changed makes unequal', False, L.Equals(FC.Layout));
  1266. finally
  1267. L.Free;
  1268. end;
  1269. end;
  1270. procedure TTestReportLayout.TestEquals3;
  1271. var
  1272. L: TFPReportLayout;
  1273. begin
  1274. L := TFPReportlayout.Create(nil);
  1275. try
  1276. FC.Layout.Top := 1;
  1277. FC.Layout.Left := 1;
  1278. FC.Layout.Width := 10;
  1279. FC.Layout.Height := 10;
  1280. L.Assign(FC.Layout);
  1281. FC.Layout.Width := 2;
  1282. AssertEquals('Width changed makes unequal', False, FC.Layout.Equals(L));
  1283. AssertEquals('Width changed makes unequal', False, L.Equals(FC.Layout));
  1284. finally
  1285. L.Free;
  1286. end;
  1287. end;
  1288. procedure TTestReportLayout.TestEquals4;
  1289. var
  1290. L: TFPReportLayout;
  1291. begin
  1292. L := TFPReportlayout.Create(nil);
  1293. try
  1294. FC.Layout.Top := 1;
  1295. FC.Layout.Left := 1;
  1296. FC.Layout.Width := 10;
  1297. FC.Layout.Height := 10;
  1298. L.Assign(FC.Layout);
  1299. FC.Layout.Height := 2;
  1300. AssertEquals('Height changed makes unequal', False, FC.Layout.Equals(L));
  1301. AssertEquals('Height changed makes unequal', False, L.Equals(FC.Layout));
  1302. finally
  1303. L.Free;
  1304. end;
  1305. end;
  1306. procedure TTestReportLayout.TestEquals5;
  1307. var
  1308. L: TFPReportLayout;
  1309. begin
  1310. L := TFPReportlayout.Create(nil);
  1311. try
  1312. FC.Layout.Top := 1;
  1313. FC.Layout.Left := 1;
  1314. FC.Layout.Width := 10;
  1315. FC.Layout.Height := 10;
  1316. L.Assign(FC.Layout);
  1317. AssertEquals('Assign results in equal', True, FC.Layout.Equals(L));
  1318. AssertEquals('Assign results in equal', True, L.Equals(FC.Layout));
  1319. finally
  1320. L.Free;
  1321. end;
  1322. end;
  1323. procedure TTestReportLayout.TestEquals6;
  1324. begin
  1325. AssertEquals('Assign results in equal', True, FC.Layout.Equals(FC.Layout));
  1326. end;
  1327. { TTestReportChildren }
  1328. procedure TTestReportChildren.SetUp;
  1329. begin
  1330. FC := TMyFPReportElementWithChildren.Create(nil);
  1331. FChild := TFPReportElement.Create(nil);
  1332. end;
  1333. procedure TTestReportChildren.TearDown;
  1334. begin
  1335. FreeAndNil(FC);
  1336. FreeAndNil(FChild);
  1337. end;
  1338. procedure TTestReportChildren.WrongParent;
  1339. begin
  1340. FC.Parent := FChild;
  1341. end;
  1342. procedure TTestReportChildren.TestCreate;
  1343. begin
  1344. AssertEquals('No children at create', 0, FC.ChildCount);
  1345. end;
  1346. procedure TTestReportChildren.TestSetParent1;
  1347. begin
  1348. AssertException('Cannot set TReportElement as parent', EReportError, @WrongParent);
  1349. end;
  1350. procedure TTestReportChildren.TestSetParent2;
  1351. begin
  1352. FChild.parent := FC;
  1353. AssertSame('Parent was saved', FC, FChild.parent);
  1354. AssertEquals('Changed was called', 1, FC.ChangedCalled);
  1355. AssertEquals('Parent childcount is 1', 1, FC.ChildCount);
  1356. AssertSame('Parent first child is OK', FChild, FC.Child[0]);
  1357. end;
  1358. procedure TTestReportChildren.TestSetParent3;
  1359. var
  1360. E: TFPReportElementWithChildren;
  1361. begin
  1362. FChild.parent := FC;
  1363. AssertSame('Parent was saved', FC, FChild.parent);
  1364. AssertEquals('Parent childcount is 1', 1, FC.ChildCount);
  1365. AssertSame('Parent first child is OK', FChild, FC.Child[0]);
  1366. FC.ResetChanged;
  1367. E := TFPReportElementWithChildren.Create(nil);
  1368. try
  1369. FChild.Parent := E;
  1370. AssertSame('Parent was saved', E, FChild.parent);
  1371. AssertEquals('Changed was called', 1, FC.ChangedCalled);
  1372. AssertEquals('Old Parent childcount is 0', 0, FC.ChildCount);
  1373. AssertEquals('Parent childcount is 1', 1, E.ChildCount);
  1374. AssertSame('Parent first child is OK', FChild, E.Child[0]);
  1375. finally
  1376. E.Free;
  1377. end;
  1378. end;
  1379. procedure TTestReportChildren.TestSetParent4;
  1380. begin
  1381. FChild.parent := FC;
  1382. AssertSame('Parent was saved', FC, FChild.parent);
  1383. AssertEquals('Parent childcount is 1', 1, FC.ChildCount);
  1384. AssertSame('Parent first child is OK', FChild, FC.Child[0]);
  1385. FreeAndNil(FC);
  1386. AssertNull('Child parent was removed when parent is freed', FChild.Parent);
  1387. end;
  1388. procedure TTestReportChildren.TestSetParent6;
  1389. begin
  1390. FChild.parent := FC;
  1391. AssertSame('Parent was saved', FC, FChild.parent);
  1392. AssertEquals('Parent childcount is 1', 1, FC.ChildCount);
  1393. AssertSame('Parent first child is OK', FChild, FC.Child[0]);
  1394. FChild.parent := nil;
  1395. AssertNull('Child parent was removed when parent is freed', FChild.Parent);
  1396. end;
  1397. procedure TTestReportChildren.TestSetParent5;
  1398. begin
  1399. FChild.parent := FC;
  1400. AssertSame('Parent was saved', FC, FChild.parent);
  1401. AssertEquals('Parent childcount is 1', 1, FC.ChildCount);
  1402. AssertSame('Parent first child is OK', FChild, FC.Child[0]);
  1403. FreeAndNil(FChild);
  1404. AssertEquals('Child removed when freed', 0, FC.ChildCount);
  1405. end;
  1406. { TMyFPReportElementWithChildren }
  1407. procedure TMyFPReportElementWithChildren.CallChange;
  1408. begin
  1409. Changed;
  1410. end;
  1411. procedure TMyFPReportElementWithChildren.ResetChanged;
  1412. begin
  1413. FChangedCalled := 0;
  1414. end;
  1415. procedure TMyFPReportElementWithChildren.DoChanged;
  1416. begin
  1417. inherited DoChanged;
  1418. Inc(FChangedCalled);
  1419. end;
  1420. { TTestFPPageSize }
  1421. procedure TTestFPPageSize.TestCreate;
  1422. var
  1423. F: TFPReportPaperSize;
  1424. begin
  1425. F := TFPReportPaperSize.Create(1.23, 3.45);
  1426. try
  1427. AssertEquals('Width stored correctly', 1.23, F.Width, 0.001);
  1428. AssertEquals('Height stored correctly', 3.45, F.Height, 0.001);
  1429. finally
  1430. F.Free;
  1431. end;
  1432. end;
  1433. { TTestFPPaperManager }
  1434. procedure TTestFPPapers.Setup;
  1435. begin
  1436. FM := TFPReportPaperManager.Create(nil);
  1437. AssertNotNull(FM);
  1438. end;
  1439. procedure TTestFPPapers.TearDown;
  1440. begin
  1441. FreeAndNil(FM);
  1442. end;
  1443. procedure TTestFPPapers.RegisterPapers(ACount: integer; Local: boolean = True);
  1444. var
  1445. F: TFPReportPaperManager;
  1446. begin
  1447. if local then
  1448. F := FM
  1449. else
  1450. F := PaperManager;
  1451. if (ACount >= 1) then
  1452. F.RegisterPaper('P3', 1.0, 2.0);
  1453. if (ACount >= 2) then
  1454. F.RegisterPaper('P2', 4.0, 8.0);
  1455. if (ACount >= 3) then
  1456. F.RegisterPaper('P1', 16.0, 32.0);
  1457. end;
  1458. procedure TTestFPPaperManager.TestAccess;
  1459. begin
  1460. case FAccess of
  1461. 0: FM.PaperNames[-1];
  1462. 1: FM.PaperNames[FM.PaperCount];
  1463. 2: FM.PaperHeight[-1];
  1464. 3: FM.PaperHeight[FM.PaperCount];
  1465. 4: FM.PaperWidth[-1];
  1466. 5: FM.PaperWidth[FM.PaperCount];
  1467. 6: FM.WidthByName['NoPaper'];
  1468. 7: FM.HeightByName['NoPaper'];
  1469. end;
  1470. end;
  1471. procedure TTestFPPaperManager.Setup;
  1472. begin
  1473. inherited Setup;
  1474. FAccess := -1;
  1475. end;
  1476. procedure TTestFPPaperManager.TestCreate;
  1477. begin
  1478. AssertEquals('No registered papers', 0, FM.PaperCount);
  1479. end;
  1480. procedure TTestFPPaperManager.TestRegister1;
  1481. begin
  1482. RegisterPapers(1);
  1483. AssertEquals('1 registered paper', 1, FM.PaperCount);
  1484. AssertEquals('Correct name', 'P3', FM.PaperNames[0]);
  1485. end;
  1486. procedure TTestFPPaperManager.TestRegister2;
  1487. begin
  1488. RegisterPapers(2);
  1489. AssertEquals('2 registered papers', 2, FM.PaperCount);
  1490. AssertEquals('Correct name paper 1', 'P2', FM.PaperNames[0]);
  1491. AssertEquals('Correct name paper 2', 'P3', FM.PaperNames[1]);
  1492. end;
  1493. procedure TTestFPPaperManager.TestRegister3;
  1494. begin
  1495. RegisterPapers(3);
  1496. AssertEquals('3 registered papers', 3, FM.PaperCount);
  1497. AssertEquals('Correct name paper 1', 'P1', FM.PaperNames[0]);
  1498. AssertEquals('Correct name paper 2', 'P2', FM.PaperNames[1]);
  1499. AssertEquals('Correct name paper 3', 'P3', FM.PaperNames[2]);
  1500. end;
  1501. procedure TTestFPPaperManager.TestRegisterDuplicate;
  1502. begin
  1503. RegisterPapers(2);
  1504. AssertEquals('2 registered papers', 2, FM.PaperCount);
  1505. AssertEquals('Correct name paper 1', 'P2', FM.PaperNames[0]);
  1506. AssertEquals('Correct name paper 2', 'P3', FM.PaperNames[1]);
  1507. try
  1508. FM.RegisterPaper('P3', 10.0, 20.0);
  1509. Fail('We expected an exception to be raised.');
  1510. except
  1511. on E: Exception do
  1512. begin
  1513. AssertEquals('Exception class', 'EReportError', E.ClassName);
  1514. AssertEquals('Exception message', 'Paper name P3 already exists', E.Message);
  1515. end;
  1516. end;
  1517. end;
  1518. procedure TTestFPPaperManager.TestClear;
  1519. begin
  1520. RegisterPapers(2);
  1521. AssertEquals('2 registered papers', 2, FM.PaperCount);
  1522. AssertEquals('Correct name paper 1', 'P2', FM.PaperNames[0]);
  1523. AssertEquals('Correct name paper 2', 'P3', FM.PaperNames[1]);
  1524. FM.Clear;
  1525. AssertEquals('0 registered papers', 0, FM.PaperCount);
  1526. end;
  1527. procedure TTestFPPaperManager.TestFind1;
  1528. begin
  1529. AssertEquals('No paper registered', -1, FM.IndexOfPaper('P1'));
  1530. end;
  1531. procedure TTestFPPaperManager.TestFind2;
  1532. begin
  1533. RegisterPapers(3);
  1534. AssertEquals('No paper registered', -1, FM.IndexOfPaper('PA1'));
  1535. end;
  1536. procedure TTestFPPaperManager.TestFind3;
  1537. begin
  1538. RegisterPapers(3);
  1539. AssertEquals('3 registered papers', 3, FM.PaperCount);
  1540. AssertEquals('Find P1 OK', 0, FM.IndexOfPaper('P1'));
  1541. AssertEquals('Find P2 OK', 1, FM.IndexOfPaper('P2'));
  1542. AssertEquals('Find P3 OK', 2, FM.IndexOfPaper('P3'));
  1543. end;
  1544. procedure TTestFPPaperManager.IllegalAccess1;
  1545. begin
  1546. RegisterPapers(3);
  1547. FAccess := 0;
  1548. AssertException('Papername[-1]', EStringListError, @TestAccess);
  1549. end;
  1550. procedure TTestFPPaperManager.IllegalAccess2;
  1551. begin
  1552. RegisterPapers(3);
  1553. FAccess := 1;
  1554. AssertException('Papername[3]', EStringListError, @TestAccess);
  1555. end;
  1556. procedure TTestFPPaperManager.IllegalAccess3;
  1557. begin
  1558. RegisterPapers(3);
  1559. FAccess := 2;
  1560. AssertException('PaperHeight[-1]', EStringListError, @TestAccess);
  1561. end;
  1562. procedure TTestFPPaperManager.IllegalAccess4;
  1563. begin
  1564. RegisterPapers(3);
  1565. FAccess := 3;
  1566. AssertException('PaperHeight[3]', EStringListError, @TestAccess);
  1567. end;
  1568. procedure TTestFPPaperManager.IllegalAccess5;
  1569. begin
  1570. RegisterPapers(3);
  1571. FAccess := 4;
  1572. AssertException('PaperWidth[-1]', EStringListError, @TestAccess);
  1573. end;
  1574. procedure TTestFPPaperManager.IllegalAccess6;
  1575. begin
  1576. RegisterPapers(3);
  1577. FAccess := 5;
  1578. AssertException('PaperWidth[3]', EStringListError, @TestAccess);
  1579. end;
  1580. procedure TTestFPPaperManager.IllegalAccess7;
  1581. begin
  1582. RegisterPapers(3);
  1583. FAccess := 6;
  1584. AssertException('WidthByName[NoPaper]', EReportError, @TestAccess);
  1585. end;
  1586. procedure TTestFPPaperManager.IllegalAccess8;
  1587. begin
  1588. RegisterPapers(3);
  1589. FAccess := 7;
  1590. AssertException('WidthByName[NoPaper]', EReportError, @TestAccess);
  1591. end;
  1592. procedure TTestFPPaperManager.TestWidth;
  1593. begin
  1594. RegisterPapers(3);
  1595. AssertEquals('Paper width 0', 16.0, FM.PaperWidth[0]);
  1596. AssertEquals('Paper width 1', 4.0, FM.PaperWidth[1]);
  1597. AssertEquals('Paper width 2', 1.0, FM.PaperWidth[2]);
  1598. AssertEquals('Width[P1]', 16.0, FM.WidthByName['P1']);
  1599. AssertEquals('Width[P2]', 4.0, FM.WidthByName['P2']);
  1600. AssertEquals('Width[P3]', 1, FM.WidthByName['P3']);
  1601. end;
  1602. procedure TTestFPPaperManager.TestHeight;
  1603. begin
  1604. RegisterPapers(3);
  1605. AssertEquals('Paper height 0', 32.0, FM.PaperHeight[0]);
  1606. AssertEquals('Paper height 1', 8.0, FM.PaperHeight[1]);
  1607. AssertEquals('Paper height 2', 2.0, FM.PaperHeight[2]);
  1608. AssertEquals('Height[P1]', 32.0, FM.HeightByName['P1']);
  1609. AssertEquals('Height[P2]', 8.0, FM.HeightByName['P2']);
  1610. AssertEquals('Height[P3]', 2, FM.HeightByName['P3']);
  1611. end;
  1612. { TMyFPReportPageSize }
  1613. procedure TMyFPReportPageSize.ResetChanged;
  1614. begin
  1615. FChangedCalled := 0;
  1616. end;
  1617. procedure TMyFPReportPageSize.Changed;
  1618. begin
  1619. Inc(FChangedCalled);
  1620. inherited Changed;
  1621. end;
  1622. { TTestFPReportPageSize }
  1623. procedure TTestFPReportPageSize.Setup;
  1624. begin
  1625. inherited Setup;
  1626. FP := TMyFPReportPageSize.Create(nil);
  1627. end;
  1628. procedure TTestFPReportPageSize.TearDown;
  1629. begin
  1630. FreeAndNil(FP);
  1631. inherited TearDown;
  1632. end;
  1633. procedure TTestFPReportPageSize.TestCreate;
  1634. begin
  1635. AssertNull('No page', FP.Page);
  1636. AssertEquals('Zero width at create', 0.0, FP.Width);
  1637. AssertEquals('Zero height at create', 0.0, FP.Height);
  1638. AssertEquals('No paper name', '', FP.PaperName);
  1639. end;
  1640. procedure TTestFPReportPageSize.TestCreateWithPage;
  1641. var
  1642. P: TFPReportPage;
  1643. F: TFPReportPageSize;
  1644. begin
  1645. P := TFPReportPage.Create(nil);
  1646. try
  1647. F := TFPReportPageSize.Create(P);
  1648. try
  1649. AssertSame('Pagesize created with page has page as page', P, F.Page);
  1650. finally
  1651. F.Free;
  1652. end;
  1653. finally
  1654. P.Free
  1655. end;
  1656. end;
  1657. procedure TTestFPReportPageSize.TestCreateByPage;
  1658. var
  1659. P: TFPReportPage;
  1660. begin
  1661. P := TFPReportPage.Create(nil);
  1662. try
  1663. AssertSame('Pagesize created with page has page as page', P, P.PageSize.Page);
  1664. finally
  1665. P.Free
  1666. end;
  1667. end;
  1668. procedure TTestFPReportPageSize.TestChanged1;
  1669. begin
  1670. FP.Width := 1.23;
  1671. AssertEquals('Setting width triggers change', 1, FP.ChangedCalled);
  1672. end;
  1673. procedure TTestFPReportPageSize.TestChanged2;
  1674. begin
  1675. FP.Height := 1.23;
  1676. AssertEquals('Setting height triggers change', 1, FP.ChangedCalled);
  1677. end;
  1678. procedure TTestFPReportPageSize.TestChanged3;
  1679. begin
  1680. FP.PaperName := 'ABC';
  1681. AssertEquals('Setting paper name without associated paper does not trigger change', 0, FP.ChangedCalled);
  1682. end;
  1683. procedure TTestFPReportPageSize.TestPaperName1;
  1684. var
  1685. F: TFPReportPaperManager;
  1686. begin
  1687. F := PaperManager;
  1688. if F.PaperCount = 0 then
  1689. Registerpapers(3, False);
  1690. FP.PaperName := F.PaperNames[0];
  1691. AssertEquals('Setting papername sets width', F.PaperWidth[0], FP.Width);
  1692. AssertEquals('Setting papername sets height', F.PaperHeight[0], FP.Height);
  1693. AssertEquals('Setting papername calls changed once', 1, FP.ChangedCalled);
  1694. end;
  1695. procedure TTestFPReportPageSize.TestPaperName2;
  1696. var
  1697. F: TFPReportPaperManager;
  1698. begin
  1699. F := PaperManager;
  1700. if F.PaperCount = 0 then
  1701. Registerpapers(3, False);
  1702. FP.PaperName := F.PaperNames[0];
  1703. AssertEquals('Setting papername sets width', F.PaperWidth[0], FP.Width);
  1704. AssertEquals('Setting papername sets height', F.PaperHeight[0], FP.Height);
  1705. FP.ResetChanged;
  1706. FP.PaperName := 'aloha'; // Non existing
  1707. AssertEquals('Setting non-existing papername leaves width', F.PaperWidth[0], FP.Width);
  1708. AssertEquals('Setting non-existing papername leaves height', F.PaperHeight[0], FP.Height);
  1709. AssertEquals('Setting non-existing papername does not call changed', 0, FP.ChangedCalled);
  1710. end;
  1711. procedure TTestFPReportPageSize.TestAssign;
  1712. var
  1713. F: TMyFPreportPageSize;
  1714. begin
  1715. F := TMyFPreportPageSize.Create(nil);
  1716. try
  1717. FP.PaperName := 'me';
  1718. FP.Width := 1.23;
  1719. FP.Height := 4.56;
  1720. F.Assign(FP);
  1721. AssertEquals('Assign assigns Width', FP.Width, F.Width);
  1722. AssertEquals('Assign assigns height', FP.Height, F.Height);
  1723. AssertEquals('Assign assigns papername', FP.PaperName, F.PaperName);
  1724. AssertEquals('Assign calls Changed once', 1, F.ChangedCalled);
  1725. finally
  1726. F.Free;
  1727. end;
  1728. end;
  1729. { TMyFPReportPage }
  1730. procedure TMyFPReportPage.SetupPage;
  1731. begin
  1732. Orientation := poPortrait;
  1733. { paper size }
  1734. PageSize.PaperName := 'A4';
  1735. { page margins }
  1736. Margins.Left := 30;
  1737. Margins.Top := 20;
  1738. Margins.Right := 30;
  1739. Margins.Bottom := 20;
  1740. end;
  1741. procedure TMyFPReportPage.PrepareObjects(aRTParent: TFPReportElement);
  1742. begin
  1743. Inc(FPrepareObjectsCalled);
  1744. inherited PrepareObjects(aRTParent);
  1745. end;
  1746. constructor TMyFPReportPage.Create(AOwner: TComponent);
  1747. begin
  1748. inherited Create(AOwner);
  1749. Font.Name := 'LiberationSerif';
  1750. end;
  1751. procedure TMyFPReportPage.ResetChanged;
  1752. begin
  1753. FChangedCalled := 0;
  1754. end;
  1755. procedure TMyFPReportPage.DoChanged;
  1756. begin
  1757. Inc(FChangedCalled);
  1758. inherited DoChanged;
  1759. end;
  1760. { TMyReportTitleBand }
  1761. procedure TMyReportTitleBand.PrepareObjects(aRTParent: TFPReportElement);
  1762. begin
  1763. Inc(FPrepareObjectsCalled);
  1764. inherited PrepareObjects(aRTParent);
  1765. end;
  1766. constructor TMyReportTitleBand.Create(AOwner: TComponent);
  1767. begin
  1768. inherited Create(AOwner);
  1769. Layout.Height := 20;
  1770. end;
  1771. { TMyDataBand }
  1772. procedure TMyDataBand.PrepareObjects(aRTParent: TFPReportElement);
  1773. begin
  1774. Inc(FPrepareObjectsCalled);
  1775. inherited PrepareObjects(aRTParent);
  1776. end;
  1777. constructor TMyDataBand.Create(AOwner: TComponent);
  1778. begin
  1779. inherited Create(AOwner);
  1780. Layout.Height := 10;
  1781. end;
  1782. { TTestReportPage }
  1783. procedure TTestReportPage.Setup;
  1784. begin
  1785. inherited Setup;
  1786. FP := TMyFPReportPage.Create(nil);
  1787. end;
  1788. procedure TTestReportPage.TearDown;
  1789. begin
  1790. FreeAndNil(FP);
  1791. inherited TearDown;
  1792. end;
  1793. procedure TTestReportPage.TestCreate1;
  1794. begin
  1795. AssertNull('Created page without parent has no report', FP.Report);
  1796. AssertNotNull('Created page has margins', FP.Margins);
  1797. AssertNotNull('Created page has pagesize', FP.PageSize);
  1798. AssertEquals('Orientation is portrait', Ord(poPortrait), Ord(FP.Orientation));
  1799. AssertEquals('No bands', 0, FP.BandCount);
  1800. end;
  1801. procedure TTestReportPage.TestCreate2;
  1802. var
  1803. R: TFPReport;
  1804. P: TMyFPReportPage;
  1805. begin
  1806. R := TFPReport.Create(nil);
  1807. try
  1808. P := TMyFPReportPage.Create(nil);
  1809. try
  1810. P.Report := R;
  1811. AssertSame('Page owner is report when created', R, P.Report);
  1812. AssertEquals('Report has one page', 1, R.PageCount);
  1813. AssertSame('Page added to pages', P, R.Pages[0]);
  1814. finally
  1815. R.Free;
  1816. end;
  1817. AssertNull('Report has notified page', P.Report);
  1818. finally
  1819. P.Free;
  1820. end;
  1821. end;
  1822. procedure TTestReportPage.TestCreate3;
  1823. var
  1824. R: TFPReport;
  1825. P: TMyFPReportPage;
  1826. begin
  1827. R := TFPReport.Create(nil);
  1828. P := TMyFPReportPage.Create(R); // Lets try passing Report as the AOwner in constructor
  1829. try
  1830. AssertSame('Page report is set', R, P.Report);
  1831. AssertSame('Page added to pages', P, R.Pages[0]);
  1832. P.Report := nil;
  1833. AssertEquals('No more pages', 0, R.PageCount);
  1834. finally
  1835. // This will free P as well, because R was set as the owner
  1836. R.Free;
  1837. end;
  1838. end;
  1839. procedure TTestReportPage.TestPageSize1;
  1840. begin
  1841. FP.ResetChanged;
  1842. FP.BeginUpdate;
  1843. try
  1844. FP.PageSize.Width := 10;
  1845. FP.PageSize.Height := 20;
  1846. finally
  1847. FP.EndUpdate;
  1848. end;
  1849. AssertEquals('Changed called', 1, FP.ChangedCalled);
  1850. AssertEquals('Top is zero', 0, FP.Layout.Top);
  1851. AssertEquals('Left is zero', 0, FP.Layout.Left);
  1852. AssertEquals('Width is pagewidth', FP.PageSize.Width, FP.Layout.Width);
  1853. AssertEquals('Height is pageheight', FP.PageSize.Height, FP.Layout.Height);
  1854. end;
  1855. procedure TTestReportPage.TestPageSize2;
  1856. begin
  1857. FP.ResetChanged;
  1858. FP.BeginUpdate;
  1859. try
  1860. FP.PageSize.Width := 10;
  1861. FP.PageSize.Height := 20;
  1862. FP.Margins.Left := 1;
  1863. FP.Margins.Right := 2;
  1864. FP.Margins.Top := 3;
  1865. FP.Margins.Bottom := 4;
  1866. finally
  1867. FP.EndUpdate;
  1868. end;
  1869. AssertEquals('Changed called', 1, FP.ChangedCalled);
  1870. AssertEquals('Top is top margin', 3, FP.Layout.Top);
  1871. AssertEquals('Left is left margin', 1, FP.Layout.Left);
  1872. AssertEquals('Width is pagewidth-rightmargin-leftmargin', 7, FP.Layout.Width);
  1873. AssertEquals('Height is pageheight-topmargin-bottommargin', 13, FP.Layout.Height);
  1874. end;
  1875. procedure TTestReportPage.TestPageSize3;
  1876. begin
  1877. FP.ResetChanged;
  1878. FP.BeginUpdate;
  1879. try
  1880. FP.Orientation := poLandScape;
  1881. FP.PageSize.Width := 10;
  1882. FP.PageSize.Height := 20;
  1883. FP.Margins.Left := 1;
  1884. FP.Margins.Right := 2;
  1885. FP.Margins.Top := 3;
  1886. FP.Margins.Bottom := 4;
  1887. finally
  1888. FP.EndUpdate;
  1889. end;
  1890. AssertEquals('Changed called', 1, FP.ChangedCalled);
  1891. AssertEquals('Top is top margin', 3, FP.Layout.Top);
  1892. AssertEquals('Left is left margin', 1, FP.Layout.Left);
  1893. AssertEquals('Width is pageheight-rightmargin-leftmargin', 17, FP.Layout.Width);
  1894. AssertEquals('Height is pagewidth-topmargin-bottommargin', 3, FP.Layout.Height);
  1895. end;
  1896. procedure TTestReportPage.TestBand1;
  1897. var
  1898. B: TFPReportCustomBand;
  1899. begin
  1900. B := TFPReportCustomBand.Create(nil);
  1901. try
  1902. FP.ResetChanged;
  1903. B.Parent := FP;
  1904. AssertEquals('Changed called', 1, FP.ChangedCalled);
  1905. AssertSame('Parent stored correctly', FP, B.Page);
  1906. AssertEquals('Bandcount correct', 1, FP.BandCount);
  1907. AssertSame('Bands[0] correct', B, FP.Bands[0]);
  1908. finally
  1909. B.Free;
  1910. end;
  1911. AssertEquals('Bandcount correct', 0, FP.BandCount);
  1912. end;
  1913. procedure TTestReportPage.TestBand2;
  1914. var
  1915. B: TFPReportCustomBand;
  1916. P: TMyFPReportPage;
  1917. begin
  1918. B := TFPReportCustomBand.Create(nil);
  1919. try
  1920. P := TMyFPReportPage.Create(nil);
  1921. try
  1922. B.Parent := P;
  1923. AssertSame('Parent stored correctly', P, B.Page);
  1924. AssertEquals('Bandcount correct', 1, P.BandCount);
  1925. AssertSame('Bands[0] correct', B, P.Bands[0]);
  1926. finally
  1927. P.Free;
  1928. end;
  1929. AssertNull('Band notified that page is gone', B.Parent);
  1930. AssertNull('Band notified that page is gone', B.Page);
  1931. finally
  1932. B.Free;
  1933. end;
  1934. end;
  1935. procedure TTestReportPage.TestData;
  1936. var
  1937. FData: TFPReportData;
  1938. begin
  1939. FData := TFPReportData.Create(nil);
  1940. try
  1941. FP.Data := FData;
  1942. finally
  1943. FData.Free;
  1944. end;
  1945. AssertNull('Data is cleared', FP.Data);
  1946. end;
  1947. procedure TTestReportPage.TestAssign;
  1948. var
  1949. E: TFPReportPage;
  1950. begin
  1951. E := TFPReportPage.Create(nil);
  1952. try
  1953. FP.Layout.Top := 1;
  1954. FP.Frame.Width := 2;
  1955. E.Assign(FP);
  1956. AssertEquals('Failed on 1', True, FP.Frame.Equals(E.Frame));
  1957. AssertEquals('Failed on 2', True, FP.Layout.Equals(E.Layout));
  1958. AssertEquals('Failed on 3', Ord(E.Orientation), Ord(FP.Orientation));
  1959. AssertEquals('Failed on 4', True, FP.Margins.Equals(E.Margins));
  1960. finally
  1961. E.Free;
  1962. end;
  1963. end;
  1964. procedure TTestReportPage.TestFindBand;
  1965. var
  1966. t: TFPReportTitleBand;
  1967. h: TFPReportPageHeaderBand;
  1968. f: TFPReportPageFooterBand;
  1969. d: TFPReportDataBand;
  1970. begin
  1971. t := TFPReportTitleBand.Create(FP);
  1972. h := TFPReportPageHeaderBand.Create(FP);
  1973. f := TFPReportPageFooterBand.Create(FP);
  1974. d := TFPReportDataBand.Create(FP);
  1975. AssertTrue('failed on 1', h = FP.FindBand(TFPReportPageHeaderBand));
  1976. AssertTrue('failed on 2', t <> FP.FindBand(TFPReportPageHeaderBand));
  1977. AssertTrue('failed on 3', t = FP.FindBand(TFPReportTitleBand));
  1978. AssertTrue('failed on 4', f = FP.FindBand(TFPReportPageFooterBand));
  1979. AssertTrue('failed on 5', d = FP.FindBand(TFPReportDataBand));
  1980. AssertTrue('failed on 6', FP.FindBand(TFPReportChildBand) = nil);
  1981. end;
  1982. { TMyFPReportData }
  1983. procedure TMyFPReportData.ResetCounts;
  1984. begin
  1985. FCC := 0;
  1986. FDFC := 0;
  1987. FEC := 0;
  1988. FFC := 0;
  1989. FNC := 0;
  1990. FOC := 0;
  1991. end;
  1992. procedure TMyFPReportData.DoInitDataFields;
  1993. begin
  1994. inherited DoInitDataFields;
  1995. Inc(FDFC);
  1996. end;
  1997. procedure TMyFPReportData.DoOpen;
  1998. begin
  1999. inherited DoOpen;
  2000. Inc(FOC);
  2001. end;
  2002. procedure TMyFPReportData.DoFirst;
  2003. begin
  2004. inherited DoFirst;
  2005. Inc(FFC);
  2006. end;
  2007. procedure TMyFPReportData.DoNext;
  2008. begin
  2009. inherited DoNext;
  2010. Inc(FNC);
  2011. end;
  2012. procedure TMyFPReportData.DoClose;
  2013. begin
  2014. inherited DoClose;
  2015. Inc(FCC);
  2016. end;
  2017. function TMyFPReportData.DoEOF: boolean;
  2018. begin
  2019. FOE := inherited DoEOF;
  2020. Inc(FEC);
  2021. Result := FReportEOF;
  2022. end;
  2023. { TTestReportData }
  2024. procedure TTestReportData.DoOpen(Sender: TObject);
  2025. begin
  2026. FHandler := True;
  2027. AssertEquals('OnOpen called before DoOpen', 0, FD.OpenCount);
  2028. AssertEquals('OnOpen called before InitFieldDefs', 0, FD.InitDataFieldsCount);
  2029. end;
  2030. procedure TTestReportData.DoNext(Sender: TObject);
  2031. begin
  2032. FHandler := True;
  2033. AssertEquals('DoNext not yet called in handler', 0, FD.NextCount);
  2034. AssertEquals('Recno is already 2 in donext', 2, FD.RecNo);
  2035. end;
  2036. procedure TTestReportData.Setup;
  2037. begin
  2038. inherited Setup;
  2039. FD := TMyFPReportData.Create(nil);
  2040. FHandler := False;
  2041. end;
  2042. procedure TTestReportData.TearDown;
  2043. begin
  2044. FreeAndNil(FD);
  2045. inherited TearDown;
  2046. end;
  2047. procedure TTestReportData.CreateFields;
  2048. begin
  2049. FD.DataFields.AddField('string', rfkString).DisplayWidth := 10;
  2050. FD.DataFields.AddField('boolean', rfkBoolean).DisplayWidth := 20;
  2051. FD.DataFields.AddField('integer', rfkInteger).DisplayWidth := 30;
  2052. FD.DataFields.AddField('float', rfkFloat).DisplayWidth := 40;
  2053. FD.DataFields.AddField('datetime', rfkDateTime).DisplayWidth := 50;
  2054. FD.Datafields.AddField('stream', rfkStream).DisplayWidth := 60;
  2055. end;
  2056. procedure TTestReportData.DoFieldByName;
  2057. var
  2058. F: TFPReportDataField;
  2059. begin
  2060. F := FD.Datafields.FieldByName('ohlala');
  2061. end;
  2062. procedure TTestReportData.TestCreate;
  2063. begin
  2064. AssertEquals('Closed recno is 0', 0, FD.RecNo);
  2065. AssertNotNull('DataFields created', FD.DataFields);
  2066. AssertEquals('Closed fieldcount is 0', 0, FD.DataFields.Count);
  2067. AssertSame('Datafields reportdata is self', FD, FD.DataFields.ReportData);
  2068. end;
  2069. procedure TTestReportData.TestOpen1;
  2070. begin
  2071. FD.OnOpen := @DoOpen;
  2072. FD.Open;
  2073. AssertEquals('OnOpen Handler called', True, FHandler);
  2074. AssertEquals('DoOpen called once', 1, FD.OpenCount);
  2075. AssertEquals('InitFieldDefs called once', 1, FD.InitDataFieldsCount);
  2076. AssertEquals('Recno is 1', 1, FD.RecNo);
  2077. end;
  2078. procedure TTestReportData.TestNext;
  2079. begin
  2080. FD.OnNext := @DoNext;
  2081. FD.Open;
  2082. FHandler := False;
  2083. FD.Next;
  2084. AssertEquals('OnNext Handler called', True, FHandler);
  2085. AssertEquals('DoNext Called once', 1, FD.NextCount);
  2086. AssertEquals('Recno is 2 after next', 2, FD.RecNo);
  2087. end;
  2088. procedure TTestReportData.TestInitFieldDefs;
  2089. begin
  2090. FD.InitFieldDefs;
  2091. AssertEquals('InitFieldDefs called once', 1, FD.InitDataFieldsCount);
  2092. end;
  2093. procedure TTestReportData.TestInitFieldDefs_OnlyAllowedOnce;
  2094. begin
  2095. FD.Open;
  2096. AssertEquals('Failed on 1', 1, FD.InitDataFieldsCount);
  2097. try
  2098. FD.InitFieldDefs;
  2099. Fail('Failed on 2. - we should not have reached here.');
  2100. except
  2101. on E: Exception do
  2102. begin
  2103. AssertEquals('Failed on 3', E.ClassName, 'EReportError');
  2104. end;
  2105. end;
  2106. AssertEquals('Failed on 4', 1, FD.InitDataFieldsCount);
  2107. end;
  2108. procedure TTestReportData.TestEOF1;
  2109. begin
  2110. FD.ReportEOF := True;
  2111. AssertEquals('ReportEOF works correctly', True, FD.EOF);
  2112. AssertEquals('Inherited EOF returns false', False, FD.OldEOF);
  2113. end;
  2114. procedure TTestReportData.TestAddDatafield;
  2115. var
  2116. F: TFPReportDataField;
  2117. begin
  2118. F := FD.DataFields.AddField('test', rfkBoolean);
  2119. AssertEquals('Boolean field Added', Ord(rfkBoolean), Ord(F.FieldKind));
  2120. AssertEquals('test field name Added', 'test', F.fieldname);
  2121. AssertEquals('0 width field Added', 0, F.DisplayWidth);
  2122. end;
  2123. procedure TTestReportData.TestDatafieldAdd;
  2124. var
  2125. I: TCollectionItem;
  2126. F: TFPReportDataField;
  2127. begin
  2128. I := FD.Datafields.Add;
  2129. AssertEquals('add creates TFPReportDataField', TFPReportDataField, I.ClassType);
  2130. F := I as TFPReportDataField;
  2131. AssertEquals('Default field of string kind', Ord(rfkString), Ord(F.FieldKind));
  2132. AssertEquals('Default field name empty', '', F.FieldName);
  2133. AssertEquals('Default field with 0', 0, F.DisplayWidth);
  2134. end;
  2135. procedure TTestReportData.AssertField(Prefix: string; F: TFPReportDataField; AFieldName: string;
  2136. AFieldKind: TFPReportFieldKind; ADisplayWidth: integer = 0);
  2137. var
  2138. S1, S2: string;
  2139. begin
  2140. AssertEquals(Prefix + ' has correct field name', AfieldName, F.FieldName);
  2141. S1 := GetEnumName(TypeInfo(TFPReportFieldKind), Ord(AFieldKind));
  2142. S2 := GetEnumName(TypeInfo(TFPReportFieldKind), Ord(F.FieldKind));
  2143. AssertEquals(Prefix + ' has corrrect fieldkind', S1, S2);
  2144. AssertEquals(Prefix + ' has correct fieldwidth', ADisplayWidth, F.DisplayWidth);
  2145. end;
  2146. procedure TTestReportData.TestCreateFields;
  2147. begin
  2148. CreateFields;
  2149. AssertEquals('Correct field count', 6, FD.FieldCount);
  2150. AssertField('Field 0', FD.DataFields[0], 'string', rfkString, 10);
  2151. AssertField('Field 1', FD.DataFields[1], 'boolean', rfkBoolean, 20);
  2152. AssertField('Field 2', FD.DataFields[2], 'integer', rfkInteger, 30);
  2153. AssertField('Field 3', FD.DataFields[3], 'float', rfkFloat, 40);
  2154. AssertField('Field 4', FD.DataFields[4], 'datetime', rfkDateTime, 50);
  2155. AssertField('Field 5', FD.DataFields[5], 'stream', rfkStream, 60);
  2156. end;
  2157. procedure TTestReportData.TestDatafieldIndexOf1;
  2158. begin
  2159. CreateFields;
  2160. AssertEquals('Finds field at pos 0', 0, FD.DataFields.IndexOfField('string'));
  2161. AssertEquals('Finds field at pos 3', 3, FD.DataFields.IndexOfField('float'));
  2162. AssertEquals('Finds field at pos 5', 5, FD.DataFields.IndexOfField('stream'));
  2163. AssertEquals('Finds field (casing) at pos 3', 3, FD.DataFields.IndexOfField('Float'));
  2164. end;
  2165. procedure TTestReportData.TestDatafieldIndexOf2;
  2166. begin
  2167. AssertEquals('No fields returns -1', -1, FD.DataFields.IndexOfField('string'));
  2168. CreateFields;
  2169. AssertEquals('Non-existing field returns -1', -1, FD.DataFields.IndexOfField('stringlslsl'));
  2170. end;
  2171. procedure TTestReportData.TestFindField1;
  2172. begin
  2173. AssertNull('No fields returns Nil', FD.DataFields.FindField('string'));
  2174. CreateFields;
  2175. AssertNull('Non-existing fields returns Nil', FD.DataFields.FindField('stringsss'));
  2176. end;
  2177. procedure TTestReportData.TestFindField2;
  2178. begin
  2179. CreateFields;
  2180. AssertSame('FindField returns correct field', FD.DataFields[0], FD.DataFields.FindField('string'));
  2181. AssertSame('FindField returns correct field', FD.DataFields[3], FD.DataFields.FindField('float'));
  2182. AssertSame('FindField returns correct field (case insensitive)', FD.DataFields[3], FD.DataFields.FindField('floaT'));
  2183. end;
  2184. procedure TTestReportData.TestFindByName1;
  2185. begin
  2186. CreateFields;
  2187. AssertSame('FieldByName returns correct field', FD.DataFields[0], FD.DataFields.FieldByName('string'));
  2188. end;
  2189. procedure TTestReportData.TestFindByName2;
  2190. begin
  2191. CreateFields;
  2192. AssertException('FieldByName (non-existent) raises exception', EReportError, @DoFieldByName);
  2193. end;
  2194. procedure TTestReportData.TestFieldAssign;
  2195. var
  2196. F1, F2: TFPReportDataField;
  2197. begin
  2198. F1 := TFPReportDataField.Create(nil);
  2199. try
  2200. f2 := TFPReportDataField.Create(nil);
  2201. try
  2202. F1.FieldKind := rfkBoolean;
  2203. F1.FieldName := 'bool';
  2204. F1.DisplayWidth := 12;
  2205. F2.Assign(F1);
  2206. AssertField('Assigned ', F2, 'bool', rfkBoolean, 12);
  2207. finally
  2208. F2.Free;
  2209. end;
  2210. finally
  2211. F1.Free;
  2212. end;
  2213. end;
  2214. procedure TTestReportData.TestGetValue;
  2215. var
  2216. v: variant;
  2217. begin
  2218. CreateFields;
  2219. v := FD.Datafields[0].GetValue;
  2220. AssertTrue('Failed on 1', V = Null);
  2221. end;
  2222. procedure TTestReportData.TestEasyAccessProperties;
  2223. var
  2224. I: integer;
  2225. begin
  2226. CreateFields;
  2227. for I := 0 to FD.FieldCount - 1 do
  2228. AssertEquals('FieldNames array OK', FD.DataFields[0].FieldName, FD.FieldNames[0]);
  2229. for I := 0 to FD.FieldCount - 1 do
  2230. AssertEquals('FieldWidth array OK', FD.DataFields[0].DisplayWidth, FD.FieldWidths[FD.FieldNames[0]]);
  2231. for I := 0 to FD.FieldCount - 1 do
  2232. AssertEquals('FieldTypes array OK', Ord(FD.DataFields[0].FieldKind), Ord(FD.FieldTypes[FD.FieldNames[0]]));
  2233. end;
  2234. { TTestUserReportData }
  2235. procedure TTestUserReportData.Setup;
  2236. begin
  2237. FD := TFPReportUserData.Create(nil);
  2238. FD.DataFields.AddField('string', rfkString);
  2239. FD.OnGetValue := @DoValue;
  2240. inherited;
  2241. end;
  2242. procedure TTestUserReportData.TearDown;
  2243. begin
  2244. FreeAndNil(FD);
  2245. inherited TearDown;
  2246. end;
  2247. procedure TTestUserReportData.DoValue(Sender: TObject; const AValueName: string; var AValue: variant);
  2248. begin
  2249. AssertSame('DoValue Sender is reportdata', FD, Sender);
  2250. AssertEquals('DoValue gets correct value name', FExpectName, AValueName);
  2251. AValue := FReturnValue;
  2252. end;
  2253. procedure TTestUserReportData.TestGetValue;
  2254. begin
  2255. FExpectName := 'string';
  2256. FReturnValue := 10;
  2257. AssertEquals('Return value correct', 10, FD.DataFields[0].GetValue);
  2258. AssertEquals('FieldValues array value correct', 10, FD.FieldValues['string']);
  2259. end;
  2260. { TTestUserReportData2 }
  2261. procedure TTestUserReportData2.DoGetValue(Sender: TObject; const AValueName: string; var AValue: variant);
  2262. begin
  2263. if AValueName = 'element' then
  2264. AValue := FSL[FData.RecNo - 1];
  2265. end;
  2266. procedure TTestUserReportData2.DoGetEOF(Sender: TObject; var IsEOF: boolean);
  2267. begin
  2268. if FData.RecNo > FSL.Count then
  2269. IsEOF := True
  2270. else
  2271. IsEOF := False;
  2272. end;
  2273. procedure TTestUserReportData2.Setup;
  2274. begin
  2275. inherited Setup;
  2276. FData := TFPReportUserData.Create(nil);
  2277. FData.OnGetValue := @DoGetValue;
  2278. // data is coming from the stringlist this time
  2279. FSL := TStringList.Create;
  2280. FSL.Add('Item 1');
  2281. FSL.Add('Item 2');
  2282. FSL.Add('Item 3');
  2283. FSL.Add('Item 4');
  2284. end;
  2285. procedure TTestUserReportData2.TearDown;
  2286. begin
  2287. FData.Free;
  2288. FSL.Free;
  2289. inherited TearDown;
  2290. end;
  2291. procedure TTestUserReportData2.TestGetValue;
  2292. begin
  2293. FData.First;
  2294. AssertEquals('Failed on 1', 'Item 1', FData.FieldValues['element']);
  2295. FData.Next;
  2296. AssertEquals('Failed on 2', 'Item 2', FData.FieldValues['element']);
  2297. FData.Next;
  2298. AssertEquals('Failed on 3', 'Item 3', FData.FieldValues['element']);
  2299. FData.Next;
  2300. AssertEquals('Failed on 4', 'Item 4', FData.FieldValues['element']);
  2301. FData.Next;
  2302. end;
  2303. procedure TTestUserReportData2.TestOnGetEOF1;
  2304. var
  2305. i: integer;
  2306. begin
  2307. FData.First;
  2308. for i := 1 to FSL.Count do
  2309. FData.Next;
  2310. // Should be False, because we haven't assigned OnGetEOF event handler
  2311. AssertTrue('Failed on 1', FData.EOF = False);
  2312. end;
  2313. procedure TTestUserReportData2.TestOnGetEOF2;
  2314. var
  2315. i: integer;
  2316. begin
  2317. FData.OnGetEOF := @DoGetEOF;
  2318. FData.First;
  2319. for i := 1 to FSL.Count do
  2320. FData.Next;
  2321. AssertTrue('Failed on 1', FData.EOF = True);
  2322. end;
  2323. { TTestDataBand }
  2324. procedure TTestDataBand.Setup;
  2325. begin
  2326. FDataBand := TFPReportDataBand.Create(nil);
  2327. inherited Setup;
  2328. end;
  2329. procedure TTestDataBand.TearDown;
  2330. begin
  2331. FreeAndNil(FDataBand);
  2332. inherited TearDown;
  2333. end;
  2334. procedure TTestDataBand.TestData;
  2335. var
  2336. D: TFPReportData;
  2337. begin
  2338. D := TFPReportData.Create(nil);
  2339. try
  2340. FDataBand.Data := D;
  2341. AssertSame('Assigned data OK', D, FDataBand.Data)
  2342. finally
  2343. D.Free;
  2344. end;
  2345. AssertNull('Free notification of Data', FDataBand.Data);
  2346. end;
  2347. procedure TTestDataBand.TestDataPropertyAutoSet;
  2348. var
  2349. p: TMyFPReportPage;
  2350. DataBand: TMyDataBand;
  2351. D: TFPReportData;
  2352. begin
  2353. SetReportData(2);
  2354. p := TMyFPReportPage.Create(Report);
  2355. p.SetupPage;
  2356. p.Name := 'Page1';
  2357. p.Data := Data;
  2358. DataBand := TMyDataBand.Create(p);
  2359. // DataBand should have been assigned p.Data automatically
  2360. AssertSame('Failed on 1', TFPReportData(Data), DataBand.Data);
  2361. D := TFPReportData.Create(nil);
  2362. try
  2363. DataBand.Data := D;
  2364. AssertTrue('Failed on 2', p.Data <> DataBand.Data);
  2365. finally
  2366. D.Free;
  2367. end;
  2368. end;
  2369. { TTestCustomReport }
  2370. procedure TTestCustomReport.HandleOnBeginReport;
  2371. begin
  2372. Inc(FBeginReportCount);
  2373. end;
  2374. procedure TTestCustomReport.HandleOnEndReport;
  2375. begin
  2376. Inc(FEndReportCount);
  2377. end;
  2378. procedure TTestCustomReport.InitializeData(const ACount: integer);
  2379. var
  2380. i: integer;
  2381. begin
  2382. // data is coming from the stringlist this time
  2383. FSL := TStringList.Create;
  2384. if ACount < 1 then
  2385. Exit;
  2386. for i := 1 to ACount do
  2387. FSL.Add('Item ' + IntToStr(i));
  2388. end;
  2389. procedure TTestCustomReport.SetReportData(const ADataCount: Byte);
  2390. begin
  2391. if ADataCount < 1 then
  2392. Exit;
  2393. InitializeData(ADataCount);
  2394. FData := TFPReportUserData.Create(nil);
  2395. FData.OnGetValue := @DoGetDataValue;
  2396. FData.OnGetEOF := @DoGetDataEOF;
  2397. FData.OnGetNames := @DoGetDataFieldNames;
  2398. end;
  2399. procedure TTestCustomReport.DoGetDataValue(Sender: TObject; const AValueName: string; var AValue: variant);
  2400. begin
  2401. if AValueName = 'element' then
  2402. AValue := FSL[FData.RecNo - 1];
  2403. end;
  2404. procedure TTestCustomReport.DoGetDataEOF(Sender: TObject; var IsEOF: boolean);
  2405. begin
  2406. if FData.RecNo > FSL.Count then
  2407. IsEOF := True
  2408. else
  2409. IsEOF := False;
  2410. end;
  2411. procedure TTestCustomReport.Setup;
  2412. begin
  2413. inherited Setup;
  2414. PaperManager.Clear;
  2415. PaperManager.RegisterStandardSizes;
  2416. Report := TMyCustomReport.Create(nil);
  2417. FBeginReportCount := 0;
  2418. FEndReportCount := 0;
  2419. gTTFontCache.Clear;
  2420. gTTFontCache.SearchPath.Text := 'fonts';
  2421. gTTFontCache.BuildFontCache;
  2422. end;
  2423. procedure TTestCustomReport.TearDown;
  2424. begin
  2425. FreeAndNil(FRpt);
  2426. FreeAndNil(FData);
  2427. FreeAndNil(FSL);
  2428. inherited TearDown;
  2429. end;
  2430. procedure TTestCustomReport.DoGetDataFieldNames(Sender: TObject; List: TStrings);
  2431. begin
  2432. List.Add('element');
  2433. end;
  2434. procedure TTestCustomReport.TestBeginReportEvent;
  2435. begin
  2436. Report.OnBeginReport := @HandleOnBeginReport;
  2437. AssertEquals('Failed on 1', 0, FBeginReportCount);
  2438. Report.RunReport;
  2439. AssertEquals('Failed on 2', 1, FBeginReportCount);
  2440. AssertEquals('Failed on 3', 0, FEndReportCount);
  2441. end;
  2442. procedure TTestCustomReport.TestEndReportEvent;
  2443. begin
  2444. Report.OnEndReport := @HandleOnEndReport;
  2445. AssertEquals('Failed on 1', 0, FEndReportCount);
  2446. Report.RunReport;
  2447. AssertEquals('Failed on 2', 1, FEndReportCount);
  2448. AssertEquals('Failed on 3', 0, FBeginReportCount);
  2449. end;
  2450. procedure TTestCustomReport.TestPagePrepareObjects;
  2451. var
  2452. p: TMyFPReportPage;
  2453. begin
  2454. SetReportData(2);
  2455. p := TMyFPReportPage.Create(Report);
  2456. p.Name := 'Page1';
  2457. p.Data := Data;
  2458. p := TMyFPReportPage.Create(Report);
  2459. p.Name := 'Page2';
  2460. p.Data := Data;
  2461. p := TMyFPReportPage.Create(Report);
  2462. p.Name := 'Page3';
  2463. p.Data := Data;
  2464. AssertEquals('Failed on 1', 0, TMyFPReportPage(Report.Pages[0]).FPrepareObjectsCalled);
  2465. AssertEquals('Failed on 2', 0, TMyFPReportPage(Report.Pages[1]).FPrepareObjectsCalled);
  2466. AssertEquals('Failed on 3', 0, TMyFPReportPage(Report.Pages[2]).FPrepareObjectsCalled);
  2467. Report.RunReport;
  2468. AssertEquals('Failed on 4', 1, TMyFPReportPage(Report.Pages[0]).FPrepareObjectsCalled);
  2469. AssertEquals('Failed on 5', 1, TMyFPReportPage(Report.Pages[1]).FPrepareObjectsCalled);
  2470. AssertEquals('Failed on 6', 1, TMyFPReportPage(Report.Pages[2]).FPrepareObjectsCalled);
  2471. end;
  2472. procedure TTestCustomReport.TestBandPrepareObjects;
  2473. var
  2474. p: TMyFPReportPage;
  2475. TitleBand: TMyReportTitleBand;
  2476. DataBand: TMyDataBand;
  2477. begin
  2478. SetReportData(2);
  2479. p := TMyFPReportPage.Create(Report);
  2480. p.SetupPage;
  2481. p.Name := 'Page1';
  2482. p.Data := Data;
  2483. TitleBand := TMyReportTitleBand.Create(p);
  2484. DataBand := TMyDataBand.Create(p);
  2485. DataBand.Data := FData;
  2486. AssertEquals('Failed on 1', 0, p.FPrepareObjectsCalled);
  2487. AssertEquals('Failed on 2', 0, TitleBand.FPrepareObjectsCalled);
  2488. AssertEquals('Failed on 3', 0, DataBand.FPrepareObjectsCalled);
  2489. Report.RunReport;
  2490. AssertEquals('Failed on 4', 1, p.FPrepareObjectsCalled);
  2491. AssertEquals('Failed on 5', 1, TitleBand.FPrepareObjectsCalled);
  2492. AssertEquals('Failed on 6', 2, DataBand.FPrepareObjectsCalled);
  2493. end;
  2494. procedure TTestCustomReport.TestRTObjects1;
  2495. var
  2496. p: TMyFPReportPage;
  2497. begin
  2498. SetReportData(2);
  2499. p := TMyFPReportPage.Create(Report);
  2500. p.SetupPage;
  2501. p.Name := 'Page1';
  2502. p.Data := Data;
  2503. p := TMyFPReportPage.Create(Report);
  2504. p.SetupPage;
  2505. p.Name := 'Page2';
  2506. p.Data := Data;
  2507. p := TMyFPReportPage.Create(Report);
  2508. p.SetupPage;
  2509. p.Name := 'Page3';
  2510. p.Data := Data;
  2511. AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  2512. Report.RunReport;
  2513. AssertEquals('Failed on 2', 3, Report.RTObjects.Count);
  2514. end;
  2515. procedure TTestCustomReport.TestRTObjects2;
  2516. var
  2517. p: TMyFPReportPage;
  2518. TitleBand: TMyReportTitleBand;
  2519. Memo: TFPReportMemo;
  2520. rtPage: TFPReportCustomPage;
  2521. begin
  2522. SetReportData(2);
  2523. p := TMyFPReportPage.Create(Report);
  2524. p.SetupPage;
  2525. p.Name := 'Page1';
  2526. p.Data := Data;
  2527. TitleBand := TMyReportTitleBand.Create(p);
  2528. Memo := TFPReportMemo.Create(TitleBand);
  2529. Memo.Text := 'THE REPORT TITLE';
  2530. Memo.Layout.Top := 5;
  2531. Memo.Layout.Left := 10;
  2532. AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  2533. Report.RunReport;
  2534. AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  2535. AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  2536. rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  2537. AssertEquals('Failed on 4', 1, rtPage.ChildCount);
  2538. AssertEquals('Failed on 5', 1, rtPage.BandCount);
  2539. AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  2540. {$IFDEF gdebug}
  2541. // writeln(Report.DebugPreparedPageAsJSON(0));
  2542. {$ENDIF}
  2543. end;
  2544. procedure TTestCustomReport.TestRTObjects3;
  2545. var
  2546. p: TMyFPReportPage;
  2547. DataBand: TMyDataBand;
  2548. Memo: TFPReportMemo;
  2549. rtPage: TFPReportCustomPage;
  2550. begin
  2551. SetReportData(2);
  2552. p := TMyFPReportPage.Create(Report);
  2553. p.SetupPage;
  2554. p.Name := 'Page1';
  2555. p.Data := Data;
  2556. DataBand := TMyDataBand.Create(p);
  2557. Memo := TFPReportMemo.Create(DataBand);
  2558. Memo.Layout.Top := 5;
  2559. Memo.Layout.Left := 10;
  2560. Memo.Text := '[element]';
  2561. AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  2562. Report.RunReport;
  2563. AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  2564. AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  2565. rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  2566. AssertEquals('Failed on 4', 2, rtPage.ChildCount);
  2567. AssertEquals('Failed on 5', 2, rtPage.BandCount);
  2568. {$IFDEF gdebug}
  2569. // writeln(Report.DebugPreparedPageAsJSON(0));
  2570. {$ENDIF}
  2571. end;
  2572. procedure TTestCustomReport.TestRTObjects4_OneDataItem;
  2573. var
  2574. p: TMyFPReportPage;
  2575. DataBand: TMyDataBand;
  2576. Memo: TFPReportMemo;
  2577. rtPage: TFPReportCustomPage;
  2578. begin
  2579. SetReportData(1);
  2580. p := TMyFPReportPage.Create(Report);
  2581. p.SetupPage;
  2582. p.Name := 'Page1';
  2583. p.SetupPage;
  2584. p.Data := Data;
  2585. DataBand := TMyDataBand.Create(p);
  2586. DataBand.Layout.Height := 23;
  2587. Memo := TFPReportMemo.Create(DataBand);
  2588. Memo.Layout.Top := 5;
  2589. Memo.Layout.Left := 10;
  2590. Memo.Text := '[element]';
  2591. AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  2592. Report.RunReport;
  2593. AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  2594. AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  2595. rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  2596. AssertEquals('Failed on 4', 1, rtPage.ChildCount);
  2597. AssertEquals('Failed on 5', 1, rtPage.BandCount);
  2598. AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  2599. {$IFDEF gdebug}
  2600. // writeln(Report.DebugPreparedPageAsJSON(0));
  2601. {$ENDIF}
  2602. end;
  2603. procedure TTestCustomReport.TestRTObjects5_TwoDataItems;
  2604. var
  2605. p: TMyFPReportPage;
  2606. DataBand: TMyDataBand;
  2607. Memo: TFPReportMemo;
  2608. rtPage: TFPReportCustomPage;
  2609. begin
  2610. SetReportData(2);
  2611. p := TMyFPReportPage.Create(Report);
  2612. p.Name := 'Page1';
  2613. p.SetupPage;
  2614. p.Data := Data;
  2615. DataBand := TMyDataBand.Create(p);
  2616. DataBand.Layout.Top := 0;
  2617. DataBand.Layout.Height := 23;
  2618. Memo := TFPReportMemo.Create(DataBand);
  2619. Memo.Layout.Top := 5;
  2620. Memo.Layout.Left := 10;
  2621. Memo.Text := '[element]';
  2622. AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  2623. Report.RunReport;
  2624. AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  2625. AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  2626. rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  2627. AssertEquals('Failed on 4', 2, rtPage.ChildCount);
  2628. AssertEquals('Failed on 5', 2, rtPage.BandCount); { each data row has its own data band }
  2629. AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  2630. AssertEquals('Failed on 7', 1, rtPage.Bands[1].ChildCount);
  2631. {$IFDEF gdebug}
  2632. // writeln(Report.DebugPreparedPageAsJSON(0));
  2633. {$ENDIF}
  2634. end;
  2635. procedure TTestCustomReport.TestInternalFunction_Page;
  2636. var
  2637. p: TMyFPReportPage;
  2638. DataBand: TMyDataBand;
  2639. Memo: TFPReportMemo;
  2640. rtPage: TFPReportCustomPage;
  2641. begin
  2642. SetReportData(1);
  2643. p := TMyFPReportPage.Create(Report);
  2644. p.Name := 'Page1';
  2645. p.SetupPage;
  2646. p.Data := Data;
  2647. DataBand := TMyDataBand.Create(p);
  2648. DataBand.Layout.Height := 23;
  2649. Memo := TFPReportMemo.Create(DataBand);
  2650. Memo.Layout.Top := 5;
  2651. Memo.Layout.Left := 10;
  2652. Memo.Text := '[PageNo]';
  2653. AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  2654. Report.RunReport;
  2655. AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  2656. AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  2657. rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  2658. AssertEquals('Failed on 4', 1, rtPage.ChildCount);
  2659. AssertEquals('Failed on 5', 1, rtPage.BandCount);
  2660. AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  2661. Memo := TFPReportMemo(rtPage.Bands[0].Child[0]);
  2662. AssertEquals('Failed on 7', '1', Memo.Text);
  2663. end;
  2664. procedure TTestCustomReport.TestInternalFunction_Page_with_text;
  2665. var
  2666. p: TMyFPReportPage;
  2667. DataBand: TMyDataBand;
  2668. Memo: TFPReportMemo;
  2669. rtPage: TFPReportCustomPage;
  2670. begin
  2671. SetReportData(1);
  2672. p := TMyFPReportPage.Create(Report);
  2673. p.Name := 'Page1';
  2674. p.SetupPage;
  2675. p.Data := Data;
  2676. DataBand := TMyDataBand.Create(p);
  2677. DataBand.Layout.Height := 23;
  2678. Memo := TFPReportMemo.Create(DataBand);
  2679. Memo.Layout.Top := 5;
  2680. Memo.Layout.Left := 10;
  2681. Memo.Text := 'Page [PageNo]';
  2682. AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  2683. Report.RunReport;
  2684. AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  2685. AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  2686. rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  2687. AssertEquals('Failed on 4', 1, rtPage.ChildCount);
  2688. AssertEquals('Failed on 5', 1, rtPage.BandCount);
  2689. AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  2690. Memo := TFPReportMemo(rtPage.Bands[0].Child[0]);
  2691. AssertEquals('Failed on 7', 'Page 1', Memo.Text);
  2692. end;
  2693. procedure TTestCustomReport.TestInternalFunction_RecNo;
  2694. var
  2695. p: TMyFPReportPage;
  2696. DataBand: TMyDataBand;
  2697. Memo: TFPReportMemo;
  2698. rtPage: TFPReportCustomPage;
  2699. i: integer;
  2700. begin
  2701. SetReportData(5);
  2702. p := TMyFPReportPage.Create(Report);
  2703. p.Name := 'Page1';
  2704. p.SetupPage;
  2705. p.Data := Data;
  2706. DataBand := TMyDataBand.Create(p);
  2707. DataBand.Layout.Height := 23;
  2708. Memo := TFPReportMemo.Create(DataBand);
  2709. Memo.Layout.Top := 5;
  2710. Memo.Layout.Left := 10;
  2711. Memo.Text := '[recno]';
  2712. AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  2713. Report.RunReport;
  2714. AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  2715. AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  2716. rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  2717. AssertEquals('Failed on 4', 5, rtPage.ChildCount); // 5 rendered data bands because we have 5 data records
  2718. AssertEquals('Failed on 5', 5, rtPage.BandCount);
  2719. AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  2720. for i := 0 to 4 do
  2721. begin
  2722. Memo := TFPReportMemo(rtPage.Bands[i].Child[0]);
  2723. AssertEquals('Failed on 7.'+IntToStr(i), IntToStr(i+1), Memo.Text); { recno is 1-based }
  2724. end;
  2725. end;
  2726. procedure TTestCustomReport.TestInternalFunction_Today;
  2727. var
  2728. p: TMyFPReportPage;
  2729. DataBand: TMyDataBand;
  2730. Memo: TFPReportMemo;
  2731. rtPage: TFPReportCustomPage;
  2732. begin
  2733. SetReportData(1);
  2734. p := TMyFPReportPage.Create(Report);
  2735. p.Name := 'Page1';
  2736. p.SetupPage;
  2737. p.Data := Data;
  2738. DataBand := TMyDataBand.Create(p);
  2739. DataBand.Layout.Height := 23;
  2740. Memo := TFPReportMemo.Create(DataBand);
  2741. Memo.Layout.Top := 5;
  2742. Memo.Layout.Left := 10;
  2743. Memo.Text := '[today]';
  2744. AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  2745. Report.RunReport;
  2746. AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  2747. AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  2748. rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  2749. AssertEquals('Failed on 4', 1, rtPage.ChildCount); // 1 rendered data band because we have 1 data record
  2750. AssertEquals('Failed on 5', 1, rtPage.BandCount);
  2751. AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  2752. Memo := TFPReportMemo(rtPage.Bands[0].Child[0]);
  2753. AssertEquals('Failed on 7', FormatDateTime('yyyy-mm-dd', Today), Memo.Text);
  2754. end;
  2755. procedure TTestCustomReport.TestInternalFunction_Today_with_text;
  2756. var
  2757. p: TMyFPReportPage;
  2758. DataBand: TMyDataBand;
  2759. Memo: TFPReportMemo;
  2760. rtPage: TFPReportCustomPage;
  2761. begin
  2762. SetReportData(1);
  2763. p := TMyFPReportPage.Create(Report);
  2764. p.Name := 'Page1';
  2765. p.SetupPage;
  2766. p.Data := Data;
  2767. DataBand := TMyDataBand.Create(p);
  2768. DataBand.Layout.Height := 23;
  2769. Memo := TFPReportMemo.Create(DataBand);
  2770. Memo.Layout.Top := 5;
  2771. Memo.Layout.Left := 10;
  2772. Memo.Text := 'Today is [today]';
  2773. AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  2774. Report.RunReport;
  2775. AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  2776. AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  2777. rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  2778. AssertEquals('Failed on 4', 1, rtPage.ChildCount); // 1 rendered data band because we have 1 data record
  2779. AssertEquals('Failed on 5', 1, rtPage.BandCount);
  2780. AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  2781. Memo := TFPReportMemo(rtPage.Bands[0].Child[0]);
  2782. AssertEquals('Failed on 7', 'Today is ' + FormatDateTime('yyyy-mm-dd', Today), Memo.Text);
  2783. end;
  2784. procedure TTestCustomReport.TestInternalFunction_Author;
  2785. var
  2786. p: TMyFPReportPage;
  2787. DataBand: TMyDataBand;
  2788. Memo: TFPReportMemo;
  2789. rtPage: TFPReportCustomPage;
  2790. begin
  2791. SetReportData(1);
  2792. p := TMyFPReportPage.Create(Report);
  2793. p.Name := 'Page1';
  2794. p.SetupPage;
  2795. p.Data := Data;
  2796. DataBand := TMyDataBand.Create(p);
  2797. DataBand.Layout.Height := 23;
  2798. Memo := TFPReportMemo.Create(DataBand);
  2799. Memo.Layout.Top := 5;
  2800. Memo.Layout.Left := 10;
  2801. Memo.Text := '[author]';
  2802. AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  2803. Report.RunReport;
  2804. AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  2805. AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  2806. rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  2807. AssertEquals('Failed on 4', 1, rtPage.ChildCount); // 1 rendered data band because we have 1 data record
  2808. AssertEquals('Failed on 5', 1, rtPage.BandCount);
  2809. AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  2810. Memo := TFPReportMemo(rtPage.Bands[0].Child[0]);
  2811. AssertEquals('Failed on 7', '', Memo.Text); // we never set Report.Author
  2812. end;
  2813. procedure TTestCustomReport.TestInternalFunction_Author_with_text;
  2814. var
  2815. p: TMyFPReportPage;
  2816. DataBand: TMyDataBand;
  2817. Memo: TFPReportMemo;
  2818. rtPage: TFPReportCustomPage;
  2819. begin
  2820. SetReportData(1);
  2821. Report.Author := 'Graeme Geldenhuys';
  2822. p := TMyFPReportPage.Create(Report);
  2823. p.Name := 'Page1';
  2824. p.SetupPage;
  2825. p.Data := Data;
  2826. DataBand := TMyDataBand.Create(p);
  2827. DataBand.Layout.Height := 23;
  2828. Memo := TFPReportMemo.Create(DataBand);
  2829. Memo.Layout.Top := 5;
  2830. Memo.Layout.Left := 10;
  2831. Memo.Text := 'The Author is [author].';
  2832. AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  2833. Report.RunReport;
  2834. AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  2835. AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  2836. rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  2837. AssertEquals('Failed on 4', 1, rtPage.ChildCount); // 1 rendered data band because we have 1 data record
  2838. AssertEquals('Failed on 5', 1, rtPage.BandCount);
  2839. AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  2840. Memo := TFPReportMemo(rtPage.Bands[0].Child[0]);
  2841. AssertEquals('Failed on 7', 'The Author is Graeme Geldenhuys.', Memo.Text);
  2842. end;
  2843. procedure TTestCustomReport.TestInternalFunction_Title;
  2844. var
  2845. p: TMyFPReportPage;
  2846. DataBand: TMyDataBand;
  2847. Memo: TFPReportMemo;
  2848. rtPage: TFPReportCustomPage;
  2849. begin
  2850. SetReportData(1);
  2851. p := TMyFPReportPage.Create(Report);
  2852. p.Name := 'Page1';
  2853. p.SetupPage;
  2854. p.Data := Data;
  2855. DataBand := TMyDataBand.Create(p);
  2856. DataBand.Layout.Height := 23;
  2857. Memo := TFPReportMemo.Create(DataBand);
  2858. Memo.Layout.Top := 5;
  2859. Memo.Layout.Left := 10;
  2860. Memo.Text := '[title]';
  2861. AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  2862. Report.RunReport;
  2863. AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  2864. AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  2865. rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  2866. AssertEquals('Failed on 4', 1, rtPage.ChildCount); // 1 rendered data band because we have 1 data record
  2867. AssertEquals('Failed on 5', 1, rtPage.BandCount);
  2868. AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  2869. Memo := TFPReportMemo(rtPage.Bands[0].Child[0]);
  2870. AssertEquals('Failed on 7', '', Memo.Text); // we never set Report.Title
  2871. end;
  2872. procedure TTestCustomReport.TestInternalFunction_Title_with_text;
  2873. var
  2874. p: TMyFPReportPage;
  2875. DataBand: TMyDataBand;
  2876. Memo: TFPReportMemo;
  2877. rtPage: TFPReportCustomPage;
  2878. begin
  2879. SetReportData(1);
  2880. Report.Title := 'My Test Report';
  2881. p := TMyFPReportPage.Create(Report);
  2882. p.Name := 'Page1';
  2883. p.SetupPage;
  2884. p.Data := Data;
  2885. DataBand := TMyDataBand.Create(p);
  2886. DataBand.Layout.Height := 23;
  2887. Memo := TFPReportMemo.Create(DataBand);
  2888. Memo.Layout.Top := 5;
  2889. Memo.Layout.Left := 10;
  2890. Memo.Text := 'Report Title is "[title]".';
  2891. AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  2892. Report.RunReport;
  2893. AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  2894. AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  2895. rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  2896. AssertEquals('Failed on 4', 1, rtPage.ChildCount); // 1 rendered data band because we have 1 data record
  2897. AssertEquals('Failed on 5', 1, rtPage.BandCount);
  2898. AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  2899. Memo := TFPReportMemo(rtPage.Bands[0].Child[0]);
  2900. AssertEquals('Failed on 7', 'Report Title is "My Test Report".', Memo.Text);
  2901. end;
  2902. { TTestReportMemo }
  2903. procedure TTestReportMemo.CauseFontNotFoundException;
  2904. begin
  2905. TMemoFriend(FMemo).RecalcLayout;
  2906. end;
  2907. procedure TTestReportMemo.SetUp;
  2908. begin
  2909. inherited SetUp;
  2910. FMemo := TFPReportMemo.Create(nil);
  2911. FMemo.Layout.SetPosition(0, 0, 60, 5);
  2912. end;
  2913. procedure TTestReportMemo.TearDown;
  2914. begin
  2915. FMemo.Free;
  2916. inherited TearDown;
  2917. end;
  2918. procedure TTestReportMemo.TestCreate;
  2919. var
  2920. m: TFPReportMemo;
  2921. begin
  2922. m := TFPReportMemo.Create(nil);
  2923. try
  2924. m.Text := 'abc 123';
  2925. AssertTrue('Failed on 1', m <> nil);
  2926. finally
  2927. m.Free;
  2928. end;
  2929. end;
  2930. procedure TTestReportMemo.TestPrepareTextBlocks;
  2931. begin
  2932. gTTFontCache.Clear;
  2933. gTTFontCache.SearchPath.Text := 'fonts';
  2934. gTTFontCache.BuildFontCache;
  2935. FMemo.Layout.Width := 100;
  2936. FMemo.Text := 'abc 123';
  2937. FMemo.UseParentFont := False;
  2938. FMemo.Font.Name := 'Calibri';
  2939. FMemo.StretchMode := smActualHeight;
  2940. TMemoFriend(FMemo).CreateRTLayout;
  2941. TMemoFriend(FMemo).RecalcLayout;
  2942. AssertEquals('Failed on 2', 1, FMemo.TextLines.Count);
  2943. end;
  2944. procedure TTestReportMemo.TestPrepareTextBlocks_multiline_data;
  2945. begin
  2946. gTTFontCache.Clear;
  2947. gTTFontCache.SearchPath.Text := 'fonts';
  2948. gTTFontCache.BuildFontCache;
  2949. FMemo.Layout.Width := 100;
  2950. FMemo.Text := 'abc'+LineEnding+'123';
  2951. FMemo.UseParentFont := False;
  2952. FMemo.Font.Name := 'Calibri';
  2953. FMemo.StretchMode := smActualHeight;
  2954. TMemoFriend(FMemo).CreateRTLayout;
  2955. TMemoFriend(FMemo).RecalcLayout;
  2956. AssertEquals('Failed on 2', 2, FMemo.TextLines.Count);
  2957. end;
  2958. procedure TTestReportMemo.TestPrepareTextBlocks_multiline_wraptext;
  2959. begin
  2960. gTTFontCache.Clear;
  2961. gTTFontCache.SearchPath.Text := 'fonts';
  2962. gTTFontCache.BuildFontCache;
  2963. FMemo.Layout.Width := 6;
  2964. FMemo.Text := 'abc 123';
  2965. FMemo.UseParentFont := False;
  2966. FMemo.Font.Name := 'Calibri';
  2967. FMemo.StretchMode := smActualHeight;
  2968. TMemoFriend(FMemo).CreateRTLayout;
  2969. TMemoFriend(FMemo).RecalcLayout;
  2970. AssertEquals('Failed on 2', 2, FMemo.TextLines.Count);
  2971. end;
  2972. procedure TTestReportMemo.TestRGBToReportColor;
  2973. var
  2974. c: TFPReportColor;
  2975. begin
  2976. c := RGBToReportColor(255, 0, 0);
  2977. AssertEquals('failed on 1', IntToHex(clRed, 8), IntToHex(c, 8));
  2978. c := RGBToReportColor(0, 128, 0);
  2979. AssertEquals('failed on 2', IntToHex(clGreen, 8), IntToHex(c, 8));
  2980. c := RGBToReportColor(0, 0, 255);
  2981. AssertEquals('failed on 3', IntToHex(clBlue, 8), IntToHex(c, 8));
  2982. end;
  2983. procedure TTestReportMemo.TestHTMLColorToReportColor_length7;
  2984. var
  2985. c: TFPReportColor;
  2986. begin
  2987. c := TMemoFriend(FMemo).HtmlColorToFPReportColor('#FF0000', clBlack);
  2988. AssertEquals('failed on 1', IntToHex(clRed, 8), IntToHex(c, 8));
  2989. c := TMemoFriend(FMemo).HtmlColorToFPReportColor('#008000', clBlack);
  2990. AssertEquals('failed on 2', IntToHex(clGreen, 8), IntToHex(c, 8));
  2991. c := TMemoFriend(FMemo).HtmlColorToFPReportColor('#0000FF', clBlack);
  2992. AssertEquals('failed on 3', IntToHex(clBlue, 8), IntToHex(c, 8));
  2993. c := TMemoFriend(FMemo).HtmlColorToFPReportColor('A0000FF', clBlack);
  2994. AssertEquals('failed on 4', IntToHex(clBlack, 8), IntToHex(c, 8));
  2995. end;
  2996. procedure TTestReportMemo.TestHTMLColorToReportColor_length6;
  2997. var
  2998. c: TFPReportColor;
  2999. begin
  3000. c := TMemoFriend(FMemo).HtmlColorToFPReportColor('FF0000', clBlack);
  3001. AssertEquals('failed on 1', IntToHex(clRed, 8), IntToHex(c, 8));
  3002. c := TMemoFriend(FMemo).HtmlColorToFPReportColor('008000', clBlack);
  3003. AssertEquals('failed on 2', IntToHex(clGreen, 8), IntToHex(c, 8));
  3004. c := TMemoFriend(FMemo).HtmlColorToFPReportColor('0000FF', clBlack);
  3005. AssertEquals('failed on 3', IntToHex(clBlue, 8), IntToHex(c, 8));
  3006. c := TMemoFriend(FMemo).HtmlColorToFPReportColor('A0000FF', clBlack);
  3007. AssertEquals('failed on 4', IntToHex(clBlack, 8), IntToHex(c, 8));
  3008. end;
  3009. procedure TTestReportMemo.TestHTMLColorToReportColor_length3;
  3010. var
  3011. c: TFPReportColor;
  3012. begin
  3013. c := TMemoFriend(FMemo).HtmlColorToFPReportColor('F00', clBlack);
  3014. AssertEquals('failed on 1', IntToHex(clRed, 8), IntToHex(c, 8));
  3015. c := TMemoFriend(FMemo).HtmlColorToFPReportColor('080', clBlack);
  3016. AssertEquals('failed on 2', IntToHex($008800, 8), IntToHex(c, 8));
  3017. c := TMemoFriend(FMemo).HtmlColorToFPReportColor('00F', clBlack);
  3018. AssertEquals('failed on 3', IntToHex(clBlue, 8), IntToHex(c, 8));
  3019. c := TMemoFriend(FMemo).HtmlColorToFPReportColor('A00F', clDkGray);
  3020. AssertEquals('failed on 4', IntToHex(clDkGray, 8), IntToHex(c, 8));
  3021. c := TMemoFriend(FMemo).HtmlColorToFPReportColor('700', clBlack);
  3022. AssertEquals('failed on 5', IntToHex($770000, 8), IntToHex(c, 8));
  3023. c := TMemoFriend(FMemo).HtmlColorToFPReportColor('006', clBlack);
  3024. AssertEquals('failed on 6', IntToHex($000066, 8), IntToHex(c, 8));
  3025. end;
  3026. procedure TTestReportMemo.TestCreateTestBlock;
  3027. var
  3028. tb: TFPTextBlock;
  3029. begin
  3030. tb := TMemoFriend(FMemo).CreateTextBlock(false);
  3031. try
  3032. AssertTrue('failed on 1', tb is TFPTextBlock);
  3033. AssertFalse('failed on 2', tb is TFPHTTPTextBlock);
  3034. finally
  3035. tb.Free;
  3036. end;
  3037. end;
  3038. procedure TTestReportMemo.TestCreateTestBlock_IsURL;
  3039. var
  3040. tb: TFPTextBlock;
  3041. begin
  3042. tb := TMemoFriend(FMemo).CreateTextBlock(true);
  3043. try
  3044. AssertTrue('failed on 1', tb is TFPTextBlock);
  3045. AssertTrue('failed on 2', tb is TFPHTTPTextBlock);
  3046. finally
  3047. tb.Free;
  3048. end;
  3049. end;
  3050. procedure TTestReportMemo.TestSubStr;
  3051. var
  3052. m: TMemoFriend;
  3053. lStartPos: integer;
  3054. begin
  3055. m := TMemoFriend(FMemo);
  3056. AssertEquals('failed on 1', '', m.SubStr('','','', 1, lStartPos));
  3057. AssertEquals('failed on 1.1', -1, lStartPos);
  3058. AssertEquals('failed on 2', 'abc', m.SubStr('xxxabcyyy','xxx','yyy', 1, lStartPos));
  3059. AssertEquals('failed on 2.1', 4, lStartPos);
  3060. AssertEquals('failed on 3', 'abc', m.SubStr('xxx,abc;xxx',',',';', 1, lStartPos));
  3061. AssertEquals('failed on 3.1', 5, lStartPos);
  3062. AssertEquals('failed on 4', 'abc', m.SubStr('<d>abc</d>','<d>','</d>', 1, lStartPos));
  3063. AssertEquals('failed on 4.1', 4, lStartPos);
  3064. AssertEquals('failed on 5', 'abc1', m.SubStr('<d>abc1</d> <d>abc2</d>','<d>','</d>', 1, lStartPos));
  3065. AssertEquals('failed on 5.1', 4, lStartPos);
  3066. AssertEquals('failed on 6', 'abc2', m.SubStr('<d>abc1</d> <d>abc2</d>','<d>','</d>', 2, lStartPos));
  3067. AssertEquals('failed on 6.1', 16, lStartPos);
  3068. AssertEquals('failed on 7', '', m.SubStr('<d>abc1</d> <d>abc2</d>','<d>','</d>', 3, lStartPos));
  3069. AssertEquals('failed on 7.1', -1, lStartPos);
  3070. AssertEquals('failed on 8', 'abc1', m.SubStr('<d>abc1</d> <d>abc2</d>','<d>','</d>', 0, lStartPos));
  3071. AssertEquals('failed on 8.1', 4, lStartPos);
  3072. AssertEquals('failed on 9', 'abc1', m.SubStr('<d>abc1</d> <d>abc2</d>','<d>','</d>', -1, lStartPos));
  3073. AssertEquals('failed on 9.1', 4, lStartPos);
  3074. end;
  3075. procedure TTestReportMemo.TestTokenCount;
  3076. var
  3077. m: TMemoFriend;
  3078. lStartPos: integer;
  3079. begin
  3080. m := TMemoFriend(FMemo);
  3081. AssertEquals('failed on 1', '', m.SubStr('','','', 1, lStartPos));
  3082. AssertEquals('failed on 1.1', -1, lStartPos);
  3083. AssertEquals('failed on 2', 'abc', m.SubStr('xxxabcyyy','xxx','yyy', 1, lStartPos));
  3084. AssertEquals('failed on 2.1', 4, lStartPos);
  3085. AssertEquals('failed on 1', m.TokenCount('', ','), 0);
  3086. AssertEquals('failed on 2', m.TokenCount('adf adf', ','), 1);
  3087. AssertEquals('failed on 3', m.TokenCount('adf,', ','), 2);
  3088. AssertEquals('failed on 4', m.TokenCount('adf,adf', ','), 2);
  3089. AssertEquals('failed on 5', m.TokenCount('adf,adf,adf', ','), 3);
  3090. AssertEquals('failed on 6', m.TokenCount('adf,adf,adf,', ','), 4);
  3091. AssertEquals('failed on 6', m.TokenCount('0mm margin top and bottom.', ' '), 5);
  3092. AssertEquals('failed on 6', m.TokenCount('0mm margin top and bottom. ', ' '), 6);
  3093. end;
  3094. procedure TTestReportMemo.TestToken;
  3095. var
  3096. m: TMemoFriend;
  3097. lStartPos: integer;
  3098. begin
  3099. m := TMemoFriend(FMemo);
  3100. AssertEquals('failed on 1', m.Token('', ',', 1), '');
  3101. AssertEquals('failed on 2', m.Token('a,b,c', ',', 1), 'a');
  3102. AssertEquals('failed on 3', m.Token('a,b,c', ',', 2), 'b');
  3103. AssertEquals('failed on 4', m.Token('a,b,c', ',', 3), 'c');
  3104. AssertEquals('failed on 5', m.Token('a,b,c', ',', 4), '');
  3105. AssertEquals('failed on 6', m.Token('aa,bb,cc', ',', 1), 'aa');
  3106. AssertEquals('failed on 7', m.Token('aa,bb,cc', ',', 2), 'bb');
  3107. AssertEquals('failed on 8', m.Token('aa,bb,cc', ',', 3), 'cc');
  3108. AssertEquals('failed on 9', m.Token('aa,bb,cc', ',', 4), '');
  3109. AssertEquals('failed on 10', m.Token('aa,bb,cc,', ',', 4), '');
  3110. AssertEquals('failed on 11', m.Token('0mm margin top and bottom.', ' ', 5), 'bottom.');
  3111. AssertEquals('failed on 12', m.Token('0mm margin top and bottom. ', ' ', 5), 'bottom.');
  3112. AssertEquals('failed on 13', m.Token('0mm margin top and bottom. ', ' ', 6), '');
  3113. end;
  3114. { TTestBandList }
  3115. procedure TTestBandList.CreateBands;
  3116. begin
  3117. b1 := TFPReportPageHeaderBand.Create(nil);
  3118. b2 := TFPReportTitleBand.Create(nil);
  3119. b3 := TFPReportDataBand.Create(nil);
  3120. end;
  3121. procedure TTestBandList.AddAllBandsToList;
  3122. begin
  3123. FList.Add(b1);
  3124. FList.Add(b2);
  3125. FList.Add(b3);
  3126. end;
  3127. procedure TTestBandList.SetUp;
  3128. begin
  3129. inherited SetUp;
  3130. FList := TBandList.Create;
  3131. CreateBands;
  3132. end;
  3133. procedure TTestBandList.TearDown;
  3134. begin
  3135. FreeAndNil(FList);
  3136. FreeAndNil(b3);
  3137. FreeAndNil(b2);
  3138. FreeAndNil(b1);
  3139. inherited TearDown;
  3140. end;
  3141. procedure TTestBandList.TestAdd;
  3142. begin
  3143. AssertEquals('Failed on 1', 0, FList.Count);
  3144. AddAllBandsToList;
  3145. AssertEquals('Failed on 2', 3, FList.Count);
  3146. end;
  3147. procedure TTestBandList.TestItems;
  3148. begin
  3149. AssertEquals('Failed on 1', 0, FList.Count);
  3150. AddAllBandsToList;
  3151. AssertEquals('Failed on 2', 3, FList.Count);
  3152. AssertTrue('failed on 3', FList.Items[0] = b1);
  3153. AssertTrue('failed on 4', FList.Items[1] = b2);
  3154. AssertTrue('failed on 5', FList.Items[1] <> b1);
  3155. AssertTrue('failed on 6', FList.Items[2] = b3);
  3156. end;
  3157. procedure TTestBandList.TestClear;
  3158. begin
  3159. AssertEquals('Failed on 1', 0, FList.Count);
  3160. AddAllBandsToList;
  3161. AssertEquals('Failed on 2', 3, FList.Count);
  3162. FList.Clear;
  3163. AssertEquals('Failed on 3', 0, FList.Count);
  3164. AssertTrue('failed on 4', b1 <> nil); // List.Clear shouldn't free bands
  3165. end;
  3166. procedure TTestBandList.TestDelete;
  3167. begin
  3168. AssertEquals('Failed on 1', 0, FList.Count);
  3169. AddAllBandsToList;
  3170. AssertEquals('Failed on 2', 3, FList.Count);
  3171. FList.Delete(0);
  3172. AssertEquals('Failed on 3', 2, FList.Count);
  3173. AssertTrue('failed on 4', b1 <> nil); // List.Delete shouldn't free bands
  3174. AssertTrue('failed on 5', FList.Items[0] = b2);
  3175. AssertTrue('failed on 6', FList.Items[1] = b3);
  3176. end;
  3177. procedure TTestBandList.TestFind1;
  3178. var
  3179. lBand: TFPReportCustomBand;
  3180. lResult: integer;
  3181. begin
  3182. AssertEquals('Failed on 1', 0, FList.Count);
  3183. AddAllBandsToList;
  3184. AssertEquals('Failed on 2', 3, FList.Count);
  3185. AssertTrue('failed on 3', FList.Find(TFPReportPageHeaderBand) <> nil);
  3186. AssertTrue('failed on 4', FList.Find(TFPReportPageHeaderBand) = b1);
  3187. AssertTrue('failed on 5', FList.Find(TFPReportTitleBand) = b2);
  3188. AssertTrue('failed on 6', FList.Find(TFPReportDataBand) = b3);
  3189. FList.Clear;
  3190. AssertTrue('failed on 7', FList.Find(TFPReportTitleBand) = nil);
  3191. end;
  3192. procedure TTestBandList.TestFind2;
  3193. var
  3194. lBand: TFPReportCustomBand;
  3195. lResult: integer;
  3196. begin
  3197. AssertEquals('Failed on 1', 0, FList.Count);
  3198. lResult := FList.Find(TFPReportPageHeaderBand, lBand);
  3199. AssertEquals('failed on 2', -1, lResult);
  3200. AssertTrue('failed on 3', lBand = nil);
  3201. AddAllBandsToList;
  3202. AssertEquals('Failed on 4', 3, FList.Count);
  3203. lResult := FList.Find(TFPReportPageHeaderBand, lBand);
  3204. AssertEquals('failed on 5', 0, lResult);
  3205. AssertTrue('failed on 6', lBand <> nil);
  3206. AssertTrue('failed on 7', lBand = b1);
  3207. lResult := FList.Find(TFPReportTitleBand, lBand);
  3208. AssertEquals('failed on 8', 1, lResult);
  3209. AssertTrue('failed on 9', lBand = b2);
  3210. lResult := FList.Find(TFPReportDataBand, lBand);
  3211. AssertEquals('failed on 10', 2, lResult);
  3212. AssertTrue('failed on 11', lBand = b3);
  3213. FList.Clear;
  3214. lResult := FList.Find(TFPReportTitleBand, lBand);
  3215. AssertTrue('failed on 12', lBand = nil);
  3216. AssertTrue('failed on 13', lResult = -1);
  3217. end;
  3218. initialization
  3219. RegisterTests(
  3220. [TTestReportComponent,
  3221. TReportElementTest,
  3222. TTestReportChildren,
  3223. TTestReportFrame,
  3224. TTestReportLayout,
  3225. TTestFPPageSize,
  3226. TTestFPPaperManager,
  3227. TTestFPReportPageSize,
  3228. TTestReportPage,
  3229. TTestReportData,
  3230. TTestUserReportData,
  3231. TTestUserReportData2,
  3232. TTestDataBand,
  3233. TTestCustomReport,
  3234. TTestReportMemo,
  3235. TTestBandList,
  3236. TTestVariable,
  3237. TTestVariables
  3238. ]);
  3239. end.