Delphi Image Print - delphi

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;