Freeform Excel Worksheet (No OLE or EXCEL required)

 

Question / Problem / Abstract:

See also : Article_3475.asp  -  (TDataSet to Excel) 

This Class allows you to create an Excel Worksheet  in  much the 
same way  as  you create a TStringGrid. ie. Cell[Column,Row]. 

-------------------------------------------------------------------------  
Features 
-------------------------------------------------------------------------  

Freeform cell access with DataType,FontIndex,FormatString, 
Alignment,Pattern and BorderStyle. 
NOTE : The col and row indexes are ZERO based  in  the same way 
        as  cells  in  a TStringGrid 

4  Mapable system fonts (Preset to .) 
       Default    =  Arial  10  regular         : FontIndex  =   0  
       Alt_1      =  Arial  10  bold            : FontIndex  =   1  
       Alt_2      =  Courier New  11  regular   : FontIndex  =   2  
       Alt_3      =  Courier New  11  bold      : FontIndex  =   3  

User definable cell formats  using  Excel syntax (Defaults  set  to .) 
       String     =   ' General '  
       Integer    =   ' 0 '  
       Double     =   ' ###,###,##0.00 '  
       DateTime   =   ' dd-mmm-yyyy hh:mm:ss '  
       Date       =   ' dd-mmm-yyyy '  
       Time       =   ' hh:mm:ss '  

Set individual Column Widths and Row Heights. 

-------------------------------------------------------------------------  
Example Code Snippet 
-------------------------------------------------------------------------  

uses MahWorksheet; 

procedure ExcelDemo; 
var i : integer; 
    oWorksheet : TExcelWorkSheet; 
    oCell : TExcelCell; 
begin 
  oWorksheet : =  TExcelWorkSheet.Create; 

   //  Override mappable font 2 and 3 
  oWorksheet.SetFont_2( ' Times Roman ' , 12 , [fsBold,fsUnderline],XL_BLUE); 
  oWorksheet.SetFont_3( ' Ms Serif ' );  //  accept other defaults 

   //  Set a column width 
  oWorksheet.ColumnWidth( 3 , 50 );    //  Excel Col D 

   //  Set a row height 
  oWorksheet.RowHeight( 25 , 40 );     //  Excel Row 26 
  oWorksheet.RowHeight( 26 , 30 );     //  Excel Row 27 

   //  Set a cell via the procedural way 
  oWorksheet.SetCell( 3 , 25 ,xlString, ' Hello World ' ,XL_FONT_2, 
                      ' General ' ,xalLeft, true ,[xbTop,xbBottom]); 

   //  Do the same thing via object oriented 
  oCell : =  oWorksheet.NewCell( 3 , 16 ); 
  oCell.DataType : =  xlDateTime; 
  oCell.Data : =  Now; 

   //  Change the data in cell 
  oCell : =  oWorksheet.GetCell( 3 , 25 ); 
  oCell.Data : =   ' Hello World with Borders ' ; 
  oCell.BorderStyle : =  [xbLeft,xbRight,xbTop,xbBottom]; 
  oCell.Align : =  xalCenter; 

   //  Write out a column of integers 
   for  i : =   1000  to  1255   do  begin 
    oCell : =  oWorksheet.NewCell( 6 ,i  -   1000 ); 
    oCell.DataType : =  xlInteger; 
    oCell.Data : =  i; 
    oCell.FormatString : =   ' ###,##0 ' ;   //  overide default '0' 
    oCell.FontIndex : =  XL_FONT_1; 
  end; 

   //  Blank out a cell 
  oWorksheet.BlankCell( 6 , 20 ); 

   //  Save our work 
  oWorksheet.SaveToFile( ' c:\temp\test ' ); 
  FreeAndNil(oWorksheet); 
end;

 

Answer:

unit MahWorksheet; 
interface  
uses Windows, Classes, SysUtils, Math, Variants, Graphics; 

//  ========================================================================= 
//  Microsoft Excel Worksheet Class 
//  Excel 2.1 BIFF2 Specification 
//  
//  Mike Heydon 2007 
//  
//  --------------------------------------------------------------------- 
//  PUBLIC Methods 
//  --------------------------------------------------------------------- 
//  function GetCell(ACol,ARow : word) : TExcelCell; 
//  function NewCell(ACol,ARow :word) : TExcelCell; 
//  function GetFont_Default : TExcelFont; 
//  function GetFont_1 : TExcelFont; 
//  function GetFont_2 : TExcelFont; 
//  function GetFont_3 : TExcelFont; 
//  procedure SetFont_Default(const AFontName : string; 
//                            AFontSize : byte = 10; 
//                            AFontStyle : TFontStyles = []; 
//                            AFontColor : word = 0); 
//  procedure SetFont_1(const AFontName : string; 
//                      AFontSize : byte = 10; 
//                      AFontStyle : TFontStyles = []; 
//                      AFontColor : word = 0); 
//  procedure SetFont_2(const AFontName : string; 
//                      AFontSize : byte = 10; 
//                      AFontStyle : TFontStyles = []; 
//                      AFontColor : word = 0); 
//  procedure SetFont_3(const AFontName : string; 
//                      AFontSize : byte = 10; 
//                      AFontStyle : TFontStyles = []; 
//                      AFontColor : word = 0); 
//  procedure BlankCell(ACol,ARow : word); 
//  procedure SetCell(ACol,ARow : word; 
//                    ADataType : TExcelDataType; 
//                    AData : Olevariant; 
//                    AFontIndex : byte = 0; 
//                    AFormatString : string = 'General'; 
//                    AAlign : TExcelCellAlign = xalGeneral; 
//                    AHasPattern : boolean = false; 
//                    ABorderStyle : TExcelBorders = []); 
//  procedure ColumnWidth(ACol : byte; AWidth : word); 
//  procedure RowHeight(ARow : word; AHeight : byte); 
//  procedure SaveToFile(const AFileName : string); 
//  
//  ========================================================================= 


