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數據集

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