1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85:
| PROCEDURE PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap); VAR BitmapHeader: pBitmapInfo; BitmapImage : POINTER; HeaderSize : DWORD; ImageSize : DWORD; BEGIN GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize); GetMem(BitmapHeader, HeaderSize); GetMem(BitmapImage, ImageSize); TRY GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^); StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top, DestRect.Right - DestRect.Left, DestRect.Bottom - DestRect.Top, 0, 0, Bitmap.Width, Bitmap.Height, BitmapImage, TBitmapInfo(BitmapHeader^), DIB_RGB_COLORS, SRCCOPY) FINALLY FreeMem(BitmapHeader); FreeMem(BitmapImage) END END;
procedure normaldruck(image:timage); var ScaleX,ScaleY:real; limog,obmog,lioff,oboff,reoff : Integer; R: TRect; begin Printer.BeginDoc;
try limog:=GetDeviceCaps(printer.Handle, physicaloffsetx); lioff:=round(lidruck*GetDeviceCaps(printer.Handle,logPixelsX)/25.4)-limog; if lioff<0 then lioff:=0; reoff:=round(redruck*GetDeviceCaps(printer.Handle,logPixelsX)/25.4)-limog; if reoff<0 then reoff:=0; obmog:=GetDeviceCaps(printer.Handle, physicaloffsety); oboff:=round(obdruck*GetDeviceCaps(printer.Handle,logPixelsY)/25.4)-obmog; if oboff<0 then oboff:=0; ScaleX := GetDeviceCaps(printer.Handle, logPixelsX)/PixelsPerInch; ScaleY := GetDeviceCaps(printer.Handle, logPixelsY)/pixelsPerInch; while scalex*image.picture.width>(printer.pagewidth-lioff-reoff) do begin scalex:=scalex-0.02; scaley:=scaley-0.02; end; if scalex<=0 then scalex:=1; if scaley<=0 then scaley:=1; R := Rect(lioff, oboff, round(lioff+Image.Picture.Width * ScaleX), round(oboff+Image.Picture.Height * ScaleY)); printbitmap(printer.canvas,R,Image.Picture.bitmap) finally printer.EndDoc; end; end;
procedure bilddrucken(const paintbox:tpaintbox); var Bitmap: TBitmap; birect:trect; image:timage; begin image:=timage.create(nil); image.autosize:=true; Bitmap := TBitmap.Create; Bitmap.Width := paintbox.Width; Bitmap.Height := paintbox.Height; birect:=paintbox.clientrect; bitmap.canvas.CopyRect(biRect,paintbox.Canvas,biRect); try image.picture.Assign(Bitmap); normaldruck(image); finally Bitmap.Free; image.Free; end; end; |