├── .gitignore ├── CHANGELOG ├── CONTRIBUTORS ├── LICENSE ├── README.md ├── demo ├── Demo.dpr ├── Demo.dproj ├── Demo.vrc ├── README.MD ├── uDemo.dfm └── uDemo.pas └── src └── uHTMLBuilder.pas /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | *.dcu 3 | *.~1~ 4 | -------------------------------------------------------------------------------- /CHANGELOG: -------------------------------------------------------------------------------- 1 | ## [1.1] - 2017-07-18 2 | 3 | ### Added 4 | - THTMLReport.Clear clearing all objects added in report 5 | 6 | ### Changed 7 | - Method THTMLTable.SetDataSet support default value for empty value 8 | - Method THTMLTable.SetDataSet get DisplayName for header and DisplayText for cell values. 9 | -------------------------------------------------------------------------------- /CONTRIBUTORS: -------------------------------------------------------------------------------- 1 | Contributors 2 | 3 | Guilherme Torres - github.com/guitorres -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2015 guitorres 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # htmlbuilder 2 | This unit allows building simplified html with Delphi. 3 | 4 | ## Hello world! 5 | 6 | ```delphi 7 | var 8 | html: THTMLReport; 9 | begin 10 | html := THTMLReport.Create; 11 | try 12 | html.Style := '*{font-size:15pt}'; 13 | html.AddParagraph('Hello World!', ''); 14 | ShowMessage(html.Build); 15 | finally 16 | html.Free; 17 | end; 18 | end; 19 | ``` 20 | 21 | ```html 22 | 23 | 24 | 27 | 28 | 29 |

30 | Hello World! 31 |

