uxlsrowcolentries.pas

DELPHI tms.component.pack.v4.6.0.7

  if (FCellList.Count >0) then FRowList.AddRow(FCellList.Count-1);
end;

procedure TCells.SaveRangeToStream(const DataStream: TStream; const CellRange: TXlsCellRange; const NeedsRecalc: boolean);
var
  i,k,j, Written :integer;
begin
  FixRows;
  WriteDimensions(DataStream, CellRange);
  i:=CellRange.Top;
  while (i<=CellRange.Bottom) do
  begin
    k:=0;Written:=0;
    while (Written<32) and (k+i<=CellRange.Bottom) do
    begin
      if FRowList.HasRow(k+i) then
      begin
        FRowList[k+i].SaveRangeToStream(DataStream, CellRange.Left, CellRange.Right);
        //inc(Written);  //We want 32 records in total, counting blanks. that's why not here
      end;
      inc(Written);
      inc(k);
    end;

    for j:= i to k+i-1 do
      if (j<=CellRange.Bottom) and (j<FCellList.Count) then FCellList[j].SaveRangeToStream(DataStream, CellRange, NeedsRecalc);

    inc(i, k);
  end;

end;


function TCells.TotalRangeSize(const CellRange: TXlsCellRange): int64;
begin
  TotalRangeSize:= DimensionsSize + FRowList.TotalRangeSize(CellRange) + FCellList.TotalRangeSize(CellRange);
end;

procedure TCells.ArrangeInsertSheet(const SheetInfo: TSheetInfo);
begin
  FCellList.ArrangeInsertSheet(SheetInfo);
end;

{ TRangeList }

procedure TRangeList.CopyFrom(const aRangeList: TRangeList);
var
  i: integer;
begin
  for i:=0 to aRangeList.Count - 1 do
    Add(aRangeList.Items[i].CopyTo);
end;

procedure TRangeList.DeleteRowsOrCols(const aRow, aCount: word;
  const SheetInfo: TSheetInfo; const UseCols: boolean);
var
  i: integer;
begin
  for i:=0 to Count-1 do Items[i].DeleteRowsOrCols(aRow, aCount, SheetInfo, UseCols);
end;

procedure TRangeList.InsertAndCopyRowsOrCols(const FirstRow, LastRow, DestRow,
  aCount: integer; const SheetInfo: TSheetInfo; const UseCols: boolean);
var
  i: integer;
begin
  for i:=0 to Count-1 do Items[i].InsertAndCopyRowsOrCols(FirstRow, LastRow, DestRow, aCount, SheetInfo, UseCols);
end;

procedure TRangeList.SaveRangeToStream(const DataStream: TStream; const CellRange: TXlsCellRange);
var
  i:integer;
begin
  for i:=0 to Count-1 do Items[i].SaveRangeToStream(DataStream, CellRange);
end;

procedure TRangeList.SaveToStream(const DataStream: TStream);
var
  i:integer;
begin
  for i:=0 to Count-1 do Items[i].SaveToStream(DataStream);
end;

function TRangeList.TotalRangeSize(const CellRange: TXlsCellRange): int64;
var
  i:integer;
begin
  Result:=0;
  for i:=0 to Count-1 do Result:=Result+Items[i].TotalRangeSize(CellRange);
end;

function TRangeList.TotalSize: int64;
var
  i:integer;
begin
  Result:=0;
  for i:=0 to Count-1 do Result:=Result+Items[i].TotalSize;
end;


{ TRowHeightCalc }
constructor TRowHeightCalc.Create(const aWg: TWorkbookGlobals);
begin
  inherited Create;
  Wg := aWg;
  bmp := TBitmap.Create;
  bmp.Height := 1;
  bmp.Width := 1;
  Canvas := bmp.Canvas;
  InitXF;
end;

procedure TRowHeightCalc.InitXF();
var
  i: integer;
  xf: TXFRecord;
  FontIndex: integer;
  Fr: TFontRecord;
begin
  SetLength (XFHeight, Wg.XF.Count);
  FillChar(XFHeight[0], Length(XFHeight), 0);
  SetLength (XFFonts, Length(XFHeight));
  FillChar(XFFonts[0], Length(XFFonts), 0);
  for i := 0 to Length(XFHeight) - 1 do
  begin
    xf := Wg.XF[i];
    FontIndex := xf.GetActualFontIndex(Wg.Fonts);
    Fr := Wg.Fonts[FontIndex];
    XFFonts[i] := Fr.FlxFont;
    Canvas.Font.Name := XFFonts[i].Name;
    Canvas.Font.Size := Round(XFFonts[i].Size20 / 20);
    XFHeight[i] := Ceil(Canvas.TextHeight('Mg') * RowMult);
  end;

