delphi3000.com - the free delphi knowledge platform
delphi3000.com - the free delphi knowledge platform
491 Users Online NOW
Have a look at your member-status

connecting people's knowledge


  - Recent ArticlesRSS feed for Recent Articles on delphi3000.com
  - List of All Articles
  - Top Viewed Articles
  - Articles (+Attachem.)
  - Articles Of Interest
  - Categories
  - Top Uploader
  - Search
  - Index

  - My Home
  - Submit an Article
  - My Articles
  - My Personal Data
  - My Bookmarks
  - Activities
  - Login/Logout

  - Sign Up
  - Why Sign Up
  - Newsletter

  - Press
  - Advertise

  - Contact
  - Feedback





Community
Borland
ClubeDelphi
Dr. Bob
UK-BUG
Delphi Meetings
Planeta Delphi



Loremo - the 1.5 liter car coming in 2009




Startblatt.de






Share this article with friendsShare this article with friends
Rate this articleRate this article - to keep the quality of delphi3000.com !
Comment this article or read through previous comments (21)


TDataSet => Excel (No OLE or EXCEL required)Format this article printer-friendly!Bookmark function is only available for registered users!
class TDataSetToExcel
Product:
Delphi all versions		Category:
Files Operation		Skill Level:
Scoring:
Last Update:
04/12/2007
Search Keys:
delphi delphi3000 article borland vcl code-snippet Excel TDataSet Conversion		Times Scored:
15		Visits:
11330
Uploader: Mike Heydon
Company: EOH		Reference: mheydon@pgbison.co.za
 
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.
Answer:



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.
Please rate this article!
Skill level:
BeginnerExpert

Useful:
No!Very!

Overall rating:
PoorExcellent



Comments to this article
Write a new comment
Merge some cells
    O L (Sep 14 2006 3:37PM)

Hello.
This article is very good.
I need any help.
I want to merge some cells. I read the article  "OpenOffice.org's Documentation of the Microsoft Excel File Format", but I did not succeed to do that.

Thanks
Respond

Null date fields
    Adrian Din (May 30 2005 1:59PM)

