首 页 网络编程
网页制作 图形图象 操作系统 冲浪宝典
软件教学 认证考试

网络安全 网络办公 行业资讯 评测对比
您当前位置：站长天空 -> 网络安全-> 黑客攻防
修改的一个导出dataset到xls的单元_delphi教程
作者：网友供稿 点击：0
推荐
西部数码-全国虚拟主机10强！20余项虚拟主机管理功能,全国领先!第6代双线路虚拟主机,南北访问畅通无阻!可在线rar解压,自动数据恢复设置虚拟目录等.免费赠送访问统计,企业邮局.Cn域名注册10元/年,自助建站480元起,免费试用7天,满意再付款!P4主机租用799元/月.月付免压金
站内搜索
文章页数：[1] 

//首先感谢原作者，但当初在csdn上搜索到该单元时，就没原作者的信息（程序里的有些乱码的注释应该是原作者留下的吧？呵呵）
//有不足的地方还请各位看官多多指点哈 ^_^

(* 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);
var iPos:Integer;
begin
  iPos := LastDelimiter(StrFlags,FullStr);
  strLeft := Copy(FullStr, 1, iPos-1);
  strRight := Copy(FullStr, iPos+1, Length(FullStr)-iPos);
end;

constructor TUniteSeveralXLSToOneThread.Create(const _TmpFlag, _Path, _FileName:String;const _iStart, _iEnd : Integer);
begin
  inherited Create(True);
  TmpFlag := _TmpFlag;
  Path := _Path;
  FileName := _FileName;
  iStart := _iStart;
  iEnd := _iEnd;
  mCompleted := False;
  Resume();
end;

destructor TUniteSeveralXLSToOneThread.Destroy;
begin
  inherited;
end;

procedure TUniteSeveralXLSToOneThread.Execute;
const
  _HeadLetterOfXls:Array [1..52]of String    //注意这里只定义了52列，需要增加就自己动手，最多256列
            = (A,B,C,D,E,F,G,H,I,J,K,L,M,
               N,O,P,Q,R,S,T,U,V,W,X,Y,Z,
               AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,
               AN,AO,AP,AQ,AR,AS,AT,AU,AV,AW,AX,AY,AZ);
  _XlsResCaption= FKULWJS_SKSLA_892x_RES;
  _XlsTmpCaption= FKULWJS_SKSLA_892x_TMP;
var
  XlsAppRes, XlsAppTmp: TExcelApplication;
  wkBookRes, wkBookTmp : _WorkBook;
  wkSheetRes, wkSheetTmp : _WorkSheet;
  LCID_Res, LCID_Tmp:Integer;
  Pos_LeftTop, Pos_RightBottom : String; //Xls中左上、右下位置
  XlsAppHwnd:THandle;
  bDontSave : Boolean;
  i : Integer;

  StrName,StrExt:String; //文件名及扩展名
