修改的一个导出DataSet到xls的单元

//首先感谢原作者，但当初在csdn上搜索到该单元时，就没原作者的信息（程序里的有些乱码的注释应该是原作者留下的吧？呵呵）

//有不足的地方还请各位看官多多指点哈 ^_^

(* Modify By 角落的青苔@2005/05/13

说明：增加导出过程中的回调功能（用户停止，进度条）

是否在第一行插入FieldName

改错：以前只能对word类型数值写入，DWord会Range Check error；已修正，见CellInteger

//这个单元原来的Col和Row刚好弄反了(已修正):-(

增加导出分页的功能，因为xls单页不能超过 65536 行（采用的笨办法，不知谁有好一点的方法吗？比如直接写标记表示分页？）

unit UnitXLSFile;

interface

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 = set of TatributCell;

TXLSWriter = class(TObject)

private

fstream:TFileStream;

procedure WriteWord(w:word);

procedure SetCellAtribut(value:TSetOfAtribut;var FAtribut:array of byte);

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:string;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: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);

CXlsEof: array[0..1] of Word = ($0A, 00);

CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);

CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);

CXlsRk: array[0..4] of Word = ($27E, 10, 0, 0, 0);

CXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);

type

//合并数个Xls为一个多页面xls的线程

TUniteSeveralXLSToOneThread = class(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;

if 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

if i<=3 then wkSheetRes:=wkBookRes.Sheets[i] as _WorkSheet

else

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,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 );

if 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 );

if XlsAppHwnd<>0 then SendMessage( XlsAppHwnd, WM_CLOSE, 0, 0);

//TerminateProcess(XlsAppHwnd,0);

end;

mCompleted := True;

Screen.Cursor := crDefault;

end;

procedure DataSetToXLS(ds:TDataSet;fname:String);

var c,r:Integer;

xls:TXLSWriter;

begin

xls:=TXLSWriter.create(fname);

if 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

if ds.Fields[c].AsString<>'' then

xls.WriteField(r,c,ds.Fields[c]);

inc(r);

ds.next;

end;

xls.writeEOF;

finally

xls.free;

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);

if Grid.FieldCount > xls.maxcols then

xls.maxcols:=Grid.fieldcount+1;

try

G_XLSWriterIsRuning := True;

xls.writeBOF;

xls.WriteDimension;

if bSetFieldName then

begin

for c:=0 to Grid.FieldCount-1 do

xls.Cellstr(0,c,Grid.Fields[c].FieldName);

r :=2;

end

else 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;

if r > xls.maxrows then Raise Exception.Create('导出的数据超过'+IntToStr(xls.maxrows)+'条记录，操作失败！');

Inc(nCurrentCount);

CallFunc(nCurrentCount/nTotalCount);

if G_UserCmd=UserStop then

begin

if bAskForStop then

case Application.MessageBox('您停止了导出数据，请问需要保存吗？(选择“取消”继续导出)','询问',MB_YESNOCANCEL) of

IDYES: Break;

IDNO: begin

bDontSave := True;

Raise Exception.Create('用户停止，导出数据未保存！');

end;

IDCANCEL: G_UserCmd := UserDoNothing;

end

else begin bDontSave := True; Raise Exception.Create('用户停止，导出数据未保存！'); end;

end;

for c:=0 to Grid.FieldCount-1 do

if (Grid.Fields[c].AsString<>'') then

xls.WriteField(r,c,Grid.Fields[c]);

inc(r);

Grid.DataSource.DataSet.Next;

end;

finally

xls.writeEOF;

xls.free;

if bDontSave then DeleteFile(fname);

Grid.DataSource.DataSet.EnableControls;

G_XLSWriterIsRuning := False;

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

if i<=3 then wkSheetRes:=wkBookRes.Sheets[i] as _WorkSheet

else

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,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 );

if 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 );

if XlsAppHwnd<>0 then SendMessage( XlsAppHwnd, WM_CLOSE, 0, 0);

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

if Grid.FieldCount > xls.maxCols then

xls.maxCols := Grid.FieldCount+1;

try

xls.WriteBOF;

xls.WriteDimension;

if bSetFieldName then

begin

for c:=0 to Grid.FieldCount-1 do

xls.Cellstr(0,c,Grid.Fields[c].FieldName);

r :=2;

end

else 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);

if nTotalCount-nCurrentCount>xls.maxrows then nOneSheetMaxRecord := xls.maxRows

