Programowanie w języku Delphi » Gotowce

Drukowanie z TImage

Wydrukować bitmapę komponentu TImage wcale nie jest tak łatwo. Nie istnieje takie coś jak Image.Picture.Print;.
Możemy ewentualnie użyć tej procedury:

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,   
      DestRect.Right - DestRect.Left, 
      DestRect.Bottom - DestRect.Top,  
      0, 0,                          
      Bitmap.Width, Bitmap.Height,     
      BitmapImage, 
      TBitmapInfo(BitmapHeader^), 
      DIB_RGB_COLORS, 
      SRCCOPY) 
  finally 
    FreeMem(BitmapHeader); 
    FreeMem(BitmapImage) 
  end 
end {PrintBitmap}; 


W tym serwisie są pokazane przykłady, jak drukować bitmapę, ale nie dzialają one na większości drukarek. Powyższy kod
także nie wszędzie zadziała.

Żeby wydrukować TImage użyj tego kodu:

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); 
//jeśli ZoomPercent = 100, obraz zostanie wydrukowany na całej powierzchni strony
var  
  relHeight, relWidth: integer; 
begin 
  Screen.Cursor := crHourglass; //ustawienie kursora na klepsydrę
  Printer.BeginDoc; 
  with Image.Picture.Bitmap do  
  begin 
    if ((Width / Height) > (Printer.PageWidth / Printer.PageHeight)) then 
    begin 
      // rozciągniecie obrazka do szerokości strony drukarki
      relWidth := Printer.PageWidth; 
      relHeight := MulDiv(Height, Printer.PageWidth, Width); 
    end  
    else 
    begin 
      // rozciagniecie obrazka do wysokosci strony drukarki 
      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; 


Poźniej w zdarzeniu OnClick przycisku należy wpisać:

procedure TForm1.Button1Click(Sender: TObject); 
begin  
  PrintImage(Image1, 40); //wielkość wydrukowanego obrazka wynosić będzie 40% 
end;


No. To juz byłoby chyba wszystko.

Przykładowy program do tego gotowca możecie ściągnąć z działu Kody Źródłowe

3 komentarze

zebmcs 2006-05-10 21:08

Pomysł dobry, no i wszystko gra, oprócz tego, że w taki albo podobny sposób niesposób wydrukować jpega (z Timage oczywiście) ale o mniejszych rozmiarach niż rzeczywiste... dla przykładu 4cm na 3 cm - takie jak zdjęcie legitymacyjne ??) bo próbuję tym sposobem i jakoś to nie wychodzi   ;)    pozdro.

Wolverine 2004-02-14 20:46

Moze byc, ale powinienes raczej wyjasnic co to jest klasa Printer i ze ma ona Canvas, na ktorym mozna se cos robic. Do czego jest BeginDoc i EndDoc etc. Pozdro

mcbury 2003-10-29 21:13

....
(Bez komentarza)
[takie to dobre]