Delphi中直接将DataSet中的数据写入Excel文件

Procedure TFormReport.ExportExcelFile(FileName: string; bWriteTitle: Boolean; aDataSet: TClientDataSet);

var

arXlsBegin: array[0..5] of Word;

arXlsEnd: array[0..1] of Word;

arXlsString: array[0..5] of Word;

arXlsNumber: array[0..4] of Word;

arXlsInteger: array[0..4] of Word;

arXlsBlank: array[0..4] of Word;

i: integer;

Col, row: word;

ABookMark: TBookMark;

aFileStream: TFileStream;

procedure incColRow; //增加行列号

begin

if Col = ADataSet.FieldCount - 1 then begin

Inc(Row);

Col :=0;

end else begin

Inc(Col);

end;

end;

procedure WriteStringCell(AValue: string);//写字符串数据

var

L: Word;

begin

L := Length(AValue);

arXlsString[1] := 8 + L;

arXlsString[2] := Row;

arXlsString[3] := Col;

arXlsString[5] := L;

aFileStream.WriteBuffer(arXlsString, SizeOf(arXlsString));

aFileStream.WriteBuffer(Pointer(AValue)^, L);

IncColRow;

end;

procedure WriteIntegerCell(AValue: integer);//写整数

var

V: Integer;

begin

arXlsInteger[2] := Row;

arXlsInteger[3] := Col;

aFileStream.WriteBuffer(arXlsInteger, SizeOf(arXlsInteger));

V := (AValue shl 2) or 2;

aFileStream.WriteBuffer(V, 4);

IncColRow;

end;

procedure WriteFloatCell(AValue: double);//写浮点数

begin

arXlsNumber[2] := Row;

arXlsNumber[3] := Col;

aFileStream.WriteBuffer(arXlsNumber, SizeOf(arXlsNumber));

aFileStream.WriteBuffer(AValue, 8);

IncColRow;

end;

begin

arXlsBegin[0]:=$809;

arXlsBegin[1]:=8;

arXlsBegin[2]:=0;

arXlsBegin[3]:=$10;

arXlsBegin[4]:=0;

arXlsBegin[5]:=0;

arXlsEnd[0]:=$0A;

arXlsEnd[1]:=00;

arXlsString[0]:=$204;

arXlsString[1]:=0;

arXlsString[2]:=0;

arXlsString[3]:=0;

arXlsString[4]:=0;

arXlsString[5]:=0;

arXlsNumber[0]:=$203;

arXlsNumber[1]:=14;

arXlsNumber[2]:=0;

arXlsNumber[3]:=0;

arXlsNumber[4]:=0;

arXlsInteger[0]:=$27E;

arXlsInteger[1]:=10;

arXlsInteger[2]:=0;

arXlsInteger[3]:=0;

arXlsInteger[4]:=0;

arXlsBlank[0]:=$201;

arXlsBlank[1]:=6;

arXlsBlank[2]:=0;

arXlsBlank[3]:=0;

arXlsBlank[4]:=$17;

if FileExists(FileName) then DeleteFile(FileName); //文件存在，先删除

aFileStream := TFileStream.Create(FileName, fmCreate);

Try

//写文件头

aFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin));

//写列头

Col := 0; Row := 0;

if bWriteTitle then begin

for i := 0 to aDataSet.FieldCount - 1 do

WriteStringCell(aDataSet.Fields[i].FieldName);

end;

//写数据集中的数据

aDataSet.DisableControls;

ABookMark := aDataSet.GetBookmark;

aDataSet.First;

while not aDataSet.Eof do begin

for i := 0 to aDataSet.FieldCount - 1 do

case ADataSet.Fields[i].DataType of

ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:

WriteIntegerCell(aDataSet.Fields[i].AsInteger);

ftFloat, ftCurrency, ftBCD:

WriteFloatCell(aDataSet.Fields[i].AsFloat)

else

WriteStringCell(aDataSet.Fields[i].AsString);

end;

aDataSet.Next;

end;

//写文件尾

AFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));

if ADataSet.BookmarkValid(ABookMark)

then aDataSet.GotoBookmark(ABookMark);

Finally

AFileStream.Free;

ADataSet.EnableControls;

end;

end;