uxlsxf.pas

来自「delphi 第三方控件很出色,表格制作的」· PAS 代码 · 共 566 行 · 第 1/2 页

unit UXlsXF;
{$IFDEF LINUX}{$INCLUDE ../FLXCOMPILER.INC}{$ELSE}{$INCLUDE ..\FLXCOMPILER.INC}{$ENDIF}

interface
uses Classes, SysUtils, UXlsBaseRecords, UXlsBaseRecordLists, XlsMessages,
     UFlxFormats, UXlsStrings;

type
  TXFDat=packed record
    Font: word;       //0
    Format: word;     //2
    Options4: word;    //4
    Options6: word;  //6
    Options8: word;  //8
    Options10: word;  //10
    Options12: word;     //12
    Options14: LongWord; //14
    Options18: Word; //18
  end;
  PXFDat=^TXFDat;

  TFontRecordList=class;
  TFormatRecordList=class;

  TXFRecord=class(TBaseRecord)
    function CellPattern: integer;
    function CellFgColorIndex: integer;
    function CellBgColorIndex: integer;

    function FontIndex: integer;
    function FormatIndex: integer;

    function GetBorderStyle(const aPos: integer; const FirstBit: byte):TFlxBorderStyle;
    function GetBorderColorIndex(const aPos: integer; const FirstBit: byte):integer;
    function GetBorderStyleExt(const aPos: integer; const FirstBit: byte):TFlxBorderStyle;
    function GetBorderColorIndexExt(const aPos: integer; const FirstBit: byte):integer;

    function DiagonalStyle: TFlxDiagonalBorder;

    function VAlign: TVFlxAlignment;
    function HAlign: THFlxAlignment;

    procedure FillMisc(var Locked, Hidden: boolean;var Parent: integer;
                       var WrapText, ShrinkToFit: boolean; var Rotation: byte;
                       var Indent: byte);

    constructor CreateFromFormat(const Fmt: TFlxFormat; const FontList: TFontRecordList; const FormatList: TFormatRecordList);
    function FlxFormat(const FontList: TFontRecordList; const FormatList: TFormatRecordList): TFlxFormat;
  end;

  TXFRecordList= class(TBaseRecordList)  //Items are TXFRecord
  {$INCLUDE TXFRecordListHdr.inc}
    function FindFormat(const XF: TXFRecord; var Index: integer): boolean;
  public
  end;

/////////////////////////////////////////////////// FONT
  TFontDat=packed record
    Height: word;
    GrBit: word;
    ColorIndex: word;
    BoldStyle: word;
    SuperSub: word;
    Underline: byte;
    Family: byte;
    CharSet: byte;
    Reserved: byte;
    //Font name is not included
  end;
  PFontDat=^TFontDat;

  TFontRecord= class(TBaseRecord)
    function Name: widestring;
    function Height: integer;
    function ColorIndex: integer;
    function Family: byte;
    function Charset: byte;

    function Style: SetOfTFlxFontStyle;
    function Underline: TFlxUnderline;

    constructor CreateFromFlxFont(const aFont: TFlxFont);
  public
    function FlxFont: TFlxFont;
  end;

  TFontRecordList=class(TBaseRecordList)  //Items are TFontRecord
  {$INCLUDE TFontRecordListHdr.inc}
  public
    function AddFont(const aFont: TFlxFont): integer;
  end;

/////////////////////////////////////////////////// Style
  TStyleRecord= class(TBaseRecord)
  end;

/////////////////////////////////////////////////// FORMAT
  TFormatRecord= class(TBaseRecord)
  public
    function FormatId: integer;
    function Value: widestring;
    constructor CreateFromData(const Fmt: Widestring; const NewID: integer);
  end;

  TFormatRecordList=class(TBaseRecordList)
  private
    function GetFormat(FormatId: integer): Widestring;  //Items are TFormatRecord
  {$INCLUDE TFormatRecordListHdr.inc}
  public
    property Format[index: integer]: Widestring read GetFormat; default;
    function AddFormat(const Fmt: WideString): integer;
  end;
