《Delphi》修正 Quick Report 预览列印的比例问题

　　Quick Report 在 1920*1080 解析度加上 125% 以上的显示设定环境时，会发生「预览列印」的比例不对(过大或过小)，但实际印出来是正常的情形，如果要修正，需要在编译环境修正 Quick Report 的 qrprntr.pas 档，有两种修正方式。

◎ 档案位置
Ç:\程序文件 (86)\EmbarcaderoStudio16.0Quickrep506qrprntr.pas

◎ 方法一
增加一个 scaleToNativeDeskRes Function 让 FMetafile.Width 及 FMetafile.Height 调用。

procedure TQRPrinter.CreateMetafileCanvas;

  function scaleToNativeDeskRes(pVal: Integer): Integer;
  var
   tTemp: HDC;
  begin
    tTemp := GetDC(0);
    try
      Result := Round((pVal * GetDeviceCaps(tTemp, VERTRES)) / GetDeviceCaps(tTemp, DESKTOPVERTRES));
    finally
      ReleaseDC(0, tTemp);
    end;
  end;

begin
...
  FMetafile.Width := scaleToNativeDeskRes(XSize(PaperWidthValue));
  FMetafile.Height := scaleToNativeDeskRes(YSize(PaperLengthValue));
  FCanvas := TMetafileCanvas.Create(FMetafile, 0);
  FCanvas.Font.PixelsPerInch := MetafileDPI;
...
end;

完整范例如下

procedure TQRPrinter.CreateMetafileCanvas;

// 解決 Windows 字型放大到 125% 以上時，預覽列印的比例會異常的問題。
 function scaleToNativeDeskRes(pVal: Integer): Integer;
  var
    tTemp: HDC;
  begin
    tTemp := GetDC(0);
    try
      Result := Round((pVal * GetDeviceCaps(tTemp, VERTRES)) / GetDeviceCaps(tTemp, DESKTOPVERTRES));
    finally
      ReleaseDC(0, tTemp);
    end;
  end;

begin
  FMetafile := TMetafile.Create;
  // {$define HIRES}
{$IFDEF HIRES}
  // try a high res canvas
  XFactor := GetDeviceCaps(aPrinter.Handle, LogPixelsX) / 254;
  YFactor := GetDeviceCaps(aPrinter.Handle, LogPixelsY) / 254;
  FMetafile.Width := XSize(PaperWidthValue);
  FMetafile.Height := YSize(PaperLengthValue);
  FCanvas := TMetafileCanvas.Create(FMetafile, aprinter.Handle);
  FCanvas.Font.PixelsPerInch := GetDeviceCaps(aprinter.Handle, LOGPIXELSY);
{$ELSE}
  // dpi fix ? suggested by David Martin
  FMetafile.Width := scaleToNativeDeskRes(XSize(PaperWidthValue)); // add // 在此處調用 scaleToNativeDeskRes。
  FMetafile.Height := scaleToNativeDeskRes(YSize(PaperLengthValue)); // add // 在此處調用 scaleToNativeDeskRes。
  FCanvas := TMetafileCanvas.Create(FMetafile, 0); // add
  FCanvas.Free; // add
  if FMetafile.Width > XSize(PaperWidthValue) then // add
    FMetafile.Inch := (96 * FMetafile.Width) div XSize(PaperWidthValue); // add
  // end fix

  FMetafile.Width := XSize(PaperWidthValue);
  FMetafile.Height := YSize(PaperLengthValue);
  FCanvas := TMetafileCanvas.Create(FMetafile, 0);
  YFactor := Screen.PixelsPerInch / 254;
  XFactor := YFactor;
  SetGraphicsMode(FCanvas.handle, GM_ADVANCED); // disable this line
{$ENDIF}
  // FHyperlinks := TList.Create;
end;

◎ 方法二

其实在 Quick Report 5.06 版中，已经有提供修正程式，写在 {$IFDF 招聘} 底下，只是程式没有在 {$定义雇佣} 定义什么情况下算高解析度，所以程式不会跑进修正程式。
因此方法二就是把 {$IFDF 招聘} 里的程式移到 {$别的} 底下，取代原本的写法即可。

procedure TQRPrinter.CreateMetafileCanvas;

begin
  FMetafile := TMetafile.Create;
  // {$define HIRES}
{$IFDEF HIRES}

{$ELSE}
  // try a high res canvas
  // 解決 Windows 字型放大到 125% 以上時，預覽列印的比例會異常的問題。
  XFactor := GetDeviceCaps(aPrinter.Handle, LogPixelsX) / 254;
  YFactor := GetDeviceCaps(aPrinter.Handle, LogPixelsY) / 254;
  FMetafile.Width := XSize(PaperWidthValue);
  FMetafile.Height := YSize(PaperLengthValue);
  FCanvas := TMetafileCanvas.Create(FMetafile, aprinter.Handle);
  FCanvas.Font.PixelsPerInch := GetDeviceCaps(aprinter.Handle, LOGPIXELSY);

  // dpi fix ? suggested by David Martin
  FMetafile.Width := scaleToNativeDeskRes(XSize(PaperWidthValue)); // add
  FMetafile.Height := scaleToNativeDeskRes(YSize(PaperLengthValue)); // add
  FCanvas := TMetafileCanvas.Create(FMetafile, 0); // add
  FCanvas.Free; // add
  if FMetafile.Width > XSize(PaperWidthValue) then // add
    FMetafile.Inch := (96 * FMetafile.Width) div XSize(PaperWidthValue); // add
  // end fix

  FMetafile.Width := XSize(PaperWidthValue);
  FMetafile.Height := YSize(PaperLengthValue);
  FCanvas := TMetafileCanvas.Create(FMetafile, 0);
  YFactor := Screen.PixelsPerInch / 254;
  XFactor := YFactor;
  SetGraphicsMode(FCanvas.handle, GM_ADVANCED); // disable this line
{$ENDIF}
  // FHyperlinks := TList.Create;
end;

【參考連結】