Make an HTML and TXT report component

Delphi/Pascal

unit LittleReport; interface uses Windows, Messages, SysUtils, Classes, DB, Graphics; const   FAuthor  = 'Author';   FVersion = '1.0'; type   TLittleReport = class(TComponent)   protected     FDataSet: TDataSet;     FWidth: Integer;     FTitle: string;     FAfterHTML: TStringList;     FPreHTML: TStringList;     procedure GetDBFieldData(StringList: TStringList; FieldName: string);     function GetDataRowsTXT: string;     function GetDataRowsHTML: string;   private     ColumnsCont: array of TStringList;     FieldNames: TStringList;     HTMLTable: TStringList;     TXTFile: TStringList;     IncRowTXT: Integer;     IncRowHTML: Integer;   published     property DataSet: TDataSet read FDataSet write FDataSet;     property HTMLTableWidth: Integer read FWidth write FWidth default 100;     property HTMLPageTitle: string read FTitle write FTitle;     property BeforeReportHTML: TStringList read FPreHTML write FPreHTML;     property AfterReportHTML: TStringList read FAfterHTML write FAfterHTML;   public     constructor Create(AOwner: TComponent); override;     // destructor Destroy; override;     procedure CreateReportHTML(Location: TFileName);     procedure CreateReportTXT(Location: TFileName);   end; procedure Register; implementation { TLittleReport } procedure Register; begin   RegisterComponents('Simone Di Cicco', [TLittleReport]); end; constructor TLittleReport.Create(AOwner: TComponent); begin   inherited;   FPreHTML := TStringList.Create;   FPreHTML.Clear;   FAfterHTML := TStringList.Create;   FAfterHTML.Clear;   FieldNames := TStringList.Create;   FieldNames.Clear;   HTMLTable := TStringList.Create;   HTMLTable.Clear;   TXTFile := TStringList.Create;   TXTFile.Clear; end; procedure TLittleReport.GetDBFieldData(StringList: TStringList;   FieldName: string); begin   StringList.Clear;   with FDataSet do   begin     Open;     DisableControls;     try       while not EOF do       begin         StringList.Add(FieldByName(FieldName).AsString);         Next;       end;     finally       EnableControls;       Close;     end;   end; end; procedure TLittleReport.CreateReportHTML(Location: TFileName); var   Counter, ColCount, RowCont: Integer;   BHTMLPRE, BContPRE, BHTMLAF, BContAF: Integer;   NameCont, FieldCont: Integer;   FieldTitle: string; begin   NameCont   := 0;   FieldCont  := 0;   RowCont    := 0;   BHTMLPRE   := 0;   BContPRE   := 0;   BHTMLAF    := 0;   BContAF    := 0;   IncRowHTML := 0;   FDataSet.Open;   FieldNames.Clear;   FDataSet.GetFieldNames(FieldNames);   ColCount := FDataSet.Fields.Count;   SetLength(ColumnsCont, ColCount);   HTMLTable.Clear;   Counter := 0;   repeat     ColumnsCont[Counter] := TStringList.Create;     GetDBFieldData(ColumnsCont[Counter], FieldNames.Strings[Counter]);     Inc(Counter, 1);   until Counter = ColCount;   RowCont  := ColumnsCont[0].Count;   BHTMLPRE := FPreHTML.Count;   if BHTMLPRE >= 1 then   begin     repeat       HTMLTable.Add(FPreHTML.Strings[BContPRE]);       Inc(BContPRE, 1);     until BContPRE = BHTMLPRE;   end;   if FTitle = '' then HTMLTable.Add('<title>' + Location + '</title>')   else     HTMLTable.Add('<title>' + FTitle + '</title>');   HTMLTable.Add('<Table Width="' + IntToStr(FWidth) + '%">');   NameCont := FieldNames.Count;   repeat     FieldTitle := FieldTitle + '</TD><TD></TD><TD><B>' +       FieldNames.Strings[FieldCont] + '</B></TD><TD></TD><TD>';     Inc(FieldCont, 1);   until NameCont = FieldCont;   FieldTitle := '<TR><TD>' + FieldTitle + '</TD></TR>';   HTMLTable.Add(FieldTitle);   repeat     HTMLTable.Add(GetDataRowsHTML);     Inc(IncRowHTML, 1);   until IncRowHTML = RowCont;   HTMLTable.Add('</table>');   BHTMLAF := FAfterHTML.Count;   if BHTMLAF >= 1 then   begin     repeat       HTMLTable.Add(FAfterHTML.Strings[BContAF]);       Inc(BContAF, 1);     until BContAF = BHTMLAF;   end;   HTMLTable.SaveToFile(Location); end; procedure TLittleReport.CreateReportTXT(Location: TFileName); var   CounterRep, ColCount, RowCont: Integer;   NameCont, FieldCont: Integer;   FieldTitle: string; begin   NameCont  := 0;   FieldCont := 0;   RowCont   := 0;   IncRowTXT := 0;   FDataSet.Open;   FieldNames.Clear;   FDataSet.GetFieldNames(FieldNames);   ColCount := FDataSet.Fields.Count;   SetLength(ColumnsCont, ColCount);   TXTFile.Clear;   CounterRep := 0;   repeat     ColumnsCont[CounterRep] := TStringList.Create;     GetDBFieldData(ColumnsCont[CounterRep], FieldNames.Strings[CounterRep]);     Inc(CounterRep, 1);   until CounterRep = ColCount;   RowCont  := ColumnsCont[0].Count;   NameCont := FieldNames.Count;   repeat     FieldTitle := FieldTitle + '| ' + FieldNames.Strings[FieldCont];     Inc(FieldCont, 1);   until NameCont = FieldCont;   FieldTitle := FieldTitle + '|';   TXTFile.Add(FieldTitle);   TXTFile.Add('"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""');   TXTFile.Add('"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""');   repeat     TXTFile.Add(GetDataRowsTXT);     TXTFile.Add('"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""');     Inc(IncRowTXT, 1);   until IncRowTXT = RowCont;   TXTFile.SaveToFile(Location); end; function TLittleReport.GetDataRowsTXT: string; var   CounterRow, ColArray: Integer;   ReportRow: string; begin   CounterRow := 0;   ColArray   := Length(ColumnsCont);   repeat     ReportRow := ReportRow + '| ' + ColumnsCont[CounterRow].Strings[IncRowTXT] + ' |';     Inc(CounterRow, 1);   until CounterRow = ColArray;   Result := ReportRow; end; function TLittleReport.GetDataRowsHTML: string; var   CounterRow, ColArray: Integer;   ReportRow: string; begin   CounterRow := 0;   ColArray   := Length(ColumnsCont);   repeat     ReportRow := ReportRow + '</TD><TD></TD><TD>' +       ColumnsCont[CounterRow].Strings[IncRowHTML] + '</TD><TD></TD><TD>';     Inc(CounterRow, 1);   until CounterRow = ColArray;   ReportRow := '<TR><TD>' + ReportRow + '</TD></TR>';   Result    := ReportRow; end; end.

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233