implementation
  {$INCLUDE TXFRecordListImp.inc}
  {$INCLUDE TFontRecordListImp.inc}
  {$INCLUDE TFormatRecordListImp.inc}

const
  XlsBuiltInFormats: array[0..49] of widestring=
  ('', '0', '0.00','#,##0','#,##0.00',                              //0..4
   '', '', '', '',                                                   //5..8  Contained in file
   '0%','0.00%','0.00E+00','?/?','# ??/??',                         //9..13
   'dd/mm/YYYY','DD-MMM-YY','DD-MMM','MMM-YY',                      //14..17
   'h:mm AM/PM','h:mm:ss AM/PM','hh:mm','hh:mm:ss',                 //18..21
   'dd/mm/YYYY hh:mm',                                              //22
   '','','','','','','','','','','','','','',                       //23..36 Reserved
   '#,##0 _$;-#,##0 _$','#,##0 _$;[Red]-#,##0 _$',              //37..38
   '#,##0.00 _$;-#,##0.00 _$','#,##0.00 _$;[Red]-#,##0.00 _$',  //39..40
   '','','','',                                                     //41..44 contained in file
   'mm:ss','[h]:mm:ss','mm:ss,0','##0.0E+0','@'                 //45..49
  );


{ TXFRecord }

function TXFRecord.CellBgColorIndex: integer;
begin
  Result:= (PXFDat(Data).Options18 and $3F80) shr 7 -7;
end;

function TXFRecord.CellFgColorIndex: integer;
begin
  Result:= PXFDat(Data).Options18 and $7F -7;
end;

function TXFRecord.CellPattern: integer;
begin
  Result:= PXFDat(Data).Options14 and $FC000000 shr 26;
end;

function BoolToBit(const Value: boolean; const ofs: integer): integer;
begin
  if Value then Result:=1 shl ofs else Result:=0;
end;

constructor TXFRecord.CreateFromFormat(const Fmt: TFlxFormat; const FontList: TFontRecordList; const FormatList: TFormatRecordList);
var
  TempData: PXFDat;
  bl, br, bb, bt: integer;
begin
  GetMem (TempData, SizeOf(TXFDat));
  try
    TempData.Font:= FontList.AddFont(Fmt.Font);
    TempData.Format:=FormatList.AddFormat(Fmt.Format);
    TempData.Options4:= BoolToBit(Fmt.Locked,0)+
                                  BoolToBit(Fmt.Hidden,1)+
                                  0 shl 2+ //Cell style
                                  0 shl 3+ //123 lotus
    //                              (Fmt.Parent shl 4) and $FFF0;
                                  0;  //No parents... they are too confusing

    TempData.Options4:=TempData.Options4 and not $0004; //not style
    TempData.Options6:=integer(Fmt.HAlignment)+
                       BoolToBit(Fmt.WrapText, 3)+
                       integer(Fmt.VAlignment)shl 4+
                       (Fmt.Rotation shl 8)and $FF00;

    TempData.Options8:=Fmt.Indent and $F+
                       BoolToBit(Fmt.ShrinkToFit, 4)+
                       0+ //mergecell
                       0+ //readingOrder
                       $0400+ //fmt not equal to parent
                       $0800+ //Font not equal to parent
                       $1000+$2000+$4000+$8000; //Many things not equal to parent...
                       //PENDING: agregar

    TempData.Options10:=integer(Fmt.Borders.Left.Style)+
                        integer(Fmt.Borders.Right.Style) shl 4+
                        integer(Fmt.Borders.Top.Style) shl 8+
                        integer(Fmt.Borders.Bottom.Style) shl 12;

    bl:=(Fmt.Borders.Left.ColorIndex+7) and $7F;
    if bl<8 then bl:=8; if bl>56+8 then bl:=56+8;
    br:=(Fmt.Borders.Right.ColorIndex+7) and $7F;
    if br<8 then br:=8; if br>56+8 then br:=56+8;
    TempData.Options12:=bl +
                        (br) shl 7+
                        integer(Fmt.Borders.DiagonalStyle) shl 14;

    bt:=(Fmt.Borders.Top.ColorIndex+7) and $7F;
    if bt<8 then bt:=8; if bt>56+8 then bt:=56+8;
    bb:=(Fmt.Borders.Bottom.ColorIndex+7) and $7F;
    if bb<8 then bb:=8; if bb>56+8 then bb:=56+8;
    TempData.Options14:= bt+
                         bb shl 7+
                        ((Fmt.Borders.Diagonal.ColorIndex+7) and $7F) shl 14+
                        integer(Fmt.Borders.Diagonal.Style) shl 21+
                        (Fmt.FillPattern.Pattern-1) shl 26;

    TempData.Options18:= (Fmt.FillPattern.FgColorIndex+7) and $7F +
                         ((Fmt.FillPattern.BgColorIndex+7) and $7F) shl 7+
                         0; //Attached to pivot table


    inherited Create(xlr_XF, PArrayOfByte(TempData), SizeOf(TXFDat));
  except
    FreeMem(TempData);
    raise;
  end;
