Delphi class TDataSetToExcel

Question/Problem/Abstract:

See Also : Article_4724.asp - (Freeform Excel Worksheet)

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 standard 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 
// 
// For a good reference on Excel BIFF? file format see site 
// http://sc.openoffice.org/excelfileformat.pdf 
// 
// 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.