home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Fourpage / MAIN.PAS < prev   
Pascal/Delphi Source File  |  1995-08-25  |  4KB  |  175 lines
  1. { copyright (c) 1995 - Microcomputer Enhancement }
  2. unit Main;
  3.  
  4. interface
  5.  
  6. uses
  7.   Classes, Controls, Dialogs, Forms, Graphics, Messages, Printers, StdCtrls,
  8.   SysUtils, WinProcs, WinTypes;
  9.  
  10. type
  11.   TfrmFourPage = class(TForm)
  12.     PrinterSetupDialog: TPrinterSetupDialog;
  13.     OpenDialog: TOpenDialog;
  14.     btnPSetup: TButton;
  15.     btnPrint: TButton;
  16.     btnClose: TButton;
  17.     cbTwoPages: TCheckBox;
  18.     procedure btnPSetupClick(Sender: TObject);
  19.     procedure btnPrintClick(Sender: TObject);
  20.     procedure btnCloseClick(Sender: TObject);
  21.   private
  22.     { Private declarations }
  23.   public
  24.     { Public declarations }
  25.   end;
  26.  
  27. var
  28.   frmFourPage: TfrmFourPage;
  29.  
  30. implementation
  31.  
  32. {$R *.DFM}
  33.  
  34. procedure TfrmFourPage.btnPSetupClick(Sender: TObject);
  35. begin
  36.   PrinterSetupDialog.Execute;
  37. end;
  38.  
  39. procedure TfrmFourPage.btnPrintClick(Sender: TObject);
  40. const
  41.   SECOND = 'Insert page(s) for second side';
  42. var
  43.   linesPerPage, charsPerLine, ctr, offset, rOffset, rowHeight,  pageWidth,
  44.   pageNum, adjPhysWidth, pagesPerPage : integer;
  45.   f : TextFile;
  46.   fileName, dateTime : string;
  47.   isPrint, havePrinted : Boolean;
  48.   PhysSize, PrintOffset : TPoint;
  49.  
  50.   procedure DoLayout;
  51.   var
  52.     s : string;
  53.     i, j, row, col : integer;
  54.   begin
  55.     col := offset;
  56.     inc(pageNum, 1);
  57.     if isPrint then
  58.     begin
  59.       s := lowercase(format('Page %d: %s @ %s', [pageNum, fileName, dateTime]));
  60.       Printer.Canvas.TextOut(col, 0, s);
  61.     end;
  62.     for i := 1 to pagesPerPage do
  63.     begin
  64.       row := 2 * rowHeight;
  65.       for j := 3 to linesPerPage do
  66.       begin
  67.         if eof(f) then exit;
  68.         readln(f, s);
  69.         if isPrint then
  70.         begin
  71.           s := copy(s, 1, charsPerLine);
  72.           Printer.Canvas.TextOut(col, row, s);
  73.           havePrinted := True;
  74.           inc(row, rowHeight);
  75.         end
  76.       end;
  77.       inc(col, pageWidth);
  78.     end
  79.   end;
  80.  
  81.   procedure OddPages;
  82.   begin
  83.     dateTime := DateTimeToStr(FileDateToDateTime(FileAge(fileName)));
  84.     AssignFile(f, fileName);
  85.     Reset(f);
  86.     isPrint := True;
  87.     havePrinted := False;
  88.     pageNum := 0;
  89.     repeat
  90.       if havePrinted then Printer.NewPage;
  91.       havePrinted := False;
  92.       DoLayout;
  93.       isPrint := not isPrint
  94.     until eof(f);
  95.     if havePrinted then Printer.NewPage;
  96.     CloseFile(f);
  97.   end;
  98.  
  99.   procedure EvenPages;
  100.   begin
  101.     dateTime := DateTimeToStr(FileDateToDateTime(FileAge(fileName)));
  102.     AssignFile(f, fileName);
  103.     Reset(f);
  104.     havePrinted := False;
  105.     isPrint := False;
  106.     pageNum := 0;
  107.     repeat
  108.       if havePrinted then Printer.NewPage;
  109.       havePrinted := False;
  110.       DoLayout;
  111.       isPrint := not isPrint
  112.     until eof(f);
  113.     CloseFile(f);
  114.   end;
  115.  
  116. begin
  117.   if not OpenDialog.Execute then exit;
  118.   if cbTwoPages.Checked then
  119.   begin
  120.     Printer.Orientation := poLandscape;
  121.     PagesPerPage := 2;
  122.     Printer.Canvas.Font.Size := 7;
  123.   end
  124.   else
  125.   begin
  126.     Printer.Orientation := poPortrait;
  127.     PagesPerPage := 1;
  128.     PRinter.Canvas.Font.Size := 7;
  129.   end;
  130.   Printer.Canvas.Font.Name := 'Courier New';
  131.   rowHeight := Printer.Canvas.TextHeight('0');
  132.   linesPerPage := Printer.PageHeight div rowHeight;
  133.   Escape(Printer.Handle, GETPHYSPAGESIZE, 0, nil, @PhysSize);
  134.   Escape(Printer.Handle, GETPRINTINGOFFSET, 0, nil, @PrintOffset);
  135.   rOffset := PhysSize.x - Printer.PageWidth - PrintOffset.x;
  136.   if rOffset > PrintOffset.x then
  137.   begin
  138.     offset := rOffset - PrintOffset.x;
  139.     adjPhysWidth := Printer.PageWidth - offset;
  140.   end
  141.   else
  142.   begin
  143.     offset := 0;
  144.     adjPhysWidth := Printer.PageWidth - (PrintOffset.x - rOffset);
  145.   end;
  146.   pageWidth := adjPhysWidth div pagesPerPage;
  147.   charsPerLine := (pageWidth div Printer.Canvas.TextWidth('0')) - 2;
  148.   Printer.BeginDoc;
  149.   for ctr := 0 to OpenDialog.Files.Count - 1 do
  150.   begin
  151.     fileName := OpenDialog.Files.Strings[ctr];
  152.     OddPages;
  153.   end;
  154.   if MessageDlg(SECOND, mtConfirmation, [mbOK, mbCancel], 0) = mrOK then
  155.     for ctr := 0 to OpenDialog.Files.Count - 1 do
  156.     begin
  157.       if ctr > 0 then Printer.NewPage;
  158.       fileName := OpenDialog.Files.Strings[ctr];
  159.       EvenPages;
  160.     end
  161.   else
  162.   begin
  163.     Printer.Abort;
  164.     WinProcs.AbortDoc(Printer.Canvas.Handle);
  165.   end;
  166.   Printer.EndDoc;
  167. end;
  168.  
  169. procedure TfrmFourPage.btnCloseClick(Sender: TObject);
  170. begin
  171.   Close;
  172. end;
  173.  
  174. end.
  175.