procedure PrintBitmap(aCanvas: TCanvas; Dest: TRect; Bitmap: TBitmap);
var Info: PBitmapInfo;
InfoSize: DWord;
Image: Pointer;
ImageSize: DWord;
begin
with Bitmap
do
begin
GetDIBSizes(
Handle, InfoSize, ImageSize);
Info := AllocMem(InfoSize);
try
Image := AllocMem(ImageSize);
try
GetDIB(
Handle, Palette, Info^, Image^);
if not Monochrome
then
SetStretchBltMode(ACanvas.Handle, STRETCH_DELETESCANS);
with Info^.bmiHeader
do
StretchDIBits(aCanvas.Handle, Dest.Left, Dest.Top,
Dest.RIght - Dest.Left, Dest.Bottom - Dest.Top,
0, 0, biWidth, biHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
finally
FreeMem(Image, ImageSize);
end;
finally
FreeMem(Info, InfoSize);
end;
end;
end;