32 | 33 | 34 | ``` 35 | 36 | ## easy table 37 | 38 | ```delphi 39 | var 40 | html: THTMLReport; 41 | table: THTMLTable; 42 | row: THTMLRow; 43 | i,j: Integer; 44 | begin 45 | html := THTMLReport.Create; 46 | table := THTMLTable.Create; 47 | try 48 | html.Style := '*{font-size:15pt}'; 49 | html.AddTable(table); 50 | 51 | for i := 1 to 100 do 52 | begin 53 | row := THTMLRow.Create; 54 | for j := 1 to 5 do 55 | row.AddCell(Format('Row %d Column %d', [i,j]), ''); 56 | table.RowList.Add(row); 57 | end; 58 | 59 | ShowMessage(html.Build); 60 | finally 61 | html.Free; 62 | end; 63 | ``` 64 | 65 | ```html 66 | 67 | 68 | 71 | 72 | 73 | 74 | 75 | 78 | 81 | 84 | 87 | 90 | 91 | 92 | 93 | 96 | 99 | 102 | 105 | 108 | 109 |
76 | Row 1 Column 1 77 | 79 | Row 1 Column 2 80 | 82 | Row 1 Column 3 83 | 85 | Row 1 Column 4 86 | 88 | Row 1 Column 5 89 |
94 | Row 100 Column 1 95 | 97 | Row 100 Column 2 98 | 100 | Row 100 Column 3 101 | 103 | Row 100 Column 4 104 | 106 | Row 100 Column 5 107 |
110 | 111 | 112 | ``` 113 | 114 | ## dataset to table 115 | 116 | ```delphi 117 | table := THTMLTable.Create; 118 | table.SetDataSet(cdsTest); 119 | ShowMessage(table.Build); 120 | ``` 121 | 122 | ## and more 123 | 124 | check the /demo directory -------------------------------------------------------------------------------- /demo/Demo.dpr: -------------------------------------------------------------------------------- 1 | program Demo; 2 | 3 | uses 4 | Forms, 5 | uDemo in '..\demo\uDemo.pas' {frmDemo}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.CreateForm(TfrmDemo, frmDemo); 12 | Application.Run; 13 | end. 14 | -------------------------------------------------------------------------------- /demo/Demo.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {345C6BB9-C2FA-4121-842D-3CC925BD19BC} 4 | Demo.dpr 5 | True 6 | Debug 7 | 1025 8 | Application 9 | VCL 10 | 18.1 11 | Win32 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | true 44 | Cfg_2 45 | true 46 | true 47 | 48 | 49 | true 50 | Cfg_2 51 | true 52 | true 53 | 54 | 55 | 00400000 56 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) 57 | ..\..\exe 58 | true 59 | 1046 60 | false 61 | 1 62 | Demo 63 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 64 | 1 65 | false 66 | vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOfficeXP;AnyDAC_PhysSQLite_D7;AnyDAC_Phys_D7;AnyDAC_ComI_D7;AnyDAC_PhysPg_D7;AnyDAC_PhysIB_D7;AnyDAC_PhysADS_D7;AnyDAC_PhysASA_D7;AnyDAC_PhysODBC_D7;AnyDAC_PhysOracl_D7;AnyDAC_PhysMySQL_D7;AnyDAC_PhysDb2_D7;AnyDAC_PhysMSSQL_D7;AnyDAC_PhysMSAcc_D7;AnyDAC_GUIxForms_D7;AnyDAC_Comp_D7;RLibWinD7vcl;JclDeveloperTools;Jcl;JclVcl;JclContainers;JvCore;JvSystem;JvStdCtrls;JvAppFrm;JvBands;JvDB;JvDlgs;JvBDE;JvControls;JvCmp;JvCrypt;JvCustom;JvDocking;JvDotNetCtrls;JvGlobus;JvHMI;JvJans;JvManagedThreads;JvMM;JvNet;JvPageComps;JvPascalInterpreter;JvPluginSystem;JvPrintPreview;JvRuntimeDesign;JvTimeFramework;JvWizards;JvXPCtrls;$(DCC_UsePackage) 67 | false 68 | false 69 | ..\..\src;$(DCC_UnitSearchPath) 70 | 71 | 72 | $(BDS)\bin\default_app.manifest 73 | System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 74 | 1033 75 | Sample_Icon.ico 76 | true 77 | true 78 | 79 | 80 | Sample_Icon.ico 81 | 82 | 83 | false 84 | 0 85 | 0 86 | RELEASE;$(DCC_Define) 87 | 88 | 89 | true 90 | true 91 | 92 | 93 | true 94 | false 95 | DEBUG;$(DCC_Define) 96 | 97 | 98 | Debug 99 | 100 | 101 | 1033 102 | ..\exe 103 | true 104 | ..\src;$(DCC_UnitSearchPath) 105 | true 106 | true 107 | 108 | 109 | 110 | MainSource 111 | 112 | 113 |
frmDemo
114 | 115 | 116 | Cfg_2 117 | Base 118 | 119 | 120 | Base 121 | 122 | 123 | Cfg_1 124 | Base 125 | 126 | 127 | 128 | Delphi.Personality.12 129 | 130 | 131 | 132 | 133 | Demo.dpr 134 | 135 | 136 | Microsoft Office 2000 Sample Automation Server Wrapper Components 137 | Microsoft Office XP Sample Automation Server Wrapper Components 138 | 139 | 140 | 141 | True 142 | True 143 | False 144 | 145 | 146 | 147 | 148 | 1 149 | 150 | 151 | 1 152 | 153 | 154 | 155 | 156 | Contents\Resources 157 | 1 158 | 159 | 160 | 161 | 162 | classes 163 | 1 164 | 165 | 166 | 167 | 168 | Contents\MacOS 169 | 0 170 | 171 | 172 | 1 173 | 174 | 175 | Contents\MacOS 176 | 1 177 | 178 | 179 | 180 | 181 | 1 182 | 183 | 184 | 1 185 | 186 | 187 | 1 188 | 189 | 190 | 191 | 192 | res\drawable-xxhdpi 193 | 1 194 | 195 | 196 | 197 | 198 | library\lib\mips 199 | 1 200 | 201 | 202 | 203 | 204 | 1 205 | 206 | 207 | 1 208 | 209 | 210 | 0 211 | 212 | 213 | 1 214 | 215 | 216 | Contents\MacOS 217 | 1 218 | 219 | 220 | library\lib\armeabi-v7a 221 | 1 222 | 223 | 224 | 1 225 | 226 | 227 | 228 | 229 | 0 230 | 231 | 232 | Contents\MacOS 233 | 1 234 | .framework 235 | 236 | 237 | 238 | 239 | 1 240 | 241 | 242 | 1 243 | 244 | 245 | 1 246 | 247 | 248 | 249 | 250 | 1 251 | 252 | 253 | 1 254 | 255 | 256 | 1 257 | 258 | 259 | 260 | 261 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 262 | 1 263 | 264 | 265 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 266 | 1 267 | 268 | 269 | 270 | 271 | 1 272 | 273 | 274 | 1 275 | 276 | 277 | 1 278 | 279 | 280 | 281 | 282 | 1 283 | 284 | 285 | 1 286 | 287 | 288 | 1 289 | 290 | 291 | 292 | 293 | library\lib\armeabi 294 | 1 295 | 296 | 297 | 298 | 299 | 0 300 | 301 | 302 | 1 303 | 304 | 305 | Contents\MacOS 306 | 1 307 | 308 | 309 | 310 | 311 | 1 312 | 313 | 314 | 1 315 | 316 | 317 | 1 318 | 319 | 320 | 321 | 322 | res\drawable-normal 323 | 1 324 | 325 | 326 | 327 | 328 | res\drawable-xhdpi 329 | 1 330 | 331 | 332 | 333 | 334 | res\drawable-large 335 | 1 336 | 337 | 338 | 339 | 340 | 1 341 | 342 | 343 | 1 344 | 345 | 346 | 1 347 | 348 | 349 | 350 | 351 | ..\ 352 | 1 353 | 354 | 355 | ..\ 356 | 1 357 | 358 | 359 | 360 | 361 | res\drawable-hdpi 362 | 1 363 | 364 | 365 | 366 | 367 | library\lib\armeabi-v7a 368 | 1 369 | 370 | 371 | 372 | 373 | Contents 374 | 1 375 | 376 | 377 | 378 | 379 | ..\ 380 | 1 381 | 382 | 383 | 384 | 385 | 1 386 | 387 | 388 | 1 389 | 390 | 391 | 1 392 | 393 | 394 | 395 | 396 | res\values 397 | 1 398 | 399 | 400 | 401 | 402 | res\drawable-small 403 | 1 404 | 405 | 406 | 407 | 408 | res\drawable 409 | 1 410 | 411 | 412 | 413 | 414 | 1 415 | 416 | 417 | 1 418 | 419 | 420 | 1 421 | 422 | 423 | 424 | 425 | 1 426 | 427 | 428 | 429 | 430 | res\drawable 431 | 1 432 | 433 | 434 | 435 | 436 | 0 437 | 438 | 439 | 0 440 | 441 | 442 | Contents\Resources\StartUp\ 443 | 0 444 | 445 | 446 | 0 447 | 448 | 449 | 0 450 | 451 | 452 | 0 453 | 454 | 455 | 456 | 457 | library\lib\armeabi-v7a 458 | 1 459 | 460 | 461 | 462 | 463 | 0 464 | .bpl 465 | 466 | 467 | 1 468 | .dylib 469 | 470 | 471 | Contents\MacOS 472 | 1 473 | .dylib 474 | 475 | 476 | 1 477 | .dylib 478 | 479 | 480 | 1 481 | .dylib 482 | 483 | 484 | 485 | 486 | res\drawable-mdpi 487 | 1 488 | 489 | 490 | 491 | 492 | res\drawable-xlarge 493 | 1 494 | 495 | 496 | 497 | 498 | res\drawable-ldpi 499 | 1 500 | 501 | 502 | 503 | 504 | 0 505 | .dll;.bpl 506 | 507 | 508 | 1 509 | .dylib 510 | 511 | 512 | Contents\MacOS 513 | 1 514 | .dylib 515 | 516 | 517 | 1 518 | .dylib 519 | 520 | 521 | 1 522 | .dylib 523 | 524 | 525 | 526 | 527 | 528 | 529 | 530 | 531 | 532 | 533 | 534 | 535 | 12 536 | 537 | 538 | 539 | 540 | 541 | -------------------------------------------------------------------------------- /demo/Demo.vrc: -------------------------------------------------------------------------------- 1 | /* ----- VS_VERSION.dwFileFlags ----- */ 2 | #define VS_FF_DEBUG 0x00000001L 3 | #define VS_FF_PRERELEASE 0x00000002L 4 | #define VS_FF_PATCHED 0x00000004L 5 | #define VS_FF_PRIVATEBUILD 0x00000008L 6 | #define VS_FF_INFOINFERRED 0x00000010L 7 | #define VS_FF_SPECIALBUILD 0x00000020L 8 | #define VS_FFI_FILEFLAGSMASK 0x0000003FL 9 | 10 | /* ----- VS_VERSION.dwFileOS ----- */ 11 | #define VOS_UNKNOWN 0x00000000L 12 | #define VOS_DOS 0x00010000L 13 | #define VOS_OS216 0x00020000L 14 | #define VOS_OS232 0x00030000L 15 | #define VOS_NT 0x00040000L 16 | #define VOS_WINCE 0x00050000L 17 | 18 | #define VOS__BASE 0x00000000L 19 | #define VOS__WINDOWS16 0x00000001L 20 | #define VOS__PM16 0x00000002L 21 | #define VOS__PM32 0x00000003L 22 | #define VOS__WINDOWS32 0x00000004L 23 | 24 | #define VOS_DOS_WINDOWS16 0x00010001L 25 | #define VOS_DOS_WINDOWS32 0x00010004L 26 | #define VOS_OS216_PM16 0x00020002L 27 | #define VOS_OS232_PM32 0x00030003L 28 | #define VOS_NT_WINDOWS32 0x00040004L 29 | 30 | /* ----- VS_VERSION.dwFileType ----- */ 31 | #define VFT_UNKNOWN 0x00000000L 32 | #define VFT_APP 0x00000001L 33 | #define VFT_DLL 0x00000002L 34 | #define VFT_DRV 0x00000003L 35 | #define VFT_FONT 0x00000004L 36 | #define VFT_VXD 0x00000005L 37 | #define VFT_STATIC_LIB 0x00000007L 38 | 39 | 1 VERSIONINFO 40 | FILEVERSION 1, 0, 0, 0 41 | PRODUCTVERSION 1, 0, 0, 0 42 | FILEFLAGSMASK VS_FFI_FILEFLAGSMASK 43 | FILEOS VOS__WINDOWS32 44 | FILETYPE VFT_APP 45 | { 46 | BLOCK "StringFileInfo" 47 | { 48 | BLOCK "040904E4" 49 | { 50 | VALUE "FileVersion", "1.0.0.0\000\000" 51 | VALUE "ProductVersion", "1.0.0.0\000\000" 52 | } 53 | } 54 | BLOCK "VarFileInfo" 55 | { 56 | VALUE "Translation", 1033, 1252 57 | } 58 | } 59 | 60 | 1 24 "Demo.$manifest" 61 | PLATFORMTARGETS RCDATA {1025} 62 | -------------------------------------------------------------------------------- /demo/README.MD: -------------------------------------------------------------------------------- 1 | example project 2 | -------------------------------------------------------------------------------- /demo/uDemo.dfm: -------------------------------------------------------------------------------- 1 | object frmDemo: TfrmDemo 2 | Left = 313 3 | Top = 176 4 | Caption = 'frmDemo' 5 | ClientHeight = 107 6 | ClientWidth = 199 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object btnSampleDataSet: TButton 18 | Left = 24 19 | Top = 24 20 | Width = 150 21 | Height = 25 22 | Caption = 'DataSet' 23 | TabOrder = 0 24 | OnClick = btnSampleDataSetClick 25 | end 26 | object btnMultiHeader: TButton 27 | Left = 24 28 | Top = 64 29 | Width = 150 30 | Height = 25 31 | Caption = 'Multi Header' 32 | TabOrder = 1 33 | OnClick = btnMultiHeaderClick 34 | end 35 | object cdsProducts: TClientDataSet 36 | Aggregates = <> 37 | Params = <> 38 | Left = 168 39 | object cdsProductsproduct: TStringField 40 | FieldName = 'product' 41 | Size = 250 42 | end 43 | object cdsProductsprice: TStringField 44 | FieldName = 'price' 45 | Size = 10 46 | end 47 | end 48 | end 49 | -------------------------------------------------------------------------------- /demo/uDemo.pas: -------------------------------------------------------------------------------- 1 | unit uDemo; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, DB, DBClient, uHTMLBuilder, ShellAPI; 8 | 9 | type 10 | TfrmDemo = class(TForm) 11 | btnSampleDataSet: TButton; 12 | cdsProducts: TClientDataSet; 13 | cdsProductsproduct: TStringField; 14 | cdsProductsprice: TStringField; 15 | btnMultiHeader: TButton; 16 | procedure FormCreate(Sender: TObject); 17 | procedure btnSampleDataSetClick(Sender: TObject); 18 | procedure btnMultiHeaderClick(Sender: TObject); 19 | private 20 | { Private declarations } 21 | procedure PopulateDataSet(dataSet: TDataSet); 22 | procedure OpenHTMLDocument(report: THTMLReport); 23 | function GetReportStyle:string; 24 | public 25 | { Public declarations } 26 | end; 27 | 28 | var 29 | frmDemo: TfrmDemo; 30 | 31 | implementation 32 | 33 | uses Math; 34 | 35 | const 36 | cNUMBER_PRODUCT=50; 37 | 38 | {$R *.dfm} 39 | 40 | procedure TfrmDemo.PopulateDataSet(dataSet: TDataSet); 41 | var 42 | i: Integer; 43 | product, price: TField; 44 | begin 45 | product := dataSet.FieldByName('product'); 46 | price := dataSet.FieldByName('price'); 47 | for i := 1 to cNUMBER_PRODUCT do 48 | begin 49 | dataSet.Append; 50 | product.AsString := 'PRODUCT ' + FormatFloat('00', i); 51 | price.AsString := '$' + FormatFloat('#,###.00', RandomRange(1, cNUMBER_PRODUCT)*10); 52 | dataSet.Post; 53 | end; 54 | end; 55 | 56 | procedure TfrmDemo.OpenHTMLDocument(report: THTMLReport); 57 | var 58 | htmlFile: string; 59 | begin 60 | htmlFile := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'teste.html'; 61 | report.SaveToFile(htmlFile); 62 | ShellExecute(Handle, 'Open', 'iexplore.exe', PChar(htmlFile), '', SW_SHOWNORMAL); 63 | end; 64 | 65 | function TfrmDemo.GetReportStyle:string; 66 | var 67 | style: TStringList; 68 | begin 69 | style := TStringList.Create; 70 | try 71 | style.Clear; 72 | style.Add('* {font-family:Arial;font-size:11pt}'); 73 | style.Add('html, body {height:100%;}'); 74 | style.Add('table {width:100% ;border-collapse: collapse;}'); 75 | Result := style.Text; 76 | finally 77 | style.Free; 78 | end; 79 | end; 80 | 81 | procedure TfrmDemo.FormCreate(Sender: TObject); 82 | begin 83 | cdsProducts.CreateDataSet; 84 | PopulateDataSet(cdsProducts); 85 | end; 86 | 87 | procedure TfrmDemo.btnSampleDataSetClick(Sender: TObject); 88 | const 89 | cPARAGRAPH_STYLE='style="font-weight:bold;font-size:15pt;text-align:center;"'; 90 | var 91 | html: THTMLReport; 92 | table: THTMLTable; 93 | begin 94 | html := THTMLReport.Create(GetReportStyle); 95 | table := THTMLTable.Create; 96 | try 97 | table.SetDataSet(cdsProducts, '#909090', '#FFFFFF', '#D0D0D0'); 98 | html.AddParagraph('Test using dataset', cPARAGRAPH_STYLE); 99 | html.AddTable(table); 100 | OpenHTMLDocument(html); 101 | finally 102 | FreeAndNil(html); 103 | end; 104 | end; 105 | 106 | procedure TfrmDemo.btnMultiHeaderClick(Sender: TObject); 107 | const 108 | cPARAGRAPH_STYLE='style="font-weight:bold;font-size:15pt;text-align:center;"'; 109 | cHEADER_STYLE='style="font-weight:bold;background-color:silver"'; 110 | var 111 | html: THTMLReport; 112 | table: THTMLTable; 113 | product, price: THTMLCell; 114 | discount10, discount5, fullprice: THTMLCell; 115 | priceValue: Integer; 116 | i: Integer; 117 | begin 118 | html := THTMLReport.Create(GetReportStyle); 119 | try 120 | table := THTMLTable.Create('border="1px solid black"'); 121 | product := THTMLCell.Create('Product', 'rowspan=2 ' + cHEADER_STYLE); 122 | price := THTMLCell.Create('Price', 'colspan=3 align=center ' + cHEADER_STYLE); 123 | discount10 := THTMLCell.Create('10% discount', 'width="15%" ' + cHEADER_STYLE); 124 | discount5 := THTMLCell.Create('5% discount', 'width="15%" ' + cHEADER_STYLE); 125 | fullprice := THTMLCell.Create('full price', 'width="20%" ' + cHEADER_STYLE); 126 | //header 127 | table.AddRow([product, price], ''); 128 | //sub header 129 | table.AddRow([fullprice, discount5, discount10], ''); 130 | //lines 131 | for i := 1 to cNUMBER_PRODUCT do 132 | begin 133 | priceValue := RandomRange(1, cNUMBER_PRODUCT)*10; 134 | table.AddRow([THTMLCell.Create('PRODUCT'+IntToStr(i), ''), 135 | THTMLCell.Create('$' + FormatFloat('#,###.00', priceValue), ''), 136 | THTMLCell.Create('$' + FormatFloat('#,###.00', (priceValue*0.95)), ''), 137 | THTMLCell.Create('$' + FormatFloat('#,###.00', (priceValue*0.9)), '')], ''); 138 | end; 139 | 140 | html.AddParagraph('Test using multi header', cPARAGRAPH_STYLE); 141 | html.AddTable(table); 142 | OpenHTMLDocument(html); 143 | finally 144 | FreeAndNil(html); 145 | end; 146 | end; 147 | 148 | end. 149 | -------------------------------------------------------------------------------- /src/uHTMLBuilder.pas: -------------------------------------------------------------------------------- 1 | unit uHTMLBuilder; 2 | 3 | interface 4 | 5 | uses 6 | Classes, Contnrs, SysUtils, DB; 7 | 8 | type 9 | THTMLBase = class 10 | end; 11 | 12 | THTMLCell = class 13 | private 14 | Fstyle: string; 15 | FName: string; 16 | FItemList: TObjectList; 17 | procedure Initialize(cellName:string = ''; cellStyle: string = ''); 18 | protected 19 | public 20 | property Style: string read FStyle write FStyle; 21 | property Name: string read FName write FName; 22 | property ItemList: TObjectList read FItemList write FItemList; 23 | function Build: string; 24 | constructor Create;overload; 25 | constructor Create(cellName, cellStyle: string);overload; 26 | destructor Destroy; override; 27 | end; 28 | 29 | TAfterAddRow = procedure ( 30 | Table: THTMLBase; 31 | DataSet: TDataSet 32 | ) of object; 33 | 34 | THTMLItem = class 35 | private 36 | FHtml: TStringList; 37 | protected 38 | public 39 | property HTML: TStringList read FHtml write FHtml; 40 | function Build: string; 41 | constructor Create(itemHtml: string = ''); 42 | destructor Destroy;override; 43 | end; 44 | 45 | THTMLParagraph = class 46 | private 47 | Fstyle: string; 48 | FName: string; 49 | FItemList: TObjectList; 50 | procedure Initialize(paragraphName:string = ''; style: string = ''); 51 | protected 52 | public 53 | property Style: string read FStyle write FStyle; 54 | property Name: string read FName write FName; 55 | property ItemList: TObjectList read FItemList write FItemList; 56 | function Build: string; 57 | constructor Create;overload; 58 | constructor Create(paragraphName, style: string);overload; 59 | destructor Destroy;override; 60 | end; 61 | 62 | THTMLRow = class 63 | private 64 | Fstyle: string; 65 | FName: string; 66 | FCellList: TObjectList; 67 | procedure Initialize(rowCellList: array of THTMLCell; rowStyle: string = ''); 68 | protected 69 | public 70 | property Style: string read FStyle write FStyle; 71 | property Name: string read FName write FName; 72 | property CellList: TObjectList read FCellList write FCellList; 73 | function Build: string; 74 | function AddCell(cellName,cellStyle:string): THTMLCell; 75 | constructor Create;overload; 76 | constructor Create(rowCellList: array of THTMLCell);overload; 77 | constructor Create(rowCellList: array of THTMLCell; rowStyle: string);overload; 78 | destructor Destroy;override; 79 | end; 80 | 81 | THTMLTable = class(THTMLBase) 82 | private 83 | FRowList: TObjectList; 84 | Fstyle: string; 85 | protected 86 | public 87 | property Style: string read FStyle write FStyle; 88 | property RowList: TObjectList read FRowList write FRowList; 89 | function AddRow ( cellList: array of THTMLCell; rowStyle: string ): THTMLRow;overload; 90 | function AddRow ( rowName, rowStyle: string ): THTMLRow;overload; 91 | function AddEmptyRow(rowStyle:string = '') : THTMLRow; 92 | function Build:string; 93 | procedure SetDataSet(dataSet: TDataSet; 94 | HeaderColor: string = ''; 95 | EvenColor: string = ''; 96 | OddColor: string = ''; 97 | EmptyValue: string = ''; 98 | AfterAddRow: TAfterAddRow = nil); 99 | constructor Create(tableStyle: string = ''); 100 | destructor Destroy;override; 101 | end; 102 | 103 | THTMLReport = class 104 | private 105 | FHTMLItemList: TObjectList; 106 | FStyle: string; 107 | FStyleHTML: string; 108 | FHead:string; 109 | function BuildDefaultStyle: string; 110 | procedure Initialize(reportStyle: string = ''); 111 | protected 112 | procedure SetStyle(value: string); 113 | public 114 | property HTMLItemList: TObjectList read FHTMLItemList write FHTMLItemList; 115 | property Style: string read FStyle write SetStyle; 116 | property StyleHTML: string read FStyleHTML write FStyleHTML; 117 | property Head: string read FHead write FHead; 118 | procedure AddTable(table: THTMLTable); 119 | procedure AddItem(item: THTMLItem); 120 | function AddParagraph(paragraphName, paragraphStyle: string): THTMLParagraph; 121 | function Build: string; 122 | procedure SaveToFile(fileName: string); 123 | procedure Clear; 124 | constructor Create;overload; 125 | constructor Create(reportStyle: string);overload; 126 | destructor Destroy;override; 127 | end; 128 | 129 | TBuild = class 130 | public 131 | class function Build(item: TObject):string; 132 | end; 133 | 134 | implementation 135 | 136 | { THTMLTable } 137 | 138 | function THTMLTable.AddRow(cellList: array of THTMLCell; 139 | rowStyle: string): THTMLRow; 140 | var 141 | row: THTMLrow; 142 | i: Integer; 143 | begin 144 | row := THTMLrow.Create; 145 | row.Style := rowStyle; 146 | for i := 0 to High(cellList) do 147 | row.CellList.Add(cellList[i]); 148 | FRowList.Add( row ); 149 | Result := row; 150 | end; 151 | 152 | function THTMLTable.AddEmptyRow(rowStyle:string = ''): THTMLRow; 153 | var 154 | row: THTMLrow; 155 | begin 156 | row := THTMLrow.Create; 157 | row.Style := rowStyle; 158 | row.CellList.Add(THTMLCell.Create(' ', 'colspan="100%"')); 159 | FRowList.Add( row ); 160 | Result := row; 161 | end; 162 | 163 | function THTMLTable.Build: string; 164 | var 165 | i: Integer; 166 | html: TStringList; 167 | begin 168 | html := TStringList.Create; 169 | try 170 | html.Clear; 171 | html.Add(''); 172 | for i := 0 to FRowList.Count - 1 do 173 | //BUILD ROW 174 | html.Add(TBuild.Build(FRowList[i])); 175 | html.Add('
'); 176 | Result := html.Text; 177 | finally 178 | FreeAndNil(html); 179 | end; 180 | end; 181 | 182 | constructor THTMLTable.Create(tableStyle: string = ''); 183 | begin 184 | RowList := TObjectList.Create; 185 | Style := tableStyle; 186 | end; 187 | 188 | destructor THTMLTable.Destroy; 189 | begin 190 | FreeAndNil(FRowList); 191 | inherited Destroy; 192 | end; 193 | 194 | function THTMLTable.AddRow(rowName, rowStyle: string): THTMLRow; 195 | begin 196 | Result := THTMLRow.Create; 197 | Result.Name := rowName; 198 | Result.Style := rowStyle; 199 | RowList.Add(Result); 200 | end; 201 | 202 | procedure THTMLTable.SetDataSet( 203 | dataSet: TDataSet; HeaderColor: string = ''; 204 | EvenColor: string = ''; OddColor: string = ''; 205 | EmptyValue: string = ''; AfterAddRow: TAfterAddRow = nil); 206 | const 207 | StyleHeader=''; 208 | StyleData=''; 209 | var 210 | i: Integer; 211 | row: THTMLRow; 212 | cell: THTMLCell; 213 | begin 214 | //prototipo 215 | row := THTMLRow.Create; 216 | row.Style := 'bgcolor="' + HeaderColor + '"'; 217 | for i := 0 to dataSet.FieldCount - 1 do 218 | if dataSet.Fields[i].Visible then 219 | row.AddCell('' + dataSet.Fields[i].DisplayName + '', StyleHeader); 220 | Self.RowList.Add(row); 221 | dataSet.DisableControls; 222 | try 223 | dataSet.First; 224 | while not dataSet.Eof do 225 | begin 226 | row := THTMLRow.Create; 227 | if ((dataSet.RecNo mod 2) <> 0) then 228 | row.Style := 'bgcolor="' + EvenColor + '"' 229 | else 230 | row.Style := 'bgcolor="' + OddColor + '"'; 231 | 232 | for i := 0 to dataSet.FieldCount - 1 do 233 | if dataSet.Fields[i].Visible then 234 | begin 235 | if dataSet.FieldByName(dataSet.Fields[i].FieldName).DataType = ftMemo then 236 | cell := row.AddCell(dataSet.FieldByName(dataSet.Fields[i].FieldName).AsString, StyleData) 237 | else 238 | cell := row.AddCell(dataSet.FieldByName(dataSet.Fields[i].FieldName).DisplayText, StyleData); 239 | 240 | if cell.Name = EmptyStr then 241 | cell.Name := EmptyValue; 242 | end; 243 | Self.RowList.Add(row); 244 | if Assigned(AfterAddRow) then 245 | AfterAddRow(Self, dataSet); 246 | 247 | dataSet.Next; 248 | end; 249 | finally 250 | dataSet.EnableControls; 251 | end; 252 | end; 253 | 254 | { THTMLCell } 255 | constructor THTMLCell.Create(cellName, cellStyle: string); 256 | begin 257 | Initialize(cellName, cellStyle); 258 | end; 259 | 260 | function THTMLCell.Build: string; 261 | var 262 | html: TStringList; 263 | i: Integer; 264 | begin 265 | html := TStringList.Create; 266 | try 267 | html.Add(' '); 268 | if Self.Name <> '' then 269 | html.Add(' ' + Self.Name); 270 | //BUILD CHILD ITEM, HTML, CELL, ETC 271 | for i := 0 to Self.ItemList.Count - 1 do 272 | html.Add(' ' + TBuild.Build(Self.ItemList[i])); 273 | html.Add(' '); 274 | Result := html.Text; 275 | finally 276 | FreeAndNil(html); 277 | end; 278 | end; 279 | 280 | destructor THTMLCell.Destroy; 281 | begin 282 | FreeAndNil(FItemList); 283 | inherited Destroy; 284 | end; 285 | 286 | constructor THTMLCell.Create; 287 | begin 288 | Initialize; 289 | end; 290 | 291 | procedure THTMLCell.Initialize(cellName:string = ''; cellStyle: string = ''); 292 | begin 293 | FItemList := TObjectList.Create; 294 | Name := cellName; 295 | Style := cellStyle; 296 | end; 297 | 298 | { THTMLRow } 299 | 300 | function THTMLRow.AddCell(cellName, cellStyle: string): THTMLCell; 301 | begin 302 | Result := THTMLCell.Create(cellName, cellStyle); 303 | CellList.Add(Result); 304 | end; 305 | 306 | function THTMLRow.Build: string; 307 | var 308 | i: Integer; 309 | html: TStringList; 310 | begin 311 | html := TStringList.Create; 312 | try 313 | html.Clear; 314 | //BUILD ROW 315 | html.Add(' '); 316 | for i := 0 to Self.CellList.Count - 1 do 317 | begin 318 | //BUILD CELL 319 | html.Add(TBuild.Build(Self.CellList[i])); 320 | end; 321 | html.Add(' '); 322 | Result := html.Text; 323 | finally 324 | FreeAndNil(html); 325 | end; 326 | end; 327 | 328 | constructor THTMLRow.Create; 329 | begin 330 | Initialize([]); 331 | end; 332 | 333 | constructor THTMLRow.Create(rowCellList: array of THTMLCell); 334 | begin 335 | Initialize(rowCellList); 336 | end; 337 | 338 | constructor THTMLRow.Create(rowCellList: array of THTMLCell; 339 | rowStyle: string); 340 | begin 341 | Initialize(rowCellList, rowStyle); 342 | end; 343 | 344 | destructor THTMLRow.Destroy; 345 | begin 346 | FreeAndNil(FCellList); 347 | inherited Destroy; 348 | end; 349 | 350 | procedure THTMLRow.Initialize(rowCellList: array of THTMLCell; 351 | rowStyle: string = ''); 352 | var 353 | i: Integer; 354 | begin 355 | FCellList := TObjectList.Create; 356 | Self.Style := rowStyle; 357 | for i := 0 to High(rowCellList) do 358 | CellList.Add(rowCellList[i]); 359 | end; 360 | 361 | { THTMLReport } 362 | 363 | procedure THTMLReport.AddItem(item: THTMLItem); 364 | begin 365 | HTMLItemList.Add(item); 366 | end; 367 | 368 | function THTMLReport.AddParagraph(paragraphName, 369 | paragraphStyle: string): THTMLParagraph; 370 | begin 371 | Result := THTMLParagraph.Create(paragraphName, paragraphStyle); 372 | HTMLItemList.Add(Result); 373 | end; 374 | 375 | procedure THTMLReport.AddTable(table: THTMLTable); 376 | begin 377 | HTMLItemList.Add(table); 378 | end; 379 | 380 | function THTMLReport.Build: string; 381 | var 382 | i: Integer; 383 | html: TstringList; 384 | begin 385 | html := TStringList.Create; 386 | try 387 | html.Clear; 388 | html.Add(''); 389 | html.Add(' '); 390 | html.Add(' '); 393 | html.Add(' '+Self.Head); 394 | //html.Add(' '); 395 | html.Add(' '); 396 | html.Add(' '); 397 | for i := 0 to HTMLItemList.Count - 1 do 398 | html.Add(TBuild.Build(HTMLItemList[i])); 399 | html.Add(' '); 400 | html.Add(''); 401 | result := html.Text; 402 | finally 403 | FreeAndNil(html); 404 | end; 405 | end; 406 | 407 | constructor THTMLReport.Create; 408 | begin 409 | Initialize; 410 | end; 411 | 412 | function THTMLReport.BuildDefaultStyle: string; 413 | var 414 | html: TStringList; 415 | begin 416 | html := TStringList.Create; 417 | try 418 | html.Clear; 419 | html.Add('html, body {height:100%;}'); 420 | html.Add('table {width:100% ;border-collapse: collapse;font-family:Arial;font-size:8pt}'); 421 | Result := html.Text; 422 | finally 423 | FreeAndNil(html); 424 | end; 425 | end; 426 | 427 | procedure THTMLReport.Clear; 428 | begin 429 | FHTMLItemList.Clear; 430 | end; 431 | 432 | constructor THTMLReport.Create(reportStyle: string); 433 | begin 434 | Initialize(reportStyle); 435 | end; 436 | 437 | destructor THTMLReport.Destroy; 438 | begin 439 | FreeAndNil(FHTMLItemList); 440 | inherited Destroy; 441 | end; 442 | 443 | procedure THTMLReport.SaveToFile(fileName: string); 444 | var 445 | toFile: TStringList; 446 | begin 447 | toFile := TStringList.Create; 448 | try 449 | toFile.Text := Self.Build; 450 | toFile.SaveToFile(fileName); 451 | finally 452 | FreeAndNil(toFile); 453 | end; 454 | end; 455 | 456 | procedure THTMLReport.SetStyle(value: string); 457 | begin 458 | if value = '' then 459 | FStyle := BuildDefaultStyle 460 | else 461 | FStyle := value; 462 | end; 463 | 464 | procedure THTMLReport.Initialize(reportStyle: string = ''); 465 | begin 466 | FHTMLItemList := TObjectList.Create; 467 | Style := reportStyle; 468 | StyleHTML := ''; 469 | Head := ''; 470 | end; 471 | 472 | { THTMLItem } 473 | 474 | function THTMLItem.Build: string; 475 | begin 476 | Result := HTML.Text; 477 | end; 478 | 479 | constructor THTMLItem.Create(itemHtml: string); 480 | begin 481 | fHTML := TStringList.Create; 482 | fHTML.Clear; 483 | fHTML.Text := itemHtml; 484 | end; 485 | 486 | destructor THTMLItem.Destroy; 487 | begin 488 | FreeAndNil(fHTML); 489 | inherited Destroy; 490 | end; 491 | 492 | { TBuild } 493 | 494 | class function TBuild.Build(item: TObject): string; 495 | begin 496 | if item is THTMLReport then 497 | Result := THTMLReport(item).Build 498 | else if item is THTMLTable then 499 | Result := THTMLTable(item).Build 500 | else if item is THTMLRow then 501 | Result := THTMLRow(item).Build 502 | else if item is THTMLCell then 503 | Result := THTMLCell(item).Build 504 | else if item is THTMLItem then 505 | Result := THTMLItem(item).Build 506 | else if item is THTMLParagraph then 507 | Result := THTMLParagraph(item).Build; 508 | end; 509 | 510 | { THTMLParagraph } 511 | 512 | constructor THTMLParagraph.Create; 513 | begin 514 | Initialize; 515 | end; 516 | 517 | function THTMLParagraph.Build: string; 518 | var 519 | html: TStringList; 520 | i: Integer; 521 | begin 522 | html := TStringList.Create; 523 | try 524 | html.Clear; 525 | html.Add('

'); 526 | html.Add(Self.Name); 527 | for i := 0 to Self.ItemList.Count - 1 do 528 | html.Add(TBuild.Build(Self.ItemList[i])); 529 | html.Add('

'); 530 | Result := html.Text; 531 | finally 532 | FreeAndNil(html); 533 | end; 534 | end; 535 | 536 | constructor THTMLParagraph.Create(paragraphName, style: string); 537 | begin 538 | Initialize(paragraphName, style); 539 | end; 540 | 541 | destructor THTMLParagraph.Destroy; 542 | begin 543 | FreeAndNil(FItemList); 544 | inherited Destroy; 545 | end; 546 | 547 | procedure THTMLParagraph.Initialize(paragraphName: string = ''; style: string = ''); 548 | begin 549 | FItemList := TObjectList.Create; 550 | Self.Name := paragraphName; 551 | Self.Style := style; 552 | end; 553 | 554 | end. 555 | --------------------------------------------------------------------------------