Question

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

每个Image都有一个相应的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个）。 / p>

我的代码有什么问题？我google了很多，一无所获！

感谢。

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;

德尔福图像打印

1 个答案: