• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号

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

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

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;

鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
delphi xe10.2 统计(计算)日期发布时间:2022-07-18
下一篇:
delphiRestful:客户端实现的四种方式及其比较发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap