unit uDataSetToText;

interface

uses DB;

function DataToText(DataSet: TDataSet): string;

implementation

uses SysUtils, Classes;

function DataToText(DataSet: TDataSet): string;

  function Max(value1, value2: Integer): Integer;
  begin
    if value1 > value2 then
      Result := value1
    else
      Result := value2;
  end;

  function StrRightPad(const Source: string; Size: Integer; C: Char = #32): string;
  begin
    Result := Source;
    if (Size > 0) and (Length(Source) < Size) then
      Result := Result + StringOfChar(C, Size - Length(Source));
  end;

  function StrLeftPad(const Source: string; Size: Integer; C: Char = #32): string;
  begin
    Result := Source;
    if (Size > 0) and (Length(Source) < Size) then
      Result := StringOfChar(C, Size - Length(Source)) + Result;
  end;

  function GetFieldText(AField: TField): string;
  begin
    if (AField.IsNull) then
      Result := '(NULL)'
    else if (AField is TStringField) then
      Result := AField.DisplayText
    else if (AField is TCurrencyField) then
      Result := CurrToStr(AField.AsFloat)
    else if (AField is TFloatField) then
      Result := FormatFloat('#,0.0000', AField.AsFloat)
    else if (AField is TBooleanField) then
      Result := AnsiUpperCase(AField.DisplayText)
    else if (AField is TDateTimeField) then
      Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', AField.AsDateTime)
    else if (AField is TMemoField) or
            ((AField is TBlobField) and (TBlobField(AField).BlobType = ftMemo)) then
      Result := AField.AsString
    else
      Result := AField.DisplayText;
  end;

var
  i,
  sz,
  ix: Integer;
  s,
  s2,
  s3: string;
  sl: TStringList;
begin
  s3 := '  ';
  Result := '';
  sl := TStringList.Create;
  try
    with DataSet do
    begin
      for i := 0 to FieldCount - 1 do
        if (Fields[i].FieldName <> 'RecId') then
          sl.AddObject(Fields[i].Name, TObject(Length(Fields[i].DisplayName)));
        
// calcula tamanhos máximos de cada coluna
      First;
      while (not EOF) do
      begin
        for i := 0 to FieldCount - 1 do
          if (Fields[i].FieldName <> 'RecId') then
          begin
            ix := sl.IndexOf(Fields[i].Name);
            sz := Length(GetFieldText(Fields[i]));
            sl.Objects[ix] := TObject(Max(sz, Integer(sl.Objects[ix])));
          end;
        Next;
      end;

// monta o cabeçalho
      s := '';
      s2 := '';
      for i := 0 to FieldCount - 1 do
        if (Fields[i].FieldName <> 'RecId') then
        begin
          ix := sl.IndexOf(Fields[i].Name);
          sz := Integer(sl.Objects[ix]);
          s := s + StrRightPad(Fields[i].DisplayLabel, sz) + s3;
          s2 := s2 + StringOfChar('-', sz) + s3;
        end;
      Result := Result + s + #13#10 + s2 + #13#10;

// monta os dados
      First;
      while (not EOF) do
      begin
        s := '';
        for i := 0 to FieldCount - 1 do
          if (Fields[i].FieldName <> 'RecId') then
          begin
            ix := sl.IndexOf(Fields[i].Name);
            sz := Integer(sl.Objects[ix]);
            s2 := GetFieldText(Fields[i]);
            if (Fields[i] is TStringField) then
              s2 := StrRightPad(s2, sz)
            else if (Fields[i] is TCurrencyField) then
              s2 := StrLeftPad(s2, sz)
            else if (Fields[i] is TFloatField) then
              s2 := StrLeftPad(s2, sz)
            else if (Fields[i] is TBooleanField) then
              s2 := StrLeftPad(s2, sz)
            else if (Fields[i] is TDateTimeField) then
              s2 := StrRightPad(s2, sz)
            else if (Fields[i] is TMemoField) or
                    ((Fields[i] is TBlobField) and (TBlobField(Fields[i]).BlobType = ftMemo)) then
              s2 := StrRightPad(s2, sz)
            else
              s2 := StrRightPad(s2, sz);
            if (Length(s2) > sz) then
              s2 := Copy(s2, 1, sz);
            s := s + s2 + s3;
          end;
        Result := Result + s + #13#10;
        Next;
      end;
    end;
  finally
    sl.Free;
  end;
end;

end.