分享
 
 
 

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

王朝delphi·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

//首先感谢原作者,但当初在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 // &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: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 &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

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 &sup3;&Igrave;&laquo;á 3 bit &Agrave;&sup3;&yen;u&brvbar;&sup3; 1 &ordm;&Oslash;&iquest;&iuml;&frac34;&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;&yen;L&laquo;&not;&ordm;A&frac14;g¤J&ordf;&Aring;&yen;&Otilde;&brvbar;r&brvbar;ê

end;

end;

initialization

G_XLSWriterIsRuning := False;

end.

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有