uxlsxf.pas

TMS Component Pack Pro v4.2

  if Pattern <> 1 then
  begin
    i := CellFgColorIndex;
    if (i >= 0) and (i < Length(UsedColors)) then
      UsedColors[i] := true;

    if Pattern <> 2 then
    begin
      i := CellBgColorIndex;
      if (i >= 0) and (i < Length(UsedColors)) then
        UsedColors[i] := true;

    end;

  end;

  i := FontList[GetActualFontIndex(FontList)].ColorIndex + 1;
  if (i >= 0) and (i < Length(UsedColors)) then
    UsedColors[i] := true;

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;
end;

function TXFRecord.FormatIndex: integer;
begin
  Result:= PXFDat(Data).Format;
end;

function TXFRecord.GetBorderColorIndex(const aPos: integer; const FirstBit: byte): integer;
begin
  Result:=(GetWord(Data, aPos) shr FirstBit) and $7F -7;
  if Result<1 then Result:=1;
end;

function TXFRecord.GetBorderColorIndexExt(const aPos: integer; const FirstBit: byte): integer;
begin
  Result:=(GetLongWord(Data, aPos) shr FirstBit) and $7F-7;
  if Result<1 then Result:=1;
end;

function TXFRecord.GetBorderStyle(const aPos: integer; const FirstBit: byte): TFlxBorderStyle;
begin
  Result:=TFlxBorderStyle((Data[aPos] shr FirstBit) and $F)
end;

function TXFRecord.GetBorderStyleExt(const aPos: integer; const FirstBit: byte): TFlxBorderStyle;
begin
  Result:=TFlxBorderStyle((GetLongWord(Data, aPos) shr FirstBit) and $F)
end;

function TXFRecord.HAlign: THFlxAlignment;
begin
  Result:=THFlxAlignment(PXFDat(Data).Options6 and $7);
end;

function TXFRecord.VAlign: TVFlxAlignment;
begin
  Result:=TVFlxAlignment(PXFDat(Data).Options6 and $70 shr 4);
end;

{ TFontRecord }
function TFontRecord.FlxFont: TFlxFont;
begin
  Result.Name:= Self.Name;
  Result.Size20:= Self.Height;
  Result.ColorIndex:= Self.ColorIndex+1;
  Result.Style:= Self.Style;
  Result.Underline:= Self.Underline;
  Result.Family:=Self.Family;
  Result.CharSet:=Self.CharSet;
end;


function TFontRecord.Charset: byte;
begin
  Result:=Data[12];
end;

function TFontRecord.ColorIndex: integer;
begin
  Result:=GetWord(Data, 4)-8;
end;

constructor TFontRecord.CreateFromFlxFont(const aFont: TFlxFont);
var
  TempData: PArrayOfByte;
  Xs: TExcelString;
begin
  Xs:= TExcelString.Create(1, aFont.Name, true);
  try
    DataSize:=SizeOf(TFontDat) + Xs.TotalSize;
    GetMem(TempData, DataSize);
    try
      PFontDat(TempData).Height:= aFont.Size20;
      PFontDat(TempData).GrBit:= 0;
      if flsItalic in aFont.Style then PFontDat(TempData).GrBit:=PFontDat(TempData).GrBit+2;
      if flsStrikeOut in aFont.Style then PFontDat(TempData).GrBit:=PFontDat(TempData).GrBit+8;

      PFontDat(TempData).ColorIndex:= Word(aFont.ColorIndex+7);
      if flsBold in aFont.Style then PFontDat(TempData).BoldStyle:=$2BC else PFontDat(TempData).BoldStyle:=$190;
      if flsSubscript in aFont.Style then PFontDat(TempData).SuperSub:= 2
      else if flsSuperscript in aFont.Style then PFontDat(TempData).SuperSub:=1
      else PFontDat(TempData).SuperSub:=0;
      case aFont.Underline of
        fu_Single: PFontDat(TempData).Underline:=$01;
        fu_Double: PFontDat(TempData).Underline:=$02;
        fu_SingleAccounting: PFontDat(TempData).Underline:=$21;
        fu_DoubleAccounting: PFontDat(TempData).Underline:=$22;
        else PFontDat(TempData).Underline:=0;
      end; //case

      PFontDat(TempData).Family:=aFont.Family;
      PFontDat(TempData).CharSet:=aFont.CharSet;
      PFontDat(TempData).Reserved:=0;

      Xs.CopyToPtr( TempData, SizeOf(TFontDat) );
      Create( xlr_FONT, TempData, DataSize);
      TempData:=nil;
    finally
      FreeMem(TempData);
    end;
  finally
    FreeAndNil(Xs);
  end;
end;

function TFontRecord.Family: byte;
begin
  Result:=Data[11];
end;

function TFontRecord.Height: integer;
begin
  Result:=GetWord(Data, 0);
end;

function TFontRecord.Name: widestring;
var
  w: widestring;
  s: string;
  aPos, DestPos, StrLen: integer;
  OptionFlags, ActualOptionFlags: byte;
  MySelf: TBaseRecord;
begin
  aPos:=16; MySelf:=Self;DestPos:=0;
  StrLen:=Data[14];
  OptionFlags:=Data[15]; ActualOptionFlags:=OptionFlags;
  SetLength(s, StrLen);
  SetLength(w, StrLen);
  ReadStr( MySelf, aPos, s, w, OptionFlags, ActualOptionFlags, DestPos, StrLen );
  if (OptionFlags and $1) = 0 then Result:=StringToWideStringNoCodePage(s) else Result:=w;

