Delphi 用文件流的方式将客户端数据集写到EXCEL中去

最近有个需求,就是将客户端数据集导入到EXCEL中,当然很多控件都是用文件流的方式导出的,但格式很麻烦,所以需要自己写个函数,把数据导入到EXCEL中,然后再修改EXCEL的标题和结尾什么的。。所以就上网查了很多资料,这个函数写的很好,我就放到网上一起共享下。。



Var
arXlsBegin: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
arXlsEnd: array[0..1] of Word = ($0A, 00);
arXlsString: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
arXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
arXlsInteger: array[0..4] of Word = ($27E, 10, 0, 0, 0);
arXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);


Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean; aDataSet: TDataSet);


implementation


Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean; aDataSet: TDataSet);
var
i,j: integer;
Col , row: word;
ABookMark: TBookMark;
aFileStream: TFileStream;
procedure incColRow; //增加行列号
begin
if Col = ADataSet.FieldCount - 1 then
      begin
         Inc(Row);
         Col :=0;
      end
else
        Inc(Col);
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
   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;





以上是一个函数,现在只需要调用下就行了,


ExportExcelFile('huangx.xls',true,adoquery1);  
//'huangx.xls' 文件名,adoquery1数据集

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章