Dbgrid 文件流导出excel【测试成功】

delphi12年前 (2014)发布 admin

407 0 0

在开发数据库应用程序中，经常要将类型相同的数据导出来，放到Excel文件中，利用Excel强大的编辑功能，对数据作进一步的加工处理。这有许多的方法，我们可以使用OLE技术，在Delphi中创建一个自动化对象，通过该对象来传送数据。也可以使用ADO，通过与Excel数据存储建立连接，使用ADO这种独立于数据库后端的技术来导出数据集的数据。

可这两种技术都有一个共同的缺点，那就是慢，数据量少还好，用户不会有太多的感觉，可一旦数据量大，比如，超过1千条，速度就让人难以忍受了，那么有没有更好的办法，既可以快速地导出数据，又不用安装附加的软件。也许好多人都想到了剪贴板的方式，这种方式速度是快，可也有不好的一面，那就是数据量大占用内存也大，并且在Excel中调用PASTE方法时，需要锁定输入，这使用起来，就有点不方便了

这里我为大家介始一种比较好的方法，使用文件流的方式，通过TfileStream直接写入Excel文件。我写了一个函数，通过它可将数据集中的数据直接导入到Excel文件中。我测试了一下，1M的数据，不到十秒就完成了。附源程序。
原文链接：http://www.cnblogs.com/tc310/p/3333600.html
定义
新增了输出文件扩展名的判断和保存窗口，对原文进行了一点修改。

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);

函数

  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;

调用

procedure TForm1.btn4Click(Sender: TObject);
begin
SaveDialog1.Filter := '*.xls|*.xls';
 if SaveDialog1.Execute then
  begin
     if extractfileExt(savedialog1.FileName)<>'.xls' then
   SaveDialog1.FileName := ChangeFileExt(SaveDialog1.FileName,'.xls');
      ExportExcelFile(SaveDialog1.FileName,True,DBGrd1.DataSource.DataSet);
  end;
end;

# delphi