const  
      //  Font Types - 4 Mapable Fonts - TExcelCell.FontIndex 
     XL_FONT_DEFAULT  =   0 ; 
     XL_FONT_1        =   1 ; 
     XL_FONT_2        =   2 ; 
     XL_FONT_3        =   3 ; 

      //  Font Colors 
     XL_BLACK    : word  =  $ 0000 ; 
     XL_WHITE    : word  =  $ 0001 ; 
     XL_RED      : word  =  $ 0002 ; 
     XL_GREEN    : word  =  $ 0003 ; 
     XL_BLUE     : word  =  $ 0004 ; 
     XL_YELLOW   : word  =  $ 0005 ; 
     XL_MAGENTA  : word  =  $ 0006 ; 
     XL_CYAN     : word  =  $ 0007 ; 
     XL_SYSTEM   : word  =  $7FFF; 

type 
      //  Border Styles used by TExcelCell.BorderStyle 
     TExcelBorderType  =  (xbLeft,xbRight,xbTop,xbBottom); 
     TExcelBorders     =   set  of TExcelBorderType; 

      //  Data types used by TExcelCell.DataType 
     TExcelDataType  =  (xlDouble,xlInteger,xlDate,xlTime, 
                       xlDateTime,xlString); 

      //  Cell Alignment used by TExcelCell.Align 
     TExcelCellAlign  =  (xalGeneral,xalLeft,xalCenter,xalRight); 

      //  Structure Returned by GetFont_?() 
     TExcelFont  =  record 
       FontName :  string ; 
       FontSize :  byte ; 
       FontStyle : TFontStyles; 
       FontColor : word; 
     end; 

      //  Cell object of a TExcelWorkSheet 
     TExcelCell  =   class (TObject) 
      private  
       FRow,FCol : word; 
      public  
       DataType : TExcelDataType; 
       Data : Olevariant; 
       FontIndex :  byte ; 
       FormatString :  string ; 
       Align : TExcelCellAlign; 
       HasPattern : boolean; 
       BorderStyle : TExcelBorders; 
       constructor Create; 
     end; 

      //  Main TExcelWorkSheet Class 
     TExcelWorkSheet  =   class (TObject) 
      private  
       FFile : file; 
       FMaxRow,FMaxCol : word; 
       FRowHeights,FFontTable, 
       FUsedRows,FFormats, 
       FColWidths,FCells : TStringList; 
       function _GetFont(AFontNum :  byte ) : TExcelFont; 
       function _CalcSize(AIndex : integer) : word; 
       procedure _SetColIdx(AListIdx : integer; ARow : word; 
                            out  AFirst : word;  out  ALast : word); 
       procedure _SaveFontTable; 
       procedure _SaveColWidths; 
       procedure _SaveFormats; 
       procedure _SaveDimensions; 
       procedure _SaveRowBlocks; 
       procedure _SaveCells(ARowFr,ARowTo : word); 
       procedure _WriteToken(AToken : word; ADataLen : word); 
       procedure _WriteFont( const  AFontName :  string ; AFontHeight, 
                            AAttribute : word); 
       procedure _SetFont(AFontNum :  byte ;  const  AFontName :  string ; 
                          AFontSize :  byte ; AFontStyle : TFontStyles; 
                          AFontColor : word); 
      public  
       constructor Create; 
       destructor Destroy;  override ; 
       function GetCell(ACol,ARow : word) : TExcelCell; 
       function NewCell(ACol,ARow :word) : TExcelCell; 
       function GetFont_Default : TExcelFont; 
       function GetFont_1 : TExcelFont; 
       function GetFont_2 : TExcelFont; 
       function GetFont_3 : TExcelFont; 
       procedure SetFont_Default( const  AFontName :  string ; 
                                 AFontSize :  byte   =   10 ; 
                                 AFontStyle : TFontStyles  =  []; 
                                 AFontColor : word  =   0 ); 
       procedure SetFont_1( const  AFontName :  string ; 
                           AFontSize :  byte   =   10 ; 
                           AFontStyle : TFontStyles  =  []; 
                           AFontColor : word  =   0 ); 
       procedure SetFont_2( const  AFontName :  string ; 
                           AFontSize :  byte   =   10 ; 
                           AFontStyle : TFontStyles  =  []; 
                           AFontColor : word  =   0 ); 
       procedure SetFont_3( const  AFontName :  string ; 
                           AFontSize :  byte   =   10 ; 
                           AFontStyle : TFontStyles  =  []; 
                           AFontColor : word  =   0 ); 
       procedure BlankCell(ACol,ARow : word); 
       procedure SetCell(ACol,ARow : word; 
                         ADataType : TExcelDataType; 
                         AData : Olevariant; 
                         AFontIndex :  byte   =   0 ; 
                         AFormatString :  string   =   ' General ' ; 
                         AAlign : TExcelCellAlign  =  xalGeneral; 
                         AHasPattern : boolean  =   false ; 
                         ABorderStyle : TExcelBorders  =  []); 
       procedure ColumnWidth(ACol :  byte ; AWidth : word); 
       procedure RowHeight(ARow : word; AHeight :  byte ); 
       procedure SaveToFile( const  AFileName :  string ); 
     end; 


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

