Registriert seit: 9. Feb 2006
Ort: Stolberg (Rhld)
4.144 Beiträge
Delphi 10.3 Rio
|
Re: Bild drucken
26. Apr 2006, 09:04
Zitat von MCXSC:
Versuchs mal mit:
Delphi-Quellcode:
function TPrintForm.Screen2PrinterX(X:integer):integer;
begin
result := (X * LogX) div 96; // 96 ist bei mir das Bezugssystem
end;
function TPrintForm.Screen2PrinterY(Y:Integer):integer;
begin
result := (Y * LogY) div 96; // 96 ist bei mir das Bezugssystem
end;
Procedure TPrintForm.DoImage(ChildControl:TControl;Top,Left:integer);
var
Info : PBitmapInfo;
InfoSize : DWORD;
Image : Pointer;
ImageSize : DWORD;
Bits : HBITMAP;
DIBWidth,
DIBHeight : Longint;
begin
LogX := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
LogY := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
{$IFDEF JPEG}
if (ChildControl as TImage).Picture.Graphic is TJPEGImage
then begin // Der einfache Weg. Um bessere Qualität zu erhalten, erst in BMP umwandeln und dann die andere Routine
Printer.Canvas.StretchDraw(Rect(Screen2PrinterX(ChildControl.Left+Left)-Rand_Links,
Screen2Printery(Top)-Rand_Oben,
Screen2PrinterX(ChildControl.Left+Left)-Rand_Links+Screen2PrinterX(ChildControl.width),
Screen2Printery(Top)-Rand_Oben+Screen2PrinterY(ChildControl.height)),
(ChildControl as TImage).Picture.Graphic);
end
else begin {$ENDIF }
Bits := (ChildControl as TImage).Picture.Bitmap.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(Printer.Canvas.Handle,
Screen2PrinterX(ChildControl.Left+Left)-Rand_Links,
Screen2Printery(Top)-Rand_Oben,
Screen2PrinterX(ChildControl.width),
Screen2PrinterY(ChildControl.height),
0, 0, DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
finally
FreeMem(Image, ImageSize);
end;
finally
FreeMem(Info, InfoSize);
end;
{$IFDEF JPEG}
end;
{$ENDIF}
end;
Die Procedure Druckt Imagekomponenten von einem Form welches in 96 DPI definiert ist.
die Koordinaten musst Du sicherlich auf Deine Wünsche anpassen...
mfg Frank
|
|
Zitat
|