begin
  FreeOnTerminate := True;
  if Terminated then Exit;
  SplitStrToTwoPartByLastFlag(FileName, ., StrName, StrExt);
  try
    Screen.Cursor := crHourGlass;
    bDontSave := False;
    XlsAppRes := TExcelApplication.Create(Nil);
    with XlsAppRes do
    begin
      Connect;
      Visible[0]:=False;
      LCID_Res:=GetUserDefaultLCID();
      DisplayAlerts[LCID_Res]:=False;
      Caption:=_XlsResCaption;
      wkBookRes:=WorkBooks.Add(EmptyParam,LCID_Res);
    end;
    XlsAppTmp := TExcelApplication.Create(Nil);
    with XlsAppTmp do
    begin
      Connect;
      Visible[0]:=False;
      LCID_Tmp :=GetUserDefaultLCID();
      DisplayAlerts[LCID_Tmp]:=False;
      Caption:=_XlsTmpCaption;
    end;
    for i:=iStart to iEnd do
    begin
      if i<=3 then wkSheetRes:=wkBookRes.Sheets[i] as _WorkSheet
      else
      begin
        wkBookRes.Sheets.Add(EmptyParam, wkSheetRes, 1, EmptyParam, LCID_Res);
        wkSheetRes := wkBookRes.Sheets[i] as _WorkSheet;
      end;
      wkBookTmp:= XlsAppTmp.WorkBooks.Open(Path+\+TmpFlag+IntToStr(i)+FileName, EmptyParam,EmptyParam,
                    EmptyParam,EmptyParam,EmptyParam,EmptyParam,
                    EmptyParam,EmptyParam,EmptyParam,EmptyParam,
                    EmptyParam,EmptyParam,LCID_Tmp);
      Pos_LeftTop := A1;
      wkSheetTmp := XlsAppTmp.ActiveSheet as _WorkSheet;
      Pos_RightBottom := _HeadLetterOfXls[wkSheetTmp.UsedRange[LCID_Tmp].Columns.Count]+IntToStr(wkSheetTmp.UsedRange[LCID_Tmp].Rows.Count);
      XlsAppTmp.Range[Pos_LeftTop, Pos_RightBottom].Copy(EmptyParam);
      wkSheetRes.Activate(LCID_Res);
      wkSheetRes.Range[Pos_LeftTop, Pos_RightBottom].Select;
      wkSheetRes.Paste(EmptyParam, EmptyParam, LCID_Res);
      wkSheetRes.Columns.AutoFit;
      wkSheetRes.Range[A1,A1].Select;
      wkSheetRes.Name := StrName+_+IntToStr(i);
    end;
  finally
    try
      (wkBookRes.Sheets[1] as _WorkSheet).Activate(LCID_Res);
      wkBookRes.Close(Not(bDontSave) ,Path+\+FileName,EmptyParam,LCID_Res);
      XlsAppRes.Quit;
      XlsAppRes.Disconnect;
    finally
      //杀死未关闭的Excel进程
      XlsAppHwnd := FindWindow( Nil,_XlsResCaption );
      if XlsAppHwnd<>0 then SendMessage( XlsAppHwnd, WM_CLOSE, 0, 0);
    end;
    try
      //wkBookTmp.Close(False ,Path+\+TmpFlag+IntToStr(i)+FileName,EmptyParam,LCID_Tmp);
      XlsAppTmp.Quit;
      XlsAppTmp.Disconnect;
    finally
      XlsAppHwnd := FindWindow( Nil,_XlsTmpCaption );
      if XlsAppHwnd<>0 then SendMessage( XlsAppHwnd, WM_CLOSE, 0, 0);
        //TerminateProcess(XlsAppHwnd,0);
    end;
    mCompleted := True;
    Screen.Cursor := crDefault;
  end;
end;

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].DisplayLabel);
    r:=1;
    ds.first;
    while (not ds.eof) and (r <= xls.maxrows) do begin
      for c:=0 to ds.FieldCount-1 do
        if ds.Fields[c].AsString<> then
          xls.WriteField(r,c,ds.Fields[c]);
      inc(r);
      ds.next;
    end;
    xls.writeEOF;
  finally
    xls.free;
  end;
end;

procedure DBGridToXLS(Grid:TDBGrid;fname:String; bSetFieldName:Boolean;CallFunc:TExportXls_CallBackProc;  bAskForStop:Boolean=True);
var c,r,i :Integer;
  xls:TXLSWriter;
  nTotalCount, nCurrentCount : Integer;
  bDontSave:Boolean;
begin
  bDontSave := False;
  Grid.DataSource.DataSet.DisableControls;
  xls:=TXLSWriter.create(fname);
  if Grid.FieldCount > xls.maxcols then
    xls.maxcols:=Grid.fieldcount+1;
  try      
    G_XLSWriterIsRuning := True;
    xls.writeBOF;
    xls.WriteDimension;
    if bSetFieldName then
    begin
      for c:=0 to Grid.FieldCount-1 do
        xls.Cellstr(0,c,Grid.Fields[c].FieldName);
      r :=2;
    end
    else r:=1;
    for c:=0 to Grid.FieldCount-1 do
      xls.Cellstr(r-1,c,Grid.Fields[c].DisplayLabel);
    nTotalCount := Grid.DataSource.DataSet.RecordCount;
    nCurrentCount := 0;
    bDontSave := False;
    Grid.DataSource.DataSet.First;
    for i:=0 to nTotalCount-1 do
    begin
      Application.ProcessMessages;
      if r > xls.maxrows then Raise Exception.Create(导出的数据超过+IntToStr(xls.maxrows)+条记录，操作失败！);
      Inc(nCurrentCount);
      CallFunc(nCurrentCount/nTotalCount);
      if G_UserCmd=UserStop then
      begin
        if bAskForStop then
        case Application.MessageBox(您停止了导出数据，请问需要保存吗？(选择“取消”继续导出),询问,MB_YESNOCANCEL) of
          IDYES: Break;
          IDNO: begin
                  bDontSave := True;
                  Raise Exception.Create(用户停止，导出数据未保存！);
                end;
          IDCANCEL: G_UserCmd := UserDoNothing;
        end
        else begin bDontSave := True; Raise Exception.Create(用户停止，导出数据未保存！); end;
      end;
      for c:=0 to Grid.FieldCount-1 do
        if (Grid.Fields[c].AsString<>) then
          xls.WriteField(r,c,Grid.Fields[c]);
      inc(r);
      Grid.DataSource.DataSet.Next;
    end;
  finally
    xls.writeEOF;
    xls.free;
    if bDontSave then DeleteFile(fname);
    Grid.DataSource.DataSet.EnableControls;
    G_XLSWriterIsRuning := False;   
  end;
