home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / Chip_2003-01_cd1.bin / zkuste / delphi / kolekce / d567 / FLEXCEL.ZIP / XLSAdapter / UXlsXF.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-10-11  |  7.8 KB  |  274 lines
  1. unit UXlsXF;
  2.  
  3. interface
  4. uses Classes, SysUtils, UXlsBaseRecords, UXlsBaseRecordLists, XlsMessages,
  5.      UFlxFormats;
  6.  
  7. type
  8.   TXFDat=packed Record
  9.     Font: word;       //0
  10.     Format: word;     //2
  11.     Options4: word;    //4
  12.     Options6: word;  //6
  13.     Options8: word;  //8
  14.     Options10: word;  //10
  15.     Options12: word;     //12
  16.     Options14: LongWord; //14
  17.     Options18: Word; //18
  18.   end;
  19.   PXFDat=^TXFDat;
  20.  
  21.   TXFRecord=class(TBaseRecord)
  22.     function CellPattern: integer;
  23.     function CellFgColorIndex: integer;
  24.     function CellBgColorIndex: integer;
  25.  
  26.     function FontIndex: integer;
  27.     function FormatIndex: integer;
  28.  
  29.     function GetBorderStyle(const aPos: integer; const FirstBit: byte):TFlxBorderStyle;
  30.     function GetBorderColorIndex(const aPos: integer; const FirstBit: byte):integer;
  31.     function GetBorderStyleExt(const aPos: integer; const FirstBit: byte):TFlxBorderStyle;
  32.     function GetBorderColorIndexExt(const aPos: integer; const FirstBit: byte):integer;
  33.  
  34.     function DiagonalStyle: TFlxDiagonalBorder;
  35.  
  36.     function VAlign: TVFlxAlignment;
  37.     function HAlign: THFlxAlignment;
  38.  
  39.     procedure FillMisc(var Locked, Hidden: boolean;var Parent: integer;
  40.                        var WrapText, ShrinkToFit: boolean; var Rotation: byte;
  41.                        var Indent: byte);
  42.                        
  43.  
  44.   end;
  45.  
  46.   TXFRecordList= class(TBaseRecordList)  //Items are TXFRecord
  47.   {$INCLUDE TXFRecordListHdr.inc}
  48.   public
  49.   end;
  50.  
  51. /////////////////////////////////////////////////// FONT
  52.   TFontRecord= class(TBaseRecord)
  53.     function Name: widestring;
  54.     function Height: integer;
  55.     function ColorIndex: integer;
  56.  
  57.     function Style: SetOfTFlxFontStyle;
  58.     function Underline: TFlxUnderline;
  59.   end;
  60.  
  61.   TFontRecordList=class(TBaseRecordList)  //Items are TFontRecord
  62.   {$INCLUDE TFontRecordListHdr.inc}
  63.   public
  64.   end;
  65.  
  66. /////////////////////////////////////////////////// Style
  67.   TStyleRecord= class(TBaseRecord)
  68.   end;
  69.  
  70. /////////////////////////////////////////////////// FORMAT
  71.   TFormatRecord= class(TBaseRecord)
  72.   public
  73.     function Id: integer;
  74.     function Value: widestring;
  75.   end;
  76.  
  77.   TFormatRecordList=class(TBaseRecordList)
  78.   private
  79.     function GetFormat(Id: integer): Widestring;  //Items are TFormatRecord
  80.   {$INCLUDE TFormatRecordListHdr.inc}
  81.   public
  82.     property Format[index: integer]: Widestring read GetFormat; default;
  83.   end;
  84. implementation
  85.   {$INCLUDE TXFRecordListImp.inc}
  86.   {$INCLUDE TFontRecordListImp.inc}
  87.   {$INCLUDE TFormatRecordListImp.inc}
  88.  
  89. const
  90.   XlsBuiltInFormats: array[0..49] of widestring=
  91.   ('', '0', '0.00','#,##0','#,##0.00',                              //0..4
  92.    '', '', '', '',                                                   //5..8  Contained in file
  93.    '0%','0.00%','0.00E+00','?/?','# ??/??',                         //9..13
  94.    'DD.MM.YY','DD. MMM YY','DD. MMM','MMM YY',                      //14..17
  95.    'h:mm AM/PM','h:mm:ss AM/PM','hh:mm','hh:mm:ss',                 //18..21
  96.    'DD.MM.YYYY hh:mm',                                              //22
  97.    '','','','','','','','','','','','','','',                       //23..36 Reserved
  98.    '"#,##0 _$;-#,##0 _$"','"#,##0 _$;[Red]-#,##0 _$"',              //37..38
  99.    '"#,##0.00 _$;-#,##0.00 _$"','"#,##0.00 _$;[Red]-#,##0.00 _$"',  //39..40
  100.    '','','','',                                                     //41..44 contained in file
  101.    '"mm:ss"','[h]:mm:ss','mm:ss,0','"##0.0E+0"','@'                 //45..49
  102.   );
  103.  
  104.  
  105. { TXFRecord }
  106.  
  107. function TXFRecord.CellBgColorIndex: integer;
  108. begin
  109.   Result:= PXFDat(Data).Options18 and $3F80 shr 7 -8;
  110. end;
  111.  
  112. function TXFRecord.CellFgColorIndex: integer;
  113. begin
  114.   Result:= PXFDat(Data).Options18 and $7F -8;
  115. end;
  116.  
  117. function TXFRecord.CellPattern: integer;
  118. begin
  119.   Result:= PXFDat(Data).Options14 and $FC000000 shr 26;
  120. end;
  121.  
  122. function TXFRecord.DiagonalStyle: TFlxDiagonalBorder;
  123. begin
  124.   Result:=TFlxDiagonalBorder((GetCardinal(Data,14) shr 14) and  3);
  125. end;
  126.  
  127. procedure TXFRecord.FillMisc(var Locked, Hidden: boolean;
  128.   var Parent: integer; var WrapText, ShrinkToFit: boolean; var Rotation, Indent: byte);
  129. begin
  130.   Locked:=PXFDat(Data).Options4 and $1 = $1;
  131.   Hidden:=PXFDat(Data).Options4 and $2 = $2;
  132.   Parent:=PXFDat(Data).Options4 and $FFF0;
  133.  
  134.   WrapText:= PXFDat(Data).Options6 and $8 = $8;
  135.  
  136.   ShrinkToFit:= PXFDat(Data).Options8 and $10 = $10;
  137.  
  138.   Rotation:= PXFDat(Data).Options6 and $FF00;
  139.   Indent:= PXFDat(Data).Options8 and $F;
  140.  
  141. end;
  142.  
  143. function TXFRecord.FontIndex: integer;
  144. begin
  145.   Result:= PXFDat(Data).Font;
  146. end;
  147.  
  148. function TXFRecord.FormatIndex: integer;
  149. begin
  150.   Result:= PXFDat(Data).Format;
  151. end;
  152.  
  153. function TXFRecord.GetBorderColorIndex(const aPos: integer; const FirstBit: byte): integer;
  154. begin
  155.   Result:=(GetWord(Data, aPos) shr FirstBit) and $7F -7;
  156. end;
  157.  
  158. function TXFRecord.GetBorderColorIndexExt(const aPos: integer; const FirstBit: byte): integer;
  159. begin
  160.   Result:=(GetCardinal(Data, aPos) shr FirstBit) and $7F-7;
  161. end;
  162.  
  163. function TXFRecord.GetBorderStyle(const aPos: integer; const FirstBit: byte): TFlxBorderStyle;
  164. begin
  165.   Result:=TFlxBorderStyle((Data[aPos] shr FirstBit) and $F)
  166. end;
  167.  
  168. function TXFRecord.GetBorderStyleExt(const aPos: integer; const FirstBit: byte): TFlxBorderStyle;
  169. begin
  170.   Result:=TFlxBorderStyle((GetCardinal(Data, aPos) shr FirstBit) and $F)
  171. end;
  172.  
  173. function TXFRecord.HAlign: THFlxAlignment;
  174. begin
  175.   Result:=THFlxAlignment(PXFDat(Data).Options6 and $7);
  176. end;
  177.  
  178. function TXFRecord.VAlign: TVFlxAlignment;
  179. begin
  180.   Result:=TVFlxAlignment(PXFDat(Data).Options6 and $70 shr 4);
  181. end;
  182.  
  183. { TFontRecord }
  184.  
  185. function TFontRecord.ColorIndex: integer;
  186. begin
  187.   Result:=GetWord(Data, 4)-8;
  188. end;
  189.  
  190. function TFontRecord.Height: integer;
  191. begin
  192.   Result:=GetWord(Data, 0);
  193. end;
  194.  
  195. function TFontRecord.Name: widestring;
  196. var
  197.   w: widestring;
  198.   s: string;
  199.   aPos, DestPos, StrLen: integer;
  200.   OptionFlags, ActualOptionFlags: byte;
  201.   MySelf: TBaseRecord;
  202. begin
  203.   aPos:=16; MySelf:=Self;DestPos:=0;
  204.   StrLen:=Data[14];
  205.   OptionFlags:=Data[15]; ActualOptionFlags:=OptionFlags;
  206.   SetLength(s, StrLen);
  207.   SetLength(w, StrLen);
  208.   ReadStr( MySelf, aPos, s, w, OptionFlags, ActualOptionFlags, DestPos, StrLen );
  209.   if (OptionFlags and $1) = 0 then Result:=StringToWideStringNoCodePage(s) else Result:=w;
  210.  
  211. end;
  212.  
  213. function TFontRecord.Style: SetOfTFlxFontStyle;
  214. begin
  215.   Result:=[];
  216.   if GetWord(Data,6)=$2BC then Include(Result,flsBold);
  217.   if GetWord(Data,2) and $02=$02 then Include(Result,flsItalic);
  218.   if GetWord(Data,2) and $08=$08 then Include(Result,flsStrikeOut);
  219.   case GetWord(Data,8) of
  220.     1: Include(Result,flsSuperscript);
  221.     2: Include(Result,flsSubscript);
  222.   end; //case
  223. end;
  224.  
  225. function TFontRecord.Underline: TFlxUnderline;
  226. begin
  227.   case data[10] of
  228.     $01: Result:=fu_Single;
  229.     $02: Result:= fu_Double;
  230.     $21: Result:=fu_SingleAccounting;
  231.     $22: Result:=fu_DoubleAccounting;
  232.     else Result:=fu_None;
  233.   end;//case
  234. end;
  235.  
  236. { TFormatRecord }
  237.  
  238. function TFormatRecord.Id: integer;
  239. begin
  240.   Result:=GetWord(Data, 0);
  241. end;
  242.  
  243. function TFormatRecord.Value: widestring;
  244. var
  245.   MySelf: TBaseRecord;
  246.   aPos: integer;
  247.   StrLen: integer;
  248.   s: string;
  249.   w: WideString;
  250.   OptionFlags, ActualOptionFlags: byte;
  251.   DestPos: integer;
  252. begin
  253.   aPos:=5;MySelf:=Self;DestPos:=0;
  254.   OptionFlags:=Data[4]; ActualOptionFlags:=OptionFlags;
  255.   StrLen:=GetWord(Data, 2);
  256.   SetLength(s, StrLen);
  257.   SetLength(w, StrLen);
  258.   ReadStr( MySelf, aPos, s, w, OptionFlags, ActualOptionFlags, DestPos, StrLen );
  259.   if (OptionFlags and $1) = 0 then Result:=StringToWideStringNoCodePage(s) else Result:=w;
  260. end;
  261.  
  262. { TFormatRecordList }
  263.  
  264. function TFormatRecordList.GetFormat(Id: integer): Widestring;
  265. var
  266.   Index: integer;
  267. begin
  268.   if Find(Id, Index) then Result:=Items[Index].Value else
  269.   if (Id>=Low(XlsBuiltInFormats)) and (Id<=High(XlsBuiltInFormats)) then Result:=XlsBuiltInFormats[Id]
  270.   else Result:='';
  271. end;
  272.  
  273. end.
  274.