TDataSet => Excel (No OLE or EXCEL required)

Problem/Question/Abstract:

TDataSet => Excel (No OLE or EXCEL required)

Answer:

This class will produce an Excel Spreadsheet from a TDataSet. No OLE is required or Excel Installation needed to create the file. The one problem with Excel OLE is that is tends to be rather Sloooow. The class uses tandard Delphi I/O functions and is considerably faster than the OLE calls.

Example.

var
  XL: TDataSetToExcel;
begin
  XL := TDataSetToExcel.Create(MyQuery, 'c:\temp\test.xls');
  XL.WriteFile;
  XL.Free;
end;

The columns are neatly sized, Numerics are formatted in "Courier" and obey "###,###,##0.00" for floats and "0" for integers. Dates are formatted "dd-MMM-yyyy hh:nn:ss". Column headers are in Bold and are boxed and shaded.

unit MahExcel;
interface
uses Windows, SysUtils, DB, Math;

// =============================================================================
// TDataSet to Excel without OLE or Excel required
// Mike Heydon Dec 2002
// =============================================================================

type
  // TDataSetToExcel
  TDataSetToExcel = class(TObject)
  protected
    procedure WriteToken(AToken: word; ALength: word);
    procedure WriteFont(const AFontName: string; AFontHeight,
      AAttribute: word);
    procedure WriteFormat(const AFormatStr: string);
  private
    FRow: word;
    FDataFile: file;
    FFileName: string;
    FDataSet: TDataSet;
  public
    constructor Create(ADataSet: TDataSet; const AFileName: string);
    function WriteFile: boolean;
  end;

  // -----------------------------------------------------------------------------
implementation

const
  // XL Tokens
  XL_DIM = $00;
  XL_BOF = $09;
  XL_EOF = $0A;
  XL_DOCUMENT = $10;
  XL_FORMAT = $1E;
  XL_COLWIDTH = $24;
  XL_FONT = $31;

  // XL Cell Types
  XL_INTEGER = $02;
  XL_DOUBLE = $03;
  XL_STRING = $04;

  // XL Cell Formats
  XL_INTFORMAT = $81;
  XL_DBLFORMAT = $82;
  XL_XDTFORMAT = $83;
  XL_DTEFORMAT = $84;
  XL_TMEFORMAT = $85;
  XL_HEADBOLD = $40;
  XL_HEADSHADE = $F8;

  // ========================
  // Create the class
  // ========================

constructor TDataSetToExcel.Create(ADataSet: TDataSet;
  const AFileName: string);
begin
  FDataSet := ADataSet;
  FFileName := ChangeFileExt(AFilename, '.xls');
end;

// ====================================
// Write a Token Descripton Header
// ====================================

procedure TDataSetToExcel.WriteToken(AToken: word; ALength: word);
var
  aTOKBuffer: array[0..1] of word;
begin
  aTOKBuffer[0] := AToken;
  aTOKBuffer[1] := ALength;
  Blockwrite(FDataFile, aTOKBuffer, SizeOf(aTOKBuffer));
end;

// ====================================
// Write the font information
// ====================================

procedure TDataSetToExcel.WriteFont(const AFontName: string;
  AFontHeight, AAttribute: word);
var
  iLen: byte;
begin
  AFontHeight := AFontHeight * 20;
  WriteToken(XL_FONT, 5 + length(AFontName));
  BlockWrite(FDataFile, AFontHeight, 2);
  BlockWrite(FDataFile, AAttribute, 2);
  iLen := length(AFontName);
  BlockWrite(FDataFile, iLen, 1);
  BlockWrite(FDataFile, AFontName[1], iLen);
end;

// ====================================
// Write the format information
// ====================================

procedure TDataSetToExcel.WriteFormat(const AFormatStr: string);
var
  iLen: byte;
begin
  WriteToken(XL_FORMAT, 1 + length(AFormatStr));
  iLen := length(AFormatStr);
  BlockWrite(FDataFile, iLen, 1);
  BlockWrite(FDataFile, AFormatStr[1], iLen);
end;

// ====================================
// Write the XL file from data set
// ====================================

function TDataSetToExcel.WriteFile: boolean;
var
  bRetvar: boolean;
  aDOCBuffer: array[0..1] of word;
  aDIMBuffer: array[0..3] of word;
  aAttributes: array[0..2] of byte;
  i: integer;
  iColNum,
    iDataLen: byte;
  sStrData: string;
  fDblData: double;
  wWidth: word;
