...einen HTML- und TXT Report-Komponente programmieren?

/////////////////////////////
//                         //
//       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.

printed from
www.swissdelphicenter.ch
developers knowledge base