const  
       //  XL Tokens 
      XL_DIM       : word  =  $ 0000 ; 
      XL_BOF       : word  =  $ 0009 ; 
      XL_EOF       : word  =  $000A; 
      XL_ROW       : word  =  $ 0008 ; 
      XL_DOCUMENT  : word  =  $ 0010 ; 
      XL_FORMAT    : word  =  $001E; 
      XL_COLWIDTH  : word  =  $ 0024 ; 
      XL_FONT      : word  =  $ 0031 ; 
      XL_FONTCOLOR : word  =  $ 0045 ; 

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


type 
      //  Used when writing in RowBlock mode 
     TRowRec  =  packed record 
       RowIdx,FirstCell,LastCell : word; 
       Height : word; 
       NotUsed : word; 
       Defs :  byte ; 
       OSet : word; 
     end; 

//  ========================================================================= 
//  Free Form Excel Spreadsheet 
//  ========================================================================= 

//  ========================================================= 
//  Create a ne Excel Cell Object and initialise defaults 
//  ========================================================= 
constructor TExcelCell.Create; 
begin 
  inherited Create; 

  FRow : =   0 ; 
  FCol : =   0 ; 
  DataType : =  xlString; 
  FontIndex : =   0 ; 
  FormatString : =   ' General ' ; 
  Align : =  xalGeneral; 
  HasPattern : =   false ; 
  BorderStyle : =  []; 
end; 

//  ============================================== 
//  Create and Destroy TExcelWorkSheet Class 
//  ============================================== 

constructor TExcelWorkSheet.Create; 
begin 
  inherited Create; 

  FColWidths : =  TStringList.Create; 
  FRowHeights : =  TStringList.Create; 
  FUsedRows : =  TStringList.Create; 
  FUsedRows.Sorted : =   true ; 
  FUsedRows.Duplicates : =  dupIgnore; 
  FFormats : =  TStringList.Create; 
  FFormats.Sorted : =   true ; 
  FFormats.Duplicates : =  dupIgnore; 
  FCells : =  TStringList.Create; 
  FCells.Sorted : =   true ; 
  FCells.Duplicates : =  dupIgnore; 
  FFontTable : =  TStringList.Create; 
  FFontTable.AddObject( ' Arial|10|0 ' ,nil); 
  FFontTable.AddObject( ' Arial|10|1 ' ,nil); 
  FFontTable.AddObject( ' Courier New|11|0 ' ,nil); 
  FFontTable.AddObject( ' Courier New|11|1 ' ,nil); 
end; 


destructor TExcelWorkSheet.Destroy; 
var i : integer; 
begin 
   for  i : =   0  to FCells.Count  -   1   do  
    TExcelCell(FCells.Objects[i]).Free; 
  FreeAndNil(FCells); 
  FreeAndNil(FColWidths); 
  FreeAndNil(FFormats); 
  FreeAndNil(FFontTable); 
  FreeAndNil(FUsedRows); 
  FreeAndNil(FRowHeights); 

  inherited Destroy; 
end; 

//  ===================================================== 
//  INTERNAL - Write out a Token and Data length record 
//  ===================================================== 

procedure TExcelWorkSheet._WriteToken(AToken : word; ADataLen : word); 
var aWord : array [ 0 .. 1 ] of word; 
begin 
  aWord[ 0 ] : =  AToken; 
  aWord[ 1 ] : =  ADataLen; 
  Blockwrite(FFile,aWord,SizeOf(aWord)); 
end; 


//  ======================================= 
//  INTERNAL - Write out a FONT record 
//  ======================================= 

procedure TExcelWorksheet._WriteFont( const  AFontName :  string ; 
                                     AFontHeight,AAttribute : word); 
var iLen :  byte ; 
begin 
  AFontHeight : =  AFontHeight  *   20 ; 
  _WriteToken(XL_FONT, 5   +  length(AFontName)); 
  BlockWrite(FFile,AFontHeight, 2 ); 
  BlockWrite(FFile,AAttribute, 2 ); 
  iLen : =  length(AFontName); 
  BlockWrite(FFile,iLen, 1 ); 
  BlockWrite(FFile,AFontName[ 1 ],iLen); 
end; 


//  ==================================================================== 
//  INTERNAL - Write out the Font Table 
//  Also create a table of used rows and rows that have height changed. 
//  Also set the Max Row and Col used for DIMENSION Record 
//  Also create the user defined format strings table 
//  ==================================================================== 

procedure TExcelWorkSheet._SaveFontTable; 
var i,iAttr,iSize, 
    iRow,iIdx : integer; 
    iColor : word; 
    sKey,sName :  string ; 
    oCell : TexcelCell; 
