This week only. Pastebin PRO Accounts Christmas Special! Don't miss out!Want more features on Pastebin? Sign Up, it's FREE!
Guest

so_21992308

By: SirRufo on Feb 25th, 2014  |  syntax: Delphi  |  size: 1.45 KB  |  views: 7  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. procedure PrintSelectedImages;
  2. var
  3.   LImageFiles : array of string;
  4.   LIdx, LTotal : integer;
  5.   LBitmapRect, LPrinterRect : TRect;
  6.   LPicture : TPicture;
  7.   LBitmap : TBitmap;
  8. begin
  9.   // temporary store the selected image filenames
  10.   SetLength( LImageFiles, images_index );
  11.   LTotal := 0;
  12.   for LIdx := 0 to images_index - 1 do
  13.     if Checks[LIdx].Checked then
  14.     begin
  15.       LImageFiles[LTotal] := images[LIdx].Hint;
  16.       Inc( LTotal );
  17.     end;
  18.   SetLength( LImageFiles, LTotal );
  19.  
  20.   // no images selected
  21.   if LTotal = 0 then
  22.   begin
  23.     MessageDlg( 'No Images Selected!', mtInformation, [mbOK], 0 );
  24.     Exit;
  25.   end;
  26.  
  27.   // printing images from the temp. array
  28.   if PrintDialog1.Execute then
  29.   begin
  30.  
  31.     LPicture := nil;
  32.     LBitmap := nil;
  33.     try
  34.  
  35.       Picture := TPicture.Create;
  36.       Bitmap := TBitmap.Create;
  37.  
  38.       Printer.BeginDoc;
  39.  
  40.       for LIdx := Low( LImageFiles ) to High( LImageFiles ) do
  41.       begin
  42.  
  43.         LPicture.LoadFromFile( LImageFiles[LIdx] );
  44.  
  45.         LBitmap.Assign( LPicture );
  46.  
  47.         // output bitmap to printer
  48.         LBitmapRect := Rect( 0, 0, Bitmap.Width, Bitmap.Height );
  49.         LPrinterRect := Rect( 0, 0, Printer.PageWidth, Printer.PageHeight );
  50.         Printer.Canvas.CopyRect( LPrinterRect, Bitmap.Canvas, LBitmapRect );
  51.  
  52.         Printer.NewPage;
  53.  
  54.       end; // LIdx
  55.  
  56.       Printer.EndDoc;
  57.  
  58.     finally
  59.       LPicture.Free;
  60.       LBitmap.Free;
  61.     end;
  62.  
  63.   end;
  64.  
  65. end;
clone this paste RAW Paste Data