begin
  bRetvar := true;
  FRow := 0;
  FillChar(aAttributes, SizeOf(aAttributes), 0);
  AssignFile(FDataFile, FFileName);

  try
    Rewrite(FDataFile, 1);
    // Beginning of File
    WriteToken(XL_BOF, 4);
    aDOCBuffer[0] := 0;
    aDOCBuffer[1] := XL_DOCUMENT;
    Blockwrite(FDataFile, aDOCBuffer, SizeOf(aDOCBuffer));

    // Font Table
    WriteFont('Arial', 10, 0);
    WriteFont('Arial', 10, 1);
    WriteFont('Courier New', 11, 0);

    // Column widths
    for i := 0 to FDataSet.FieldCount - 1 do
    begin
      wWidth := (FDataSet.Fields[i].DisplayWidth + 1) * 256;
      if FDataSet.FieldDefs[i].DataType = ftDateTime then
        inc(wWidth, 2000);
      if FDataSet.FieldDefs[i].DataType = ftDate then
        inc(wWidth, 1050);
      if FDataSet.FieldDefs[i].DataType = ftTime then
        inc(wWidth, 100);
      WriteToken(XL_COLWIDTH, 4);
      iColNum := i;
      BlockWrite(FDataFile, iColNum, 1);
      BlockWrite(FDataFile, iColNum, 1);
      BlockWrite(FDataFile, wWidth, 2);
    end;

    // Column Formats
    WriteFormat('General');
    WriteFormat('0');
    WriteFormat('###,###,##0.00');
    WriteFormat('dd-mmm-yyyy hh:mm:ss');
    WriteFormat('dd-mmm-yyyy');
    WriteFormat('hh:mm:ss');

    // Dimensions
    WriteToken(XL_DIM, 8);
    aDIMBuffer[0] := 0;
    aDIMBuffer[1] := Min(FDataSet.RecordCount, $FFFF);
    aDIMBuffer[2] := 0;
    aDIMBuffer[3] := Min(FDataSet.FieldCount - 1, $FFFF);
    Blockwrite(FDataFile, aDIMBuffer, SizeOf(aDIMBuffer));

    // Column Headers
    for i := 0 to FDataSet.FieldCount - 1 do
    begin
      sStrData := FDataSet.Fields[i].DisplayName;
      iDataLen := length(sStrData);
      WriteToken(XL_STRING, iDataLen + 8);
      WriteToken(FRow, i);
      aAttributes[1] := XL_HEADBOLD;
      aAttributes[2] := XL_HEADSHADE;
      BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
      BlockWrite(FDataFile, iDataLen, SizeOf(iDataLen));
      if iDataLen > 0 then
        BlockWrite(FDataFile, sStrData[1], iDataLen);
      aAttributes[2] := 0;
    end;

    // Data Rows
    while not FDataSet.Eof do
    begin
      inc(FRow);

      for i := 0 to FDataSet.FieldCount - 1 do
      begin
        case FDataSet.FieldDefs[i].DataType of
          ftBoolean,
            ftWideString,
            ftFixedChar,
            ftString:
            begin
              sStrData := FDataSet.Fields[i].AsString;
              iDataLen := length(sStrData);
              WriteToken(XL_STRING, iDataLen + 8);
              WriteToken(FRow, i);
              aAttributes[1] := 0;
              BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
              BlockWrite(FDataFile, iDataLen, SizeOf(iDataLen));
              if iDataLen > 0 then
                BlockWrite(FDataFile, sStrData[1], iDataLen);
            end;

          ftAutoInc,
            ftSmallInt,
            ftInteger,
            ftWord,
            ftLargeInt:
            begin
              fDblData := FDataSet.Fields[i].AsFloat;
              iDataLen := SizeOf(fDblData);
              WriteToken(XL_DOUBLE, 15);
              WriteToken(FRow, i);
              aAttributes[1] := XL_INTFORMAT;
              BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
              BlockWrite(FDataFile, fDblData, iDatalen);
            end;

          ftFloat,
            ftCurrency,
            ftBcd:
            begin
              fDblData := FDataSet.Fields[i].AsFloat;
              iDataLen := SizeOf(fDblData);
              WriteToken(XL_DOUBLE, 15);
              WriteToken(FRow, i);
              aAttributes[1] := XL_DBLFORMAT;
              BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
              BlockWrite(FDataFile, fDblData, iDatalen);
            end;

          ftDateTime:
            begin
              fDblData := FDataSet.Fields[i].AsFloat;
              iDataLen := SizeOf(fDblData);
              WriteToken(XL_DOUBLE, 15);
              WriteToken(FRow, i);
              aAttributes[1] := XL_XDTFORMAT;
              BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
              BlockWrite(FDataFile, fDblData, iDatalen);
            end;

          ftDate:
            begin
              fDblData := FDataSet.Fields[i].AsFloat;
              iDataLen := SizeOf(fDblData);
              WriteToken(XL_DOUBLE, 15);
              WriteToken(FRow, i);
              aAttributes[1] := XL_DTEFORMAT;
              BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
              BlockWrite(FDataFile, fDblData, iDatalen);
            end;

          ftTime:
            begin
              fDblData := FDataSet.Fields[i].AsFloat;
              iDataLen := SizeOf(fDblData);
              WriteToken(XL_DOUBLE, 15);
              WriteToken(FRow, i);
              aAttributes[1] := XL_TMEFORMAT;
              BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
              BlockWrite(FDataFile, fDblData, iDatalen);
            end;

        end;
      end;

      FDataSet.Next;
    end;

    // End of File
    WriteToken(XL_EOF, 0);
    CloseFile(FDataFile);
  except
    bRetvar := false;
  end;

  Result := bRetvar;
end;

end.