Title: Little component to make HTML Reports
Question: how to make a little report component
Answer:
/////////////////////////////
// //
// LittleReport //
// //
// HTML Reports //
// //
// //
// Unit written by //
// //
// Simone Di Cicco //
// simone.dicicco@tin.it //
// simone.dicicco@email.it //
// //
/////////////////////////////
unit LittleReport;
interface
uses Windows, Messages, SysUtils, Classes, DB, Graphics;
const
FAuthor = 'Simone Di Cicco';
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(''+Location+'')
else HTMLTable.Add(''+FTitle+'');
HTMLTable.Add('');
NameCont := FieldNames.Count;
repeat
FieldTitle := FieldTitle+''+FieldNames.Strings[FieldCont]+'';
inc(FieldCont, 1);
until NameCont = FieldCont;
FieldTitle := ''+FieldTitle+'';
HTMLTable.Add(FieldTitle);
repeat
HTMLTable.Add(GetDataRowsHTML);
inc(IncRowHTML, 1);
until IncRowHTML = RowCont;
HTMLTable.Add('');
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+''+ColumnsCont[CounterRow].Strings[IncRowHTML]+'';
inc(CounterRow, 1);
until CounterRow = ColArray;
ReportRow := ''+ReportRow+'';
Result := ReportRow;
end;
end.