Make a HTML and TXT report component

Make a HTML and TXT report component

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 + '';
  HTMLTable.Add(FieldTitle);
  repeat

    HTMLTable.Add(GetDataRowsHTML);
    Inc(IncRowHTML, 1);
  until IncRowHTML = RowCont;
  HTMLTable.Add('
' + FieldNames.Strings[FieldCont] + ''; Inc(FieldCont, 1); until NameCont = FieldCont; FieldTitle := '
' + FieldTitle + '
'); 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.