Delphi中直接将DataSet中的数据写入Excel文件-阿里云开发者社区

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

2017-11-14 1406

版权

本文内容由阿里云实名注册用户自发贡献，版权归原作者所有，阿里云开发者社区不拥有其著作权，亦不承担相应法律责任。具体规则请查看《阿里云开发者社区用户服务协议》和《阿里云开发者社区知识产权保护指引》。如果您发现本社区中有涉嫌抄袭的内容，填写侵权投诉表单进行举报，一经查实，本社区将立刻删除涉嫌侵权内容。

简介：

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;

本文转自 OldHawk 博客园博客，原文链接：http://www.cnblogs.com/taobataoma/archive/2007/06/12/780930.html，如需转载请自行联系原作者

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

热门文章

最新文章

相关电子书

相关实验场景