Code666 (代码贴、代码片段)

[Delphi (Object Pascal)] delphi打印TImage图片 →→→→→进入此内容的聊天室

来自 , 2019-08-03, 写在 Delphi (Object Pascal), 查看 173 次.
URL http://www.code666.cn/view/9ab8a8a9
  1. uses
  2.   Printers;
  3.  
  4. // code from http://www.sharejs.com/codes/
  5. procedure TForm1.Button1Click(Sender: TObject);
  6. var
  7.   ScaleX, ScaleY: Integer;
  8.   RR: TRect;
  9. begin
  10.   with Printer do
  11.   begin
  12.     BeginDoc;
  13.     // Mit BeginDoc wird ein Druckauftrag initiiert.
  14.     // The StartDoc function starts a print job.
  15.     try
  16.       ScaleX := GetDeviceCaps(Handle, logPixelsX) div PixelsPerInch;
  17.       ScaleY := GetDeviceCaps(Handle, logPixelsY) div PixelsPerInch;
  18.       // Informationen über die Auflösung
  19.       // Retrieves information about the Pixels per Inch of the Printer.
  20.       RR := Rect(0, 0, Image1.picture.Width * scaleX, Image1.Picture.Height * ScaleY);
  21.       Canvas.StretchDraw(RR, Image1.Picture.Graphic);
  22.       // An die Auflösung anpassen
  23.       // Stretch to fit
  24.  
  25.     finally
  26.       EndDoc;   //Methode EndDoc beendet den aktuellen Druckauftrag und schließt die
  27.       // Textdatei-Variable.
  28.       // Steht in finally - um auch bei Abbruch des Druckauftrages Papierausgabe
  29.       // sicherzustellen
  30.     end;
  31.   end;
  32. end;
  33.  
  34.  
  35. {2.}
  36. {************************************************************************}
  37.  
  38. // Based on posting to borland.public.delphi.winapi by Rodney E Geraghty, 8/8/97.
  39.  
  40.  
  41. procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap);
  42. var
  43.   BitmapHeader: pBitmapInfo;
  44.   BitmapImage: Pointer;
  45.   HeaderSize: DWORD;
  46.   ImageSize: DWORD;
  47. begin
  48.   GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
  49.   GetMem(BitmapHeader, HeaderSize);
  50.   GetMem(BitmapImage, ImageSize);
  51.   try
  52.     GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
  53.     StretchDIBits(Canvas.Handle,
  54.       DestRect.Left, DestRect.Top,    // Destination Origin
  55.       DestRect.Right - DestRect.Left, // Destination Width
  56.       DestRect.Bottom - DestRect.Top, // Destination Height
  57.       0, 0,                           // Source Origin
  58.       Bitmap.Width, Bitmap.Height,    // Source Width & Height
  59.       BitmapImage,
  60.       TBitmapInfo(BitmapHeader^),
  61.       DIB_RGB_COLORS,
  62.       SRCCOPY)
  63.   finally
  64.     FreeMem(BitmapHeader);
  65.     FreeMem(BitmapImage)
  66.   end
  67. end {PrintBitmap};
  68.  
  69.  
  70. {3.}
  71. {************************************************************************}
  72. // from www.experts-exchange.com
  73.  
  74. uses
  75.   printers;
  76.  
  77. procedure DrawImage(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap);
  78. var
  79.   Header, Bits: Pointer;
  80.   HeaderSize: DWORD;
  81.   BitsSize: DWORD;
  82. begin
  83.   GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);
  84.   Header := AllocMem(HeaderSize);
  85.   Bits := AllocMem(BitsSize);
  86.   try
  87.     GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^);
  88.     StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top,
  89.       DestRect.Right, DestRect.Bottom,
  90.       0, 0, ABitmap.Width, ABitmap.Height, Bits, TBitmapInfo(Header^),
  91.       DIB_RGB_COLORS, SRCCOPY);
  92.   finally
  93.     FreeMem(Header, HeaderSize);
  94.     FreeMem(Bits, BitsSize);
  95.   end;
  96. end;
  97.  
  98. procedure PrintImage(Image: TImage; ZoomPercent: Integer);
  99.   // if ZoomPercent=100, Image will be printed across the whole page
  100. var
  101.   relHeight, relWidth: integer;
  102. begin
  103.   Screen.Cursor := crHourglass;
  104.   Printer.BeginDoc;
  105.   with Image.Picture.Bitmap do
  106.   begin
  107.     if ((Width / Height)  (Printer.PageWidth / Printer.PageHeight)) then
  108.     begin
  109.       // Stretch Bitmap to width of PrinterPage
  110.       relWidth := Printer.PageWidth;
  111.       relHeight := MulDiv(Height, Printer.PageWidth, Width);
  112.     end
  113.     else
  114.     begin
  115.       // Stretch Bitmap to height of PrinterPage
  116.       relWidth  := MulDiv(Width, Printer.PageHeight, Height);
  117.       relHeight := Printer.PageHeight;
  118.     end;
  119.     relWidth := Round(relWidth * ZoomPercent / 100);
  120.     relHeight := Round(relHeight * ZoomPercent / 100);
  121.     DrawImage(Printer.Canvas, Rect(0, 0, relWidth, relHeight), Image.Picture.Bitmap);
  122.   end;
  123.   Printer.EndDoc;
  124.   Screen.cursor := crDefault;
  125. end;
  126.  
  127. // Example Call:
  128.  
  129. procedure TForm1.Button1Click(Sender: TObject);
  130. begin
  131.   // Print image at 40% zoom:
  132.   PrintImage(Image1, 40);
  133. end;
  134. //delphi/8747

回复 "delphi打印TImage图片"

这儿你可以回复上面这条便签

captcha

贴代码片段 - Code666