begin 
  FMaxRow : =   0 ; 
  FMaxCol : =   0 ; 
  FFormats.Clear; 
  FUsedRows.Clear; 

   //  Add any new formats - Get Unique Rows Used 
   for  i : =   0  to FCells.Count  -   1   do  begin 
    oCell : =  TExcelCell(FCells.Objects[i]); 
     if  not SameText( ' General ' ,oCell.FormatString) then 
      FFormats.Add(oCell.FormatString); 
    FUsedRows.Add(FormatFloat( ' 00000 ' ,oCell.FRow)); 
    FMaxRow : =  Min(oCell.FRow,$FFFF); 
    FMaxCol : =  Min(oCell.FCol,$FFFF); 
  end; 

   //  Add any custom row heights 
   for  i : =   0  to FRowHeights.Count  -   1   do  begin 
    iRow : =  StrToInt(FRowHeights[i]); 
    sKey : =  FormatFloat( ' 00000 ' ,iRow); 
    iSize : =  word(FRowHeights.Objects[i]); 

     if  FUsedRows.Find(sKey,iIdx) then 
      FUsedRows.Objects[iIdx] : =  TObject(iSize) 
     else  
      FUsedRows.AddObject(sKey,TObject(iSize)); 
  end; 

   //  Write Font Table 
   for  i : =   0  to FFontTable.Count  -   1   do  begin 
    sKey : =  FFontTable[i]; 
    sName : =  copy(sKey, 1 ,pos( ' | ' ,sKey)  -   1 ); 
    sKey : =  copy(sKey,pos( ' | ' ,skey)  +   1 , 2096 ); 
    iSize : =  StrToInt(copy(sKey, 1 ,pos( ' | ' ,sKey)  -   1 )); 
    iAttr : =  StrToInt(copy(sKey,pos( ' | ' ,skey)  +   1 , 2096 )); 
    _WriteFont(sName,iSize,iAttr); 
    _WriteToken(XL_FONTCOLOR, 2 ); 
    iColor : =  word(FFontTable.Objects[i]); 
    Blockwrite(FFile,iColor, 2 ); 
  end; 

end; 


//  ======================================================== 
//  INTERNAL - Write out the default + user format strings 
//  ======================================================== 

procedure TExcelWorkSheet._SaveFormats; 
var i : integer; 
    iLen :  byte ; 
    sFormat :  string ; 
begin 
   //  FFormats already loaded in _SaveFontTable 
  FFormats.Add( ' 0 ' );                      //  Integer Default 
  FFormats.Add( ' ###,###,##0.00 ' );         //  Double Default 
  FFormats.Add( ' dd-mmm-yyyy hh:mm:ss ' );   //  DateTime Default 
  FFormats.Add( ' dd-mmm-yyyy ' );            //  Date Default 
  FFormats.Add( ' hh:mm:ss ' );               //  Time default 

   //  Add General Default index 0 
  sFormat : =   ' General ' ; 
  _WriteToken(XL_FORMAT, 1   +  length(sFormat)); 
  iLen : =  length(sFormat); 
  Blockwrite(FFile,iLen, 1 ); 
  Blockwrite(FFile,sFormat[ 1 ],iLen); 

   for  i : =   0  to FFormats.Count  -   1   do  begin 
    sFormat : =  trim(FFormats[i]); 

     if  not SameText(sFormat, ' General ' ) then begin 
      _WriteToken(XL_FORMAT, 1   +  length(sFormat)); 
      iLen : =  length(sFormat); 
      Blockwrite(FFile,iLen, 1 ); 
      Blockwrite(FFile,sFormat[ 1 ],iLen); 
    end; 
  end; 
end; 


//  ============================================= 
//  INTERNAL - Write out DIMENSION Record 
//  ============================================= 

procedure TExcelWorkSheet._SaveDimensions; 
var aDIMBuffer : array [ 0 .. 3 ] of word; 
begin 
  _WriteToken(XL_DIM, 8 ); 
  aDIMBuffer[ 0 ] : =   0 ; 
  aDIMBuffer[ 1 ] : =  FMaxRow; 
  aDIMBuffer[ 2 ] : =   0 ; 
  aDIMBuffer[ 3 ] : =  FMaxCol; 
  Blockwrite(FFile,aDIMBuffer,SizeOf(aDIMBuffer)); 
end; 


//  ===================================== 
//  INTERNAL - Save Cell Records 
//  ===================================== 

procedure TExcelWorkSheet._SaveCells(ARowFr,ARowTo : word); 
var i,iIdx : integer; 
    iRow,iCol : word; 
    iDataLen,iFmtIdx, 
    iBorders, 
    iShade,iAlign, 
    iFntIdx,iFmtFnt :  byte ; 
    oCell : TExcelCell; 
    dDblData :  double ; 
    sStrData :  string ; 
    aAttributes : array [ 0 .. 2 ] of  byte ; 
