Category : Printer Utilities
Archive   : DOCPRINT.ZIP
Filename : DOCPRINT.PAS

PROGRAM DocPrint ( Input, Output );

USES Dos,
Crt,
Superwin,
Things,
Picture;

(**************************************************************************
DocPrint 4/20/90
Version 1.0
By: Joseph C. Lloyd

Uses Superwin 3.0 By William Russell

DocPrint allows you to print files to either the screen or printer
with the printer allowing MicroFont, Wide, Near Letter Quality,
and normal prints.

The printer codes here are set for a Tandy DMP 130/130A, check your
printer manual for the proper codes and just change them.
**************************************************************************)

CONST MicroFont = Chr(27)+Chr(77);
MicroOff = Chr(27)+Chr(77);
NearLetQual = Chr(27)+Chr(18);
NearQualOff = Chr(27)+Chr(29);
Wide = Chr(27)+Chr(14);
WideOff = Chr(27)+Chr(15);
Normal = Chr(27)+Chr(19);
CrOff = Chr(27)+Chr(21);

VAR FileName,
Printer : Text;
Name,
Line : String;
Deadkey,
Choice : Char;
Finished : Boolean;
Counter : Integer;

PROCEDURE Menu;

BEGIN
Window ( 1, 1, 80, 25 );
ExplodeWindow ( 29, 14, 47, 20, 15, 1, 10, 10, Border[5], True );
WritelnXy ( 30, 15,' Print File To ');
WritelnXy ( 30, 16, '[ ] Printer ');
TextColor ( 11 );
WriteXy ( 31, 16, '1' );
TextColor ( 15 );
WriteXy ( 30, 17, '[ ] Screen ' );
TextColor ( 11 );
WriteXy ( 31, 17, '2' );
TextColor ( 15 );
WriteXy ( 30, 18, '[ ] Quit ' );
TextColor ( 11 );
WriteXy ( 31, 18, 'Esc');
TextColor ( 15 );
WriteXy ( 30, 19,' Choice -=> ');
GotoXy ( 42, 19 );
Choice := Readkey;
Write ( Output, Choice );
END;

PROCEDURE ThePrinter;

LABEL Stop;

BEGIN
Assign ( Printer, 'Prn');
Rewrite ( Printer );
Write ( Printer, CrOff );
Write ( Printer, MicroOff );
Write ( Printer, NearQualOff );
Write ( Printer, WideOff );
Window ( 1, 13, 80, 25 );
TextBackGround ( 0 );
ClrScr;
ExplodeWindow ( 26, 3, 50, 11, 15, 1, 10, 10, Border[5], True );
WritelnXy ( 27, 4, ' Printer Controls ');
WriteXy ( 27, 5, '[ ] Micro Font ' );
TextColor ( 11 );
WriteXy ( 28, 5, '1' );
TextColor ( 15 );
WriteXy ( 27, 6, '[ ] Near Letter Quality' );
TextColor ( 11 );
WriteXy ( 28, 6, '2' );
TextColor ( 15 );
WriteXy ( 27, 7, '[ ] Wide ' );
TextColor ( 11 );
WriteXy ( 28, 7, '3' );
TextColor ( 15 );
WriteXy ( 27, 8, '[ ] Normal ' );
TextColor ( 11 );
WriteXy ( 28, 8, '4' );
TextColor ( 15 );
WriteXY ( 27, 9, '[ ] Main Menu ' );
TextColor ( 11 );
WriteXy ( 28, 9, 'Esc' );
TextColor ( 15 );
WriteXy ( 27, 10, ' Choice -=> ');
TextBackGround ( 0 );
WriteXy ( 25, 1,' Filename: ' );
Readln ( Input, Name );
{$I-}
Assign ( FileName, Name );
Reset ( Filename );
{$I+}
If IOResult <> 0 Then
BEGIN
WritelnXy ( 25, 2, ' File Not Found...');
Delay ( 1250 );
END
ELSE
BEGIN
TextBackGround ( 1 );
GotoXy ( 42, 10 );
Choice := Readkey;
REPEAT
CASE Choice OF
'1' : Write ( Printer, MicroFont );
'2' : Write ( Printer, NearLetQual );
'3' : Write ( Printer, Wide );
'4' : Write ( Printer, Normal );
#27 : Goto Stop;
END;
UNTIL (( Choice > '0' ) AND ( Choice < '5' ));
TextBackGround ( 0 );
ClrScr;
WritelnXy ( 30, 6, ' Printing...');
WHILE NOT EOF(FileName) DO
BEGIN
Readln ( FileName, Line );
Writeln ( Printer, Line );
END;
Close ( Printer );
Close ( Filename );
END;
Stop:;
TextBackGround ( 0 );
ClrScr;
END;

PROCEDURE Screen;

BEGIN
Counter := 0;
TextBackGround ( 0 );
Window ( 1, 13, 80, 25 );
ClrScr;
WriteXy ( 25, 1,' FileName: ' );
Readln ( Input, Name );
{$I-}
Assign ( FileName, Name );
Reset ( Filename );
{$I+}
IF IOResult <> 0 THEN
BEGIN
WritelnXy ( 25, 2, ' File Not Found...');
END
ELSE
BEGIN
Window ( 1, 1, 80, 25 );
ClrScr;
TextBackGround ( 1 );
Write ( Output, ' Filename: ');
GotoXy ( 36, 1 );
Write ( Output, Name );
TextBackGround ( 0 );
Writeln;
Window ( 1, 3, 80, 25 );
WHILE NOT EOF(FileName) DO
BEGIN
Counter := Counter + 1;
Readln ( FileName, Line );
Writeln ( Output, Line );
Counter := Counter + 1;
IF ( Counter MOD 42 ) = 0 THEN
BEGIN
WritelnXy ( 30, 22,' - More - ');
DeadKey := Readkey;
ClrScr;
END;
END;
END;
Writeln ( Output, '' );
Writeln ( Output,' Press Any Key...');
Deadkey := Readkey;
Window ( 1, 1, 80, 25 );
ClrScr;
EchoPicture;
Window ( 1, 13, 80, 25 );
END;

PROCEDURE Quit;

BEGIN
TextColor ( 15 );
TextBackGround ( 0 );
ClrScr;
WritelnXy ( 20, 10, 'Thank you for using DocPrint.');
Music ( 1, 2000, 1000 );
WritelnXy ( 20, 12, ' Goodbye! ');
Finished := True;
END;

BEGIN
Finished := False;
TextBackGround ( 0 );
EchoPicture;
WHILE NOT Finished DO
BEGIN
Menu;
CASE Choice OF
'1' : ThePrinter;
'2' : Screen;
#27 : Quit;
END;
END;
END.