直接将数据导出到Excel文件,直接操作文件没有使用Variant

最新推荐文章于 2024-09-17 14:00:00 发布
最新推荐文章于 2024-09-17 14:00:00 发布
阅读量943 收藏
点赞数
文章标签： excel border string destructor integer byte
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/helodd/article/details/1698902
版权

unit xls_un;

interface

uses 
      Windows, Messages, SysUtils,   Classes,
      Forms, Dialogs,db, dbctrls,  comctrls, DBGrids;

  const 
  {BOF} 
      CBOF             =   $0009; 
      BIT_BIFF5   =   $0800;
      BOF_BIFF5   =   CBOF   or   BIT_BIFF5; 
  {EOF} 
      BIFF_EOF   =   $000a; 
  {Document   types} 
      DOCTYPE_XLS   =   $0010; 
  {Dimensions} 
      DIMENSIONS   =   $0000; 
  type 
      TAtributCell  =  (acHidden,acLocked,acShaded,acBottomBorder,acTopBorder, acBorder,
                                 acRightBorder,acLeftBorder,acLeft,acCenter,acRight,acFill);
  
      TSetOfAtribut  =  set   of   TatributCell;

     TXLSWriter  =  class(Tobject)
     private 
          fstream:TFileStream; 
          procedure   WriteWord(w:word); 
      protected 
          procedure   WriteBOF; 
          procedure   WriteEOF; 
          procedure   WriteDimension; 
      public 
          maxCols,maxRows:Word; 
          procedure   CellWord(vCol,vRow:word;aValue:word;vAtribut:TSetOfAtribut=[]); 
          procedure   CellDouble(vCol,vRow:word;aValue:double;vAtribut:TSetOfAtribut=[]); 
          procedure   CellStr(vCol,vRow:word;aValue:String;vAtribut:TSetOfAtribut=[]); 
          procedure   WriteField(vCol,vRow:word;Field:TField);
          constructor   create(vFileName:string); 
          destructor   destroy;override; 
      end; 
  
  procedure   SetCellAtribut(value:TSetOfAtribut;var   FAtribut:array   of   byte);
  //导出 DataSet 到Excel 文件 
  procedure   DataSetToXLS(ds:TDataSet;fname:String);
  //导出 DataGrid 到Excel 文件
  procedure   DataGridToXLS(dg:TDBGrid;fname:String);
  //导出listView 到Excel 文件
  procedure   ListViewToXLS(lv:TListView;fname: string);
  implementation
  
procedure   DataSetToXLS(ds:TDataSet;fname:String); 
var   c,r:Integer; 
    xls:TXLSWriter; 
begin 
    xls:=TXLSWriter.create(fname); 
    if   ds.FieldCount   >   xls.maxcols   then 
        xls.maxcols:=ds.fieldcount+1; 
    try 
        xls.writeBOF; 
        xls.WriteDimension; 
        for   c:=0   to   ds.FieldCount-1   do 
            xls.Cellstr(0,c,ds.Fields[c].FieldName); 
        r:=1; 
        ds.first; 
        while   (not   ds.eof)   and   (r   <=   xls.maxrows)   do   begin 
            for   c:=0   to   ds.FieldCount-1   do 
                xls.WriteField(r,c,ds.Fields[c]); 
            inc(r); 
            ds.next; 
        end; 
        xls.writeEOF; 
    finally 
        xls.free; 
    end; 
end; 
  
procedure   DataGridToXLS(dg:TDBGrid;fname:String); 
var   c,r:Integer;
    xls:TXLSWriter;
begin 
  dg.DataSource.DataSet.DisableControls; 
    xls:=TXLSWriter.create(fname);
    if   dg.FieldCount   >   xls.maxcols   then
        xls.maxcols:=dg.FieldCount+1;
    try
        xls.writeBOF;
        xls.WriteDimension;
        for   c:=1   to   dg.FieldCount-1   do
            xls.Cellstr(0,c,dg.Columns.Items[c].Title.Caption);
        r:=1;
        dg.DataSource.DataSet.First;
        while   (not   dg.DataSource.DataSet.eof)   and   (r   <=   xls.maxrows)   do   begin
            for   c:=1   to   dg.FieldCount-1   do
                xls.WriteField(r,c,dg.Fields[c]);
            inc(r);
            dg.DataSource.DataSet.Next;
        end;
        xls.writeEOF;
    finally
        xls.free;
    end;
  dg.DataSource.DataSet.EnableControls;   
end; 
  

procedure  ListViewToXLS(lv:TListView;fname: string);
var  c,r:Integer;
     xls:TXLSWriter;