begin 
  aAttributes[ 0 ] : =   0 ;   //  No reference to XF 

   for  i : =   0  to FCells.Count  -   1   do  begin 
    oCell : =  TExcelCell(FCells.Objects[i]); 
     //  Row and Col resolve 
    iRow : =  oCell.FRow; 

     if  iRow  >=  ARowFr then begin 
       if  iRow  >  ARowTo then  break ; 
      iCol : =  oCell.FCol; 
       if  iCol  >   255  then iCol : =   255 ; 

       //  Format IDX resolve - set defaults for numerics/dates 
      iFmtIdx : =   0 ; 

       if  SameText( ' General ' ,oCell.FormatString) and 
         (oCell.DataType  <>  xlString) then begin 
       case  oCell.DataType of 
        xlInteger   : oCell.FormatString : =   ' 0 ' ; 
        xlDateTime  : oCell.FormatString : =   ' dd-mmm-yyyy hh:mm:ss ' ; 
        xlTime      : oCell.FormatString : =   ' hh:mm:ss ' ; 
        xlDate      : oCell.FormatString : =   ' dd-mmm-yyyy ' ; 
        xlDouble    : oCell.FormatString : =   ' ###,###,##0.00 ' ; 
        end; 
      end; 

       if  FFormats.Find(oCell.FormatString,iIdx) then begin 
         if  iIdx  >   62  then iIdx : =   62 ; 
        iFmtIdx : =  iIdx  +   1 ; 
      end; 

       //  Font IDX resolve and or with format 
      iFntIdx : =  oCell.FontIndex shl  6 ; 
      iFmtFnt : =  iFmtIdx or iFntIdx; 

       //  Shading and alignment and borders 
      iShade : =   0 ; 
       if  oCell.HasPattern then iShade : =  $ 80 ; 
      iAlign : =   byte (oCell.Align); 
      iBorders : =   0 ; 
       if  xbLeft  in  oCell.BorderStyle then iBorders : =  iBorders or $ 08 ; 
       if  xbRight  in  oCell.BorderStyle then iBorders : =  iBorders or $ 10 ; 
       if  xbTop  in  oCell.BorderStyle then iBorders : =  iBorders or $ 20 ; 
       if  xbBottom  in  oCell.BorderStyle then iBorders : =  iBorders or $ 40 ; 

       //  Resolve Data Type 
       case  oCell.DataType of 
        xlInteger, 
        xlDateTime, 
        xlTime, 
        xlDate, 
        xlDouble  : begin 
                      dDblData : =  oCell.Data; 
                      iDataLen : =  SizeOf( double ); 
                      _WriteToken(XL_DOUBLE, 15 ); 
                      _WriteToken(iRow,iCol); 
                      aAttributes[ 1 ] : =  iFmtFnt; 
                      aAttributes[ 2 ] : =  iAlign or iShade or iBorders; 
                      Blockwrite(FFile,aAttributes,SizeOf(aAttributes)); 
                      Blockwrite(FFile,dDblData,iDatalen); 
                    end; 

        xlString  : begin 
                      sStrData : =  oCell.Data; 
                      iDataLen : =  length(sStrData); 
                      _WriteToken(XL_STRING,iDataLen  +   8 ); 
                      _WriteToken(iRow,iCol); 
                      aAttributes[ 1 ] : =  iFmtFnt; 
                      aAttributes[ 2 ] : =  iAlign or iShade or iBorders; 
                      Blockwrite(FFile,aAttributes,SizeOf(aAttributes)); 
                      Blockwrite(FFile,iDataLen,SizeOf(iDataLen)); 
                       if  iDataLen  >   0  then Blockwrite(FFile,sStrData[ 1 ],iDataLen); 
                    end; 
      end; 
    end; 
  end; 
end; 



//  ======================================================= 
//  INTERNAL - Calulate the size of the cell record + data 
//  ======================================================= 

function TExcelWorkSheet._CalcSize(AIndex : integer) : word; 
var iResult : word; 
    oCell : TExcelCell; 
begin 
  iResult : =   0 ; 
  oCell : =  TExcelCell(FCells.Objects[AIndex]); 

   case  oCell.DataType of 
    xlInteger, 
    xlDateTime, 
    xlTime, 
    xlDate, 
    xlDouble  : iResult : =   19 ; 

    xlString  : iResult : =  length(oCell.Data)  +   12 ; 
  end; 

  Result : =  iResult; 
end; 


//  ================================================================ 
//  INTERNAL - Fint fisrt and last used column ro ROW Record 
//  Only used when writing in RowBlock mode (_SaveRowBlocks) 
//  ================================================================ 

procedure TExcelWorkSheet._SetColIdx(AListIdx : integer; 
                                     ARow : word; 
                                      out  AFirst : word; 
                                      out  ALast : word); 
var sKey :  string ; 
    i,iIdx, 
    iRow : integer; 
    iDataSize : word; 
begin 
  FUsedRows.Objects[AListIdx] : =  nil; 
  iDataSize : =   0 ; 
  iIdx : =   - 1 ; 
  AFirst : =   0 ; 
  ALast : =   0 ; 

   //  Find first row-col combo 
   for  i : =   0  to FCells.Count  -   1   do  begin 
    sKey : =  FCells[i]; 
    iRow : =  StrToInt( ' $ '   +  copy(sKey, 1 , 4 )); 

     if  iRow  =  ARow then begin 
      iIdx : =  i; 
       break ; 
    end; 
  end; 

   //  Found rows? 
   if  iIdx  >=   0  then begin 
    AFirst : =  StrToInt( ' $ '   +  copy(sKey, 5 , 4 )); 
    ALast : =  AFirst; 
    inc(iDataSize,_CalcSize(iIdx)); 
    inc(iIdx); 

     //  Repeat until last row-col 
     if  iIdx  <  FCells.Count then begin 
       while   true   do  begin 
        sKey : =  FCells[iIdx]; 
        iRow : =  StrToInt( ' $ '   +  copy(sKey, 1 , 4 )); 

         if  iRow  =  ARow then begin 
          ALast : =  StrToInt( ' $ '   +  copy(sKey, 5 , 4 )); 
          inc(iDataSize,_CalcSize(iIdx)); 
        end 
         else  
           break ; 

        inc(iIdx); 
         if  iIdx  =  FCells.Count then  break ; 
      end; 
    end; 

    inc(ALast); 
    FUsedRows.Objects[AListIdx] : =  TObject(iDataSize); 
  end; 