end;

//将数个XLS合并成一个（分页）
procedure UniteSeveralXLSToOne(const TmpFlag, Path, FileName : String;const iStart, iEnd : Integer);
const
  _HeadLetterOfXls:Array [1..52]of String
            = (A,B,C,D,E,F,G,H,I,J,K,L,M,
               N,O,P,Q,R,S,T,U,V,W,X,Y,Z,
               AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,
               AN,AO,AP,AQ,AR,AS,AT,AU,AV,AW,AX,AY,AZ);
  _XlsResCaption= FKULWJS_SKSLA_892x_RES;
  _XlsTmpCaption= FKULWJS_SKSLA_892x_TMP;
var
  XlsAppRes, XlsAppTmp: TExcelApplication;
  wkBookRes, wkBookTmp : _WorkBook;
  wkSheetRes, wkSheetTmp : _WorkSheet;
  LCID_Res, LCID_Tmp:Integer;
  Pos_LeftTop, Pos_RightBottom : String; //Xls中左上、右下位置
  XlsAppHwnd:THandle;
  bDontSave : Boolean;
  i : Integer;

  StrName,StrExt:String; //文件名及扩展名
begin
  SplitStrToTwoPartByLastFlag(FileName, ., StrName, StrExt);
  try
    bDontSave := False;
    XlsAppRes := TExcelApplication.Create(Nil);
    with XlsAppRes do
    begin
      Connect;
      Visible[0]:=False;
      LCID_Res:=GetUserDefaultLCID();
      DisplayAlerts[LCID_Res]:=False;
      Caption:=_XlsResCaption;
      wkBookRes:=WorkBooks.Add(EmptyParam,LCID_Res);
    end;
    XlsAppTmp := TExcelApplication.Create(Nil);
    with XlsAppTmp do
    begin
      Connect;
      Visible[0]:=False;
      LCID_Tmp :=GetUserDefaultLCID();
      DisplayAlerts[LCID_Tmp]:=False;
      Caption:=_XlsTmpCaption;
    end;
    for i:=iStart to iEnd do
    begin
      if i<=3 then wkSheetRes:=wkBookRes.Sheets[i] as _WorkSheet
      else
      begin
        wkBookRes.Sheets.Add(EmptyParam, wkSheetRes, 1, EmptyParam, LCID_Res);
        wkSheetRes := wkBookRes.Sheets[i] as _WorkSheet;
      end;
      wkBookTmp:= XlsAppTmp.WorkBooks.Open(Path+\+TmpFlag+IntToStr(i)+FileName, EmptyParam,EmptyParam,
                    EmptyParam,EmptyParam,EmptyParam,EmptyParam,
                    EmptyParam,EmptyParam,EmptyParam,EmptyParam,
                    EmptyParam,EmptyParam,LCID_Tmp);
      Pos_LeftTop := A1;
      wkSheetTmp := XlsAppTmp.ActiveSheet as _WorkSheet;
      Pos_RightBottom := _HeadLetterOfXls[wkSheetTmp.UsedRange[LCID_Tmp].Columns.Count]+IntToStr(wkSheetTmp.UsedRange[LCID_Tmp].Rows.Count);
      XlsAppTmp.Range[Pos_LeftTop, Pos_RightBottom].Copy(EmptyParam);
      wkSheetRes.Activate(LCID_Res);
      wkSheetRes.Range[Pos_LeftTop, Pos_RightBottom].Select;
      wkSheetRes.Paste(EmptyParam, EmptyParam, LCID_Res);
      wkSheetRes.Columns.AutoFit;
      wkSheetRes.Range[A1,A1].Select;
      wkSheetRes.Name := StrName+__+IntToStr(i);
    end;
  finally
    try
      (wkBookRes.Sheets[1] as _WorkSheet).Activate(LCID_Res);
      wkBookRes.Close(Not(bDontSave) ,Path+\+FileName,EmptyParam,LCID_Res);
      XlsAppRes.Quit;
      XlsAppRes.Disconnect;
    finally
      //杀死未关闭的Excel进程
      XlsAppHwnd := FindWindow( Nil,_XlsResCaption );
      if XlsAppHwnd<>0 then SendMessage( XlsAppHwnd, WM_CLOSE, 0, 0);
    end;
    try
      //wkBookTmp.Saved[LCID_Tmp]:=True;
      XlsAppTmp.Quit;
      XlsAppTmp.Disconnect;
    finally
      XlsAppHwnd := FindWindow( Nil,_XlsTmpCaption );
      if XlsAppHwnd<>0 then SendMessage( XlsAppHwnd, WM_CLOSE, 0, 0);
    end;
  end;
