当前位置：首页 » 软件开发

开发技术指南» 文章正文

    引言： //首先感谢原作者，但当初在csdn上搜索到该单元时，就没原作者

 

 

修改的一个导出DataSet到xls的单元

//首先感谢原作者,但当初在csdn上搜索到该单元时,就没原作者的信息（程序里的有些乱码的注释应该是原作者留下的吧?呵呵）

//有不足的地方还请各位看官多多指点哈 ^_^ 【程序编程相关:[原创]Delphi中ScriptCon】

【推荐阅读:找VB,DELPHI高手开发功能简单的进】

【扩展信息:用BCB和DELPHI开发OPC监控程序】

(* modify by 角落的青苔@2005/05/13

   说明:增加导出过程中的回调功能（用户停止,进度条）

         是否在第一行插入fieldname

         改错:以前只能对word类型数值写入,dword会range check error;已修正,见cellinteger

         //这个单元原来的col与row刚好弄反了(已修正):-(

         增加导出分页的功能,因为xls单页不能超过 65536 行（采用的笨办法,不知谁有好一点的方法吗?比如直接写标记表示分页?）

*)

unit unitxlsfile;

interface

uses

  windows, messages, variants, sysutils, classes, graphics, controls, forms, dialogs,

  db,dbgrids, oleserver, excel2000;

const _msg_xlswriterisruning=有其它任务正在导出数据,暂时不能执行该操作,请稍后重试！;

type

  tusercommand=(userstop, userneedsave, usernotsave, userskip, userdonothing);

  texportxls_callbackproc = procedure(ipos:real) of object;

  tatributcell = (achidden,aclocked,acshaded,acbottomborder,actopborder,

                acrightborder,acleftborder,acleft,accenter,acright,acfill);

  tsetofatribut = set of tatributcell;

  txlswriter = class(tobject)

  private

    fstream:tfilestream;

    procedure writeword(w:word);

    procedure setcellatribut(value:tsetofatribut;var fatribut:array of byte);

  protected

    procedure writebof;

    procedure writeeof;

    procedure writedimension;

  public

    maxcols,maxrows:word;

    //add by 角落的青苔@2005/05/18

    procedure cellinteger(vrow,vcol:word;avalue:integer;vatribut:tsetofatribut=[]);

    procedure celldouble(vrow,vcol:word;avalue:double;vatribut:tsetofatribut=[]);

    procedure cellstr(vrow,vcol:word;avalue:string;vatribut:tsetofatribut=[]);

    procedure writefield(vrow,vcol:word;field:tfield);

    constructor create(vfilename:string;const vmaxcols:integer=100;const vmaxrows:integer=65534);

    destructor destroy;override;

  end;

procedure datasettoxls(ds:tdataset;fname:string);

//add by 角落的青苔@2005/05/13 //只能导出最多65536条记录

procedure dbgridtoxls(grid:tdbgrid;fname:string; bsetfieldname:boolean;callfunc:texportxls_callbackproc; baskforstop:boolean=true );

//add by 角落的青苔@2005/05/19

//突破xls单页65536行的限制,把数据分成数页

function dbgridtoxlsex(grid:tdbgrid;fname:string; bsetfieldname:boolean;callfunc:texportxls_callbackproc;const baskforstop:boolean=true; const bneedunite:boolean=true ):integer;

//将数个xls合并成一个（分页）,必须保证path最后无\或/,实际已经做成线程,以免程序无响应

procedure uniteseveralxlstoone(const tmpflag, path, filename : string;const istart, iend : integer);

//procedure stringgridtoxls(grid:tstringgrid;fname:string);

var

  g_usercmd:tusercommand;

  g_xlswriterisruning : boolean; //是否有xlswriter实例在运行,因为g_usercmd是全局变量,防止被非法刷新

implementation

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;

var

  cxlsbof: array[0..5] of word = ($809, 8, 0, $10, 0, 0);

  cxlseof: array[0..1] of word = ($0a, 00);

  cxlslabel: array[0..5] of word = ($204, 0, 0, 0, 0, 0);

  cxlsnumber: array[0..4] of word = ($203, 14, 0, 0, 0);

  cxlsrk: array[0..4] of word = ($27e, 10, 0, 0, 0);

  cxlsblank: array[0..4] of word = ($201, 6, 0, 0, $17);

type

  //合并数个xls为一个多页面xls的线程

  tuniteseveralxlstoonethread = class(tthread)

  private

    tmpflag : string;

    path : string;

    filename : string;

    istart : integer;

    iend : integer;

  protected

    mcompleted : boolean;

    procedure execute; override;

  public

    constructor create(const _tmpflag, _path, _filename:string;const _istart, _iend : integer);

    destructor destroy; override;

  end;

//根据strflags在fullstr最后出现的位置,将fullstr分割成两部分,取得的两部分均不包含strflags

procedure splitstrtotwopartbylastflag(const fullstr,strflags:string;var strleft,strright:string);

...   下一页

» 本期热门文章：

· 热门栏目：

» 相关精选文章

» 其它相关：