end;

function CalcAngle(const ExcelRotation: integer; var Vertical: boolean): extended;
begin
  Vertical:=ExcelRotation=255;
  if ExcelRotation<0 then Result:=0
  else if ExcelRotation<=90 then Result:=ExcelRotation*2*pi/360
  else if ExcelRotation<=180 then Result:=(90-ExcelRotation)*2*pi/360
  else Result:=0;
end;


function TRowHeightCalc.CalcCellHeight(const Row: integer; const Col: integer; const val: TRichString; const XF: integer; const Workbook: pointer; const RowMultDisplay: Extended; const ColMultDisplay: Extended): integer;
{$IFDEF FLEXCEL}
var
  XFRec: TXFRecord;
  Vertical: Boolean;
  Alpha: Extended;
  CellHeight, CellWidth: extended;
  rg: TXlsCellRange;
  c: integer;
  r: integer;
  TextExtent: TSize;
  TextLines: WidestringArray;
  Clp: Extended;
  Wr: Extended;
  RtfRuns2: TRTFRunListList;
  H,W: Extended;
  SinAlpha: Extended;
  CosAlpha: Extended;
{$ENDIF}
begin
{$IFNDEF FLEXCEL}
  Result := 255;
{$ELSE}
  if XF < 0 then
    begin Result := 255; exit; end;

  if XF >= Length(XFHeight) then  //Just to make sure. We dont want a wrong file to blow here.
    begin Result := 255; exit; end;

  Result := XFHeight[XF];
  if val.Value = '' then
    exit;

  XFRec := Wg.XF[XF];
  Alpha := CalcAngle(XFRec.Rotation, Vertical);
  if (not XFRec.WrapText and not Vertical) and (Alpha = 0) then
    exit;

  Canvas.Font.Name := XFFonts[XF].Name;
  Canvas.Font.Size := Round(XFFonts[XF].Size20 / 20.0);

  if XFFonts[XF].Underline <> fu_None then
      Canvas.Font.Style:=Canvas.Font.Style+[fsUnderline];

  if flsBold in XFFonts[XF].Style then Canvas.Font.Style:=Canvas.Font.Style+[fsBold];
  if flsItalic in XFFonts[XF].Style then Canvas.Font.Style:=Canvas.Font.Style+[fsItalic];
  if flsStrikeOut in XFFonts[XF].Style then Canvas.Font.Style:=Canvas.Font.Style+[fsStrikeOut];

  CellHeight:=0; CellWidth:=0;
  rg := TExcelFile(Workbook).CellMergedBounds[Row, Col];
  if rg.Bottom > rg.Top then exit; //We can not autofit merged cells with more than one row.

    for c := rg.Left to rg.Right do
    begin
      CellWidth:= CellWidth + (TExcelFile(Workbook).ColumnWidthHiddenIsZero[c] / ColMultDisplay);
    end;

    for r := rg.Top to rg.Bottom do
    begin
      CellHeight := CellHeight + TExcelFile(Workbook).RowHeightHiddenIsZero[r] / RowMultDisplay;
    end;

    Clp := (1 * 72.0) / 100.0;

    if Alpha = 0 then
      Wr := (CellWidth) - (2 * Clp) else
    begin
      Wr := 1000000;
    end;

    TFlexcelGrid.SplitText(TExcelFile(Workbook), Canvas, val.Value, Round(Wr), TextLines, val.RTFRuns, RTFRuns2, TextExtent, Vertical, 1);
    if Length(TextLines) <= 0 then exit;

{    H := 0;
    W := 0;
    for i := 0 to Length(TextLines) - 1 do
    begin
      H:= H + TextLines[i].YExtent;
      if TextLines[i].XExtent > W then
        W := TextLines[i].XExtent;

    end;
    }
    H:= TextExtent.cy * Length(TextLines);
    W:= TextExtent.cx;


    if Alpha <> 0 then
    begin
      SinAlpha := Sin((Alpha * PI) / 180);
      CosAlpha := Cos((Alpha * PI) / 180);
      H := (H * CosAlpha) + (W * Abs(SinAlpha));
    end;

  Result := Ceil(RowMultDisplay * H);
{$ENDIF}
end;

