delphi - Tprinter キャンバスにビットマップを描画する信頼できる方法はありますか?

Question

印刷プレビュー オブジェクトを作成しました。これにより、さまざまなソースからの複数のグラフィック オブジェクトを印刷ページに整理できます。

これらのオブジェクトをプリンター キャンバスにレンダリングするには、最初にそれらを計算されたサイズのビットマップにレンダリングし、次に canvas.draw(x,y,bitmap) メソッドを使用して正しい位置で Tprinter キャンバスにビットマップをレンダリングする必要があります。

デバイスに依存しないビットマップが必要であることを早い段階で知り、ピクセル形式を pf24bit に設定しました。

オフィスの HP Laserjet でこれを試してみましたが、正常に動作し、HP color Deskjet は正常に動作しますが、Cannon カラー プリンタは動作しないか、ランダムなポイントでグラフィックが断続的に表示されることがあります。

グラフィック オブジェクトをプリンタ キャンバスに直接レンダリングすると、すべて正常に動作します。

ただし、プリンター キャンバスに直接レンダリングすることは、さまざまな理由から、長期的に実行できる解決策ではありません。

それで、私の質問は、Tprinter.canvas がハードウェアに依存する原因は何ですか?また、回避策はありますか?

ページをマージンとセル パディングを使用して 4 つの象限に分割し、各象限にグラフィカル オブジェクトを配置するサンプル コード。各グラフィカル オブジェクトには、グラフィックを描画する RenderToBitmap メソッドがあります。

procedure TMultiPrintForm.PrintBtnClick(Sender: TObject);
var w,h,h2,w2,mv,iw,ih,pv,cw,ch:integer; Abmp:Tbitmap;
begin
  Abmp:=Tbitmap.create;
  Abmp.PixelFormat := pf24bit;
  try
    with Printer do
    begin
      w:=pagewidth;   
      h:=pageheight; 
      h2:=h div 2; 
      w2:=w div 2;
      mv:=h*margin.value div 200;    //margin percentage div 2 
      pv:=h*padding.value div 400;   //padding percentage div 4
      iw:=w-mv;                      //internal width
      ih:=h-mv;                      //internal height
      cw:=(iw-mv) div 2-pv;          //Quadrant Cell Width
      ch:=(ih-mv) div 2-pv;          //Quadrant Cell Height
      Abmp.width:=cw;
      Abmp.height:=ch;
      If Fsources[0]<>nil then
      begin
        Fsources[0].rendertoBitmap(Abmp);
        canvas.draw(mv,mv,Abmp);
      end;
      If Fsources[1]<>nil then
      begin
        Fsources[1].rendertoBitmap(Abmp);
        canvas.draw(w2+pv,mv,Abmp);
      end;
      If Fsources[2]<>nil then
      begin
        Fsources[2].rendertoBitmap(Abmp);
        canvas.draw(mv,h2+pv,Abmp);
      end;
      If Fsources[3]<>nil then
      begin
        Fsources[3].rendertoBitmap(Abmp);
        canvas.draw(w2+pv,h2+pv,Abmp);
      end;
    end;
  finally
    printer.Enddoc;
    Abmp.free;
  end
end;

ネット上でさらに調査した結果、Microsoft が推奨する手法を使用する PrintBitmap 手順に関するいくつかの提案を蓄積しました。

すべての Canvas.draw 呼び出しを PrintBitmap 呼び出しに置き換えました (begindoc と enddoc が呼び出しの外に設定されていると想定しています)。

週末なので、オフィスの問題のあるプリンターでテストすることはできませんが、少なくとも自宅の HP Deskjet プリンター (どちらの方法でも動作します) での印刷が中断されることはありません。

procedure PrintBitmap(X,Y:integer; Abmp:Tbitmap);
var Info: PBitmapInfo;
  InfoSize,ImageSize: DWORD;  Image: Pointer;
  DIBWidth, DIBHeight: LongInt;
begin
  with Printer do
  begin
    GetDIBSizes(Abmp.Handle, InfoSize, ImageSize);
    Info  := AllocMem(InfoSize);
    Image := AllocMem(ImageSize);
    try
      GetDIB(Abmp.Handle, 0, Info^, Image^);
      with Info^.bmiHeader do
      begin
        DIBWidth := biWidth;
        DIBHeight := biHeight;
      end;
      StretchDIBits(Canvas.Handle, X, Y, DIBWidth, DIBHeight, 0, 0,
      DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
    finally
      FreeMem(Image, ImageSize);
      FreeMem(Info, InfoSize);
    end
  end;
end;