/////////////////////////////
// //
// 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('<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.
|
Bewerten Sie diesen Tipp:
|
|
|
