提高FastReport导出xlsx的图片清晰度

Delphi的打印控件，现在最好用的也就是FastReport了，其他的控件导出的excel多多少少都跟预览的效果不一样，但是FastReport导出的excel图片就很不清晰，不过有个解决办法就是用xls的控件，不要用xlsx,但是xls在unigui里面兼容性就没那么好了，还有就是FastReport的图片导出的excel图片是emf格式的，国内的WPS对emf格式的图片兼容性也不好，后面我就一直找各种report控件测试，但是效果都不怎么好，没办法只能是调整FastReprot了，首先我们找到frxExportXLSX，找到以下代码

with TfrxWriter.Create(FContentTypes) do
  begin
    Write(['<?xml version="1.0" encoding="UTF-8" standalone="yes"?>',
      '<Types xmlns="http://schemas.openxmlformats.org/package/2006/content-types">',
      '<Default Extension="xml" ContentType="application/xml"/>',
      '<Default Extension="rels" ContentType=',
      '"application/vnd.openxmlformats-package.relationships+xml"/>',
      '<Default Extension="emf" ContentType="image/x-emf"/>',
      '<Override PartName="/xl/styles.xml" ContentType=',
      '"application/vnd.openxmlformats-officedocument.spreadsheetml.styles+xml"/>',
      '<Override PartName="/xl/workbook.xml" ContentType=',
      '"application/vnd.openxmlformats-officedocument.spreadsheetml.sheet.main+xml"/>',
      '<Override PartName="/xl/sharedStrings.xml" ContentType=',
      '"application/vnd.openxmlformats-officedocument.spreadsheetml',
      '.sharedStrings+xml"/>',
      '<Override PartName="/docProps/core.xml" ContentType="application/vnd.',
      'openxmlformats-package.core-properties+xml"/>']);

    Free;
  end;

把emf改成PNG

with TfrxWriter.Create(FContentTypes) do
  begin
    Write(['<?xml version="1.0" encoding="UTF-8" standalone="yes"?>',
      '<Types xmlns="http://schemas.openxmlformats.org/package/2006/content-types">',
      '<Default Extension="xml" ContentType="application/xml"/>',
      '<Default Extension="rels" ContentType=',
      '"application/vnd.openxmlformats-package.relationships+xml"/>',
      '<Default Extension="png" ContentType="image/x-png"/>',
      '<Override PartName="/xl/styles.xml" ContentType=',
      '"application/vnd.openxmlformats-officedocument.spreadsheetml.styles+xml"/>',
      '<Override PartName="/xl/workbook.xml" ContentType=',
      '"application/vnd.openxmlformats-officedocument.spreadsheetml.sheet.main+xml"/>',
      '<Override PartName="/xl/sharedStrings.xml" ContentType=',
      '"application/vnd.openxmlformats-officedocument.spreadsheetml',
      '.sharedStrings+xml"/>',
      '<Override PartName="/docProps/core.xml" ContentType="application/vnd.',
      'openxmlformats-package.core-properties+xml"/>']);

    Free;
  end;

再找到这段

 for i := 0 to Pictures.Count - 1 do
      begin
        // The extension must be "emf", regardless what the actual format is.
        s := Format('image-s%d-p%d%s', [m.Index, i + 1, '.emf'], SetFormat);

        Write(Format('<Relationship Id="rId%d" Type="http://schemas.' +
          'openxmlformats.org/officeDocument/2006/relationships/image"' +
          ' Target="../media/%s"/>', [i + 1, s], SetFormat));
        SaveGraphicAs(TfrxIEMObject(Pictures[i]).Metafile, IOTransport.TempFilter.GetStream(FDocFolder + 'xl/media/' + s), PictureType);
        TfrxIEMObject(Pictures[i]).UnloadImage;
      end;

改成

for i := 0 to Pictures.Count - 1 do
      begin
        // The extension must be "emf", regardless what the actual format is.
        s := Format('image-s%d-p%d%s', [m.Index, i + 1, '.png'], SetFormat);

        Write(Format('<Relationship Id="rId%d" Type="http://schemas.' +
          'openxmlformats.org/officeDocument/2006/relationships/image"' +
          ' Target="../media/%s"/>', [i + 1, s], SetFormat));
        SaveGraphicAs(TfrxIEMObject(Pictures[i]).Metafile, IOTransport.TempFilter.GetStream(FDocFolder + 'xl/media/' + s), gpPNG);
        TfrxIEMObject(Pictures[i]).UnloadImage;
      end;

然后根据SaveGraphicAs找到frxImageConverter
找到

 procedure SaveAsPNG;
  {$IFNDEF FPC}
  {$IFNDEF Delphi12}
  type
    TPngImage = TPngObject;
  {$ENDIF}
  var
    Image: TPngImage;
  begin
    Image := TPngImage.CreateBlank(COLOR_RGB, 8, Graphic.Width, Graphic.Height);

    try
      Image.TransparentColor := $FFFFFF;
      Image.Canvas.Lock;
      try
        Image.Canvas.Brush.Color := Image.TransparentColor;
        Image.Canvas.FillRect(Image.Canvas.ClipRect);

        Image.Canvas.Draw(0, 0, Graphic);
      finally
        Image.Canvas.Unlock;
      end;
      Image.SaveToStream(Stream);
    finally
      Image.Free
    end
  end;

改成

procedure SaveAsPNG;
  {$IFNDEF FPC}
  {$IFNDEF Delphi12}
  type
    TPngImage = TPngObject;
  {$ENDIF}
  var
    Image: TPngImage;
  begin
    Image := TPngImage.CreateBlank(COLOR_RGB, 8, Graphic.Width*10, Graphic.Height*10);

    try
      Image.TransparentColor := $FFFFFF;
      Image.Canvas.Lock;
      try
        Image.Canvas.Brush.Color := Image.TransparentColor;
        Image.Canvas.FillRect(Image.Canvas.ClipRect);

        Image.Canvas.StretchDraw(Rect(0, 0, Image.Width, Image.Height), Graphic);
      finally
        Image.Canvas.Unlock;
      end;
      Image.SaveToStream(Stream);
    finally
      Image.Free
    end
  end;

导出的xlsx图片就清晰了，而且格式是PNG的，记录一下免得下次忘记，我的版本是6.9.14的，其他版本的你们可以自己研究研究