home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap04 / howto03 / delphi10 / ccprnmgr.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-11-23  |  11.8 KB  |  337 lines
  1. unit Ccprnmgr;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, Printers, DrwsUtl1;
  8.  
  9. type
  10.   TCCPrintForm = class(TForm)
  11.     ComboBox1: TComboBox;
  12.     Label1: TLabel;
  13.     BitBtn1: TBitBtn;
  14.     BitBtn3: TBitBtn;
  15.     BitBtn4: TBitBtn;
  16.     Bevel1: TBevel;
  17.     Label2: TLabel;
  18.     Label3: TLabel;
  19.     Label4: TLabel;
  20.     Bevel2: TBevel;
  21.     Label5: TLabel;
  22.     Label6: TLabel;
  23.     Bevel3: TBevel;
  24.     ListBox1: TListBox;
  25.     Label7: TLabel;
  26.     BitBtn6: TBitBtn;
  27.     BitBtn7: TBitBtn;
  28.     BitBtn8: TBitBtn;
  29.     Label8: TLabel;
  30.     Label9: TLabel;
  31.     Label10: TLabel;
  32.     Label11: TLabel;
  33.     RadioGroup1: TRadioGroup;
  34.     BitBtn9: TBitBtn;
  35.     FontDialog1: TFontDialog;
  36.     BitBtn10: TBitBtn;
  37.     BitBtn11: TBitBtn;
  38.     BitBtn12: TBitBtn;
  39.     PrintDialog1: TPrintDialog;
  40.     PrinterSetupDialog1: TPrinterSetupDialog;
  41.     procedure FormCreate(Sender: TObject);
  42.     procedure BitBtn1Click(Sender: TObject);
  43.     procedure BitBtn7Click(Sender: TObject);
  44.     procedure BitBtn9Click(Sender: TObject);
  45.     procedure RadioGroup1Click(Sender: TObject);
  46.     procedure BitBtn6Click(Sender: TObject);
  47.     procedure BitBtn4Click(Sender: TObject);
  48.   private
  49.     { Private declarations }
  50.   public
  51.     { Public declarations }
  52.     procedure HandlePrinting;
  53.   end;
  54.  
  55. var
  56.   CCPrintForm: TCCPrintForm;
  57.   GlobalPrinterAbortFlag : Boolean;
  58. implementation
  59.  
  60. {$R *.DFM}
  61.  
  62. procedure TCCPrintForm.HandlePrinting;
  63. var TheFile      : TextFile;    { Used to open text files     }
  64.     TheBitmap    : TBitmap;     { Used to open bitmap files   }
  65.     Counter_1 ,                 { Loop Counter for Selections }
  66.     Counter_2    : Integer;     { Loop Counter for lines      }
  67.     TheString    : String;      { Text file IO handler        }
  68.     TestString   : String;      { Used to check file extension}
  69.     Info         : PBitmapInfo; { Used to print bitmap        }
  70.     InfoSize     : Integer;     { Used to print bitmap        }
  71.     Image        : Pointer;     { Used to print bitmap        }
  72.     ImageSize    : Longint;     { Used to print bitmap        }
  73.     Bits         : HBITMAP;     { Used to print bitmap        }
  74.     DIBWidth ,                  { Used to print bitmap        }
  75.     DIBHeight    : Longint;     { Used to print bitmap        }
  76.     PrintWidth ,                { Used to print bitmap        }
  77.     PrintHeight  : Longint;     { Used to print bitmap        }
  78. begin
  79.   { Print text and bitmap files directly and shell all }
  80.   { other files out to windows to print, if possible.  }
  81.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  82.   begin
  83.     { Allow checks for hitting abort button }
  84.     Application.ProcessMessages;
  85.     if GlobalPrinterAbortFlag then exit;
  86.     { Check for selected file in the listbox to do a print }
  87.     if ListBox1.Selected[ Counter_1 ] then
  88.     begin
  89.       { Check against extension of file selected }
  90.       TestString := Uppercase( ExtractFileExt( ListBox1.Items[ Counter_1 ] ));
  91.       if TestString = '.TXT' then
  92.       begin { Print out text files directly to demo method }
  93.         { Call begindoc method }
  94.         Printer.BeginDoc;
  95.         try
  96.           { Try to assign and open the file, barf if can't }
  97.           AssignFile( TheFile , ListBox1.Items[ Counter_1 ] );
  98.           Reset( TheFile );
  99.           { Set the lines printed counter }
  100.           Counter_2 := 1;
  101.           { Run to the end of the file }
  102.           while not EOF( TheFile ) do
  103.           begin
  104.             { Allow the user to abort }
  105.             Application.ProcessMessages;
  106.             if GlobalPrinterAbortFlag then
  107.             begin
  108.               { call abort to end current document rather }
  109.               {than EndDoc                                }
  110.               Printer.Abort;
  111.               { Display brief abort message }
  112.               Label6.Font.Color := clRed;
  113.               Label6.Caption := 'Aborting...';
  114.               Label6.Show;
  115.               { Go bye bye }
  116.               exit;
  117.             end;
  118.             { Do the actual printing with textout }
  119.             { Read the next line in               }
  120.             Readln( TheFile , TheString );
  121.             { Put it out down the page per line }
  122.             Printer.Canvas.TextOut( 10 , 20 +
  123.              ( Counter_2  * ( Printer.Canvas.TextHeight( 'W' ) + 5 )) ,
  124.               TheString );
  125.             { Increment the line counter and test for end of page }
  126.             Counter_2 := Counter_2 + 1;
  127.             if (( Counter_2 * ( Printer.Canvas.TextHeight( 'W' ) +
  128.              5 )) + 20 ) > ( Printer.PageHeight - 20 ) then
  129.             begin
  130.               { Send a form feed to printer and reset line counter }
  131.               Printer.NewPage;
  132.               Counter_2 := 1;
  133.             end;
  134.           end;
  135.           { Close the file being printed }
  136.           CloseFile( TheFile );
  137.         except
  138.           { Assume HandlePrint reraises exception }
  139.           On E:EPrinter do
  140.           begin
  141.             { Beep on error }
  142.             MessageBeep( MB_ICONEXCLAMATION );
  143.             { Set status label color to red }
  144.             Label6.Font.Color := clRed;
  145.             { Set the caption to the error message }
  146.             Label6.Caption := E.Message;
  147.             { If any exceptions occur chicken out and dump }
  148.             Printer.Abort;
  149.             exit;
  150.           end;
  151.         end;
  152.         { Call Enddoc method }
  153.         Printer.EndDoc;
  154.       end
  155.       else
  156.       begin
  157.         if TestString = '.BMP' then
  158.         begin { Print out bitmap files directly to demo method }
  159.           { If not graphics capabile signal error }
  160.           if Label9.Caption = 'Graphics Capable'
  161.           then
  162.           begin
  163.             { Otherwise create the bitmap and load the file }
  164.             TheBitmap := TBitmap.Create;
  165.             try
  166.               TheBitmap.LoadFromFile( ListBox1.Items[ Counter_1 ] );
  167.             except
  168.               { Abort on error }
  169.               raise;
  170.               exit;
  171.             end;
  172.             try
  173.               { Start the printing }
  174.               Printer.BeginDoc;
  175.               { Perform magic since normal canvas stuff won't work! }
  176.               with Printer, Canvas do
  177.               begin
  178.                 { Get a handle to the bitmap's data }
  179.                 Bits := TheBitmap.Handle;
  180.                 { Find out memory requirements }
  181.                 GetDIBSizes(Bits, InfoSize, ImageSize);
  182.                 { Get a pointer to enough memory for structure }
  183.                 Info := MemAlloc(InfoSize);
  184.                 try
  185.                   { Now try to hold the bits }
  186.                   Image := MemAlloc(ImageSize);
  187.                   try
  188.                     { And conver them to Device Independent }
  189.                     GetDIB(Bits, 0, Info^, Image^);
  190.                     with Info^.bmiHeader do
  191.                     begin
  192.                       { Get width and height when done }
  193.                       DIBWidth := biWidth;
  194.                       DIBHeight := biHeight;
  195.                     end;
  196.                     { Set these to enlarge but could scale }
  197.                     PrintWidth := DIBWidth * 3;
  198.                     PrintHeight := DIBHeight * 3;
  199.                     { Do actual print via StretchDIBits API call }
  200.                     StretchDIBits(Canvas.Handle, 20 , 20 , PrintWidth,
  201.                      PrintHeight, 0, 0, DIBWidth, DIBHeight, Image,
  202.                       Info^, DIB_RGB_COLORS, SRCCOPY);
  203.                   finally
  204.                     { Release memory regardless }
  205.                     FreeMem(Image, ImageSize);
  206.                   end;
  207.                 finally
  208.                   { Release more memory regardless }
  209.                   FreeMem(Info, InfoSize);
  210.                   { Free the bitmap }
  211.                   TheBitmap.Free;
  212.                 end;
  213.               end;
  214.               { End the printing }
  215.               Printer.EndDoc;
  216.             except
  217.               { Assume HandlePrint reraises exception }
  218.               On E:EPrinter do
  219.               begin
  220.                 { Beep on error }
  221.                 MessageBeep( MB_ICONEXCLAMATION );
  222.                 { Set status label color to red }
  223.                 Label6.Font.Color := clRed;
  224.                 { Set the caption to the error message }
  225.                 Label6.Caption := E.Message;
  226.                 { If any exceptions occur chicken out and dump }
  227.                 Printer.Abort;
  228.                 exit;
  229.               end;
  230.             end;
  231.           end
  232.           { Complain about printing to nonraster device! }
  233.           else MessageDlg( 'Cannot Print A Bitmap On Non-Graphics Printer!',
  234.            mtError, [mbOK],0 );
  235.         end
  236.         else
  237.         begin
  238.           { Otherwise try to shell out to windows to print complex file }
  239.           if not ShellExec( ExpandFileName( ListBox1.Items[ Counter_1 ] )
  240.             , '' , '', true , SW_SHOWMINIMIZED , true ) then
  241.             MessageDlg('Could not Print ' + ListBox1.Items[ Counter_1 ] ,
  242.              mtError, [mbOK], 0);
  243.         end;
  244.       end;
  245.     end;
  246.   end;
  247. end;
  248.  
  249. procedure TCCPrintForm.FormCreate(Sender: TObject);
  250. begin
  251.   { Clear the combobox and assign the available printers }
  252.   Combobox1.Clear;
  253.   Combobox1.Items.Assign( Printer.Printers );
  254.   Combobox1.Itemindex := Printer.PrinterIndex;
  255.   { Display currently active printer }
  256.   Label4.Caption := Printer.Printers[ Printer.PrinterIndex ];
  257.   { Display resolution of currently active printer }
  258.   Label11.Caption := 'Width: ' + InttoStr( Printer.PageWidth ) +
  259.    ' Height: ' + IntToStr( Printer.PageHeight );
  260.   { Display orientation of currently active printer }
  261.   case Printer.Orientation of
  262.     poPortrait  : RadioGroup1.ItemIndex := 0;
  263.     poLandscape : RadioGroup1.ItemIndex := 1;
  264.   end;
  265.   { Set label for status }
  266.   Label6.Font.Color := clBlack;
  267.   Label6.Caption := 'Idle';
  268.   { Determine basic device capabilities of the selected printer }
  269.   if GetDeviceCaps( Printer.Handle , TECHNOLOGY ) = DT_RASPRINTER then
  270.    Label9.Caption := 'Graphics Capable' else Label9.Caption := 'Character Device';
  271.   if GetDeviceCaps( Printer.Handle , BITSPIXEL ) > 1 then
  272.    Label8.Caption := 'Color Capable' else Label8.Caption := 'Monochrome';
  273.   Label10.Caption := 'Resolution: ' +
  274.    IntToStr( GetDeviceCaps( Printer.Handle , LOGPIXELSX )) + ' dpi';
  275. end;
  276.  
  277. procedure TCCPrintForm.BitBtn1Click(Sender: TObject);
  278. begin
  279.   { Set the Default printer to be the selection of the combobox }
  280.   Printer.PrinterIndex := ComboBox1.ItemIndex;
  281.   { And cleverly reset the display! }
  282.   FormCreate( Self );
  283. end;
  284.  
  285. procedure TCCPrintForm.BitBtn7Click(Sender: TObject);
  286. begin
  287.   { This just runs the printer setup dialog }
  288.   PrinterSetupDialog1.Execute;
  289. end;
  290.  
  291. procedure TCCPrintForm.BitBtn9Click(Sender: TObject);
  292. begin
  293.   { This just displays available fonts for the printer }
  294.   FontDialog1.Execute;
  295. end;
  296.  
  297. procedure TCCPrintForm.RadioGroup1Click(Sender: TObject);
  298. begin
  299.   { Set the printer orientation based on the radiogroup itemindex }
  300.   case RadioGroup1.ItemIndex of
  301.     0 : Printer.Orientation := poPortrait;
  302.     1 : Printer.Orientation := poLandscape;
  303.   end;
  304. end;
  305.  
  306. procedure TCCPrintForm.BitBtn6Click(Sender: TObject);
  307. begin
  308.   { If execute print dialog then call HandlePrint method and deal with exceptions }
  309.   if PrintDialog1.Execute then
  310.   begin
  311.     { Reset Label font color }
  312.     Label6.Font.Color := clBlack;
  313.     { Change status label to printing }
  314.     Label6.Caption := 'Printing...';
  315.     { Call HandlePrinting Method }
  316.     HandlePrinting;
  317.     { Reset the display to indicate printing not in progress }
  318.     Label6.Caption := 'Idle';
  319.   end;
  320. end;
  321.  
  322. procedure TCCPrintForm.BitBtn4Click(Sender: TObject);
  323. begin
  324.   { If already printing do abort }
  325.   if Printer.Printing then
  326.   begin
  327.     { call abort method }
  328.     Printer.Abort;
  329.     GlobalPrinterAbortFlag := true;
  330.     { Reset status label }
  331.     Label6.Font.Color := clBlack;
  332.     Label6.Caption := 'Aborted...';
  333.   end;
  334. end;
  335.  
  336. end.
  337.