Hello,
I have tested this unit - it work great but:
if I have in dataset one null data field (datetime type) the result in excel is not a blank field as should be - is: 00.01.1900 ....
so I gues the datetime format must have an exception for null fields (like mask in numeric fields for +, - and 0  (ex : '#,###.00; - #,###.00, '0.00'')
Is any solution to this problem ?
Thank you
Respond

RE: Null date fields
Adrian Din (May 30 2005 2:03PM)

I have changed the code and the problem is 'gone':
...
while not FDataSet.Eof do
  begin
   inc(FRow);
for i := 0 to FDataSet.FieldCount - 1 do
      begin
        if  not FDataSet.Fields[i].IsNull then
...
Respond

RE: Null date fields
Adrian Din (May 30 2005 2:03PM)

I have changed the code and the problem is 'gone':
...
while not FDataSet.Eof do
  begin
   inc(FRow);
   for i := 0 to FDataSet.FieldCount - 1 do
      begin
        if  not FDataSet.Fields[i].IsNull then
...
Respond

Excelent Excel chart
    Birkir (Feb 17 2005 1:34PM)

Thank you very much for this peace of software.

It works excelently and is simple and yet powerfull.  It's easy to undarstand and modify.

The outputfiles are small and good.

Best regards Birkir
Respond

Question: How can save data into different worksheets of one workbook?
    Zhigang Liu (Aug 19 2004 10:20AM)

I got a trouble. I want to save the data into separate sheets in one workbook?  OLEDB or OLE can do this. But a lot of data need to be saved. TDataSetToExcel is very good. But I don't know how to make them into different sheets in one workbook. If it can be done, it will be very perfect!

Expecting the answer!

Thanks a lot!
Respond

RE: Question: How can save data into different worksheets of one workbook?
Mike Heydon (Mar 24 2005 12:47PM)

Don't think BIFF2 format will do this you may need to move to a higher
BIFF format

Excel 2.1 BIFF2 Worksheet Stream
Excel 3.0 BIFF3 Worksheet Stream
Excel 4.0 BIFF4S Worksheet Stream
BIFF4W Workbook Stream
Excel 5.0 BIFF5 Workbook Compound Document
Excel 7.0 (Excel 95) BIFF7 Workbook Compound Document
Excel 8.0 (Excel 97) BIFF8 Workbook Compound Document
Excel 9.0 (Excel 2000) BIFF8 Workbook Compound Document
Excel 10.0 (Excel XP) BIFF8X Workbook Compound Document
Excel 11.0 (Excel 2003) BIFF8X Workbook Compound Document

See web site http://sc.openoffice.org/excelfileformat.pdf for specs on these formats
Respond

A very good Article
    huiting cheng (May 22 2003 4:28AM)

This article is very good.Now i want to know how to change one cell's font(include:font name,style and size).
Respond

RE:Cell Formats
Mike Heydon (Aug 7 2007 9:59AM)

See my new article #4724 "Freeform Excel Workbook"
Respond

Found it useful
    Jayan Chan (Dec 12 2002 7:10AM)

Am converting it into a component with customisable Formatting.

Thanks.
Respond

RE: Found it useful
Julien Albrecht (Dec 12 2002 11:55AM)

Nice class and functions. I am working in France and the float, date  format are not the same that in english. Instead of giving the format in hard code I rather prefere to get :
...
    WriteFormat('General');
    WriteFormat('0');
    WriteFormat('# ##0,00');
    WriteFormat(ShortDateFormat + ' ' +LongTimeFormat);
    WriteFormat(ShortDateFormat);
    WriteFormat(LongTimeFormat); // prototype in sysutils.pas)
...

Can you tell me how I can have numeric fields like 124 instead of 124,00. Can you also tell me how can I give or get the float format instead of '# ##0,00'.
Thanks.
Respond

RE: Formats
Mike Heydon (Dec 12 2002 1:18PM)

Change the code (I have hard coded the formats for my use ... you may want to make them assignable properties for flexibility) to any formats that Excel uses.
    
    // My Column Formats
    WriteFormat('General');    {TEXT}
    WriteFormat('0');  {INTEGER}
    WriteFormat('###,###,##0.00');  {FLOAT}
    WriteFormat('dd-mmm-yyyy hh:mm:ss');  {DATETIME}
    WriteFormat('dd-mmm-yyyy');  {DATE}
    WriteFormat('hh:mm:ss');   {TIME}
eg.

    // Changed Column Formats
    WriteFormat('General');
    WriteFormat('0');
    WriteFormat('0.000');
    WriteFormat('dd/mm/yyyy h:mm');
    WriteFormat('dd-mmm-yyyy');
    WriteFormat('h:mm AM/PM');

Have a look in Excel when you right click a cell and select "Format Cells" and then look at the "Custom Formats"  

    
Respond

RE: RE: Formats
Julien Albrecht (Dec 12 2002 1:27PM)

Thank you for responding so soon.
I have tried tu put the tip you gave me.
When I open the file with excel, I obtain a message "File error. Some number formats may be losted".
The Interger values that I want without the ,00 still come with the ,00 despite I put '# ###' in the interger write format.
What did I do wrong ?
Respond

RE: Formats
Mike Heydon (Dec 12 2002 1:34PM)

I think your format mask "# ###" is not legal. I am not an an expert in Excel, but I assume that the Custom Formats must obey certain syntax rules. Try to search Excel for info on Custom Formats or the Web. You should be able to assign any LEGAL custom format to the string picture. Maybe some Delphi3000 subscriber has experience with Excel (Help Anyone ?)
Respond

RE: RE: Formats
Julien Albrecht (Dec 12 2002 1:51PM)

When just after I execute the function, the Excell file shows integer fields in # ###,00 mask. The format I put before the export (# ### for integer) is shown in the different user defined formats list. When I manually assign the cell to the format # ###, the cell is dispalyed correctly. There is maybe a trouble in the matching of field format/cell format ?


Respond

RE: RE: RE: Formats
Mike Heydon (Dec 12 2002 2:06PM)

It may be a version problem. My class is written using BIFF2 standards (ie. Excel 2). The mask "# ###" may not be valid in a BIFF2 file ???.
BIFF3 or BIFF4 may support different masks. I specifically wrote for BIFF2 so that any version of Excel should be able to load the file. You could try to write in BIFF3 of BIFF4 format, the specs are available on the Web. (NOTE: Excel 2000 is a different animal as it uses OLE file storage and is somewhat more complex)
Respond

RE Formats
Mike Heydon (Dec 12 2002 2:20PM)

I have just changed the code to.
    
    // My Column Formats
    WriteFormat('General');    {TEXT}
    WriteFormat(# ###');  {INTEGER}
    WriteFormat('# ###');  {FLOAT}
    WriteFormat('dd-mmm-yyyy hh:mm:ss');  {DATETIME}
    WriteFormat('dd-mmm-yyyy');  {DATE}
    WriteFormat('hh:mm:ss');   {TIME}

and it works fine on my machine. ie. 1234 becomes 1 234
and 1234.56 becomes 1 236

I use Excel 2000 (don't know if it makes diffenece)


Respond

RE: RE Formats
Julien Albrecht (Dec 12 2002 2:30PM)

I have tried with excell 2000 and excell 2002 (french version), the result
is the same for both microsoft hippopotamus ....
Respond

RE: RE: RE Formats
Julien Albrecht (Dec 12 2002 4:34PM)

I have made some search onto Microsoft support and I found in :
http://support.microsoft.com/default.aspx?scid=kb;EN-US;178605
some informations about the different formats of files.

Can you tell me where do you tell that your file is in BIFFxx ?
The BOF record seems to have changed in the new versions...
Respond

RE: How about Hebrew
avk klio (Jan 9 2003 10:28AM)

How Can i Write a string in hebrew or other language
and see it in excel
Respond




 
Sign up to consume product discounts for Bronze memberships !

read more


  Visit our Sponsor

 

  Community Ad of
L. Rosenstein		  
   














 







     
  Copyright © 2000 - 2007 delphi3000.com - All rights reserved. Terms of use. || Privacy
delphi3000.com is a service by bluestep.com IT-Services GmbH (Vienna)