delphi導出數據至Excel的三種方法及比較
2010-02-24 20:56
閒來無事,跑到網上蒐集了幾種導出DataSet至Excel的幾種方法。另外使用GetTickcount函數計算時差,以便比較。(本來使用Timer控件,但是Timer不適合做高精度時間計算)

使用TADOConnect,TADOQuery查詢數據。測試數據有1182條(記錄比較小,可能會影響最後效果。本人純粹是出於好奇,所以知道大概就可以,需要的朋友可以使用更多數據測試)
方法一:
   使用TADOQuery + Varaint方法,循環遍曆數據集中數據,直接插入到Excel的WookBook單元。這是初學者最易懂和易接受的方法。

在下面代碼中沒有仔細注意語法(比如沒有使用try..finally結構體),如果需要使用,請注意:

//使用ADO循環方式保存
procedure TForm1.btn_WhileClick(Sender: TObject);
var
   Eclapp:variant;
   n:integer;
   filename: string;
   t1,t2: Int64;
begin

   Eclapp := CreateOleObject('Excel.Application');
   Eclapp.WorkBooks.Add;
   Eclapp.Visible:= False;
   filename :='d:數據1.xls';
   lbl2.Caption := '0';
   if FileExists(fileName) then
     DeleteFile(fileName);
   t1:= GetTickCount;
   qry1.DisableControls;
   qry1.First;
   n:=2;
   while not qry1.Eof do
   begin
     eclapp.cells[n,1] := qry1.Fields[0].AsString;
     eclapp.cells[n,2] := qry1.Fields[1].AsString;
     eclapp.cells[n,3] := qry1.Fields[2].AsString;
     eclapp.cells[n,4] := qry1.Fields[3].AsString;
     //為了簡單,只添加了4個欄位
     inc(n);
     qry1.Next;
     application.ProcessMessages;
   end;
   qry1.EnableControls;
   t2:= GetTickCount;
   eclapp.visible := false;
   eclapp.Workbooks[1].SaveAs(filename);
   Eclapp.Quit;
   Eclapp:= Unassigned;
   lbl2.Caption := IntToStr(t2 - t1);
end;

方法二:使用OLE方法導入。
    本方法中有許多初學者可以借鑑和學習的地方。先講TDateSet中的數據保存為二維OLEVariant數組中,再保存到Excel Sheet中

///使用OLE方式保存

procedure TForm1.btn_OleVariantClick(Sender: TObject);
var
fileName: string;
xlApp, Sheet: OleVariant;
rowCount, Colcount, index: Integer;
t1,t2: Int64;

function RefToCell(RowID, ColID: Integer): string;
var
    ACount, APos: Integer;
begin
    ACount := ColID div 26;
    APos := ColID mod 26;
    if APos = 0 then
    begin
      ACount := ACount - 1;
      APos := 26;
    end;
    if ACount = 0 then
      Result := Chr(Ord('A') + ColID - 1) + IntToStr(RowID);
    if ACount = 1 then
      Result := 'A' + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
    if ACount > 1 then
      Result := Chr(Ord('A') + ACount - 1) + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
end;
function getData(ds: TDataSet): OleVariant;
var
    Data: OLEVariant;
    i,j : Integer;
begin
    rowCount := ds.RecordCount;
    colCount := ds.FieldCount;
    Data := VarArrayCreate([1, rowCount + 1, 1, colCount], varVariant); //1,rowCount 表示第一維數組的上下標,1,colCount表示第二維數組的上下標
    i := 1;
    for j := 0 to colCount - 1 do
    begin
      if not ds.Fields[j].Visible then
        continue;
      Data[i,j + 1] := ds.Fields[j].DisplayLabel;
    end;

    Inc(i);
    ds.DisableControls;
    try
      ds.First;
      while not ds.Eof do
      begin
        for j := 0 to colCount - 1 do
        begin
          Data[i,j + 1] := ds.Fields[j].AsString;
        end;
        Inc(i);
        ds.Next;
        Application.ProcessMessages;
      end;
    finally
      ds.EnableControls;
    end;
    result := Data;

end;
begin
fileName := 'd:數據.xls';
lbl1.Caption := '0';
t1:= GetTickCount;//開始計時
if FileExists(fileName) then
    DeleteFile(fileName);
xlApp := CreateOleObject('Excel.Application');
try
    XLApp.Visible := False;
    XLApp.DisplayAlerts := False;
    XLApp.Workbooks.Add;
    // 刪除多餘的 worksheet
    for index := XLApp.SheetsInNewWorkbook downto 2 do
    begin
      XLApp.Workbooks[1].Worksheets[index].Delete;
    end;

    Sheet := XLApp.Workbooks[1].Worksheets[1];
    index := 1;
    if index <> 0 then
      Sheet := XLApp.Workbooks[1].Worksheets.Add;
    Sheet.Name := qry1.Name;
    //Sheet.Columns.NumberFormatLocal := '@'; //設置單元格式為文本
    Sheet.Range[RefToCell(1, 1), RefToCell(rowCount + 1, colCount)].Value := getData(qry1);

    XLApp.Workbooks[1].SaveAs(fileName);
finally
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
      application.ProcessMessages;
      t2:= GetTickCount;
      lbl1.Caption := IntToStr( t2 - t1);
    end;
end;
end;

方法三:現在最流行的文件流方法
以下代碼從網絡中得到,在此留作備份,以備日後自己查閱

.....

var
Form1: TForm1;
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

{$R *.dfm}
//使用文件流
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;
        Application.ProcessMessages;
      end;
      //寫文件尾  
      AFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));
      //if ADataSet.BookmarkValid(ABookMark) then aDataSet.GotoBookmark(ABookMark);

   Finally
     AFileStream.Free;
     ADataSet.EnableControls;
   end;
end;

//調用:
procedure TForm1.btn_FileStreamClick(Sender: TObject);
var
t1,t2: Int64;
begin
lbl3.Caption := '0';
t1:= GetTickCount;
ExportExcelFile('d:數據2.xls',true,qry1);
t2:= GetTickCount;
lbl3.Caption:= IntToStr(t2 - t1);
end;

最後得到的比較圖

奇怪的是得到的文件大小也不一樣,忽略第一種方法得到的 數據1.xls。


giga0066 發表在 痞客邦 PIXNET 留言(0) 人氣()