Delphi Image Print

Question

I have an array of TImages each one containing thumbnail of a Image file in a specified directory and their Hint property set to their Image Filename for printing purpose. all files are located on a remote server in a shared directory (Example: \192.168.1.50\imgscan\12-14-54\ *.jpg).

also each Image has a corresponding TCheckBox that users can check to mark images for printing.

I use the following code for printing (variable images_index holds the number of images in the selected directory)...

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;

Now... On Microsoft XPS Document Writer I have no problems and all the pages are printed fine, but on real printers most of the time white papers come out and sometimes only some of the selected images are printed (for example 4 of 10 selected files).

What is the problem with my code? i googled a lot and found nothing!

Thanks.

Answer 1

The Canvas CopyRect function uses StretchBLT. We have had better results using the DIBits functions SetDIBitsToDevice or StretchDIBits. Here is our draw code. We have a DrawParams struct that is passed in with the details on how this image should be drawn.

The code below is using a TBitmap32 from graphics32. We use that because of some other drawing and resize routines we find useful. But the same code will work with a normal 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;