//首先感谢原作者但当初在csdn上搜索到该单元时就没原作者信息(里有些乱码注释应该是原作者留下吧？呵呵)
//有不足地方还请各位看官多多指点哈 ^_^

(* Mody By 角落青苔@2005/05/13
介绍说明:增加导出过程中回调功能(用户停止进度条)
是否在第行插入FieldName
改错:以前只能对word类型数值写入DWord会Range Check error；已修正见CellInteger
//这个单元原来Col和Row刚好弄反了(已修正):-(
增加导出分页功能xls单页不能超过 65536 行(采用笨办法不知谁有好点思路方法吗？比如直接写标记表示分页？)
*)

unit UnitXLSFile;

erface

uses
Windows, Messages, Variants, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DB,DBGrids, OleServer, Excel2000;

const _MSG_XLSWriterIsRuning=\'有其它任务正在导出数据暂时不能执行该操作请稍后重试！\';
type
TUserCommand=(UserStop, UserNeedSave, UserNotSave, UserSkip, UserDoNothing);
TExportXls_CallBackProc = procedure(iPos:Real) of object;

TAtributCell = (acHidden,acLocked,acShaded,acBottomBorder,acTopBorder,
acRightBorder,acLeftBorder,acLeft,acCenter,acRight,acFill);

TSetOfAtribut = of TatributCell;

TXLSWriter = (TObject)
private
fstream:TFileStream;
procedure WriteWord(w:word);
procedure SetCellAtribut(value:TSetOfAtribut;var FAtribut:.gif' /> of );
protected
procedure WriteBOF;
procedure WriteEOF;
procedure WriteDimension;
public
maxCols,maxRows:Word;
//add by 角落青苔@2005/05/18
procedure CellInteger(vRow,vCol:word;aValue:Integer;vAtribut:TSetOfAtribut=);
procedure CellDouble(vRow,vCol:word;aValue:double;vAtribut:TSetOfAtribut=);
procedure CellStr(vRow,vCol:word;aValue:String;vAtribut:TSetOfAtribut=);
procedure WriteField(vRow,vCol:word;Field:TField);
constructor Create(vFileName:;const vMaxCols:Integer=100;const vMaxRows:Integer=65534);
destructor Destroy;override;
end;

procedure DataSetToXLS(ds:TDataSet;fname:String);
//Add By 角落青苔@2005/05/13 //只能导出最多65536条记录
procedure DBGridToXLS(Grid:TDBGrid;fname:String; bSetFieldName:Boolean;CallFunc:TExportXls_CallBackProc; bAskForStop:Boolean=True );
//Add By 角落青苔@2005/05/19
//突破xls单页65536行限制把数据分成数页
function DBGridToXlsEx(Grid:TDBGrid;fname:String; bSetFieldName:Boolean;CallFunc:TExportXls_CallBackProc;const bAskForStop:Boolean=True; const bNeedUnite:Boolean=True ):Integer;
//将数个XLS合并成个(分页)必须保证Path最后无\'\\\'或\'/\'实际已经做成线程以免无响应
procedure UniteSeveralXLSToOne(const TmpFlag, Path, FileName : String;const iStart, iEnd : Integer);
//procedure StringGridToXLS(grid:TStringGrid;fname:String);

var
G_UserCmd:TUserCommand;
G_XLSWriterIsRuning : Boolean; //是否有XLSWriter例子在运行G_UserCmd是全局变量防止被非法刷新
implementation

const
{BOF}
CBOF = $0009;
BIT_BIFF5 = $0800;
BOF_BIFF5 = CBOF or BIT_BIFF5;
{EOF}
BIFF_EOF = $000a;
{Document types}
DOCTYPE_XLS = $0010;
{Dimensions}
DIMENSIONS = $0000;

var
CXlsBof: .gif' />[0..5] of Word = ($809, 8, 0, $10, 0, 0);
CXlsEof: .gif' />[0..1] of Word = ($0A, 00);
CXlsLabel: .gif' />[0..5] of Word = ($204, 0, 0, 0, 0, 0);
CXlsNumber: .gif' />[0..4] of Word = ($203, 14, 0, 0, 0);
CXlsRk: .gif' />[0..4] of Word = ($27E, 10, 0, 0, 0);
CXlsBlank: .gif' />[0..4] of Word = ($201, 6, 0, 0, $17);
type
//合并数个Xls为个多页面xls线程
TUniteSeveralXLSToOneThread = (TThread)
private
TmpFlag : String;
Path : String;
FileName : String;
iStart : Integer;
iEnd : Integer;
protected
mCompleted : Boolean;
procedure Execute; override;
public
constructor Create(const _TmpFlag, _Path, _FileName:String;const _iStart, _iEnd : Integer);
destructor Destroy; override;
end;

//根据StrFlags在FullStr最后出现位置将FullStr分割成两部分取得两部分均不包含StrFlags
procedure SplitStrToTwoPartByLastFlag(const FullStr,StrFlags:String;var strLeft,strRight:String);
var iPos:Integer;
begin
iPos := LastDelimiter(StrFlags,FullStr);
strLeft := Copy(FullStr, 1, iPos-1);


strRight := Copy(FullStr, iPos+1, Length(FullStr)-iPos);
end;

constructor TUniteSeveralXLSToOneThread.Create(const _TmpFlag, _Path, _FileName:String;const _iStart, _iEnd : Integer);
begin
inherited Create(True);
TmpFlag := _TmpFlag;
Path := _Path;
FileName := _FileName;
iStart := _iStart;
iEnd := _iEnd;
mCompleted := False;
Resume;
end;

destructor TUniteSeveralXLSToOneThread.Destroy;
begin
inherited;
end;

procedure TUniteSeveralXLSToOneThread.Execute;
const
_HeadLetterOfXls:Array [1..52]of String //注意这里只定义了52列需要增加就自己动手最多256列
= (\'A\',\'B\',\'C\',\'D\',\'E\',\'F\',\'G\',\'H\',\'I\',\'J\',\'K\',\'L\',\'M\',
\'N\',\'O\',\'P\',\'Q\',\'R\',\'S\',\'T\',\'U\',\'V\',\'W\',\'X\',\'Y\',\'Z\',
\'AA\',\'AB\',\'AC\',\'AD\',\'AE\',\'AF\',\'AG\',\'AH\',\'AI\',\'AJ\',\'AK\',\'AL\',\'AM\',
\'AN\',\'AO\',\'AP\',\'AQ\',\'AR\',\'AS\',\'AT\',\'AU\',\'AV\',\'AW\',\'AX\',\'AY\',\'AZ\');
_XlsResCaption= \'FKULWJS_SKSLA_892x_RES\';
_XlsTmpCaption= \'FKULWJS_SKSLA_892x_TMP\';
var
XlsAppRes, XlsAppTmp: TExcelApplication;
wkBookRes, wkBookTmp : _WorkBook;
wkSheetRes, wkSheetTmp : _WorkSheet;
LCID_Res, LCID_Tmp:Integer;
Pos_LeftTop, Pos_RightBottom : String; //Xls中左上、右下位置
XlsAppHwnd:THandle;
bDontSave : Boolean;
i : Integer;

StrName,StrExt:String; //文件名及扩展名
begin
FreeOnTerminate := True;
Terminated then Exit;
SplitStrToTwoPartByLastFlag(FileName, \'.\', StrName, StrExt);
try
Screen.Cursor := crHourGlass;
bDontSave := False;
XlsAppRes := TExcelApplication.Create(Nil);
with XlsAppRes do
begin
Connect;
Visible[0]:=False;
LCID_Res:=GetUserDefaultLCID;
DisplayAlerts[LCID_Res]:=False;
Caption:=_XlsResCaption;
wkBookRes:=WorkBooks.Add(EmptyParam,LCID_Res);
end;
XlsAppTmp := TExcelApplication.Create(Nil);
with XlsAppTmp do
begin
Connect;
Visible[0]:=False;
LCID_Tmp :=GetUserDefaultLCID;
DisplayAlerts[LCID_Tmp]:=False;
Caption:=_XlsTmpCaption;
end;
for i:=iStart to iEnd do
begin
i<=3 then wkSheetRes:=wkBookRes.Sheets[i] as _WorkSheet

begin
wkBookRes.Sheets.Add(EmptyParam, wkSheetRes, 1, EmptyParam, LCID_Res);
wkSheetRes := wkBookRes.Sheets[i] as _WorkSheet;
end;
wkBookTmp:= XlsAppTmp.WorkBooks.Open(Path+\'\\\'+TmpFlag+IntToStr(i)+FileName, EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,LCID_Tmp);
Pos_LeftTop := \'A1\';
wkSheetTmp := XlsAppTmp.ActiveSheet as _WorkSheet;
Pos_RightBottom := _HeadLetterOfXls[wkSheetTmp.UsedRange[LCID_Tmp].Columns.Count]+IntToStr(wkSheetTmp.UsedRange[LCID_Tmp].Rows.Count);
XlsAppTmp.Range[Pos_LeftTop, Pos_RightBottom].Copy(EmptyParam);
wkSheetRes.Activate(LCID_Res);
wkSheetRes.Range[Pos_LeftTop, Pos_RightBottom].Select;
wkSheetRes.Paste(EmptyParam, EmptyParam, LCID_Res);
wkSheetRes.Columns.AutoFit;
wkSheetRes.Range[\'A1\',\'A1\'].Select;
wkSheetRes.Name := StrName+\'_\'+IntToStr(i);


end;
finally
try
(wkBookRes.Sheets[1] as _WorkSheet).Activate(LCID_Res);
wkBookRes.Close(Not(bDontSave) ,Path+\'\\\'+FileName,EmptyParam,LCID_Res);
XlsAppRes.Quit;
XlsAppRes.Disconnect;
finally
//杀死未关闭Excel进程
XlsAppHwnd := FindWindow( Nil,_XlsResCaption );
XlsAppHwnd<>0 then SendMessage( XlsAppHwnd, WM_CLOSE, 0, 0);
end;
try
//wkBookTmp.Close(False ,Path+\'\\\'+TmpFlag+IntToStr(i)+FileName,EmptyParam,LCID_Tmp);
XlsAppTmp.Quit;
XlsAppTmp.Disconnect;
finally
XlsAppHwnd := FindWindow( Nil,_XlsTmpCaption );
XlsAppHwnd<>0 then SendMessage( XlsAppHwnd, WM_CLOSE, 0, 0);
//TerminateProcess(XlsAppHwnd,0);
end;
mCompleted := True;
Screen.Cursor := crDefault;
end;
end;

procedure DataSetToXLS(ds:TDataSet;fname:String);
var c,r:Integer;
xls:TXLSWriter;
begin
xls:=TXLSWriter.create(fname);
ds.FieldCount > xls.maxcols then
xls.maxcols:=ds.fieldcount+1;
try
xls.writeBOF;
xls.WriteDimension;
for c:=0 to ds.FieldCount-1 do
xls.Cellstr(0,c,ds.Fields[c].DisplayLabel);
r:=1;
ds.first;
while (not ds.eof) and (r <= xls.maxrows) do begin
for c:=0 to ds.FieldCount-1 do
ds.Fields[c].AsString<>\'\' then
xls.WriteField(r,c,ds.Fields[c]);
inc(r);
ds.next;
end;
xls.writeEOF;
finally
xls.free;
end;
end;

procedure DBGridToXLS(Grid:TDBGrid;fname:String; bSetFieldName:Boolean;CallFunc:TExportXls_CallBackProc; bAskForStop:Boolean=True);
var c,r,i :Integer;
xls:TXLSWriter;
nTotalCount, nCurrentCount : Integer;
bDontSave:Boolean;
begin
bDontSave := False;
Grid.DataSource.DataSet.DisableControls;
xls:=TXLSWriter.create(fname);
Grid.FieldCount > xls.maxcols then
xls.maxcols:=Grid.fieldcount+1;
try
G_XLSWriterIsRuning := True;
xls.writeBOF;
xls.WriteDimension;
bSetFieldName then
begin
for c:=0 to Grid.FieldCount-1 do
xls.Cellstr(0,c,Grid.Fields[c].FieldName);
r :=2;
end
r:=1;
for c:=0 to Grid.FieldCount-1 do
xls.Cellstr(r-1,c,Grid.Fields[c].DisplayLabel);
nTotalCount := Grid.DataSource.DataSet.RecordCount;
nCurrentCount := 0;
bDontSave := False;
Grid.DataSource.DataSet.First;
for i:=0 to nTotalCount-1 do
begin
Application.ProcessMessages;
r > xls.maxrows then Raise Exception.Create(\'导出数据超过\'+IntToStr(xls.maxrows)+\'条记录操作失败！\');
Inc(nCurrentCount);
CallFunc(nCurrentCount/nTotalCount);
G_UserCmd=UserStop then
begin
bAskForStop then
Application.MessageBox(\'您停止了导出数据请问需要保存吗？(选择“取消”继续导出)\',\'询问\',MB_YESNOCANCEL) of
IDYES: Break;
IDNO: begin
bDontSave := True;
Raise Exception.Create(\'用户停止导出数据未保存！\');
end;
IDCANCEL: G_UserCmd := UserDoNothing;


end
begin bDontSave := True; Raise Exception.Create(\'用户停止导出数据未保存！\'); end;
end;
for c:=0 to Grid.FieldCount-1 do
(Grid.Fields[c].AsString<>\'\') then
xls.WriteField(r,c,Grid.Fields[c]);
inc(r);
Grid.DataSource.DataSet.Next;
end;
finally
xls.writeEOF;
xls.free;
bDontSave then DeleteFile(fname);
Grid.DataSource.DataSet.EnableControls;
G_XLSWriterIsRuning := False;
end;
end;

//将数个XLS合并成个(分页)
procedure UniteSeveralXLSToOne(const TmpFlag, Path, FileName : String;const iStart, iEnd : Integer);
const
_HeadLetterOfXls:Array [1..52]of String
= (\'A\',\'B\',\'C\',\'D\',\'E\',\'F\',\'G\',\'H\',\'I\',\'J\',\'K\',\'L\',\'M\',
\'N\',\'O\',\'P\',\'Q\',\'R\',\'S\',\'T\',\'U\',\'V\',\'W\',\'X\',\'Y\',\'Z\',
\'AA\',\'AB\',\'AC\',\'AD\',\'AE\',\'AF\',\'AG\',\'AH\',\'AI\',\'AJ\',\'AK\',\'AL\',\'AM\',
\'AN\',\'AO\',\'AP\',\'AQ\',\'AR\',\'AS\',\'AT\',\'AU\',\'AV\',\'AW\',\'AX\',\'AY\',\'AZ\');
_XlsResCaption= \'FKULWJS_SKSLA_892x_RES\';
_XlsTmpCaption= \'FKULWJS_SKSLA_892x_TMP\';
var
XlsAppRes, XlsAppTmp: TExcelApplication;
wkBookRes, wkBookTmp : _WorkBook;
wkSheetRes, wkSheetTmp : _WorkSheet;
LCID_Res, LCID_Tmp:Integer;
Pos_LeftTop, Pos_RightBottom : String; //Xls中左上、右下位置
XlsAppHwnd:THandle;
bDontSave : Boolean;
i : Integer;

StrName,StrExt:String; //文件名及扩展名
begin
SplitStrToTwoPartByLastFlag(FileName, \'.\', StrName, StrExt);
try
bDontSave := False;
XlsAppRes := TExcelApplication.Create(Nil);
with XlsAppRes do
begin
Connect;
Visible[0]:=False;
LCID_Res:=GetUserDefaultLCID;
DisplayAlerts[LCID_Res]:=False;
Caption:=_XlsResCaption;
wkBookRes:=WorkBooks.Add(EmptyParam,LCID_Res);
end;
XlsAppTmp := TExcelApplication.Create(Nil);
with XlsAppTmp do
begin
Connect;
Visible[0]:=False;
LCID_Tmp :=GetUserDefaultLCID;
DisplayAlerts[LCID_Tmp]:=False;
Caption:=_XlsTmpCaption;
end;
for i:=iStart to iEnd do
begin
i<=3 then wkSheetRes:=wkBookRes.Sheets[i] as _WorkSheet

begin
wkBookRes.Sheets.Add(EmptyParam, wkSheetRes, 1, EmptyParam, LCID_Res);
wkSheetRes := wkBookRes.Sheets[i] as _WorkSheet;
end;
wkBookTmp:= XlsAppTmp.WorkBooks.Open(Path+\'\\\'+TmpFlag+IntToStr(i)+FileName, EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,LCID_Tmp);
Pos_LeftTop := \'A1\';
wkSheetTmp := XlsAppTmp.ActiveSheet as _WorkSheet;
Pos_RightBottom := _HeadLetterOfXls[wkSheetTmp.UsedRange[LCID_Tmp].Columns.Count]+IntToStr(wkSheetTmp.UsedRange[LCID_Tmp].Rows.Count);
XlsAppTmp.Range[Pos_LeftTop, Pos_RightBottom].Copy(EmptyParam);
wkSheetRes.Activate(LCID_Res);
wkSheetRes.Range[Pos_LeftTop, Pos_RightBottom].Select;
wkSheetRes.Paste(EmptyParam, EmptyParam, LCID_Res);


wkSheetRes.Columns.AutoFit;
wkSheetRes.Range[\'A1\',\'A1\'].Select;
wkSheetRes.Name := StrName+\'__\'+IntToStr(i);
end;
finally
try
(wkBookRes.Sheets[1] as _WorkSheet).Activate(LCID_Res);
wkBookRes.Close(Not(bDontSave) ,Path+\'\\\'+FileName,EmptyParam,LCID_Res);
XlsAppRes.Quit;
XlsAppRes.Disconnect;
finally
//杀死未关闭Excel进程
XlsAppHwnd := FindWindow( Nil,_XlsResCaption );
XlsAppHwnd<>0 then SendMessage( XlsAppHwnd, WM_CLOSE, 0, 0);
end;
try
//wkBookTmp.Saved[LCID_Tmp]:=True;
XlsAppTmp.Quit;
XlsAppTmp.Disconnect;
finally
XlsAppHwnd := FindWindow( Nil,_XlsTmpCaption );
XlsAppHwnd<>0 then SendMessage( XlsAppHwnd, WM_CLOSE, 0, 0);
end;
end;
end;

function DBGridToXlsEx(Grid:TDBGrid;fname:String; bSetFieldName:Boolean;CallFunc:TExportXls_CallBackProc;const bAskForStop:Boolean; const bNeedUnite:Boolean ):Integer;
var
c,r,i :Integer;
xls:TXLSWriter;
nTotalCount, nCurrentCount : Integer;
bDontSave:Boolean;
nOneSheetMaxRecord : Integer;
Path, FileName, tmpFile:String;
bNotEof : Boolean;
begin
G_XLSWriterIsRuning := True;
Result := 0;
bDontSave := False;
nTotalCount := Grid.DataSource.DataSet.RecordCount;
nCurrentCount := 0;
SplitStrToTwoPartByLastFlag(fname,\'\\/\',Path,FileName);
Grid.DataSource.DataSet.DisableControls;
bNotEof := True;
try
while bNotEof do
begin
Inc(Result);
tmpFile := Path+\'\\$$$\'+IntToStr(Result)+FileName;
DeleteFile(tmpFile);
xls:=TXLSWriter.Create(tmpFile,Grid.FieldCount+1, 65530 ); //65530
Grid.FieldCount > xls.maxCols then
xls.maxCols := Grid.FieldCount+1;
try
xls.WriteBOF;
xls.WriteDimension;
bSetFieldName then
begin
for c:=0 to Grid.FieldCount-1 do
xls.Cellstr(0,c,Grid.Fields[c].FieldName);
r :=2;
end
r:=1;
for c:=0 to Grid.FieldCount-1 do
xls.Cellstr(r-1,c,Grid.Fields[c].DisplayLabel);

Grid.DataSource.DataSet.First;
Grid.DataSource.DataSet.MoveBy(nCurrentCount);
nTotalCount-nCurrentCount>xls.maxrows then nOneSheetMaxRecord := xls.maxRows
nOneSheetMaxRecord := nTotalCount-nCurrentCount;
for i:=0 to nOneSheetMaxRecord-1 do
begin
Application.ProcessMessages;
Inc(nCurrentCount);
CallFunc(nCurrentCount/nTotalCount);
G_UserCmd=UserStop then
begin
bAskForStop then
Application.MessageBox(\'您停止了导出数据请问需要保存吗？(选择“取消”继续导出)\',\'询问\',MB_YESNOCANCEL) of
IDYES:begin
G_UserCmd := UserNeedSave;
Break;


end;
IDNO: begin
G_UserCmd := UserNotSave;
bDontSave := True;
Raise Exception.Create(\'用户停止导出数据未保存！\');
end;
IDCANCEL: G_UserCmd := UserDoNothing;
end
begin bDontSave := True; Raise Exception.Create(\'用户停止导出数据未保存！\'); end;
end;
for c:=0 to Grid.FieldCount-1 do
(Grid.Fields[c].AsString<>\'\') then
xls.WriteField(r,c,Grid.Fields[c]);
inc(r);
Grid.DataSource.DataSet.Next;
end;
xls.writeEOF;
finally
xls.Free;
end;
bNotEof := (Not Grid.DataSource.DataSet.Eof) and (G_UserCmd = UserDoNothing);
end; //Not Grid.DataSource.DataSet.Eof
finally
bDontSave then
for i:=1 to Result do DeleteFile(Path+\'\\$$$\'+IntToStr(i)+FileName);
Grid.DataSource.DataSet.EnableControls;
end;
bNeedUnite and (Not bDontSave) then
begin
Result=1 then
begin
DeleteFile(fname);
RenameFile(tmpFile, fname)
end

begin
with TUniteSeveralXLSToOneThread.Create(\'$$$\', Path, FileName, 1, Result) do
begin
while Not mCompleted do
begin
Application.ProcessMessages;
Sleep(0);
end;
end;
for i:=1 to Result do DeleteFile(Path+\'\\$$$\'+IntToStr(i)+FileName);
end;
end;
G_XLSWriterIsRuning := False;
end;
(*
procedure StringGridToXLS(grid:TStringGrid;fname:String);
var c,r,rMax:Integer;
xls:TXLSWriter;
begin
xls:=TXLSWriter.create(fname);
rMax:=grid.RowCount;
grid.ColCount > xls.maxcols then
xls.maxcols:=grid.ColCount+1;
rMax > xls.maxrows then // &brvbar;&sup1;&reg;&aelig;&brvbar;&iexcl;&sup3;&Igrave;&brvbar;h&yen;u&macr;à&brvbar;s 65535 Rows
rMax:=xls.maxrows;
try
xls.writeBOF;
xls.WriteDimension;
for c:=0 to grid.ColCount-1 do
for r:=0 to rMax-1 do
xls.Cellstr(r,c,grid.Cells[c,r]);
xls.writeEOF;
finally
xls.free;
end;
end;
*)
{ TXLSWriter }

constructor TXLSWriter.Create(vFileName:;const vMaxCols, vMaxRows:Integer);
begin
inherited create;
FileExists(vFilename) then
fStream:=TFileStream.Create(vFilename,fmOpenWrite)

fStream:=TFileStream.Create(vFilename,fmCreate);
vMaxCols<100 then maxCols := vMaxCols //mody by 角落青苔@2005/05/19
maxCols := 100;
vMaxCols<65535 then maxRows := vMaxRows
maxRows := 65535;
//maxCols:=100; // <2002-11-17> dllee Column &Agrave;&sup3;&cedil;&Oacute;&not;O¤&pound;&yen;i&macr;à¤j&copy;ó 65535, &copy;&Ograve;&yen;H¤&pound;&brvbar;A&sup3;B&sup2;z


//maxRows:=65530;//65535; // <2002-11-17> dllee &sup3;o&shy;&Oacute;&reg;&aelig;&brvbar;&iexcl;&sup3;&Igrave;¤j&yen;u&macr;à&sup3;o&raquo;ò¤j&iexcl;A&frac12;&ETH;&ordf;`·N¤j&ordf;&ordm;&cedil;ê&reg;&AElig;&reg;w&laquo;&Uuml;&reg;e&copy;&ouml;&acute;N¤j&copy;ó&sup3;o&shy;&Oacute;&shy;&Egrave;
end;

destructor TXLSWriter.Destroy;
begin
fStream <> nil then
fStream.free;
inherited;
end;

procedure StreamWriteWordArray(Stream: TStream; wr: .gif' /> of Word);
var
i: Integer;
begin
for i := 0 to Length(wr)-1 do
{$IFDEF CIL}
Stream.Write(wr[i]);
{$ELSE}
Stream.Write(wr[i], SizeOf(wr[i]));
{$ENDIF}
end;

procedure StreamWriteAnsiString(Stream: TStream; S: String);
{$IFDEF CIL}
var
b: TBytes;
{$ENDIF}
begin
{$IFDEF CIL}
b := BytesOf(AnsiString(S));
Stream.Write(b, Length(b));
{$ELSE}
Stream.Write(PChar(S)^, Length(S));
{$ENDIF}
end;

procedure TXLSWriter.WriteBOF;
begin
Writeword(BOF_BIFF5);
Writeword(6); // count of s
Writeword(0);
Writeword(DOCTYPE_XLS);
Writeword(0);
end;

procedure TXLSWriter.WriteDimension;
begin
Writeword(DIMENSIONS); // dimension OP Code
Writeword(8); // count of s
Writeword(0); // min cols
Writeword(maxRows); // max rows
Writeword(0); // min rowss
Writeword(maxcols); // max cols
end;

procedure TXLSWriter.CellDouble(vRow, vCol: word; aValue: double;
vAtribut: TSetOfAtribut);
//var FAtribut:.gif' /> [0..2] of ;
begin
CXlsNumber[2] := vRow;
CXlsNumber[3] := vCol;
StreamWriteWordArray(fStream, CXlsNumber);
//SetCellAtribut(vAtribut,fAtribut);
//fStream.Write(fAtribut,3);
fStream.WriteBuffer(aValue, 8);
end;

procedure TXLSWriter.CellInteger(vRow,vCol:word;aValue:Integer;vAtribut:TSetOfAtribut=);
var V:Integer;
begin
CXlsRk[2] := vRow;
CXlsRk[3] := vCol;
StreamWriteWordArray(fStream, CXlsRk);
V := (aValue shl 2) or 2;
fStream.WriteBuffer(V, 4);
end;

procedure TXLSWriter.CellStr(vRow, vCol: word; aValue: String;
vAtribut: TSetOfAtribut);
var slen:Word;
begin
slen := Length(aValue);
CXlsLabel[1] := 8 + slen;
CXlsLabel[2] := vRow;
CXlsLabel[3] := vCol;
//SetCellAtribut(vAtribut, CXlsLabel[4]);
CXlsLabel[5] := slen;
StreamWriteWordArray(fStream, CXlsLabel);
StreamWriteAnsiString(fStream, aValue);
end;

procedure TXLSWriter.SetCellAtribut(value:TSetOfAtribut;var FAtribut:.gif' /> of );
var
i:eger;
begin
//re
for i:=0 to High(FAtribut) do
FAtribut[i]:=0;


acHidden in value then // 0 bit 7:
FAtribut[0] := FAtribut[0] + 128;

acLocked in value then // 0 bit 6:
FAtribut[0] := FAtribut[0] + 64 ;

acShaded in value then // 2 bit 7:
FAtribut[2] := FAtribut[2] + 128;

acBottomBorder in value then // 2 bit 6
FAtribut[2] := FAtribut[2] + 64 ;

acTopBorder in value then // 2 bit 5
FAtribut[2] := FAtribut[2] + 32;

acRightBorder in value then // 2 bit 4
FAtribut[2] := FAtribut[2] + 16;

acLeftBorder in value then // 2 bit 3
FAtribut[2] := FAtribut[2] + 8;

// <2002-11-17> dllee &sup3;&Igrave;&laquo;á 3 bit &Agrave;&sup3;&yen;u&brvbar;&sup3; 1 &ordm;&Oslash;&iquest;&iuml;&frac34;&Uuml;
acLeft in value then // 2 bit 1


FAtribut[2] := FAtribut[2] + 1
acCenter in value then // 2 bit 1
FAtribut[2] := FAtribut[2] + 2
acRight in value then // 2, bit 0 dan bit 1
FAtribut[2] := FAtribut[2] + 3
acFill in value then // 2, bit 0
FAtribut[2] := FAtribut[2] + 4;
end;

procedure TXLSWriter.WriteWord(w: word);
begin
fstream.Write(w,2);
end;

procedure TXLSWriter.WriteEOF;
begin
Writeword(BIFF_EOF);
Writeword(0);
end;

procedure TXLSWriter.WriteField(vRow, vCol: word; Field: TField);
begin
field.DataType of
ftString,ftWideString,ftBoolean,ftDate,ftDateTime,ftTime:
Cellstr(vRow,vCol,field.as);
ftSmall, ftInteger, ftWord, ftAutoInc, ftBytes:
CellInteger(vRow,vCol,field.AsInteger);
ftFloat, ftBCD:
CellDouble(vRow,vCol,field.AsFloat);

Cellstr(vRow,vCol,EmptyStr); // <2002-11-17> dllee ¨&auml;&yen;L&laquo;&not;&ordm;A&frac14;g¤J&ordf;&Aring;&yen;&Otilde;&brvbar;r&brvbar;ê
end;
end;

initialization
G_XLSWriterIsRuning := False;

end.