end;

function TFontRecord.Style: SetOfTFlxFontStyle;
begin
  Result:=[];
  if GetWord(Data,6)=$2BC then Include(Result,flsBold);
  if GetWord(Data,2) and $02=$02 then Include(Result,flsItalic);
  if GetWord(Data,2) and $08=$08 then Include(Result,flsStrikeOut);
  case GetWord(Data,8) of
    1: Include(Result,flsSuperscript);
    2: Include(Result,flsSubscript);
  end; //case
end;

function TFontRecord.Underline: TFlxUnderline;
begin
  case data[10] of
    $01: Result:=fu_Single;
    $02: Result:= fu_Double;
    $21: Result:=fu_SingleAccounting;
    $22: Result:=fu_DoubleAccounting;
    else Result:=fu_None;
  end;//case
end;

{ TFormatRecord }

constructor TFormatRecord.CreateFromData(const Fmt: Widestring; const NewID: integer);
var
  TempData: PArrayOfByte;
  Xs: TExcelString;
begin
  Xs:= TExcelString.Create(2, Fmt);
  try
    DataSize:=2 + Xs.TotalSize;
    GetMem(TempData, DataSize);
    try
      SetWord( TempData, 0, NewID);
      Xs.CopyToPtr( TempData, 2 );
      Create( xlr_Format, TempData, DataSize);
      TempData:=nil;
    finally
      FreeMem(TempData);
    end;
  finally
    FreeAndNil(Xs);
  end;
end;

function TFormatRecord.FormatId: integer;
begin
  Result:=GetWord(Data, 0);
end;

function TFormatRecord.Value: widestring;
var
  MySelf: TBaseRecord;
  aPos: integer;
  StrLen: integer;
  s: string;
  w: WideString;
  OptionFlags, ActualOptionFlags: byte;
  DestPos: integer;
begin
  aPos:=5;MySelf:=Self;DestPos:=0;
  OptionFlags:=Data[4]; ActualOptionFlags:=OptionFlags;
  StrLen:=GetWord(Data, 2);
  SetLength(s, StrLen);
  SetLength(w, StrLen);
  ReadStr( MySelf, aPos, s, w, OptionFlags, ActualOptionFlags, DestPos, StrLen );
  if (OptionFlags and $1) = 0 then Result:=StringToWideStringNoCodePage(s) else Result:=w;
end;

{ TFormatRecordList }

function TFormatRecordList.AddFormat(const Fmt: WideString): integer;
var
  i: integer;
  NewId: integer;
begin
  for i:=0 to Count-1 do
    if Fmt= Items[i].Value then
    begin
      Result:=Items[i].FormatId;
      exit;
    end;

    for i:= Low(XlsBuiltInFormatsUs) to High(XlsBuiltInFormatsUs) do
      if Fmt=XlsBuiltInFormats(i) then
      begin
        Result:=i;
        exit;
      end;

  if not Sorted then Sort;
  if Count=0 then  NewId:=$A4 else NewId:= Items[Count-1].FormatId+1;
  if NewId<$A4 then NewId:=$A4;  //user defined format.
  Result:=Items[Add(TFormatRecord.CreateFromData(Fmt, NewId))].FormatId;
end;

function TFormatRecordList.GetFormat(FormatId: integer): Widestring;
var
  Index: integer;
begin
  if Find(FormatId, Index) then Result:=Items[Index].Value else
  if (FormatId>=Low(XlsBuiltInFormatsUs)) and (FormatId<=High(XlsBuiltInFormatsUs)) then Result:=XlsBuiltInFormats(FormatId)
  else Result:='';
end;

{ TXFRecordList }

function TXFRecordList.FindFormat(const XF: TXFRecord; var Index: integer): boolean;
var
  i: integer;
begin
  for i:=0 to Count -1 do if
    CompareMem(Items[i].Data, XF.Data, XF.DataSize) then
    begin
      Result:=true;
      Index:=i;
      exit;
    end;
  Result:=false;
  Index:=-1;
end;

function TXFRecordList.GetUsedColors(const ColorCount: integer; const FontList: TFontRecordList): BooleanArray;
var
  i: integer;
begin
  SetLength (Result, ColorCount);
  if (ColorCount > 0) then FillChar(Result[0], Length(Result), 0);
  for i := 0 to Count - 1 do
        Self[i].FillUsedColors(Result, FontList);
end;

{ TFontRecordList }

function TFontRecordList.AddFont(const aFont: TFlxFont): integer;
var
  i: integer;
  TempFont: TFontRecord;
begin
  Result:=-1;
  TempFont:= TFontRecord.CreateFromFlxFont(aFont);
  try
    for i:=0 to Count-1 do if (TempFont.DataSize=Items[i].DataSize) and
      CompareMem(TempFont.Data, Items[i].Data, Items[i].DataSize) then
      begin
        Result:=i; if Result>=4 then Inc(Result); //Font number 4 does not exists
        FreeAndNil(TempFont);
        exit;
      end;
    Result:=Add(TempFont);
    if Result>=4 then Inc(Result); //Font number 4 does not exists
  except
    FreeAndNil(TempFont);
  end; //except
end;

end.