Category : Files from Magazines
Archive   : ITP9101.ZIP
Filename : GRL.PAS

 
Output of file : GRL.PAS contained in archive : ITP9101.ZIP
PROGRAM TestReadln;

USES Crt,Graph;

TYPE
String2 = String[2];
CommandType = (Nothing,ArrowLeft,ArrowRight,Del,
BackSpace,ExitField,UnknownXtd,UnknownNor);

{===== Check out key press to see if it is a command ===========}

FUNCTION GetCmd(Key : String2) : CommandType;
CONST
Null = #0; {Special Command Keys}
KeyBackSpace = #8;
KeyEnter = #13;
KeyEscape = #27;
KeyLeftArrow = #75; {Extended character Keys}
KeyRightArrow = #77;
KeyDel = #83;
BEGIN
IF Key = Null THEN BEGIN
Key := ReadKey;
CASE Key[1] OF {Extended commands}
Null : GetCmd := Nothing;
KeyLeftArrow : GetCmd := ArrowLeft;
KeyRightArrow : GetCmd := ArrowRight;
KeyDel : GetCmd := Del
ELSE
GetCmd := UnknownXtd
END
END
ELSE
CASE Key[1] OF {Normal Keys}
KeyBackSpace : GetCmd := BackSpace;
KeyEnter : GetCmd := ExitField;
KeyEscape : GetCmd := ExitField
ELSE
GetCmd := UnknownNor
END
END;

{========= The audio feedback portion of our program ===========}

PROCEDURE Beep(Freq : Integer);
BEGIN
NoSound;
Sound(Freq);
Delay(150);
NoSound
END;


{================= Manage the cursor display ===================}

PROCEDURE DrawWordCursor(X,Y,W,H : Integer);
BEGIN
Line(X,Y+H+1,X+W-2,Y+H+1)
END;

PROCEDURE DeleteWordCursor(X,Y,W,H : Integer);
BEGIN
Bar(X,Y+H+1,X+W-2,Y+H+1)
END;

{============= The ReadLn function for graphics mode ===========}

FUNCTION GrReadln(Ax,Ay : Integer; LenMax: Byte): String;

VAR
TextPoint : Integer;
Position : Integer;
TempString: String;
Key : Char;
Cmd : CommandType;
CWidth,CHeight : Integer;


PROCEDURE OffLetter; {Procedure to erase charcters from screen}
VAR
Ch : String[1]; {Create a string here just to increase }
BEGIN { the readability of the code, you could }
Ch := Copy(TempString,Position,1); {put the Copy function }
Bar(Ax,Ay,Ax+TextWidth(Ch)-1,Ay+TextHeight(Ch)-1) { here. }
END;

BEGIN

FillChar(TempString[1],LenMax,' '); {Initialize String}
TempString[0] := Chr(LenMax);
CWidth := TextWidth(' '); {Set cursor width}
CHeight := TextHeight(' '); {Set cursor height}
Position := 1; {Position in the character String}
SetTextJustify(LeftText,TopText);
TextPoint := Ax; {Initial left edge}

REPEAT

DrawWordCursor(Ax,Ay,CWidth,CHeight); {Turn cursor on}
Key := ReadKey; {Get keypress}
Cmd := GetCmd(Key); {Check if keypress is a command}
DeleteWordCursor(Ax,Ay,CWidth,CHeight); {Turn cursor off}

CASE Cmd OF

Del : BEGIN {Delete character under cursor}
OffLetter;
TempString[Position] := ' ';
END;

ArrowLeft : BEGIN
IF Position > 1 THEN BEGIN
Dec(Position);
Ax := Ax-TextWidth(Copy(TempString,Position+1,1))
END
ELSE
Beep(65)
END;

ArrowRight : BEGIN
IF Position < LenMax THEN BEGIN
Inc(Position);
Ax := Ax+TextWidth(Copy(TempString,Position-1,1))
END
ELSE
Beep(65)
END;

BackSpace : BEGIN
IF Position > 1 THEN BEGIN
Dec(Position); {Check and adjust Position}
Ax := Ax - TextWidth(Copy(TempString,Position+1,1));
OffLetter; {Kill current onscreen letter}
Delete(TempString,Position,1); {Remove from String}
Insert(' ',TempString,Position) {Replace with space}
END
ELSE
Beep(65)
END;

ExitField, UnknownXtd: BEGIN
Beep(820);
END;

ELSE BEGIN
TempString[Position] := Key; {Put character in String}
OffLetter; {Erase onscreen letter }
OutTextXY(Ax,Ay,Key); {Display character onscreen}

Inc(Position); {Increment position in String}

IF Position > LenMax THEN BEGIN
Position := LenMax;
Beep(65)
END
ELSE
Ax := Ax + TextWidth(Key)
END {CASE ELSE}
END {CASE}
UNTIL (Cmd = ExitField);
GrReadln := TempString
END;

{================================================================
= GrInit - Initialize graphics system, and set the video =
= controller card to the highest resolution. Assumes =
= the proper .BGI files are in the current directory =
= OUT: 0 if no error, the error number otherwise. =
================================================================}

FUNCTION GrInit: Integer;
VAR
GrDriver, GrMode, GrErr : Integer;
BEGIN
DetectGraph(GrDriver, GrMode); {* Initialize graphics system *}
IF (GrDriver < 0) THEN
GrInit := -1
ELSE BEGIN
InitGraph(GrDriver, GrMode,'');
GrErr:=GraphResult;
IF (GrErr <> 0) THEN
GrInit := GrErr
ELSE
GrInit := 0
END
END;

{======================== Main block ===========================}

VAR
TestStr : String;
X,Y : Integer;
Msg : String; { Dummy message string }
Cmd : CommandType;

BEGIN
ClrScr;
X := GrInit;
IF X = 0 THEN BEGIN
SetTextStyle(DefaultFont,HorizDir,1);
SetFillStyle(EmptyFill,0); {General demo setup instructions}
SetColor(LightCyan);

X := GetMaxX DIV 2;
Y := GetMaxY DIV 2;

SetTextJustify(CenterText,TopText); { Display 1st message }

Msg := 'Enter a String';
OutTextXY(X-(TextWidth(Msg) DIV 2),Y-80,Msg);

TestStr := GrReadln(X-70,Y-40,20); { Enter message }

SetTextJustify(CenterText,TopText); { Display 2nd message }
Msg := 'You wrote = ';
OutTextXY(X-(TextWidth(Msg) DIV 2),Y,Msg);

SetTextJustify(LeftText,TopText); { Display what you typed }
OutTextXY(X-70,Y+40,TestStr);

Msg := 'Press to end PROGRAM'; { Close up shop }
OutTextXY(X-(TextWidth(Msg) DIV 2),Y+80,Msg);
ReadLn;
CloseGraph
END
ELSE BEGIN
WriteLn('Graphics System initialization error.');
WriteLn(GraphErrorMsg(X))
END
END.


  3 Responses to “Category : Files from Magazines
Archive   : ITP9101.ZIP
Filename : GRL.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/