destructor TRowHeightCalc.Destroy;
begin
  FreeAndNil(bmp);
  inherited;
end;

{ TColWidthCalc }
constructor TColWidthCalc.Create(const aWg: TWorkbookGlobals);
begin
  inherited Create;
  Wg := aWg;
  bmp := TBitmap.Create;
  bmp.Height := 1;
  bmp.Width := 1;
  Canvas := bmp.Canvas;
  InitXF;
end;

procedure TColWidthCalc.InitXF();
var
  i: integer;
  xf: TXFRecord;
  FontIndex: integer;
  Fr: TFontRecord;
begin
  SetLength (XFFonts, Wg.XF.Count);
  FillChar(XFFonts[0], Length(XFFonts), 0);
  for i := 0 to Length(XFFonts) - 1 do
  begin
    xf := Wg.XF[i];
    FontIndex := xf.GetActualFontIndex(Wg.Fonts);
    Fr := Wg.Fonts[FontIndex];
    XFFonts[i] := Fr.FlxFont;
  end;

end;

function TColWidthCalc.CalcCellWidth(const Row: integer; const Col: integer; const val: TRichString; const XF: integer; const Workbook: pointer; const RowMultDisplay: Extended; const ColMultDisplay: Extended): integer;
{$IFDEF FLEXCEL}
var
  XFRec: TXFRecord;
  Vertical: Boolean;
  Alpha: Extended;
  rg: TXlsCellRange;
  TextExtent: TSize;
  TextLines: WidestringArray;
  Clp: Extended;
  Wr: Extended;
  CellHeight: extended;
  r: integer;
  H: Extended;
  W: Extended;
  SinAlpha: Extended;
  CosAlpha: Extended;
  RtfRuns2: TRTFRunListList;
{$ENDIF}
begin
{$IFNDEF FLEXCEL}
  Result := 0;
{$ELSE}
  if (val.Value = '') then begin Result := 0; exit; end;

  XFRec := Wg.XF[XF];
  Alpha := CalcAngle(XFRec.Rotation, Vertical);

  Canvas.Font.Name := XFFonts[XF].Name;
  Canvas.Font.Size := Round(XFFonts[XF].Size20 / 20.0);
  if XFFonts[XF].Underline <> fu_None then Canvas.Font.Style:=Canvas.Font.Style+[fsUnderline];
  if flsBold in XFFonts[XF].Style then Canvas.Font.Style:=Canvas.Font.Style+[fsBold];
  if flsItalic in XFFonts[XF].Style then Canvas.Font.Style:=Canvas.Font.Style+[fsItalic];
  if flsStrikeOut in XFFonts[XF].Style then Canvas.Font.Style:=Canvas.Font.Style+[fsStrikeOut];


  rg := TExcelFile(Workbook).CellMergedBounds[Row, Col];
  if rg.Right > rg.Left then
    begin Result := 0; exit; end; //We can not autofit merged cells with more than one column.

  Clp := (1 * 72.0) / 100.0;

  if (Alpha <> 90) and (Alpha <> -90) then
    Wr := 1000000 else
  begin
    CellHeight:=0;
    for r := rg.Top to rg.Bottom do
    begin
      CellHeight := CellHeight + TExcelFile(Workbook).RowHeightHiddenIsZero[r] / RowMultDisplay;
    end;

    Wr := CellHeight - (2 * Clp);
  end;

  TFlexCelGrid.SplitText(TExcelFile(Workbook), Canvas, val.Value, Round(Wr), TextLines, val.RTFRuns, RtfRuns2, TextExtent, Vertical, 1);
  if Length(TextLines) <= 0 then
    begin Result := 0; exit; end;

  H:= TextExtent.cy;
  W:= TextExtent.cx;
{ H := 0;
  W := 0;
  for i := 0 to Length(TextLines) - 1 do
   begin
    H:= H + TextLines[i].YExtent;
    if (TextLines[i].XExtent + (2 * Clp)) > W then
      W := TextLines[i].XExtent;

  end;
}
  if Alpha <> 0 then
  begin
    SinAlpha := Sin((Alpha * PI) / 180);
    CosAlpha := Cos((Alpha * PI) / 180);
    W := (W * CosAlpha) + (H * Abs(SinAlpha));
  end;

  Result := Ceil(ColMultDisplay * (W + (2 * Clp)));
{$ENDIF}
end;

destructor TColWidthCalc.Destroy;
begin
  FreeAndNil(bmp);
  inherited;
end;


end.