unit LittleReport;   interface   uses Windows, Messages, SysUtils, Classes, DB, Graphics;   const   FAuthor  = 'Author';   FVersion = '1.0';   type     TLittleReport = class(TComponent)   protected     FDataSet: TDataSet;     FWidth: Integer;     FTitle: string;     FAfterHTML: TStringList;     FPreHTML: TStringList;     procedure GetDBFieldData(StringList: TStringList; FieldName: string);     function GetDataRowsTXT: string;     function GetDataRowsHTML: string;   private       ColumnsCont: array of TStringList;     FieldNames: TStringList;     HTMLTable: TStringList;     TXTFile: TStringList;     IncRowTXT: Integer;     IncRowHTML: Integer;   published     property DataSet: TDataSet read FDataSet write FDataSet;     property HTMLTableWidth: Integer read FWidth write FWidth default 100;     property HTMLPageTitle: string read FTitle write FTitle;     property BeforeReportHTML: TStringList read FPreHTML write FPreHTML;     property AfterReportHTML: TStringList read FAfterHTML write FAfterHTML;   public       constructor Create(AOwner: TComponent); override;     // destructor Destroy; override;     procedure CreateReportHTML(Location: TFileName);     procedure CreateReportTXT(Location: TFileName);   end;   procedure Register;   implementation   { TLittleReport }   procedure Register; begin   RegisterComponents('Simone Di Cicco', [TLittleReport]); end;   constructor TLittleReport.Create(AOwner: TComponent); begin   inherited;   FPreHTML := TStringList.Create;   FPreHTML.Clear;   FAfterHTML := TStringList.Create;   FAfterHTML.Clear;   FieldNames := TStringList.Create;   FieldNames.Clear;   HTMLTable := TStringList.Create;   HTMLTable.Clear;   TXTFile := TStringList.Create;   TXTFile.Clear; end;   procedure TLittleReport.GetDBFieldData(StringList: TStringList;   FieldName: string); begin   StringList.Clear;   with FDataSet do   begin     Open;     DisableControls;     try       while not EOF do         begin         StringList.Add(FieldByName(FieldName).AsString);         Next;       end;     finally       EnableControls;       Close;     end;   end; end;   procedure TLittleReport.CreateReportHTML(Location: TFileName); var   Counter, ColCount, RowCont: Integer;   BHTMLPRE, BContPRE, BHTMLAF, BContAF: Integer;   NameCont, FieldCont: Integer;   FieldTitle: string; begin   NameCont   := 0;   FieldCont  := 0;   RowCont    := 0;   BHTMLPRE   := 0;   BContPRE   := 0;   BHTMLAF    := 0;   BContAF    := 0;   IncRowHTML := 0;   FDataSet.Open;   FieldNames.Clear;   FDataSet.GetFieldNames(FieldNames);   ColCount := FDataSet.Fields.Count;   SetLength(ColumnsCont, ColCount);   HTMLTable.Clear;   Counter := 0;   repeat     ColumnsCont[Counter] := TStringList.Create;     GetDBFieldData(ColumnsCont[Counter], FieldNames.Strings[Counter]);     Inc(Counter, 1);   until Counter = ColCount;   RowCont  := ColumnsCont[0].Count;   BHTMLPRE := FPreHTML.Count;   if BHTMLPRE >= 1 then     begin     repeat       HTMLTable.Add(FPreHTML.Strings[BContPRE]);       Inc(BContPRE, 1);     until BContPRE = BHTMLPRE;   end;   if FTitle = '' then HTMLTable.Add('<title>' + Location + '</title>')   else     HTMLTable.Add('<title>' + FTitle + '</title>');   HTMLTable.Add('<Table Width="' + IntToStr(FWidth) + '%">');   NameCont := FieldNames.Count;   repeat       FieldTitle := FieldTitle + '</TD><TD></TD><TD><B>' +       FieldNames.Strings[FieldCont] + '</B></TD><TD></TD><TD>';     Inc(FieldCont, 1);   until NameCont = FieldCont;   FieldTitle := '<TR><TD>' + FieldTitle + '</TD></TR>';   HTMLTable.Add(FieldTitle);   repeat       HTMLTable.Add(GetDataRowsHTML);     Inc(IncRowHTML, 1);   until IncRowHTML = RowCont;   HTMLTable.Add('</table>');   BHTMLAF := FAfterHTML.Count;   if BHTMLAF >= 1 then   begin     repeat       HTMLTable.Add(FAfterHTML.Strings[BContAF]);       Inc(BContAF, 1);     until BContAF = BHTMLAF;   end;   HTMLTable.SaveToFile(Location); end;   procedure TLittleReport.CreateReportTXT(Location: TFileName); var   CounterRep, ColCount, RowCont: Integer;   NameCont, FieldCont: Integer;   FieldTitle: string; begin   NameCont  := 0;   FieldCont := 0;   RowCont   := 0;   IncRowTXT := 0;   FDataSet.Open;   FieldNames.Clear;   FDataSet.GetFieldNames(FieldNames);   ColCount := FDataSet.Fields.Count;   SetLength(ColumnsCont, ColCount);   TXTFile.Clear;   CounterRep := 0;   repeat     ColumnsCont[CounterRep] := TStringList.Create;     GetDBFieldData(ColumnsCont[CounterRep], FieldNames.Strings[CounterRep]);     Inc(CounterRep, 1);   until CounterRep = ColCount;   RowCont  := ColumnsCont[0].Count;   NameCont := FieldNames.Count;   repeat     FieldTitle := FieldTitle + '| ' + FieldNames.Strings[FieldCont];     Inc(FieldCont, 1);   until NameCont = FieldCont;   FieldTitle := FieldTitle + '|';   TXTFile.Add(FieldTitle);   TXTFile.Add('"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""');   TXTFile.Add('"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""');   repeat       TXTFile.Add(GetDataRowsTXT);     TXTFile.Add('"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""');     Inc(IncRowTXT, 1);   until IncRowTXT = RowCont;   TXTFile.SaveToFile(Location); end;   function TLittleReport.GetDataRowsTXT: string; var     CounterRow, ColArray: Integer;   ReportRow: string; begin   CounterRow := 0;   ColArray   := Length(ColumnsCont);   repeat     ReportRow := ReportRow + '| ' + ColumnsCont[CounterRow].Strings[IncRowTXT] + ' |';     Inc(CounterRow, 1);   until CounterRow = ColArray;   Result := ReportRow; end;   function TLittleReport.GetDataRowsHTML: string; var   CounterRow, ColArray: Integer;   ReportRow: string; begin   CounterRow := 0;   ColArray   := Length(ColumnsCont);   repeat       ReportRow := ReportRow + '</TD><TD></TD><TD>' +       ColumnsCont[CounterRow].Strings[IncRowHTML] + '</TD><TD></TD><TD>';     Inc(CounterRow, 1);   until CounterRow = ColArray;   ReportRow := '<TR><TD>' + ReportRow + '</TD></TR>';   Result    := ReportRow; end;   end.