advgridexcel.pas

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

  Ms := TMemoryStream.Create;
  try

    if (PicType = xli_Jpeg) and not (Pic.Graphic is TJPEGImage) then
    begin //Convert the image
      JPic := TJPEGImage.Create;
      try
        BPic := TBitmap.Create; //we cant assign a metafile to a jpeg, so the temporary bitmap.
        try
          BPic.Width := Pic.Width;
          BPic.Height := Pic.Height;
          BPic.Canvas.Draw(0, 0, Pic.Graphic);
          JPic.Assign(BPic);
        finally
          FreeAndNil(BPic);
        end; //finally
        JPic.SaveToStream(Ms);
      finally
        FreeAndNil(JPic);
      end; //finally
    end
    else
      Pic.Graphic.SaveToStream(Ms);

    Ms.Position := 0;
    SetLength(s, Ms.Size);
    Ms.Read(s[1], Ms.Size);
    PSize := CurrentGrid.CellGraphicSize[cg, rg];
    CSize := CurrentGrid.CellSize(cg, rg);
    dh := 1;
    dw := 1;
    Cr := CurrentGrid.CellGraphics[cg, rg];

    case Cr.CellHAlign of
      haLeft:
        begin
        //Nothing, this is default
        end;
      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);
var
  Borders: TCellBorders;
  LeftPen, RightPen, TopPen, BottomPen: TPen;
  i: integer;
  Span: integer;
begin
  Span:=SpanCol;
  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);
    LeftPen.Assign(TopPen);
    RightPen.Assign(TopPen);
    BottomPen.Assign(TopPen);
    
    if Assigned(CurrentGrid.OnGetCellBorderProp) then
       CurrentGrid.OnGetCellBorderProp(CurrentGrid, rg, cg, LeftPen, TopPen, RightPen, BottomPen);

    if (cbTop in Borders) then
    begin
      Fm.Borders.Top.Style:= fbs_Thin;
      Fm.Borders.Top.ColorIndex:=MatchNearestColor(Workbook, ColorToRGB(TopPen.Color));
    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:=MatchNearestColor(Workbook, ColorToRGB(LeftPen.Color));
    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 := MatchNearestColor(Workbook, ColorToRGB(RightPen.Color));
      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:=MatchNearestColor(Workbook, ColorToRGB(BottomPen.Color));

      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: TPicture;
  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;

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

  //Adjust Row/Column sizes and set Row/Column formats

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

          //Font
          Fm.Font.ColorIndex := MatchNearestColor(Workbook, AFont.Color);
          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);

          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 := MatchNearestColor(Workbook, ColorToRGB(ABrush.Color));
          end;