Category : Pascal Source Code
Archive   : TSRUNIT.ZIP
Filename : TSRDEMO.PAS

PROGRAM TSRDemo; {An example TSR program created using TSRUnit. }

{$M $0800,0,0} {Set stack and heap size for demo program. }

USES CRT, DOS, TSRUNIT; {Specify the TSRUNIT in the USES statement.}
{Do not use the PRINTER unit, instead treat}
{the printer like a file; i.e. use the }
{Assign, Rewrite, and Close procedures. }

CONST DemoPgmName : STRING[16] = 'TSR Demo Program';

VAR
Lst : TEXT; {Define variable name for the printer. }
TextFile : TEXT; { " " " " a data file. }
InsStr : STRING; {Storage for characters to be inserted into}
{keyboard input stream--must be a gobal or }
{heap variable. }

FUNCTION IOError: BOOLEAN; {Provides a message when an I/O error}
VAR i : WORD; {occurs. }
BEGIN
i := IOResult;
IOError := FALSE;
IF i <> 0 THEN BEGIN
Writeln('I/O Error No. ',i);
IOError := TRUE;
END;
END; {OurIOResult.}
{
***** Demo routine to be called when TSRDemo is popped up.
be compiled as a FAR FUNCTION that returns a WORD containing
the number of characters to insert into the keyboard input
stream.
}
{$F+} FUNCTION DemoTasks: WORD; {$F-}
CONST
FileName : STRING[13] = ' :TSRDemo.Dat';
EndPos = 40;
Wx1 = 15; Wy1 = 2; Wx2 = 65; Wy2 = 23;
VAR
Key, Drv : CHAR;
Done, IOErr : BOOLEAN;
InputPos, RowNumb : INTEGER;
DosVer : WORD;
InputString : STRING;

PROCEDURE ClearLine; {Clears current line and resets line pointer}
BEGIN
InputString := ''; InputPos := 1;
GotoXY( 1, WhereY ); ClrEol;
END;

BEGIN
DemoTasks := 0; {Default to 0 characters to insert.}
Window( Wx1, Wy1, Wx2, Wy2 ); {Set up the screen display. }
TextColor( Black );
TextBackground( LightGray );
LowVideo;
ClrScr; {Display initial messages. }
Writeln;
Writeln(' Example Terminate & Stay-Resident (TSR) program');
Writeln(' --written with Turbo Pascal 5.0 and uses TSRUnit.');
Window( Wx1+1, Wy1+4, Wx2-1, Wy1+12);
TextColor( LightGray );
TextBackground( Black );
ClrScr; {Display function key definitions. }
Writeln;
Writeln(' Function key definitions:');
Writeln(' [F1] Write message to TSRDEMO.DAT');
Writeln(' [F2] " " to printer.');
Writeln(' [F3] Read from saved screen.');
Writeln(' [F8] Exit and insert text.');
Writeln(' [F10] Exit TSR and keep it.');
Write( ' or simply echo your input.');

{Create active display window. }
Window( Wx1+1, Wy1+14, Wx2-1, Wy2-1 );
ClrScr;
{Display system information. }
Writeln('TSRUnit Version: ', Hi(TSRVersion):8, '.',
Lo(TSRVersion):2 );
Writeln('Video Mode, Page:', TSRMode:4, TSRPage:4 );
Writeln('Cursor Row, Col.:', TSRRow:4, TSRColumn:4 );

DosVer := DosVersion;
Writeln('DOS Version: ', Lo(DosVer):8, '.', Hi(DosVer):2 );

InputString := ''; {Initialize variables. }
InputPos := 1;
Done := False;

REPEAT {Loop for processing keystrokes. }
GotoXY( InputPos, WhereY ); {Move cursor to input position. }
Key := ReadKey; {Wait for a key to be pressed. }
IF Key = #0 THEN BEGIN {Check for a special key. }
Key := ReadKey; {If a special key, get auxiliary}
CASE Key OF {byte to identify key pressed. }

{Cursor Keys and simple editor.}
{Home} #71: InputPos := 1;
{Right} #75: IF InputPos > 1 THEN Dec( InputPos );
{Left} #77: IF (InputPos < Length( InputString ))
OR ((InputPos = Length( InputString ))
AND (InputPos < EndPos )) THEN Inc( InputPos );
{End} #79: BEGIN
InputPos := Succ( Length( InputString ) );
IF InputPos > EndPos THEN InputPos := EndPos;
END;
{Del} #83: BEGIN
Delete( InputString, InputPos, 1 );
Write( Copy( InputString, InputPos, EndPos ), ' ');
END;

