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

[入库:2005年8月18日] [更新:2007年3月24日]

本文简介:选择自 cornermoss 的 blog

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;

本文关键:修改的一个导出DataSet到xls的单元
  相关方案
Google
 

本站最佳浏览方式为 分辨率 1024x768 IE 6.0(或更高版本的 IE浏览器)

go top