Печать изображения

[1123]

Доброго времени суток всем!!! У меня проблема - не могу распечатать изображение из компонента TImage так, чтобы оно печаталось на весь лист А4. Кто-нибудь помогите с этим вопросом, пожалуйста. (Разрешение рисунка и, соответственно TImage, - 880x1244).
Код, используемый мной:

procedure TForm1.Button3Click(Sender: TObject);
begin
  with Printer do
    begin
      BeginDoc;
      Canvas.Draw(0, 0, Image1.Picture.Graphic);
      EndDoc ;
    end;
end;

[zetrix]

Картинка должна быть в Image1.

procedure TForm1.Button1Click(Sender: TObject);
var
 X1,X2,Y1,Y2:Integer;
 PointsX,PointsY:double;
 PrintDlg:TPrintDialog;
begin
 PrintDlg:=TPrintDialog.Create(Owner);
 if PrintDlg.Execute then
  begin
   Printer.BeginDoc;
   Printer.Canvas.Refresh;
   PointsX:=GetDeviceCaps(Printer.Canvas.Handle,LOGPIXELSX)/70;
   PointsY:=GetDeviceCaps(Printer.Canvas.Handle,LOGPIXELSY)/70;

   X1:=round((Printer.PageWidth - Image1.Picture.Bitmap.Width*PointsX)/2);
   Y1:=round((Printer.PageHeight - Image1.Picture.Bitmap.Height*PointsY)/2);
   X2:=round(X1+Image1.Picture.Bitmap.Width*PointsX);
   Y2:=round(Y1+Image1.Picture.Bitmap.Height*PointsY);
   Printer.Canvas.CopyRect(Rect(X1,Y1,X2,Y2),Image1.Picture.Bitmap.Canvas,
             Rect(0,0,Image1.Picture.Bitmap.Width,Image1.Picture.Bitmap.Height));

   Printer.EndDoc;
  end;
 PrintDlg.Free;
end;

[Umen]

Вот ешё варианты:

uses  
  Printers;  
procedure TForm1.Button1Click(Sender: TObject);  
var  
  ScaleX, ScaleY: Integer;  
  RR: TRect;  
begin  
  with Printer do  
  begin  
    BeginDoc;  
    // The StartDoc function starts a print job.  
    try  
      ScaleX := GetDeviceCaps(Handle, logPixelsX) div PixelsPerInch;  
      ScaleY := GetDeviceCaps(Handle, logPixelsY) div PixelsPerInch;  
      // Retrieves information about the Pixels per Inch of the Printer.  
      RR := Rect(0, 0, Image1.picture.Width * scaleX, Image1.Picture.Height * ScaleY);  
      Canvas.StretchDraw(RR, Image1.Picture.Graphic);  
      // Stretch to fit  
    finally  
      EndDoc;    
    end;  
  end;  
end;

procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap);  
var  
  BitmapHeader: pBitmapInfo;  
  BitmapImage: Pointer;  
  HeaderSize: DWORD;  
  ImageSize: DWORD;  
begin  
  GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);  
  GetMem(BitmapHeader, HeaderSize);  
  GetMem(BitmapImage, ImageSize);  
  try  
    GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);  
    StretchDIBits(Canvas.Handle,  
      DestRect.Left, DestRect.Top,    // Destination Origin  
      DestRect.Right - DestRect.Left, // Destination Width  
      DestRect.Bottom - DestRect.Top, // Destination Height  
      0, 0,                           // Source Origin  
      Bitmap.Width, Bitmap.Height,    // Source Width & Height  
      BitmapImage,  
      TBitmapInfo(BitmapHeader^),  
      DIB_RGB_COLORS,  
      SRCCOPY)  
  finally  
    FreeMem(BitmapHeader);  
    FreeMem(BitmapImage)  
  end  
end {PrintBitmap};

uses  
  printers;  
procedure DrawImage(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap);  
var  
  Header, Bits: Pointer;  
  HeaderSize: DWORD;  
  BitsSize: DWORD;  
begin  
  GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);  
  Header := AllocMem(HeaderSize);  
  Bits := AllocMem(BitsSize);  
  try  
    GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^);  
    StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top,  
      DestRect.Right, DestRect.Bottom,  
      0, 0, ABitmap.Width, ABitmap.Height, Bits, TBitmapInfo(Header^),  
      DIB_RGB_COLORS, SRCCOPY);  
  finally  
    FreeMem(Header, HeaderSize);  
    FreeMem(Bits, BitsSize);  
  end;  
end;  
procedure PrintImage(Image: TImage; ZoomPercent: Integer);  
  // if ZoomPercent=100, Image will be printed across the whole page  
var   
  relHeight, relWidth: integer;  
begin  
  Screen.Cursor := crHourglass;  
  Printer.BeginDoc;  
  with Image.Picture.Bitmap do   
  begin  
    if ((Width / Height) > (Printer.PageWidth / Printer.PageHeight)) then  
    begin  
      // Stretch Bitmap to width of PrinterPage  
      relWidth := Printer.PageWidth;  
      relHeight := MulDiv(Height, Printer.PageWidth, Width);  
    end   
    else  
    begin  
      // Stretch Bitmap to height of PrinterPage  
      relWidth  := MulDiv(Width, Printer.PageHeight, Height);  
      relHeight := Printer.PageHeight;  
    end;  
    relWidth := Round(relWidth * ZoomPercent / 100);  
    relHeight := Round(relHeight * ZoomPercent / 100);  
    DrawImage(Printer.Canvas, Rect(0, 0, relWidth, relHeight), Image.Picture.Bitmap);  
  end;  
  Printer.EndDoc;  
  Screen.cursor := crDefault;  
end;  
// Example Call:  
procedure TForm1.Button1Click(Sender: TObject);  
begin  
  // Print image at 40% zoom:  
  PrintImage(Image1, 40);  
end;