end; 

//  ================================================================== 
//  INTERNAL - Write out row/cells in ROWBLOCK format 
//  NOTE : This mode is onley used when at least 1 row has 
//  had it's height set by SetRowHeight(), otherwise _SaveCell() 
//  is run from first to last cells in sheet (faster) 
//  ================================================================== 

procedure TExcelWorkSheet._SaveRowBlocks; 
const  aWINDOW1 : array [ 0 .. 13 ] of  byte   =  ($3d,$ 00 ,$0A,$ 00 ,$ 68 ,$ 01 ,$D2, 
                                          $ 00 ,$DC,$ 41 ,$B8,$ 29 ,$ 00 ,$ 00 ); 
var i,iArrIdx, 
    iIdx,iCount,iLoop : integer; 
    iFirst,iLast,iHeight : word; 
    aAttributes : array [ 0 .. 2 ] of  byte ; 
    aRowRec : array of TRowRec; 
begin 
  aAttributes[ 0 ] : =   0 ;   //  No reference to XF 
  iLoop : =   0 ; 

   //  Process in blocks of 32 rows 
   while   true   do  begin 
    iArrIdx : =   0 ; 

     if  iLoop  +   31   <  FUsedRows.Count  -   1  then begin 
      iCount : =  iLoop  +   31 ; 
      SetLength(aRowRec, 32 ); 
    end 
     else  begin 
      iCount : =  FUsedRows.Count  -   1 ; 
      SetLength(aRowRec,iCount  -  iLoop  +   1 ); 
    end; 

     for  i : =  iLoop to iCount  do  begin 
      aRowRec[iArrIdx].RowIdx : =  StrToInt(FUsedRows[i]); 
      _SetColIdx(i,aRowRec[iArrIdx].RowIdx,iFirst,iLast); 
      aRowRec[iArrIdx].FirstCell : =  iFirst; 
      aRowRec[iArrIdx].LastCell : =  iLast; 
      aRowRec[iArrIdx].Defs : =   0 ; 
      aRowRec[iArrIdx].NotUsed : =   0 ; 
      aRowRec[iArrIdx].Height : =  $80FF; 
      iIdx : =  FRowHeights.IndexOf(IntToStr(aRowRec[iArrIdx].RowIdx)); 

       if  iIdx  <>   - 1  then begin 
        iHeight : =  word(FRowHeights.Objects[iIdx]); 
         if  iHeight  <>   0  then aRowRec[iArrIdx].Height : =  iHeight  *   20 ; 
      end; 

       if  iArrIdx  =   0  then 
        aRowRec[iArrIdx].OSet : =  (iCount  -  iLoop)  *  
                                 (SizeOf(TRowRec)  +   4 ) 
       else  
        aRowRec[iArrIdx].OSet : =  word(FUsedRows.Objects[i  -   1 ]); 

      _WriteToken(XL_ROW,SizeOf(TRowRec)); 
      BlockWrite(FFile,aRowRec[iArrIdx],SizeOf(TRowRec)); 
      inc(iArrIdx); 
    end; 

    _SaveCells(aRowRec[ 0 ].RowIdx,aRowRec[high(aRowRec)].RowIdx); 
    SetLength(aRowRec, 0 ); 
    iLoop : =  iLoop  +  (iCount  -  iLoop  +   1 ); 
     if  iLoop  >=  FUsedRows.Count  -   1  then  break ; 
  end; 

   //  Write WINDOW1 Record 
  BlockWrite(FFile,aWINDOW1,SizeOf(aWINDOW1)); 
end; 


//  ========================================================= 
//  INTERNAL - Write out non-default column widths as 
//  set by ColumnWidth() 
//  ========================================================= 

procedure TExcelWorkSheet._SaveColWidths; 
var i : integer; 
    iCol :  byte ; 
    iWidth : word; 
begin 
   for  i : =   0  to FColWidths.Count  -   1   do  begin 
    iCol : =  StrToInt(FColWidths[i]); 
    iWidth : =   256   *  word(FColWidths.Objects[i]); 
    _WriteToken(XL_COLWIDTH, 4 ); 
    Blockwrite(FFile,iCol, 1 ); 
    Blockwrite(FFile,iCol, 1 ); 
    Blockwrite(FFile,iWidth, 2 ); 
  end; 
end; 


//  ======================================================= 
//  INTERNAL Base Font Setting Method - Default and 1..3 
//  ======================================================= 

procedure TExcelWorkSheet._SetFont(AFontNum :  byte ; 
                                    const  AFontName :  string ; 
                                   AFontSize :  byte ; 
                                   AFontStyle : TFontStyles; 
                                   AFontColor : word); 
var sKey :  string ; 
    iAttr : integer; 
