Печать картинки

← →
REA (2003-01-17 16:08) [0]

Хочу напечатать сабж на принтер. Не видел ли кто рабочей процедуры печати на принтер TGraphic?
Я конечно сделал кое-как, но печатает не всегда и приходится сначала в Bitmap переводить, а дальше из него с помощью StretchDIBits. Хочется сделать чтобы стабильно работало для всех палитр, принтеров, глубины цвета и т.п.

← →
REA (2003-01-17 17:41) [1]

Неужели никто не печатал картинки или вопрос неуместен?
Сорри за повтор.

← →
LongIsland (2003-01-17 17:57) [2]

procedure TfmMain.mmPrintClick(Sender: TObject); var Info: PBitmapInfo; InfoSize, ImageSize: DWord; Images: Pointer; begin if not dgPrint.Execute then Exit; Printer.BeginDoc; GetDIBSizes(Image.Picture.Bitmap.Handle, InfoSize, ImageSize); Info:=AllocMem(InfoSize); try Images:=AllocMem(ImageSize); try GetDIB(Image.Picture.Bitmap.Handle, 0, Info^, Images^); StretchDIBits(Printer.Canvas.Handle, 0, 0, Printer.PageWidth, Printer.PageHeight, 0, 0, Image.Width, Image.Height, Images, Info^, DIB_RGB_COLORS, SRCCOPY); finally FreeMem(Images, ImageSize); end; finally FreeMem(Info, InfoSize); end; Printer.EndDoc; end;
Содержимое TImage я печатаю таким образом.

← →
rea (2003-01-20 16:19) [3]

Я печатаю почти так же. Печатается не всегда и не все.

Canvas.Lock;
With Canvas Do
Try
Bits := Bmp.Handle;
GetDIBSizes(Bits, InfoSize, ImageSize);
Info := AllocMem(InfoSize);
Try
Image := AllocMem(ImageSize);
Try
GetDIB(Bits, 0, Info^, Image^);
With Info^.bmiHeader Do
Begin
DIBWidth := biWidth;
DIBHeight := biHeight;
End;
StretchDIBits(Handle, rc.Left, rc.Top, rc.Right-rc.Left, rc.Bottom-rc.Top, 0, 0,
DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
Finally
FreeMem(Image, ImageSize);
End;
Finally
FreeMem(Info, InfoSize);
End;
Finally
Canvas.Unlock;
End;

Печать картинки Найти похожие ветки