Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailemVyřešeno Delphi - Ako tlačiť TImage?

U velkých obrázků (>4MPix) toto selže, protože se zhroutí API funkce BitBlt a StretchBlt, které na to Delphi použije. Pro větší obrázky je třeba nějaký takovýto postup - např. tisk fotky - předpokládám, že Bitmapu z TImage umíš vydojit ;-):

// Printer := objekt TPRinter z unity Printers
// PrintBMP := TBitmap k tisku
Printer.BeginDoc ();
// Tisk s přispůsobením na celou stránku - například fotka:
DrawBitMap (PrintBMP, Printer.Canvas, Rect (0, 0, Printer.PageWidth, Printer.PageHeight));
// Kdybys to nechtěl roztáhnout na celou stránku (tisk obrázku 1:1), použije se to třeba takto:
// DrawBitMap (PrintBMP, Printer.Canvas, Rect (0, 0, PrintBMP.Width, PrintBMP.Height));
Printer.EndDoc ();


//A ještě procedura DrawBitMap:

{---------------------- Nakreslení velkých bitmap na Canvas (třeba tiskárny) -------------------------------------}
{ 1. verze, dne  2.  7. 2003                                                                                      }
{                                                                                                                 }
procedure DrawBitMap (const ABitmap: TBitmap; const ACanvas: TCanvas; const ARect: TRect);
{	ABitmap	:= Bitmapa								}
{	ACanvas	:= Canvas, kam to chceme nakreslit					}
{	ARect	:= Rectangle v Canvasu, kam to nakreslit				}
var BitmapHeader: pBitmapInfo; BitmapImage: Pointer; HeaderSize, ImageSize: dword;    // DWORD je pro D3-D5 kompatibilitu
begin
	GetDIBSizes	(ABitmap.Handle, HeaderSize, ImageSize);
	GetMem		(BitmapHeader,  HeaderSize); GetMem (BitmapImage, ImageSize);
	try
		GetDIB (ABitmap.Handle, ABitmap.Palette, BitmapHeader^, BitmapImage^);
		StretchDIBits (ACanvas.Handle, ARect.Left, ARect.Top, ARect.Right - ARect.Left, ARect.Bottom - ARect.Top, 0, 0, ABitmap.Width, ABitmap.Height, BitmapImage, TBitmapInfo (BitmapHeader^), DIB_RGB_COLORS, SRCCOPY);
	finally 
		FreeMem (BitmapHeader); FreeMem (BitmapImage) 
	end
end;

Reakce na odpověď

1 Zadajte svou přezdívku:
2 Napište svou odpověď:
3 Pokud chcete dostat ban, zadejte libovolný text:

Zpět do poradny