home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programming Unleashed / Delphi_Programming_Unleashed_SAMS_Publishing_1995.iso / misc / printsrc / main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-21  |  4.3 KB  |  168 lines
  1. unit Main;
  2.  
  3. { Copyright (c) 1995 by Charles Calvert)
  4. { Project Name: PRINTSRC }
  5.  
  6. { This program will allow you to iterate through directories,
  7.   selecting multiple text files, and then print them.
  8.  
  9.   At this stage, this program is not very robust. Sometimes
  10.   I've found it best to leave the default font, rather than
  11.   trying to select a new one.
  12.  
  13.   I don't know how much Windows handles automatically, but
  14.   this program does not test for running out of paper, or
  15.   for overflowing the print buffer.
  16. }
  17.  
  18. interface
  19.  
  20. uses
  21.   SysUtils, WinTypes, WinProcs,
  22.   Messages, Classes, Graphics,
  23.   Controls, Forms, Dialogs,
  24.   StdCtrls, AllDirs, Fileiter, ExtCtrls, FileCtrl, Buttons;
  25.  
  26. type
  27.   TForm1 = class(TForm)
  28.     FileIterator1: TFileIterator;
  29.     ListBox1: TListBox;
  30.     PrintDialog1: TPrintDialog;
  31.     PrinterSetupDialog1: TPrinterSetupDialog;
  32.     FontDialog1: TFontDialog;
  33.     DirectoryListBox1: TDirectoryListBox;
  34.     DriveComboBox1: TDriveComboBox;
  35.     Panel1: TPanel;
  36.     Label1: TLabel;
  37.     ChooseFiles: TBitBtn;
  38.     PrintFiles: TBitBtn;
  39.     PrinterFont: TBitBtn;
  40.     BitBtn1: TBitBtn;
  41.     EExt: TEdit;
  42.     Label2: TLabel;
  43.     procedure FileIterator1FoundFile(FileName: String; SR: TSearchRec);
  44.     procedure ChooseFilesClick(Sender: TObject);
  45.     procedure PrintFilesClick(Sender: TObject);
  46.     procedure PrinterFontClick(Sender: TObject);
  47.     procedure FormCreate(Sender: TObject);
  48.     procedure BitBtn1Click(Sender: TObject);
  49.   private
  50.     PrintCancel: Boolean;
  51.     procedure PrintHeader(N: string; TextHeight: Integer; PageNumber: Integer);
  52.     procedure PrintFile(N: string);
  53.     function LinesPerPrintedPage: Integer;
  54.   public
  55.     { Public declarations }
  56.   end;
  57.  
  58. var
  59.   Form1: TForm1;
  60.  
  61. implementation
  62.  
  63. uses
  64.   Printers;
  65.  
  66. {$R *.DFM}
  67.  
  68. procedure TForm1.FileIterator1FoundFile(FileName: String; SR: TSearchRec);
  69. begin
  70.   ListBox1.Items.Add(FileName);
  71. end;
  72.  
  73. procedure TForm1.ChooseFilesClick(Sender: TObject);
  74. begin
  75.   ListBox1.Clear;
  76.   FileIterator1.Run(EExt.Text, DirectoryListBox1.Directory);
  77.   PrintFiles.Enabled := True;
  78. end;
  79.  
  80. function TForm1.LinesPerPrintedPage: Integer;
  81. var
  82.   PageHeight, TextHeight: Integer;
  83.   TextMetrics: TTextMetric;
  84. begin
  85.   PageHeight := Printer.PageHeight;
  86.   GetTextMetrics(Printer.Handle, TextMetrics);
  87.   TextHeight := TextMetrics.tmHeight + TextMetrics.tmExternalLeading;
  88.   Result := PageHeight div TextHeight; { Lines Per Page on Printer }
  89. end;
  90.  
  91. procedure TForm1.PrintHeader(N: String; TextHeight: Integer; PageNumber: Integer);
  92. var
  93.   S: string;
  94. begin
  95.   S := '=====================================================';
  96.   Printer.Canvas.TextOut(1, TextHeight * 0, S);
  97.   Printer.Canvas.TextOut(1, TextHeight * 1, N + ' Page: ' + IntToStr(PageNumber));
  98.   Printer.Canvas.TextOut(1, TextHeight * 2, S);
  99. end;
  100.  
  101. procedure TForm1.PrintFile(N: string);
  102. var
  103.   S: string;
  104.   P: TPrinter;
  105.   F: System.Text;
  106.   I, LinesPerPage, TextHeight, PageNumber : Integer;
  107. begin
  108.   LinesPerPage := LinesPerPrintedPage;
  109.   pageNumber := 1;
  110.   i := 3;
  111.   System.Assign(F, N);
  112.   try
  113.     TextHeight := Printer.Canvas.TextHeight(N);
  114.     System.Reset(F);
  115.     Printer.BeginDoc;
  116.     PrintHeader(N, TextHeight, PageNumber);
  117.     repeat
  118.       if PrintCancel = True then Exit;
  119.       ReadLn(F, S);
  120.       Printer.Canvas.TextOut(1, TextHeight * i, S);
  121.       Inc(i);
  122.       if i = LinesPerPage then begin
  123.         i := 3;
  124.         Printer.NewPage;
  125.         Inc(PageNumber);
  126.         PrintHeader(N, TextHeight, PageNumber);
  127.       end;
  128.     until EOF(F);
  129.     Printer.EndDoc;
  130.   finally
  131.     System.Close(F);
  132.   end;
  133. end;
  134.  
  135. procedure TForm1.PrintFilesClick(Sender: TObject);
  136. var
  137.   N: string;
  138.   i: Integer;
  139. begin
  140.   PrinterSetUpDialog1.Execute;
  141.   for i := 0 to ListBox1.Items.Count - 1 do begin
  142.     SendMessage(ListBox1.Handle, lb_SetCurSel, i, 0);
  143.     N := ListBox1.Items.Strings[i];
  144.     PrintFile(N);
  145.     if PrintCancel = True then Exit;
  146.   end;
  147. end;
  148.  
  149. procedure TForm1.PrinterFontClick(Sender: TObject);
  150. begin
  151.   FontDialog1.Font := Printer.Canvas.Font;
  152.   if FontDialog1.Execute then
  153.     Printer.Canvas.Font := FontDialog1.Font;
  154. end;
  155.  
  156. procedure TForm1.FormCreate(Sender: TObject);
  157. begin
  158.   Label1.Left := ListBox1.Left;
  159.   PrintCancel := False;
  160. end;
  161.  
  162. procedure TForm1.BitBtn1Click(Sender: TObject);
  163. begin
  164.   PrintCancel := True;
  165. end;
  166.  
  167. end.
  168.