end;

function DBGridToXlsEx(Grid:TDBGrid;fname:String; bSetFieldName:Boolean;CallFunc:TExportXls_CallBackProc;const bAskForStop:Boolean; const bNeedUnite:Boolean ):Integer;
var
  c,r,i :Integer;
  xls:TXLSWriter;
  nTotalCount, nCurrentCount : Integer;
  bDontSave:Boolean;
  nOneSheetMaxRecord : Integer;
  Path, FileName, tmpFile:String;
  bNotEof : Boolean;
begin
  G_XLSWriterIsRuning := True;
  Result := 0;
  bDontSave := False;
  nTotalCount := Grid.DataSource.DataSet.RecordCount;
  nCurrentCount := 0;
  SplitStrToTwoPartByLastFlag(fname,\/,Path,FileName);
  Grid.DataSource.DataSet.DisableControls;
  bNotEof := True;
  try
    while bNotEof do
    begin
      Inc(Result);
      tmpFile := Path+\$$$+IntToStr(Result)+FileName;
      DeleteFile(tmpFile);
      xls:=TXLSWriter.Create(tmpFile,Grid.FieldCount+1, 65530 );    //65530
      if Grid.FieldCount > xls.maxCols then
        xls.maxCols := Grid.FieldCount+1;
      try
        xls.WriteBOF;
        xls.WriteDimension;
        if bSetFieldName then
        begin
          for c:=0 to Grid.FieldCount-1 do
            xls.Cellstr(0,c,Grid.Fields[c].FieldName);
          r :=2;
        end
        else r:=1;
        for c:=0 to Grid.FieldCount-1 do
          xls.Cellstr(r-1,c,Grid.Fields[c].DisplayLabel);

        Grid.DataSource.DataSet.First;
        Grid.DataSource.DataSet.MoveBy(nCurrentCount);
        if nTotalCount-nCurrentCount>xls.maxrows then nOneSheetMaxRecord := xls.maxRows
        else nOneSheetMaxRecord := nTotalCount-nCurrentCount;
        for i:=0 to nOneSheetMaxRecord-1 do
        begin
          Application.ProcessMessages;
          Inc(nCurrentCount);
          CallFunc(nCurrentCount/nTotalCount);
          if G_UserCmd=UserStop then
          begin
            if bAskForStop then
            case Application.MessageBox(您停止了导出数据，请问需要保存吗？(选择“取消”继续导出),询问,MB_YESNOCANCEL) of
              IDYES:begin
                      G_UserCmd := UserNeedSave;
                      Break;
                    end;
              IDNO: begin
                      G_UserCmd := UserNotSave;
                      bDontSave := True;
                      Raise Exception.Create(用户停止，导出数据未保存！);
                    end;
              IDCANCEL: G_UserCmd := UserDoNothing;
            end
            else begin bDontSave := True; Raise Exception.Create(用户停止，导出数据未保存！); end;
          end;
          for c:=0 to Grid.FieldCount-1 do
            if (Grid.Fields[c].AsString<>) then
              xls.WriteField(r,c,Grid.Fields[c]);
          inc(r);
          Grid.DataSource.DataSet.Next;
        end;
        xls.writeEOF;
      finally
        xls.Free;
      end;
      bNotEof := (Not Grid.DataSource.DataSet.Eof) and (G_UserCmd = UserDoNothing);
    end; //Not Grid.DataSource.DataSet.Eof
  finally
    if bDontSave then
      for i:=1 to Result do DeleteFile(Path+\$$$+IntToStr(i)+FileName);
    Grid.DataSource.DataSet.EnableControls;
  end;
  if bNeedUnite and (Not bDontSave) then
  begin
    if Result=1 then
    begin
      DeleteFile(fname);
      RenameFile(tmpFile, fname)
    end
    else
    begin
      with TUniteSeveralXLSToOneThread.Create($$$, Path, FileName, 1, Result) do
      begin
        while Not mCompleted do
        begin
          Application.ProcessMessages;
          Sleep(0);
        end;
      end;
      for i:=1 to Result do DeleteFile(Path+\$$$+IntToStr(i)+FileName);
    end;
  end;
  G_XLSWriterIsRuning := False;
