//首先感謝原作者，但當初在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,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;
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;
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;
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,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;
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
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;
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;
if grid.ColCount > xls.maxcols then
xls.maxcols:=grid.ColCount+1;
if rMax > xls.maxrows then // ¦¹®æ¦&IExcl;³Ì¦h¥u&Macr;à¦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: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;
//maxCols:=100; // <2002-11-17> dllee Column À³¸Ó¬O¤£¥i&Macr;à¤j©ó 65535, ©Ò¥H¤£¦A³B²z
//maxRows:=65530;//65535; // <2002-11-17> dllee ³o­Ó®æ¦¡³Ì¤j¥u&Macr;à³o»ò¤j&IExcl;A½Ðª`·N¤jªº¸ê®Æ®w«Ü®e©&oUML;´N¤j©ó³o­Ó­È
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 ºØ¿ï¾&UUML;
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 ¨&aUML;¥L«¬ºA¼g¤JªÅ¥Õ¦r¦ê
end;
end;
initialization
G_XLSWriterIsRuning := False;
end.
