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.