advgridexcel.pas

DELPHI tms.component.pack.v4.6.0.7

      Fm.Borders.Bottom.Style := fbs_Thin;
      Fm.Borders.Bottom.ColorIndex := NearestColorIndex(Workbook, ColorToRGB(BottomPen.Color), UsedColors);
      for i:=0 to Span do
      begin
        LastRowBorders[cg+i].HasBottom := true;
        LastRowBorders[cg+i].BottomColor := Fm.Borders.Bottom.ColorIndex;
      end;
    end else
    begin
      for i:=0 to Span do
      begin
        LastRowBorders[cg+i].HasBottom:=false;
      end;
    end;

    if (cbRight in Borders) then
    begin
      Fm.Borders.Right.Style:= fbs_Thin;
      Fm.Borders.Right.ColorIndex:=NearestColorIndex(Workbook, ColorToRGB(RightPen.Color), UsedColors);

      LastRowBorders[cg+Span+1].HasRight:=true;
      LastRowBorders[cg+Span+1].RightColor:=Fm.Borders.Right.ColorIndex;
    end else
    begin
      LastRowBorders[cg+Span+1].HasRight:=false;
    end;

  finally
    FreeAndNil(BottomPen);
  end;
  finally
    FreeAndNil(RightPen);
  end;
  finally
    FreeAndNil(TopPen);
  end;
  finally
    FreeAndNil(LeftPen);
  end;

end;

procedure TAdvGridExcelIO.CopyFmToMerged(const Workbook: TExcelFile; const cp: TCellProperties; const rx, cx: integer; const Fm: TFlxFormat);
var
  r,c: integer;
  fmi: integer;
begin
  if (cp <> nil) and ((cp.CellSpanX > 0) or (cp.CellSpanY > 0)) then
  begin
    fmi:=Workbook.AddFormat(Fm);
    for c:=cp.CellSpanX downto 0 do
      for r:=cp.CellSpanY downto 0 do
        Workbook.CellFormat[rx+r, cx+c]:=Fmi;
  end;
end;

procedure TAdvGridExcelIO.ResizeCommentBox(const Workbook: TExcelFile; const Comment: string; var h, w: integer);
{$IFDEF FLEXCEL}
var
  TextLines: WidestringArray;
  OutRTFRuns: TRTFRunList;
  RTFRuns: TRTFRunListList;
  TextExtent: TSize;
  TmpCanvas: TTmpCanvas;
{$ENDIF}
begin
{$IFDEF FLEXCEL}
  TmpCanvas := TTmpCanvas.Create();
  try
    TmpCanvas.Canvas.Font.Name:='Arial';
    TmpCanvas.Canvas.Font.Size := 10;
    SetLength(OutRTFRuns, 0);
    TFlexCelGrid.SplitText(Workbook, TmpCanvas.Canvas, Comment, w, TextLines, OutRTFRuns, RTFRuns, TextExtent, false, 1);
    h:= Ceil((TextExtent.cy + 1) * (Length(TextLines) + 1));
  finally
    FreeAndNil(TmpCanvas);
  end; //finally
{$ENDIF}
end;


procedure TAdvGridExcelIO.ExportData(const Workbook: TExcelFile);
var
  Zoom100: extended;
  rg, cg, rx, cx: integer;
  Fm: TFlxFormat;
  w: widestring;
  Pic: TCellGraphic;
  AState: TGridDrawState;
  ABrush: TBrush;
  AColorTo,AMirrorColor,AMirrorColorTo: TColor;
  AFont: TFont;
  HA: TAlignment;
  VA: TVAlignment;
  WW: Boolean;
  cp: TCellProperties;
  AAngle: integer;
  Comment, Formula: string;
  Properties: TImageProperties;
  Cr: TXlsCellRange;
  aDateFormat, aTimeFormat: widestring;
  LastRowBorders: TRowBorderArray;
  HiddenColCount: Integer;
  HiddenRowCount: Integer;
  SpanX, SpanY: integer;
  CReal, RReal: Integer;
  UsedColors: BooleanArray;
  GD: TCellGradientDirection;
  NamedRange: TXlsNamedRange;

  HasFixedRows, HasFixedCols: boolean;
  ExportCellAsString: boolean;
  GridColCount, GridRowCount: integer;
  hid: integer;

  CommentHeight: integer;
  CommentWidth: integer;