begin
    xls:=TXLSWriter.create(fname); 
    if   lv.Columns.Count >  xls.maxcols   then
        xls.maxcols:=lv.Columns.Count+1;
    try
        xls.writeBOF;
        xls.WriteDimension;
        //write title
        for   c:=0   to   lv.Columns.Count-1   do
            xls.Cellstr(0,c,lv.Columns.Items[c].Caption);
        //Write Data   
        for c:=1 to lv.Items.Count do
        begin
           xls.CellStr(c,0,lv.Items.Item[c-1].Caption);
           for r:=0 to lv.Items.Item[c-1].SubItems.Count-1 do
              xls.CellStr(c,r+1,lv.Items.Item[c-1].SubItems.Strings[r]);
        end;
        xls.writeEOF;
    finally
        xls.free;
    end;
end;


  
{   TXLSWriter   } 
  
constructor   TXLSWriter.create(vFileName:string); 
begin 
    inherited   create; 
    if   FileExists(vFilename)   then 
        fStream:=TFileStream.Create(vFilename,fmOpenWrite) 
    else 
        fStream:=TFileStream.Create(vFilename,fmCreate); 
  
    maxCols:=100;       // 
    maxRows:=65535;   // 
end; 
  
destructor   TXLSWriter.destroy; 
begin 
    if   fStream   <>   nil   then 
        fStream.free; 
    inherited; 
end; 
  
procedure   TXLSWriter.WriteBOF; 
begin 
    Writeword(BOF_BIFF5); 
    Writeword(6);                       //   count   of   bytes 
    Writeword(0); 
    Writeword(DOCTYPE_XLS); 
    Writeword(0); 
end; 
  
procedure   TXLSWriter.WriteDimension; 
begin 
    Writeword(DIMENSIONS);     //   dimension   OP   Code 
    Writeword(8);                       //   count   of   bytes 
    Writeword(0);                       //   min   cols 
    Writeword(maxRows);           //   max   rows 
    Writeword(0);                       //   min   rowss 
    Writeword(maxcols);           //   max   cols 
end; 
  
procedure   TXLSWriter.CellDouble(vCol,   vRow:   word;   aValue:   double; 
    vAtribut:   TSetOfAtribut); 
var     FAtribut:array   [0..2]   of   byte; 
begin 
    Writeword(3);                       //   opcode   for   double 
    Writeword(15);                     //   count   of   byte 
    Writeword(vCol); 
    Writeword(vRow); 
    SetCellAtribut(vAtribut,fAtribut); 
    fStream.Write(fAtribut,3); 
    fStream.Write(aValue,8); 
end; 
  
procedure   TXLSWriter.CellWord(vCol,vRow:word;aValue:word;vAtribut:TSetOfAtribut=[]); 
var     FAtribut:array   [0..2]   of   byte; 
begin 
    Writeword(2);                       //   opcode   for   word 
    Writeword(9);                       //   count   of   byte 
    Writeword(vCol); 
    Writeword(vRow); 
    SetCellAtribut(vAtribut,fAtribut); 
    fStream.Write(fAtribut,3); 
    Writeword(aValue); 
end; 
  
procedure   TXLSWriter.CellStr(vCol,   vRow:   word;   aValue:   String; 
    vAtribut:   TSetOfAtribut); 
var     FAtribut:array   [0..2]   of   byte; 
    slen:byte; 
begin 
    Writeword(4);                       //   opcode   for   string 
    slen:=length(avalue); 
    Writeword(slen+8);             //   count   of   byte 
    Writeword(vCol); 
    Writeword(vRow); 
    SetCellAtribut(vAtribut,fAtribut); 
    fStream.Write(fAtribut,3); 
    fStream.Write(slen,1); 
    fStream.Write(aValue[1],slen); 
end;

procedure SetCellAtribut(value:TSetOfAtribut;var   FAtribut:array   of   byte); 
var 
      i:integer; 
begin 
  //reset 
    for   i:=0   to   High(FAtribut)   do 
        FAtribut[i]:=0; 
  
          {Byte   Offset           Bit       Description                                           Contents
          0                     7           Cell   is   not   hidden                             0b 
                                            Cell   is   hidden                                     1b 
                                6           Cell   is   not   locked                             0b 
                                            Cell   is   locked                                     1b 
                                5-0       Reserved,   must   be   0                           000000b 
          1                     7-6       Font   number   (4   possible) 
                                5-0       Cell   format   code 
          2                     7           Cell   is   not   shaded                             0b 
                                            Cell   is   shaded                                     1b 
                                6           Cell   has   no   bottom   border               0b 
                                            Cell   has   a   bottom   border                 1b 
                                5           Cell   has   no   top   border                     0b 
                                            Cell   has   a   top   border                       1b 
                                4           Cell   has   no   right   border                 0b 
                                            Cell   has   a   right   border                   1b 
                                3           Cell   has   no   left   border                   0b 
                                            Cell   has   a   left   border                     1b 
                                2-0       Cell   alignment   code 
                                                      general                                         000b 
                                                      left                                               001b 
                                                      center                                           010b 
                                                      right                                             011b 
                                                      fill                                               100b 
                                                      Multiplan   default   align.       111b 
          } 
  
          //     bit   sequence   76543210 
  
          if     acHidden   in   value   then               //byte   0   bit   7: 
                  FAtribut[0]   :=   FAtribut[0]   +   128; 
  
          if     acLocked   in   value   then               //byte   0   bit   6: 
                  FAtribut[0]   :=   FAtribut[0]   +   64   ; 
  
          if     acShaded   in   value   then               //byte   2   bit   7: 
                  FAtribut[2]   :=   FAtribut[2]   +   128; 
  
          if     acBottomBorder   in   value   then   //byte   2   bit   6 
                  FAtribut[2]   :=   FAtribut[2]   +   64   ; 
  
          if     acTopBorder   in   value   then         //byte   2   bit   5 
                  FAtribut[2]   :=   FAtribut[2]   +   32; 

          if     acRightBorder   in   value   then     //byte   2   bit   4 
                  FAtribut[2]   :=   FAtribut[2]   +   16; 
  
          if     acLeftBorder   in   value   then       //byte   2   bit   3 
                  FAtribut[2]   :=   FAtribut[2]   +   8; 
  
          if     acLeft   in   value   then                   //byte   2   bit   1 
                  FAtribut[2]   :=   FAtribut[2]   +   1 
          else   if     acCenter   in   value   then     //byte   2   bit   1 
                  FAtribut[2]   :=   FAtribut[2]   +   2 
          else   if   acRight   in   value   then         //byte   2,   bit   0   dan   bit   1 
                  FAtribut[2]   :=   FAtribut[2]   +   3 
          else   if   acFill   in   value   then           //byte   2,   bit   0 
                  FAtribut[2]   :=   FAtribut[2]   +   4; 