begin 
  iAttr : =   0 ; 
   if  fsBold  in  AFontStyle then iAttr : =  iAttr or  1 ; 
   if  fsItalic  in  AFontStyle then iAttr : =  iAttr or  2 ; 
   if  fsUnderline  in  AFontStyle then iAttr : =  iAttr or  4 ; 
   if  fsStrikeOut  in  AFontStyle then iAttr : =  iAttr or  8 ; 
  sKey : =  trim(AFontName)  +   ' | '   +  IntToStr(AFontSize)  +  
           ' | '   +  IntToStr(iAttr); 
  FFontTable[AFontNum] : =  sKey; 
  FFontTable.Objects[AFontNum] : =  TObject(AFontColor); 
end; 


//  ======================================================= 
//  INTERNAL Base Font Get Info Method - Default and 1..3 
//  ======================================================= 

function TExcelWorkSheet._GetFont(AFontNum :  byte ) : TExcelFont; 
var rResult : TExcelFont; 
    sKey :  string ; 
    iStyle : integer; 
begin 
  rResult.FontStyle : =  []; 
   if  AFontNum  >   3  then AFontNum : =   3 ; 
  sKey : =  FFontTable[AFontNum]; 
  rResult.FontName : =  copy(skey, 1 ,pos( ' | ' ,sKey)  -   1 ); 
  sKey : =  copy(sKey,pos( ' | ' ,skey)  +   1 , 2096 ); 
  rResult.FontSize : =  StrToInt(copy(sKey, 1 ,pos( ' | ' ,sKey)  -   1 )); 
  iStyle : =  StrToInt(copy(sKey,pos( ' | ' ,skey)  +   1 , 2096 )); 
  rResult.FontColor : =  integer(FFontTable.Objects[AFontNum]); 
   if  iStyle and  1   =   1  then include(rResult.FontStyle,fsBold); 
   if  iStyle and  2   =   2  then include(rResult.FontStyle,fsItalic); 
   if  iStyle and  4   =   4  then include(rResult.FontStyle,fsUnderline); 
   if  iStyle and  8   =   8  then include(rResult.FontStyle,fsStrikeOut); 

  Result : =  rResult; 
end; 


//  ===================================== 
//  PUBLIC - Font Setting Methods 
//  ===================================== 

procedure TExcelWorkSheet.SetFont_Default( const  AFontName :  string ; 
                                          AFontSize :  byte   =   10 ; 
                                          AFontStyle : TFontStyles  =  []; 
                                          AFontColor : word  =   0 ); 
begin 
  _SetFont(XL_FONT_DEFAULT,AFontName,AFontSize,AFontStyle,AFontColor); 
end; 


procedure TExcelWorkSheet.SetFont_1( const  AFontName :  string ; 
                                    AFontSize :  byte   =   10 ; 
                                    AFontStyle : TFontStyles  =  []; 
                                    AFontColor : word  =   0 ); 
begin 
  _SetFont(XL_FONT_1,AFontName,AFontSize,AFontStyle,AFontColor); 
end; 

procedure TExcelWorkSheet.SetFont_2( const  AFontName :  string ; 
                                    AFontSize :  byte   =   10 ; 
                                    AFontStyle : TFontStyles  =  []; 
                                    AFontColor : word  =   0 ); 
begin 
  _SetFont(XL_FONT_2,AFontName,AFontSize,AFontStyle,AFontColor); 
end; 

procedure TExcelWorkSheet.SetFont_3( const  AFontName :  string ; 
                                    AFontSize :  byte   =   10 ; 
                                    AFontStyle : TFontStyles  =  []; 
                                    AFontColor : word  =   0 ); 
begin 
  _SetFont(XL_FONT_3,AFontName,AFontSize,AFontStyle,AFontColor); 
end; 


//  ====================================== 
//  PUBLIC - Font Get Information Methods 
//  ====================================== 

function TExcelWorkSheet.GetFont_Default : TExcelFont; 
begin 
  Result : =  _GetFont(XL_FONT_DEFAULT); 
end; 

function TExcelWorkSheet.GetFont_1 : TExcelFont; 
begin 
  Result : =  _GetFont(XL_FONT_1); 
end; 

function TExcelWorkSheet.GetFont_2 : TExcelFont; 
begin 
  Result : =  _GetFont(XL_FONT_2); 
end; 

function TExcelWorkSheet.GetFont_3 : TExcelFont; 
begin 
  Result : =  _GetFont(XL_FONT_3); 
end; 


//  ===================================== 
//  Set a single column width 
//  ===================================== 

procedure TExcelWorkSheet.ColumnWidth(ACol :  byte ; AWidth : word); 
var sKey :  string ; 
    iIdx : integer; 
begin 
  sKey : =  IntToStr(ACol); 
  iIdx : =  FColWidths.IndexOf(sKey); 
   if  AWidth  >   255  then AWidth : =   255 ; 

   if  iIdx  <>   - 1  then 
    FColWidths.Objects[iIdx] : =  TObject(AWidth) 
   else  
    FColWidths.AddObject(sKey,TObject(AWidth)); 
end; 


//  ============================ 
//  Set a single row height 
//  ============================ 

procedure TExcelWorkSheet.RowHeight(ARow : word; AHeight :  byte ); 
var sKey :  string ; 
    iIdx : integer; 
