Delphi 用文件流的方式将客户端数据集写到EXCEL中去

最新推荐文章于 2019-08-28 11:16:00 发布

void_1987

最新推荐文章于 2019-08-28 11:16:00 发布

阅读量1.2k

点赞数

分类专栏： delphi 文章标签： excel delphi string integer

delphi 专栏收录该内容

2 篇文章 0 订阅

订阅专栏

最近有个需求，就是将客户端数据集导入到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;