end;

function TXFRecord.DiagonalStyle: TFlxDiagonalBorder;
begin
  Result:=TFlxDiagonalBorder((GetCardinal(Data,12) shr 14) and  3);
end;

procedure TXFRecord.FillMisc(var Locked, Hidden: boolean;
  var Parent: integer; var WrapText, ShrinkToFit: boolean; var Rotation, Indent: byte);
begin
  Locked:=PXFDat(Data).Options4 and $1 = $1;
  Hidden:=PXFDat(Data).Options4 and $2 = $2;
  Parent:=PXFDat(Data).Options4 and $FFF0;

  WrapText:= PXFDat(Data).Options6 and $8 = $8;

  ShrinkToFit:= PXFDat(Data).Options8 and $10 = $10;

  Rotation:= Hi(PXFDat(Data).Options6 and $FF00);
  Indent:= PXFDat(Data).Options8 and $F;

end;

function TXFRecord.FlxFormat(const FontList: TFontRecordList; const FormatList: TFormatRecordList): TFlxFormat;
var
  FontIdx: integer;
begin
  FontIdx:=FontIndex;
  if FontIdx>=4 then Dec(FontIdx); //Font number 4 does not exists
  if (FontIdx<0) or (FontIdx>=FontList.Count) then FontIdx:=0;
  Result.Font:= FontList[FontIdx].FlxFont;

  Result.Borders.Left.Style:= GetBorderStyle(10,0);
  Result.Borders.Right.Style:= GetBorderStyle(10,4);
  Result.Borders.Top.Style:= GetBorderStyle(11,0);
  Result.Borders.Bottom.Style:= GetBorderStyle(11,4);

  Result.Borders.Left.ColorIndex:= GetBorderColorIndex(12,0);
  Result.Borders.Right.ColorIndex:= GetBorderColorIndex(12,7);
  Result.Borders.Top.ColorIndex:= GetBorderColorIndex(14,0);
  Result.Borders.Bottom.ColorIndex:= GetBorderColorIndex(14,7);

  Result.Borders.Diagonal.Style:=GetBorderStyleExt(14,21);
  Result.Borders.Diagonal.ColorIndex:=GetBorderColorIndexExt(14,14);

  Result.Borders.DiagonalStyle:=DiagonalStyle;

  Result.Format:= FormatList[FormatIndex];

  Result.FillPattern.Pattern:=CellPattern+1;
  Result.FillPattern.FgColorIndex:=CellFgColorIndex;
  Result.FillPattern.BgColorIndex:=CellBgColorIndex;

  Result.HAlignment:=HAlign;
  Result.VAlignment:=VAlign;

  FillMisc(Result.Locked, Result.Hidden, Result.Parent, Result.WrapText,
              Result.ShrinkToFit, Result.Rotation, Result.Indent); //all togheter, to sve some function calls...

end;

function TXFRecord.FontIndex: integer;
begin
  Result:= PXFDat(Data).Font;