【原创】将TsWorksheetGrid（fpspreadsheet）选择的Cell拷贝为图片

网友有个很特别的需求：将xlsx文件选定的单元格复制为图形，然后粘贴到其他单元格以保持复制的单元格不变形，虽然用excel可以完成这个任务，我选择fpspreadsheet来解决这个问题。TsWorksheetGrid选择的Cell拷贝为图片。
已知问题：
超出可视范围复制会存在错位的问题。

 复制粘贴后：

 

直接给出代码：

procedure TForm1.CopyCellToPic(ws:TsWorksheetGrid;bgColor:Boolean=true);
var
  Image:TImage;
  RC1, RC2: TRect;
  range: TsCellRangeArray;
  w,h,y1,x1:integer;
  sel: TsCellRange;
  r, c: Cardinal;
  srccell: PCell;
  ACellFormat2:TsCellFormat;
begin
  setlength(range,1);
  range:=ws.Workbook.ActiveWorksheet.GetSelection;

  if not bgcolor then  //不保留背景颜色
  begin
    for sel in ws.Workbook.ActiveWorksheet.GetSelection do
    begin
      for r := sel.Row1 to sel.Row2 do
      begin
        for c := sel.Col1 to sel.Col2 do
        begin
          srccell :=ws.Workbook.ActiveWorksheet.FindCell(r, c);
          if ws.Workbook.ActiveWorksheet.IsMerged(srccell) then
            srccell := ws.Workbook.ActiveWorksheet.FindMergeBase(srccell);
          if srccell <> nil then
          begin
            ACellFormat2:=ws.Workbook.ActiveWorksheet.ReadCellFormat(srccell);
            ACellFormat2.UsedFormattingFields:=[uffTextRotation, uffFont, uffBorder,
            uffNumberFormat, uffWordWrap, uffHorAlign, uffVertAlign, uffBiDi,
            uffProtection, uffDoNotPrint];
            ws.Workbook.ActiveWorksheet.WriteCellFormat(srccell,ACellFormat2);
          end;
        end;
      end;
    end;
  end;
  ws.ClearSelections;
  ws.Refresh;
  range[0].Col1:=range[0].Col1+1;
  range[0].Col2:=range[0].Col2+1;
  range[0].Row1:=range[0].Row1+1;
  range[0].Row2:=range[0].Row2+1;

  Image:=TImage.Create(ws);
  w:=ws.CellRect(range[0].Col1,range[0].Row1,range[0].Col2,range[0].Row2).Width;
  h:=ws.CellRect(range[0].Col1,range[0].Row1,range[0].Col2,range[0].Row2).Height;

  x1:=ws.CellRect(0,0,range[0].Col1-1,range[0].Row1).Width;
  y1:=ws.CellRect(0,0,0,range[0].Row1-1).Height;
  Image.Width:=w;
  Image.Height:=h;

  RC1 := Rect(0, 0, w, h);
  RC2 := Rect(x1, y1, w+x1, h+y1);

  r:=ws.Workbook.ActiveWorksheet.ActiveCellRow;
  c:=ws.Workbook.ActiveWorksheet.ActiveCellCol;

  ws.ClearSelections;
  ws.Refresh;
  ws.Workbook.ActiveWorksheet.SelectCell(r+1,c+1);
  ws.ClearSelections;
  ws.Refresh;

  Image.Canvas.CopyRect(rc1,ws.Canvas,rc2);
  Stream:=TMemoryStream.Create;
  Image.Picture.SaveToStream(Stream);

  ws.Workbook.ActiveWorksheet.SelectCell(r,c);
  ws.ClearSelections;
  ws.Refresh;

  Image.Free;
end;

procedure TForm1.PasteCellToPic(ws:TsWorksheetGrid);
var
  r,c:integer;
begin
  if Stream<>nil then
  begin
    r:=ws.Workbook.ActiveWorksheet.ActiveCellRow;
    c:=ws.Workbook.ActiveWorksheet.ActiveCellCol;
    ws.Workbook.ActiveWorksheet.
    WriteImage(r, c, Stream);
    ws.Refresh;
  end;
end;