{Function Keys--TSRDemo's special features.}
{F1} #59: BEGIN {Write short message to a file. }
ClearLine;
REPEAT
Write('Enter disk drive: ',FileName[1] );
Drv := UpCase( ReadKey ); Writeln;
IF Drv <> #13 THEN FileName[1] := Drv;
Writeln('Specifying an invalid drive will cause your');
Write('system to crash. Use drive ',
FileName[1], ': ? [y/N] ');
Key := UpCase( ReadKey ); Writeln( Key );
UNTIL Key = 'Y';
Writeln('Writing to ',FileName );
{$I-} {Disable I/O checking.}
Assign( TextFile, 'TSRDemo.Dat' );
IF NOT IOError THEN BEGIN {Check for error. }
Rewrite( TextFile );
IF NOT IOError THEN BEGIN
Writeln(TextFile,'File was written by TSRDemo.');
IOErr := IOError;
Close( TextFile );
IOErr := IOError;
END;
END;
{$I+} {Enable standard I/O checking.}
Writeln('Completed file operation.');
END; {F1}

{F2} #60: BEGIN {Print a message, use TSRUnit's auxiliary }
{function PrinterOkay to check printer status. }
ClearLine;
Writeln('Check printer status, then print if okay.');
IF PrinterOkay THEN BEGIN {Check if printer is okay}
Assign( Lst, 'LPT1' ); {Define printer device. }
Rewrite( Lst ); {Open printer. }
Writeln( Lst, 'Printing performed from TSRDemo');
Close( Lst ); {Close printer. }
END
ELSE Writeln('Printer is not ready.');
Writeln( 'Completed print operation.' );
END; {F2}

{F3} #61: BEGIN {Display a line from the saved screen image--not}
{valid if the TSR was popped up while the }
{display was in a graphics mode. }
ClearLine;
CASE TSRMode OF {Check video mode of saved image.}
0..3,
7: BEGIN
{$I-}
REPEAT
Writeln('Enter row number [1-25] from ');
Write('which to copy characters: ');
Readln( RowNumb );
UNTIL NOT IOError;
{$I+}
IF RowNumb <= 0 THEN RowNumb := 1;
IF RowNumb > 25 THEN RowNumb := 25;
Writeln( ScreenLineStr( RowNumb ) );
END;
ELSE Writeln('Not valid for graphics modes.');
END; {CASE TSRMode}
END; {F3}
{F8} #66: BEGIN {Exit and insert string into keyboard buffer.}
ClearLine;
Writeln('Enter characters to insert;');
Writeln('Up to 255 character may be inserted.');
Writeln('Terminate input string by pressing [F8].');
InsStr := '';
REPEAT {Insert characters into a}
Key := ReadKey; {until [F8] is pressed. }
IF Key = #0 THEN BEGIN {Check for special key.}
Key := ReadKey; {Check if key is [F8]. }
IF Key = #66 THEN Done := TRUE; {[F8] so done. }
END
ELSE BEGIN {Not special key, add it to the string.}
IF Length(InsStr) < Pred(SizeOf(InsStr)) THEN
BEGIN
IF Key = #13 THEN Writeln
ELSE Write( Key );
InsStr := InsStr + Key;
END
ELSE Done := TRUE; {Exceeded character limit. }
END;
UNTIL Done;
DemoTasks := Length( InsStr ); {Return no. of chr. }
TSRChrPtr := @InsStr[1]; {Set ptr to 1st chr.}
END; {F8}

{F10} #68: Done := TRUE; {Exit and Stay-Resident. }

END; {CASE Key}
END {IF Key = #0}
ELSE BEGIN {Key pressed was not a special key--just echo it. }
CASE Key OF
{BS} #08: BEGIN {Backspace}
IF InputPos > 1 THEN BEGIN
Dec( InputPos );
Delete( InputString, InputPos, 1 );
GotoXY( InputPos, WhereY );
Write( Copy( InputString, InputPos, EndPos ), ' ');
END;
END; {BS}
{CR} #13: BEGIN {Enter}
Writeln;
InputString := '';
InputPos := 1;
END; {CR}
{Esc} #27: ClearLine;
ELSE
IF Length( InputString ) >= EndPos THEN
Delete( InputString, EndPos, 1 );
Insert( Key, InputString, InputPos );
Write( Copy( InputString, InputPos, EndPos ) );
IF InputPos < EndPos THEN
Inc( InputPos );
END; {CASE...}
END; {ELSE BEGIN--Key <> #0}
UNTIL Done;
END; {DemoTasks.}

BEGIN
TSRInstall( @DemoPgmName, @DemoTasks, AltKey, 'E' );
END. {TSRDemo.}