else nOneSheetMaxRecord := nTotalCount-nCurrentCount;

for i:=0 to nOneSheetMaxRecord-1 do

begin

Application.ProcessMessages;

Inc(nCurrentCount);

CallFunc(nCurrentCount/nTotalCount);

if G_UserCmd=UserStop then

begin

if bAskForStop then

case 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

else begin bDontSave := True; Raise Exception.Create('用户停止，导出数据未保存！'); end;

end;

for c:=0 to Grid.FieldCount-1 do

if (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

if bDontSave then

for i:=1 to Result do DeleteFile(Path+'\$$$'+IntToStr(i)+FileName);

Grid.DataSource.DataSet.EnableControls;

end;

if bNeedUnite and (Not bDontSave) then

begin

if Result=1 then

begin

DeleteFile(fname);

RenameFile(tmpFile, fname)

end

else

begin

with TUniteSeveralXLSToOneThread.Create('$$$', Path, FileName, 1, Result) do

begin

while Not mCompleted do

begin

Application.ProcessMessages;

Sleep(0);

end;

for i:=1 to Result do DeleteFile(Path+'\$$$'+IntToStr(i)+FileName);

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;

if grid.ColCount > xls.maxcols then

xls.maxcols:=grid.ColCount+1;

if rMax > xls.maxrows then // ¦¹®æ¦¡³Ì¦h¥u¯à¦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;

{ TXLSWriter }

constructor TXLSWriter.Create(vFileName:string;const vMaxCols, vMaxRows:Integer);

begin

inherited create;

if FileExists(vFilename) then

fStream:=TFileStream.Create(vFilename,fmOpenWrite)

else

fStream:=TFileStream.Create(vFilename,fmCreate);

if vMaxCols<100 then maxCols := vMaxCols //modify by 角落的青苔@2005/05/19

else maxCols := 100;

if vMaxCols<65535 then maxRows := vMaxRows

else maxRows := 65535;

end;

destructor TXLSWriter.Destroy;

begin

if fStream <> nil then

fStream.free;

inherited;

end;

procedure StreamWriteWordArray(Stream: TStream; wr: array 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 bytes

Writeword(0);

Writeword(DOCTYPE_XLS);

Writeword(0);

end;

procedure TXLSWriter.WriteDimension;

begin

Writeword(DIMENSIONS); // dimension OP Code

Writeword(8); // count of bytes

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:array [0..2] of byte;

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:array of byte);

var

i:integer;

begin

//reset

for i:=0 to High(FAtribut) do

FAtribut[i]:=0;

if acHidden in value then //byte 0 bit 7:

FAtribut[0] := FAtribut[0] + 128;

if acLocked in value then //byte 0 bit 6:

FAtribut[0] := FAtribut[0] + 64 ;

if acShaded in value then //byte 2 bit 7:

FAtribut[2] := FAtribut[2] + 128;

if acBottomBorder in value then //byte 2 bit 6

FAtribut[2] := FAtribut[2] + 64 ;

if acTopBorder in value then //byte 2 bit 5

FAtribut[2] := FAtribut[2] + 32;

if acRightBorder in value then //byte 2 bit 4

FAtribut[2] := FAtribut[2] + 16;

if acLeftBorder in value then //byte 2 bit 3

FAtribut[2] := FAtribut[2] + 8;

// <2002-11-17> dllee ³Ì«á 3 bit À³¥u¦³ 1 ºØ¿ï¾Ü

if acLeft in value then //byte 2 bit 1

FAtribut[2] := FAtribut[2] + 1

else if acCenter in value then //byte 2 bit 1

FAtribut[2] := FAtribut[2] + 2

else if acRight in value then //byte 2, bit 0 dan bit 1

FAtribut[2] := FAtribut[2] + 3

else if acFill in value then //byte 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

case field.DataType of

ftString,ftWideString,ftBoolean,ftDate,ftDateTime,ftTime:

Cellstr(vRow,vCol,field.asstring);

ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:

CellInteger(vRow,vCol,field.AsInteger);

ftFloat, ftBCD:

CellDouble(vRow,vCol,field.AsFloat);

else

Cellstr(vRow,vCol,EmptyStr); // <2002-11-17> dllee ¨ä¥L«¬ºA¼g¤JªÅ¥Õ¦r¦ê

end;

initialization

G_XLSWriterIsRuning := False;

end.