advgridexcel.pas

TMS Component Pack Pro v4.2

      haRight:
        begin
          dw := CSize.X - PSize.X;
        end;
      haCenter:
        begin
          if (PSize.X < CSize.X) then
          begin
            dw := (CSize.X - PSize.X) div 2;
          end
        end;
      haBeforeText:
        begin
        //Nothing
        end;
      haAfterText:
        begin
        //Nothing
        end;
      haFull:
        begin
        //Nothing
        end;
    end;

    case Cr.CellVAlign of
      vaTop, vaAboveText:
        begin
        //This is default
        end;
      vaBottom:
        begin
          dh := CSize.Y - PSize.Y;
        end;
      vaCenter:
        begin
          if PSize.Y < CSize.Y then
          begin
            dh := (CSize.Y - PSize.Y) div 2;
          end
        end;
      vaUnderText:
        begin
        //Nothing
        end;
      vaFull:
        begin
        //Nothing
        end;
    end;


    CalcImgCells(Workbook, rx, cx, dh, dw, PSize.y, PSize.x, Props);
    Workbook.AddImage(s, PicType, Props, at_MoveAndDontResize);
  finally
    FreeAndNil(Ms);
  end; //finally
end;

function TAdvGridExcelIO.SupressCR(const s: Widestring): widestring;
var
  i, k: integer;
begin
  SetLength(Result, Length(s));
  k := 1;
  for i := 1 to Length(s) do if s[i] <> #13 then
    begin
      Result[k] := s[i];
      inc(k);
    end;

  SetLength(Result, k - 1);
end;

procedure TAdvGridExcelIO.SetBorders(const cg, rg: integer; var LastRowBorders: TRowBorderArray; SpanRow, SpanCol: integer;
                                     var Fm: TFlxFormat; const Workbook: TExcelFile; const UsedColors: BooleanArray);
var
  Borders: TCellBorders;
  LeftPen, RightPen, TopPen, BottomPen: TPen;
  i: integer;
  Span: integer;
begin
  Span:=SpanCol;
  if (Span<0) then Span:=0;
  if cg+Span>Length(LastRowBorders)-1 then Span:=Length(LastRowBorders)-1-cg;

  Borders:=[];
  LeftPen:=TPen.Create;
  try
  TopPen:=TPen.Create;
  try
  RightPen:=TPen.Create;
  try
  BottomPen:=TPen.Create;
  try
    CurrentGrid.GetCellBorder(cg, rg, TopPen, Borders);
    BottomPen.Assign(TopPen);
    LeftPen.Assign(TopPen);
    RightPen.Assign(LeftPen);

    if Assigned(CurrentGrid.OnGetCellBorderProp) then
       CurrentGrid.OnGetCellBorderProp(CurrentGrid, rg, cg, LeftPen, TopPen, RightPen, BottomPen);

    if (Options.ExportHardBorders) and (CurrentGrid.GridLineWidth>0) then
    begin
      if (goVertLine in CurrentGrid.Options) then
      begin
        if not (cbTop in Borders) then
        begin
          TopPen.Color:= CurrentGrid.GridLineColor;
          Include( Borders, cbTop);
        end;

        if not (cbBottom in Borders) then
        begin
          BottomPen.Color:= CurrentGrid.GridLineColor;
          Include(Borders, cbBottom);
        end;
      end;
      if (goHorzLine in CurrentGrid.Options) then
      begin
        if not (cbLeft in Borders) then
        begin
          LeftPen.Color:= CurrentGrid.GridLineColor;
          Include( Borders, cbLeft);
        end;

        if not (cbRight in Borders) then
        begin
          RightPen.Color:= CurrentGrid.GridLineColor;
          Include(Borders, cbRight);
        end;
      end;
    end;

    if (cbTop in Borders) then
    begin
      Fm.Borders.Top.Style:= fbs_Thin;
      Fm.Borders.Top.ColorIndex:=NearestColorIndex(Workbook, ColorToRGB(TopPen.Color), UsedColors);
    end else
    if (LastRowBorders[cg].HasBottom) then
    begin
      Fm.Borders.Top.Style:= fbs_Thin;
      Fm.Borders.Top.ColorIndex:=LastRowBorders[cg].BottomColor;
    end;

    if (cbLeft in Borders) then
    begin
      Fm.Borders.Left.Style:= fbs_Thin;
      Fm.Borders.Left.ColorIndex:=NearestColorIndex(Workbook, ColorToRGB(LeftPen.Color), UsedColors);
    end
    else
    if (LastRowBorders[cg+Span].HasRight) then
    begin
      Fm.Borders.Left.Style:= fbs_Thin;
      Fm.Borders.Left.ColorIndex:=LastRowBorders[cg+Span].RightColor;
    end;

    if (cbBottom in Borders) then
    begin
      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.ExportData(const Workbook: TExcelFile);
var
  Zoom100: extended;
  rg, cg, rx, cx: integer;
  Fm: TFlxFormat;
  w: widestring;
  Pic: TCellGraphic;
  AState: TGridDrawState;
  ABrush: TBrush;
  AColorTo: 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;
  HiddenCount: Integer;
  SpanX, SpanY: integer;
  CReal: Integer;
  UsedColors: BooleanArray;
  GD: TCellGradientDirection;
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);

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

  if Options.ExportCellSizes then
  begin
    for rg := GridStartRow to CurrentGrid.RowCount - 1 do
    begin
      rx := rg - GridStartRow + XlsStartRow;
      Workbook.RowHeight[rx] := Round(CurrentGrid.RowHeights[rg] * RowMult / Zoom100) - CellOfs;
    end;

    for cg := GridStartCol to CurrentGrid.ColCount - 1 do
    begin
      cx := cg - GridStartCol + XlsStartCol;
      Workbook.ColumnWidth[cx] := Round(CurrentGrid.ColWidths[cg] * ColMult / Zoom100) - CellOfs;
    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;

  CurrentGrid.ExportNotification(esExportStart,-1);
  HiddenCount := CurrentGrid.NumHiddenColumns;

  if Options.ExportHiddenColumns then
    CurrentGrid.ColCount := CurrentGrid.ColCount + HiddenCount;

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

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

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

      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(cg, rg, AState, false, false, not Options.ExportHiddenColumns , ABrush, AColorTo, 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.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(cg, rg, 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(cg, rg, 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, rg])
          else
            w := SupressCR(CurrentGrid.SaveCell(creal, rg));

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

          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;