修改的一个导出DataSet到xls的单元
2006-02-04 14:37:40 来源：WEB开发网//首先感谢原作者，但当初在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 // ¦¹®æ¦¡³Ì¦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;
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¯à¤j©ó 65535, ©Ò¥H¤£¦A³B²z
//maxRows:=65530;//65535; // <2002-11-17> dllee ³oӮ榡³Ì¤j¥u¯à³o»ò¤j¡A½Ðª`·N¤jªº¸ê®Æ®w«Ü®e©ö´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 ºØ¿ï¾Ü
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;
end;
initialization
G_XLSWriterIsRuning := False;
end.
中查找“修改的一个导出DataSet到xls的单元”更多相关内容
中查找“修改的一个导出DataSet到xls的单元”更多相关内容更多精彩
赞助商链接