end;
(*
procedure StringGridToXLS(grid:TStringGrid;fname:String);
var c,r,rMax:Integer;
  xls:TXLSWriter;
begin
  xls:=TXLSWriter.create(fname);
  rMax:=grid.RowCount;
  if grid.ColCount > xls.maxcols then
    xls.maxcols:=grid.ColCount+1;
  if rMax > xls.maxrows then          // &brvbar;&sup1;&reg;&aelig;&brvbar;&iexcl;&sup3;&Igrave;&brvbar;h&yen;u&macr;à&brvbar;s 65535 Rows
    rMax:=xls.maxrows;
  try
    xls.writeBOF;
    xls.WriteDimension;
    for c:=0 to grid.ColCount-1 do
      for r:=0 to rMax-1 do
        xls.Cellstr(r,c,grid.Cells[c,r]);
    xls.writeEOF;
  finally
    xls.free;
  end;
end;
*)
{ TXLSWriter }

constructor TXLSWriter.Create(vFileName:string;const vMaxCols, vMaxRows:Integer);
begin
  inherited create;
  if FileExists(vFilename) then
    fStream:=TFileStream.Create(vFilename,fmOpenWrite)
  else
    fStream:=TFileStream.Create(vFilename,fmCreate);
  if vMaxCols<100 then maxCols := vMaxCols   //modify by 角落的青苔@2005/05/19
  else maxCols := 100;
  if vMaxCols<65535 then maxRows := vMaxRows
  else maxRows := 65535;
  //maxCols:=100;   // <2002-11-17> dllee Column &Agrave;&sup3;&cedil;&Oacute;&not;O¤&pound;&yen;i&macr;à¤j&copy;ó 65535, &copy;&Ograve;&yen;H¤&pound;&brvbar;A&sup3;B&sup2;z
  //maxRows:=65530;//65535; // <2002-11-17> dllee &sup3;o&shy;&Oacute;&reg;&aelig;&brvbar;&iexcl;&sup3;&Igrave;¤j&yen;u&macr;à&sup3;o&raquo;ò¤j&iexcl;A&frac12;&ETH;&ordf;`·N¤j&ordf;&ordm;&cedil;ê&reg;&AElig;&reg;w&laquo;&Uuml;&reg;e&copy;&ouml;&acute;N¤j&copy;ó&sup3;o&shy;&Oacute;&shy;&Egrave;
end;

destructor TXLSWriter.Destroy;
begin
  if fStream <> nil then
    fStream.free;
  inherited;
end;

procedure StreamWriteWordArray(Stream: TStream; wr: array of Word);
var
  i: Integer;
begin
  for i := 0 to Length(wr)-1 do
{$IFDEF CIL}
    Stream.Write(wr[i]);
{$ELSE}
    Stream.Write(wr[i], SizeOf(wr[i]));
{$ENDIF}
end;

procedure StreamWriteAnsiString(Stream: TStream; S: String);
{$IFDEF CIL}
var
  b: TBytes;
{$ENDIF}
begin
{$IFDEF CIL}
    b := BytesOf(AnsiString(S));
    Stream.Write(b, Length(b));
{$ELSE}
    Stream.Write(PChar(S)^, Length(S));
{$ENDIF}
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(vRow, vCol: word; aValue: double;
  vAtribut: TSetOfAtribut);
//var  FAtribut:array [0..2] of byte;
begin
  CXlsNumber[2] := vRow;
  CXlsNumber[3] := vCol;
  StreamWriteWordArray(fStream, CXlsNumber);
  //SetCellAtribut(vAtribut,fAtribut);
  //fStream.Write(fAtribut,3);
  fStream.WriteBuffer(aValue, 8);
end;

procedure TXLSWriter.CellInteger(vRow,vCol:word;aValue:Integer;vAtribut:TSetOfAtribut=[]);
var V:Integer;
begin
  CXlsRk[2] := vRow;
  CXlsRk[3] := vCol;
  StreamWriteWordArray(fStream, CXlsRk);
  V := (aValue shl 2) or 2;
  fStream.WriteBuffer(V, 4);
