Растягивание изображения при печати
Материал из DRKB
Я пишу программу, которая печатает изображение на принтере с помощью объекта TPrinter. Проблема происходит когда я пытаюсь "растянуть" изображение до требуемого размера на бумаге. Мой метод растяжения (bitblts и принтерном DC) приводит к белым кляксам, а само изображение получается практически серым. Конечно это не то, что мне хотелось. Кто-нибудь может мне помочь?
Попробуй это:
procedure DrawImage(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap);
var
Header, Bits: Pointer;
HeaderSize: Integer;
BitsSize: Longint;
begin
GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);
Header := MemAlloc(HeaderSize);
Bits := MemAlloc(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);
{ вам может понадобиться цветовой стандарт DIB_PAL_COLORS,
но это уже выходит за рамки моих знаний. }
finally
MemFree(Header, HeaderSize);
MemFree(Bits, BitsSize);
end;
end;
{ Печатаем изображение, растягивая его до целого листа }
procedure PrintBitmap(ABitmap: TBitmap);
var
relHeight, relWidth: Integer;
begin
Screen.Cursor := crHourglass;
Printer.BeginDoc;
if ((ABitmap.Width / ABitmap.Height) > l(Printer.PageWidth / Printer.PageHeight)) then
begin
{ Растягиваем ширину изображения до ширины бумаги }
relWidth := Printer.PageWidth;
relHeight := MulDiv(ABitmap.Height, Printer.PageWidth, ABitmap.Width);
end
else
begin
{ Растягиваем высоту изображения до высоты бумаги }
relWidth := MulDiv(ABitmap.Width, Printer.PageHeight, ABitmap.Height);
relHeight := Printer.PageHeight;
end;
DrawImage(Printer.Canvas, Rect(0, 0, relWidth, relHeight), ABitmap);
Printer.EndDoc;
Screen.Cursor := crDefault;
end;
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 03237