begin
  Zoom100 := 1;
  Assert(Workbook <> nil, 'AdvGridWorkbook can''t be nil');
  Assert(CurrentGrid <> nil, 'AdvStringGrid can''t be nil');

  //Workbook.DefaultRowHeight:=Round(CurrentGrid.DefaultRowHeight*RowMult/Zoom100);
  //Workbook.DefaultColWidth:=Round(CurrentGrid.DefaultColWidth*ColMult/Zoom100);

  if Options.ExportPrintOptions then
  begin
    Workbook.PrintOptions := Workbook.PrintOptions and not fpo_NoPls;
    Workbook.PrintScale := 100;
    if (CurrentGrid.PrintSettings.Orientation = poPortrait) then
    begin
      Workbook.PrintOptions := Workbook.PrintOptions or fpo_Orientation;
    end else
    begin
      Workbook.PrintOptions := Workbook.PrintOptions and not fpo_Orientation;
    end;

    HasFixedRows := (CurrentGrid.PrintSettings.RepeatFixedRows) and (CurrentGrid.FixedRows > 0);
    HasFixedcols := (CurrentGrid.PrintSettings.RepeatFixedCols) and (CurrentGrid.FixedCols > 0);

    if HasFixedRows or HasFixedCols then
    begin
      InitializeNamedRange(NamedRange);
      NamedRange.Name:=InternalNameRange_Print_Titles;
      NamedRange.NameSheetIndex:=Workbook.ActiveSheet;
      if HasFixedRows then
      begin
        NamedRange.RangeFormula:='=$A$1:$' + EncodeColumn(Max_Columns+1) + '$' + IntToStr(CurrentGrid.FixedRows);
      end;
      if HasFixedCols then
      begin
        if NamedRange.RangeFormula <> '' then NamedRange.RangeFormula:= NamedRange.RangeFormula+', ' else NamedRange.RangeFormula:='=';
        NamedRange.RangeFormula:= NamedRange.RangeFormula +'$A$1:$' + EncodeColumn(CurrentGrid.FixedCols) + '$' + IntToStr(Max_Rows + 1);
      end;

      Workbook.AddRange(NamedRange);
    end;

  end;

  Workbook.OutlineSummaryRowsBelowDetail := Options.ExportSummaryRowsBelowDetail;
  Workbook.OutlineSummaryColsRightOfDetail := Options.ExportSummaryRowsBelowDetail;


  Workbook.ShowGridLines := Options.ExportShowGridLines;
  //Adjust Row/Column sizes and set Row/Column formats
  UsedColors := GetUsedPaletteColors(Workbook);

  CurrentGrid.ExportNotification(esExportStart,-1);
  HiddenColCount := CurrentGrid.NumHiddenColumns;
  HiddenRowCount := CurrentGrid.NumHiddenRows;

  GridColCount := CurrentGrid.ColCount;
  if Options.ExportHiddenColumns then inc(GridColCount, HiddenColCount);

  CurrentGrid.ColCount := CurrentGrid.ColCount + HiddenColCount;
  try
    GridRowCount := CurrentGrid.RowCount + HiddenRowCount;
    if Options.FExportHiddenRows then
      CurrentGrid.RowCount := CurrentGrid.RowCount + HiddenRowCount;
    try

      if Options.ExportCellSizes then
      begin
        rx := XlsStartRow; hid:=0;
        for rg := GridStartRow to GridRowCount - 1 do
        begin
          if CurrentGrid.IsHiddenRow(rg) then
          begin
            if Options.FExportHiddenRows then
            begin
              Workbook.RowHidden[rx] := true;
              inc(rx);
            end;
            inc(hid);
            continue;

          end;
          Workbook.RowHeight[rx] := Round(CurrentGrid.RowHeights[rg - hid] * RowMult / Zoom100) - CellOfs;
          inc(rx);
        end;

        cx := XlsStartCol;
        for cg := GridStartCol to CurrentGrid.ColCount - 1 do
        begin
          if CurrentGrid.IsHiddenColumn(cg) then
          begin
            if Options.ExportHiddenColumns then Workbook.ColumnHidden[cx] := true else continue;
          end;
          Workbook.ColumnWidth[cx] := Round(CurrentGrid.AllColWidths[cg] * ColMult / Zoom100) - CellOfs;
          inc(cx);
        end;
      end;

      SetLength(LastRowBorders, CurrentGrid.ColCount + 2);
      for cg := 0 to  Length(LastRowBorders) - 1 do
      begin
        LastRowBorders[cg].HasBottom:=false;
        LastRowBorders[cg].HasRight:=false;
      end;

      //Export data
      for rg := GridStartRow to CurrentGrid.RowCount - 1 do
      begin
        CurrentGrid.ExportNotification(esExportNewRow,rg);
        rx := rg - GridStartRow + XlsStartRow;

        if Options.FExportHiddenRows then
        begin
          if (CurrentGrid.IsHiddenRow(rg)) then
            rreal :=CurrentGrid.RowCount - CurrentGrid.NumHiddenRows
          else
            rreal := CurrentGrid.DisplRowIndex(rg);
        end
        else
          rreal := rg;

        for cg := GridStartCol to GridColCount - 1 do
        begin
          cx := cg - GridStartCol + XlsStartCol;

         if Options.ExportHiddenColumns then
           creal := cg
         else
           creal := CurrentGrid.RealColIndex(cg);

          //Merged Cells
          cp := TCellProperties( CurrentGrid.GridObjects[creal,rreal]);

          if (cp <> nil) and not (cp.IsBaseCell) then
            Continue;

          if (cp <> nil) and ((cp.CellSpanX > 0) or (cp.CellSpanY > 0)) then
            Workbook.MergeCells(rx, cx, rx + cp.CellSpanY, cx + cp.CellSpanX);

          Fm := CellFormatDef(Workbook, rx, cx);

          AFont := TFont.Create;
          try
            ABrush := TBrush.Create;
            ABrush.Color := CurrentGrid.Color;
            try
              CurrentGrid.GetVisualProperties(creal, rreal, AState, false, false, false , ABrush, AColorTo,AMirrorColor,AMirrorColorTo, AFont, HA, VA, WW, GD);

              //Font
              Fm.Font.ColorIndex := NearestColorIndex(Workbook, AFont.Color, UsedColors);
              Fm.Font.Size20 := Trunc(-AFont.Height * 72 / AFont.PixelsPerInch * 20 / Zoom100);
              //Fm.Font.Size20 := AFont.Size * 20;

              Fm.Font.Name := AFont.Name;
              if fsBold in AFont.Style then
                Fm.Font.Style := Fm.Font.Style + [flsBold] else Fm.Font.Style := Fm.Font.Style - [flsBold];
              if fsItalic in AFont.Style then
                Fm.Font.Style := Fm.Font.Style + [flsItalic] else Fm.Font.Style := Fm.Font.Style - [flsItalic];
              if fsStrikeOut in AFont.Style then
                Fm.Font.Style := Fm.Font.Style + [flsStrikeOut] else Fm.Font.Style := Fm.Font.Style - [flsStrikeOut];
              if fsUnderline in AFont.Style then
                Fm.Font.Underline := fu_Single else Fm.Font.Underline := fu_None;

              //Pattern
              {Bmp:=nil;
              try
                if Fm.FillPattern.Pattern=1 then
                begin
                  if (ACanvas.Brush.Color<>clwhite) then
                    ACanvas.Brush.Color:=clwhite;
                end else
                if Fm.FillPattern.Pattern=2 then
                begin
                  if (ACanvas.Brush.Color<>ABrushFg) then
                    ACanvas.Brush.Color:=ABrushFg;
                end else
                begin
                  Bmp:=CreateBmpPattern(Fm.FillPattern.Pattern, ABrushFg, ABrushBg);
                  Acanvas.Brush.Bitmap:=Bmp;
                end;

                ACanvas.FillRect(Rect(Round(Cw*ZoomPreview), Round(Ch*ZoomPreview), Round((Cw+RealColWidth(Col,Zoom100,XPpi))*ZoomPreview), Round((Ch+RealRowHeight(Row,Zoom100,YPpi))*ZoomPreview)));

              finally
                ACanvas.Brush.Bitmap:=nil;
                FreeAndNil(Bmp);
              end; //finally
              }

              if (cp = nil) then
              begin
                SpanY := 0;
                SpanX := 0;
              end else
              begin
                SpanY := cp.CellSpanY;
                SpanX := cp.CellSpanX;
              end;
              SetBorders(creal, rreal, LastRowBorders, SpanY, SpanX, Fm, Workbook, UsedColors);

              if ColorToRGB(ABrush.Color) = $FFFFFF then
              begin
                Fm.FillPattern.Pattern := 1; //no fill
              end else
              begin
                Fm.FillPattern.Pattern := 2; //Solid fill
                Fm.FillPattern.FgColorIndex := NearestColorIndex(Workbook, ColorToRGB(ABrush.Color), UsedColors);
              end;

              if CurrentGrid.IsRotated(creal, rreal, AAngle) then
              begin
                if AAngle < 0 then AAngle := 360 - (Abs(AAngle) mod 360) else
                  AAngle := AAngle mod 360;
                if (AAngle >= 0) and (AAngle <= 90) then Fm.Rotation := AAngle
                else if (AAngle >= 270) then Fm.Rotation := 360 - AAngle + 90;
              end;

              if FUseUnicode then
                w := SupressCR(CurrentGrid.WideCells[creal, rreal])
              else
                w := SupressCR(CurrentGrid.SaveCell(creal, rreal));

              Formula := SupressCR(CurrentGrid.SaveCell(creal, rreal));

              if (FOptions.ExportReadonlyCellsAsLocked) then
              begin
                Fm.Locked := CurrentGrid.ReadOnly[creal, rreal];
              end;

              if not Options.ExportHTMLTags then
              begin
                StringReplace(w,'<br>','#13#10',[rfReplaceAll, rfIgnoreCase]);
              end;

              if (pos(#10, w) > 0) or (CurrentGrid.WordWrap and Options.ExportWordWrapped) then
                Fm.WrapText := true;

              if (pos('</',w) > 0) and not Options.ExportHTMLTags then
                w := HTMLStrip(w);

              //Cell Align
              case HA of
                taLeftJustify: Fm.HAlignment := fha_left;
                taCenter: Fm.HAlignment := fha_center;
                taRightJustify: Fm.HAlignment := fha_right;
              else Fm.HAlignment := fha_general;
              end; //case

              case VA of
                vtaTop: Fm.VAlignment := fva_top;
                vtaCenter: Fm.VAlignment := fva_center;
              else Fm.VAlignment := fva_bottom;
              end; //case

              if Assigned(OnCellFormat) then
                OnCellFormat(CurrentGrid, creal, rreal, cx, rx, w, Fm);

              ExportCellAsString := not FOptions.ExportCellFormats;
              if Assigned(OnExportColumnFormat) then OnExportColumnFormat(CurrentGrid, creal, rreal, cx, rx, w, ExportCellAsString);