end;

procedure TXLSWriter.CellStr(vRow, vCol: word; aValue: String;
  vAtribut: TSetOfAtribut);
var slen:Word;
begin
  slen := Length(aValue);
  CXlsLabel[1] := 8 + slen;
  CXlsLabel[2] := vRow;
  CXlsLabel[3] := vCol;
  //SetCellAtribut(vAtribut, CXlsLabel[4]);
  CXlsLabel[5] := slen;
  StreamWriteWordArray(fStream, CXlsLabel);
  StreamWriteAnsiString(fStream, aValue);
end;

procedure TXLSWriter.SetCellAtribut(value:TSetOfAtribut;var FAtribut:array of byte);
var
   i:integer;
begin
 //reset
  for i:=0 to High(FAtribut) do
    FAtribut[i]:=0;


     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;

     // <2002-11-17> dllee &sup3;&Igrave;&laquo;á 3 bit &Agrave;&sup3;&yen;u&brvbar;&sup3; 1 &ordm;&Oslash;&iquest;&iuml;&frac34;&Uuml;
     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(vRow, vCol: word; Field: TField);
begin
  case field.DataType of
     ftString,ftWideString,ftBoolean,ftDate,ftDateTime,ftTime:
       Cellstr(vRow,vCol,field.asstring);
     ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
       CellInteger(vRow,vCol,field.AsInteger);
     ftFloat, ftBCD:
       CellDouble(vRow,vCol,field.AsFloat);
  else
       Cellstr(vRow,vCol,EmptyStr);   // <2002-11-17> dllee ¨&auml;&yen;L&laquo;&not;&ordm;A&frac14;g¤J&ordf;&Aring;&yen;&Otilde;&brvbar;r&brvbar;ê
  end;
end;

initialization
  G_XLSWriterIsRuning := False;
 
end.


文章整理：站长天空 网址：http://www.z6688.com/
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!

文章页数：[1] 


放大字体显示 缩小字体显示 打印文章 推荐给朋友
热门文章
·J2EE平台介绍-JSP教程,J2ME开发
·自己制作友好的页面“确认对话框”-ASP教程,ASP应用
·DataAdapter是如何更新数据库数据的？-.NET教程,数据库应用
·jsp项目中实现关闭浏览器后吊线，只要不关闭不操作也保持在线-JSP教程,Jsp/Servlet
·企业Java技术开发技巧2则-JSP教程,Java技巧及代码
·刚刚整理好-汉字转拼音缩写的函数-.NET教程,评论及其它
·关于数据返回给调用页面-ASP教程,数据库相关
·如何使用C＃压缩文件及注意的问题！-.NET教程,C#语言
·数据库安装程序-.NET教程,数据库应用
·DataGrid的自定义分页UserControl-.NET教程,数据库应用
最新文章
·王通：网站推广的18种秘笈_营销推广
·什么是mfa，以及停止mfa的好处_网赚技巧
·google adsense 域名保护功能是否作恶_网赚技巧
·关于无效点击－adsense团队资深专员如是说_网赚技巧
·google adsense将以人民币支付_站长访谈
·bbmao的神秘配方：打破中文聚类搜索的低迷_站长访谈
·你的网站为什么粘不住流量？_站长心得
·决定网站成败重要的六个因素_站长心得
·widnows vista是吃内存大户 优化vista攻略_windows vista
·首页所应该达到的几个目标（1）_站长心得
相关主题
西部数码虚拟主机
友情链接
CNNIC 西部数码
万网 自助建站
虚拟主机 asp空间
域名注册 域名
域名申请 主页空间
论坛空间 网站空间
国际域名 虚拟空间
空间租用 DDOS防火墙
成都主机托管 四川主机托管
主机租用 服务器租用
网站目录 自助建站
虚拟主机 网址大全
软件下载
 自助链接
虚拟主机资讯 特价虚拟主机
版权申明：本站文章均来自网络，如有侵权，请联系我们，我们收到后立即删除，谢谢！
关于我们：站长天空：专业提供最新的站长资讯、在线教程、虚拟主机权威评测、虚拟主机性能对比、网站制作教程,开发教程,站长工具。包括网页制作教程、冲浪宝典、编程参考、操作系统、软件教学、行业动态等。
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有。
发表评论　打印　 刷新 　　 　关闭
站长天空 版权所有 本站虚拟主机由西部数码提供
All rights reserved.2004