Problem drawing images on printer-canvas...

Edited text of question

Hey why don't you try this code, and see what happens....

 Printer.Begindoc;
   for aa := 0 to 4 do begin
     Image1 := TImage.Create(self); //the self word not form1
     Image1.Picture.LoadFromFile(
       format('c:\pics\pic%0.2d.bmp',[aa+1]));
     Printer.Canvas.StretchDraw(Rect(aa*300,10,aa*300+290,300),Image1.Picture.Graphic);

     Image1.Free;
   end;
   Printer.Enddoc;

So try this and report what happens...

Regards,
Viktor Ivanov

It's Viktor again!
If the sample I gave you doesn't help please get the error and tell us what is it...

Regards,
Viktor Ivanov

I've tried your suggestion but the problem remained. Then I rewrote the code to include 36 pictures, since I need to be able to display that many pictures (like an negative chart).
It then left out about 10 pictures, until I added the line marked with *****. Then it worked just fine, but why should I have to StretchDraw twice??

  Printer.Begindoc;
  for aa := 0 to 35 do begin
    Image := TImage.Create(Self);
    try
      Image.Picture.LoadFromFile(format('c:\bildregister\bilder\aa\aa%0.2d.bmp',[aa+1]));
    except
      //If a picture is missing, a blank should be printed...
    end;
    DestRect.Left := (aa mod 7) * 300;
    DestRect.Top := (aa div 7) * 300;
    DestRect.Right := (DestRect.Left + 290);
    DestRect.Bottom := (DestRect.Top + 290);
    Printer.Canvas.StretchDraw(DestRect,
      Image.Picture.Graphic);
    Printer.Canvas.StretchDraw(DestRect,
      Image.Picture.Graphic); ***************
    Image.Free;
  end;
  Printer.Enddoc;

Suggestions?

Here is what I've got. Remember to include the Printers unit in the uses clause...

The lines followed by // ** are essential. The others are to get the scaling correct otherwise you end up with extremely small images. Printer resolutions are higher than your screen resolution.
--------------------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
var
  ScaleX, ScaleY: Integer;
  R: TRect;
begin
  Printer.BeginDoc;  // **
  with Printer do
  try
    ScaleX := GetDeviceCaps(Handle, logPixelsX) div PixelsPerInch;
    ScaleY := GetDeviceCaps(Handle, logPixelsY) div PixelsPerInch;
    R := Rect(0, 0, Image1.Picture.Width * ScaleX,
      Image1.Picture.Height * ScaleY);
    Canvas.StretchDraw(R, Image1.Picture.Graphic);  // **
  finally
    EndDoc;  // **
  end;
end;
{Hey, because I haven't included how to do it for 35 images, you need to do your for loop, and assign and load the image from where you want to. If you still can't do it let me know and I'll give you the final code}
-----------------------------------------------
I hope this helps you do your job...

Regards,
Viktor Ivanov

You've misunderstood my problem, viktor. I'm having no problem positioning the pictures on the canvas, I'm down to less than 0.5 millimeters accuracy and perfect scale ratio.

The question was and is: Why do I have to repeat the Stretchdraw command twice to be sure that all the pictures are included? Why is the single StretchDraw command ignored sometimes, and sometimes not?

What's wrong with my answer?  I perfectly understood your question, and my example shows you exactly how to do it with only one StretchDraw. Isn't that right?

Anyway, instead of using

  Printer.Canvas.StretchDraw(DestRect,  Image.Picture.Graphic);***************

try using this

 Printer.Canvas.StretchDraw(DestRect,  Image.Picture.Graphic);  //**

and see if it works fine in your way, otherwise why don't you use my way to do it...

Regards,
Viktor Ivanov

Oh, and if the example above works you won't need to have two Stretches, but only one...

//Viktor Ivanov

The code I submitted, where I have an aa loop variable from 0 to 35 doesn't work unless I use 2 StretchDraw commands. I want to know why. That's the answer I'm looking for, nothing else. Try my example and see if it works for you. If you do, try it four or five times, and use only one StretchDraw. If it works for you, then maybe it's my printer driver or something else that is the problem and by clarifying that you have helped me. But I have tried it on two different printers, as I stated before, and the same problem occured on both printers.

Your example, besides the scaling, use the exact same technique of putting the image on paper that I do and that method does not work for me. Therefore I haven't tested it, it does not fit into the application I'm developing since I use a different technique of calculating the DestRect.

Please don't answer the question if you have any more suggestions, put it as a comment so I can have some opinions from other experts. If you submit a comment that solves the problem, I will gladly let you repost it as an answer and give you the best grade available!

Hi,
What you seem to need to do is to reduce the printer load, since your printers doesn't seem to cope with the images you send them.
Try to use an intermediate TBitmap with a smaller size (1:4-8) and draw your images onto it first and the draw it on the printer canvas. This will reduce the number of pixels transmitted significantly.

  bmIntermediate: TBitmap;

  bmIntermediate := TBitmap.Create;
  bmIntermediate.Width  := bmOriginal.Width div 4; // or whatever
  bmIntermediate.Height := bmOriginal.Height div 4; // or whatever
  bmIntermediate.Canvas.StretchDraw( Rect( 0, 0, bmIntermediate.Width, bmIntermediate.Height ), bmOriginal );
  Printer.Canvas.Draw( 100, 100, bmIntermediate );

Or something like that. Give it a try.

/// John

I'll check it out. The funny thing is that I tried to add an extra StretchDraw line in the database application I'm developing (the real application...) and then it works just fine; all pictures are shown and in the correct overlapping order.

The problem with your suggestion is that it must reduce picture quality by the same factor, and I'm very eager to get a good looking printout from the application. Earlier I tried to time the StretchDraw so I sent one image every other second, but it didn't help either.

Well, that's all I could do. Anyway, I'm not sure why it asks for 2nd stretching. It is supose to be working with only one stretch, but i don't know what's going on. maybe some other expert can help :)
All best!

Regards,
Viktor Ivanov

I never use StretchDraw. You say it works here, but if I was you, I still wouldn't use it. Try something like:


Var
  Info: PBitmapInfo;
  InfoSize: Integer;
  Image: Pointer;
  ImageSize: DWORD;
  DIBWidth, DIBHeight: Longint;
  bmp: TBitmap;
**********************************************
  GetDIBSizes(bmp.Handle, InfoSize, ImageSize);
  Info := AllocMem(InfoSize);
  Image := AllocMem(ImageSize);
  GetDIB(bmp.Handle, 0, Info^, Image^);
  with Info^.bmiHeader do
  begin
    DIBWidth := biWidth;
    DIBHeight := biHeight;
  end;
  With Printer Do
    StretchDIBits(Canvas.Handle, 0, 0, PageWidth, PageHeight,
                  0, 0, DIBWidth, DIBHeight, Image, Info^,
                  DIB_RGB_COLORS, SRCCOPY);
  FreeMem(Info, InfoSize);
  FreeMem(Image, ImageSize);

hi, dippen.

what happens if u create timage b4 begindoc and free it after enddoc?

Black Death.

Dippen,

What version of Delphi is it you're using?

I'll try your suggestion, Black Death. I'm using v3.0 with Windows 95

Matvey, if you hear this I would like you to repost your comment as an answer, since I gladely reward you the points. Not only did it solve my problem with the duplicate StretchDraw's, it also solved a problem concerning printing images to a black and white laser printer.