begin 
  sKey : =  IntToStr(ARow); 
  iIdx : =  FRowHeights.IndexOf(sKey); 

   if  iIdx  <>   - 1  then 
    FRowHeights.Objects[iIdx] : =  TObject(AHeight) 
   else  
    FRowHeights.AddObject(sKey,TObject(AHeight)); 
end; 


//  ================================================= 
//  Get a cell info object 
//  NOTE : A reference to the object is returned. 
//         No need for user to FREE the object 
//  ================================================= 

function TExcelWorkSheet.GetCell(ACol,ARow :word) : TExcelCell; 
var oResult : TExcelCell; 
    sKey :  string ; 
    iIndex : integer; 
begin 
  sKey : =  IntToHex(ARow, 4 )  +  IntToHex(ACol, 4 ); 

   //  Existing ? 
   if  FCells.Find(sKey,iIndex) then 
    oResult : =  TExcelCell(FCells.Objects[iIndex]) 
   else  
    oResult : =  nil; 

  Result : =  oResult; 
end; 

//  ==================================================== 
//  Add or replace a cell in the worksheet 
//  NOTE : A reference to the object is returned. 
//         No need for user to FREE the object 
//  ==================================================== 

function TExcelWorkSheet.NewCell(ACol,ARow :word) : TExcelCell; 
var oResult : TExcelCell; 
    sKey :  string ; 
    iIndex : integer; 
begin 
  oResult : =  TExcelCell.Create; 
  oResult.FRow : =  ARow; 
  oResult.FCol : =  ACol; 
   if  ACol  >   255  then oResult.FCol : =   255 ; 
  sKey : =  IntToHex(ARow, 4 )  +  IntToHex(ACol, 4 ); 

   //  Existing ? 
   if  FCells.Find(sKey,iIndex) then begin 
    TExcelCell(FCells.Objects[iIndex]).Free; 
    FCells.Objects[iIndex] : =  oResult; 
  end 
   else  
    FCells.AddObject(sKey,oResult); 

  Result : =  oResult; 
end; 


//  ========================================= 
//  Blanks out a cell in the worksheet 
//  ========================================= 

procedure TExcelWorkSheet.BlankCell(ACol,ARow :word); 
var sKey :  string ; 
    iIndex : integer; 
begin 
  sKey : =  IntToHex(ARow, 4 )  +  IntToHex(ACol, 4 ); 

   //  Existing ? 
   if  FCells.Find(sKey,iIndex) then begin 
    TExcelCell(FCells.Objects[iIndex]).Free; 
    FCells.Delete(iIndex); 
  end; 
end; 

//  =========================================== 
//  Procedural way to add or change a cell 
//  =========================================== 

procedure TExcelWorkSheet.SetCell(ACol,ARow : word; 
                                  ADataType : TExcelDataType; 
                                  AData : Olevariant; 
                                  AFontIndex :  byte   =   0 ; 
                                  AFormatString :  string   =   ' General ' ; 
                                  AAlign : TExcelCellAlign  =  xalGeneral; 
                                  AHasPattern : boolean  =   false ; 
                                  ABorderStyle : TExcelBorders  =  []); 
var oCell : TExcelCell; 
    sKey :  string ; 
    iIndex : integer; 
begin 
  oCell : =  TExcelCell.Create; 
  oCell.FRow : =  ARow; 
  oCell.FCol : =  ACol; 
   if  ACol  >   255  then ACol : =   255 ; 
  oCell.DataType : =  ADataType; 
  oCell.Data : =  AData; 
  oCell.FontIndex : =  AFontIndex; 
   if  AFontIndex  >   3  then oCell.FontIndex : =   3 ; 

  oCell.FormatString : =  AFormatString; 
  oCell.Align : =  AAlign; 
  oCell.HasPattern : =  AHasPattern; 
  oCell.BorderStyle : =  ABorderStyle; 
  sKey : =  IntToHex(ARow, 4 )  +  IntToHex(ACol, 4 ); 

   //  Existing ? 
   if  FCells.Find(sKey,iIndex) then begin 
    TExcelCell(FCells.Objects[iIndex]).Free; 
    FCells.Objects[iIndex] : =  oCell; 
  end 
   else  
    FCells.AddObject(sKey,oCell); 
end; 

//  ==================================== 
//  Save Worksheet as an XLS file 
//  ==================================== 

procedure TExcelWorkSheet.SaveToFile( const  AFileName :  string ); 
var aWord : array [ 0 .. 1 ] of word; 
begin 
  AssignFile(FFile,ChangeFileExt(AFileName, ' .xls ' )); 
  Rewrite(FFile, 1 ); 

   //  BOF 
  _WriteToken(XL_BOF, 4 ); 
  aWord[ 0 ] : =   0 ; 
  aWord[ 1 ] : =  XL_DOCUMENT; 
  Blockwrite(FFile,aWord,SizeOf(aWord)); 

   //  FONT 
  _SaveFontTable; 

   //  COLWIDTH 
  _SaveColWidths; 

   //  COLFORMATS 
  _SaveFormats; 

   //  DIMENSIONS 
  _SaveDimensions; 

   //  CELLS 
   if  FRowHeights.Count  >   0  then 
    _SaveRowBlocks           //  Slower 
   else  
    _SaveCells( 0 ,$FFFF);     //  Faster 

   //  EOF 
  _WriteToken(XL_EOF, 0 ); 
  CloseFile(FFile); 
end; 

end.