德尔福图像打印

Question

我有一个 TImage 数组，每个 TImage 都包含指定目录中图像文件的缩略图，并且它们的 Hint 属性设置为其图像文件名以用于打印目的。所有文件都位于远程服务器上的共享目录中(例如:\192.168.1.50\imgscan\12-14-54\*.jpg)。

此外，每个图像都有一个相应的 TCheckBox，用户可以选中它来标记要打印的图像。

我使用以下代码进行打印(变量images_index保存所选目录中的图像数量)...

procedure PrintSelectedImages;
  var
    i: integer;
    R1, R2: TRect;
    Picture: TPicture;
    Bitmap: TBitmap;
    Total, done: integer;
begin
  Total := 0;
  done := 0;

  for i := 0 to images_index - 1 do
    if Checks[i].Checked then
      INC(Total);

  if Total = 0 then
    begin
      MessageDlg('No Images Selected!', mtInformation, [mbOK], 0);
      Exit;
    end;

  Printer.BeginDoc;

 if PrintDialog1.Execute then
   begin

     for i := 0 to images_index - 1 do
       begin

       if Checks[i].Checked then
         begin

           try
             Picture := TPicture.Create;
             Picture.LoadFromFile(images[i].Hint);
             Bitmap := TBitmap.Create;
           try
             Bitmap.Width := Picture.Width;
             Bitmap.Height := Picture.Height;
             Bitmap.Canvas.Draw(0, 0, Picture.Graphic);

             R1 := Rect(0, 0, Bitmap.Width, Bitmap.Height);
             R2 := Rect(0, 0, Printer.PageWidth, Printer.PageHeight);
             Printer.Canvas.CopyRect(R2, Bitmap.Canvas, R1);

             INC(done);
           finally
             Bitmap.Free;
           end;
           finally
             Picture.Free;
           end;

          if done < Total  then
            Printer.NewPage;
         end; // if

       end;  // i

   end;  // if


  Printer.EndDoc;
end;

现在...在 Microsoft XPS Document Writer 上，我没有任何问题，所有页面都打印得很好，但在真正的打印机上，大多数时候都会打印出白纸，有时只打印某些选定的图像(例如 10 个选定文件中的 4 个)。

我的代码有什么问题？我用谷歌搜索了很多，但一无所获!

谢谢。

Answer 1

Canvas CopyRect 函数使用 StretchBLT。我们使用 DIBits 函数获得了更好的结果 SetDIBitsToDevice或StretchDIBits 。这是我们的抽奖代码。我们有一个 DrawParams 结构体，其中包含有关如何绘制该图像的详细信息。

下面的代码使用 graphics32 中的 TBitmap32 。我们使用它是因为我们发现其他一些绘图和调整大小例程很有用。但相同的代码也适用于普通的 TBitmap。

{ TDrawParamsRecord }
  TDrawParamsRecord = record
  private
    function GetHeight(): integer;
    function GetWidth(): integer;

  public
    PictureZoom: integer;
    Stretch: boolean;
    Center: boolean;
    KeepAspectRatio: boolean;

    OutputRect: TRect;

    ResizeMode: TResizeMode;

    property Height: integer read GetHeight;
    property Width: integer read GetWidth;

    function Equal(OtherParams: TDrawParamsRecord): boolean;
  end;


{
  TCFImage.OutputToCanvas
  ---------------------------------------------------------------------------
  When writing to the canvas we could have a Screen canvas, a metafile canvas
  used to create a PDF file, or a printer canvas.  Because of this we want to
  make sure we are using the DIBits functions.  Many printer drivers can't use
  the StretchBLT function because of color space changes.  Everyone should
  support StretchDIBits.

  When resizing the image we sometimes will resize it internally to match the
  output size and other times we will let StretchDIBits handle the conversion.

}
procedure TCFImage.OutputToCanvas(Canvas: TCanvas; Image: TBitmap32; DrawParams: TDrawParamsRecord);
var
  // StretchDIBits has BmpInfo passed in as a Var parameter so we can't
  // use the read only property.
  BmpInfo: TBitmapInfo;
begin

  BmpInfo := Image.BitmapInfo;


  // If th output matches the current image size then we can just move the bits,
  // no reason for "Stretch"
  if (DrawParams.Height = Image.Height) and (DrawParams.Width = Image.Width) then
  begin
    SetDIBitsToDevice(Canvas.Handle,
                      DrawParams.OutputRect.Left, DrawParams.OutputRect.Top,
                      DrawParams.Width, DrawParams.Height,
                      0, 0, 0, Image.Height, Image.Bits, BmpInfo, DIB_RGB_COLORS);

  end
  else
  begin
    StretchDIBits(Canvas.Handle,
                  DrawParams.OutputRect.Left, DrawParams.OutputRect.Top,
                  DrawParams.Width, DrawParams.Height,
                  0, 0, Image.Width, Image.Height,
                  Image.Bits, BmpInfo, DIB_RGB_COLORS, SRCCOPY);
  end;
end;