end; 
  
procedure  TXLSWriter.WriteWord(w:   word);
begin 
    fstream.Write(w,2); 
end; 
  
procedure   TXLSWriter.WriteEOF; 
begin 
    Writeword(BIFF_EOF); 
    Writeword(0); 
end; 
  
procedure TXLSWriter.WriteField(vCol,   vRow:   word;   Field:   TField); 
begin 
    case   field.DataType   of
          ftString,ftWideString,ftBoolean,ftDate,ftDateTime,ftTime: 
              Cellstr(vcol,vrow,field.asstring);
          ftAutoInc,ftSmallint,ftInteger,ftWord: 
              CellWord(vcol,vRow,field.AsInteger); 
          ftFloat,   ftBCD: 
              CellDouble(vcol,vrow,field.AsFloat); 
    else 
              Cellstr(vcol,vrow,EmptyStr);
    end;
end;


end.

 

helodd
关注
C++中实现把表的数据导出到EXCEL并打印实例代码
08-30
在C++编程中，将数据从数据库表导出到Excel并进行...这种技术适用于需要将大量数据导出到易于查看、分析和打印的格式的场景。在实际项目中，根据具体需求，你可能还需要处理错误、优化性能，或者支持更多自定义功能。
XLSReadWriteII5 Cell Comments 单元注释
lyhoo163的专栏
10-12 2670
XLSReadWriteII5、6可以为Cell加入注释，通过TXLSComment读写Cell指定注释。
Delphi里如何保存并关闭excel
beyondqd的专栏
01-27 7659
procedure TForm1.Button6Click(Sender: TObject); var    xlstest, thesheet:Variant; begin   try     xlstest:=CreateOleObject('Excel.Application');   except     Exit;   end;   
关于在读取Excle文件的时候报错：Cell index must be ＞= 0解决方法
热门推荐
qq_29188567的博客
10-20 1万+
关于在读取Excle文件的时候报错：Cell index must be >= 0
Exceltext.rar_EXCEL导出_VC excel_VC操作EXCEL_excel导入_导出到excel
07-14
除了直接操作Excel文件，你还可以将数据存储在内存中，然后一次性写入Excel。这通常通过创建`Variant`数组来实现，`Variant`能容纳多种类型的数据，适合数据交换。 综上所述，"Exceltext.rar"提供的示例涵盖了VC++...
LotusScript代理导出数据到Excel
01-11
在处理企业级应用时，经常需要将数据库中的数据导出至Excel格式，以方便进行进一步的数据分析或报告制作。对于Lotus Notes/Domino平台，通常有两种方法实现这一功能：前端JavaScript导出与后台LotusScript代理导出。...
delphi 将DBGrid的数据导出到Excel
01-17
本文将介绍如何使用 Delphi 将 DBGrid 中的数据导出到 Excel 文件中。 在 Delphi 中，我们可以使用 OleVariant 对象来与 Excel 进行交互。OleVariant 是 Delphi 中的一个变体类型，它可以用来存储不同的数据类型，...
Delphi实现Excel数据导出到Access数据库中.rar
07-10
3. **数据导出过程**：要将Excel数据导入Access，首先需要读取Excel文件，这可能涉及到打开工作簿、选择工作表，然后循环遍历每个单元格，提取数据。在Delphi中，可以使用类似以下的代码片段： ```delphi var ...
Excel爬虫使用实例-百度热搜
最新发布
路过人间
09-17 647
一个excel爬虫的小小例子，百度热搜的前50（还有一个置顶的热搜）
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值