Category : Pascal Source Code
Archive   : ASG53.ZIP
Filename : DEMO.PAS
strated in the source code is followed by the word DEMO so you can examine
how it is used. Not all the procedures are demonstrated but there is a good
representation. Read the *.DOC files for a listing of all of the available
functions and procedures.}
PROGRAM Demo;
{$V-}
USES
CRT, { For TPCRT get source code and recompile }
BlueBag,
AtSayGet,
ReadASG;
TYPE
PhoneType = STRING[14];
VAR
AllOK : BOOLEAN;
B : BYTE;
C : CHAR;
DS1,
DS2 : DateString;
Dt1,
Dt2 : Date;
BigDt : DelimitedDate;
Change: LONGINT;
Str10 : STRING[10];
AnyS : STRING;
Doc : TEXT;
Any : WORD;
CONST
Cont : BOOLEAN =True;
Phone : PhoneType='( ) - ';
AR : REAL =0.0;
LI : LONGINT =0;
I : INTEGER =0;
W : WORD =0;
{$I RASGDEMO.INC} { <--- LOOK AT THIS TO SEE HOW READASG.TPU IS USED}
{$I R2ENGLSH.INC}
BEGIN
TextAttr:=7; ClrScr;
OrgAttr:=7; SayAttr:=7; GetAttr:=30; EndAttr:=15;
DrawBox(23,1,55,3,3); {DEMO}
AtSay(25,2,'AtSayGet and BlueBag TPU Demo'); {DEMO}
DrawBox(1,4,80,21,2);
AtSay(3,5,'If you like boxes but find them a fuss you''ll love DrawBox()');
AtSay(3,7,'We have regular boxes...');
DrawBox(28,7,38,10,1); Delay(500);
DrawBox(41,7,51,10,2); Delay(500);
DrawBox(54,7,64,10,3); Delay(500);
DrawBox(67,7,77,10,4); Delay(500);
AtSay(3,12,'and lots of others.....');
DrawBox(28,12,38,15,176); Delay(500);
DrawBox(41,12,51,15,177); Delay(500);
DrawBox(54,12,64,15,178); Delay(500);
DrawBox(67,12,77,15,219); Delay(500);
DrawBox(28,17,38,20,36); Delay(500);
DrawBox(41,17,51,20,63); Delay(500); INC(TextAttr,Blink);
DrawBox(54,17,64,20,248); Delay(500); DEC(TextAttr,Blink);
DrawBox(67,17,77,20,240); Delay(500);
AtSay(2,23,'Sometimes it''s nice to halt everything and just WAIT for the user to');
GoToXY(2,24);
WAIT; {DEMO}
OpenWindow(20,7,78,20,White,Red,1,' WINDOWS '); {DEMO}
WRITELN; WRITELN;
WRITELN(' The image below this window was just saved on the heap.');
WRITELN(' You may have up to 9 windows active at any time. When');
WRITELN(' you close a window the saved image that was below it is');
WRITELN(' quickly restored to the screen and the space it took on');
WRITELN(' the heap is returned to DOS.');
WRITELN; WRITELN;
WRITE(' '); WAIT;
OpenWindow( 3, 1,15,12,LightGray,Blue,2,' 2 '); DELAY(500);
OpenWindow(10, 3,22,14,Yellow,Magenta,3,' 3 '); DELAY(500);
OpenWindow(20, 5,32,16,White,Blue,4,' 4 '); DELAY(500);
OpenWindow(30, 7,42,18,Black,LightGray,176,' 5 '); DELAY(500);
OpenWindow(40, 9,52,20,White,Green,177,' 6 '); DELAY(500);
OpenWindow(50,11,62,22,LightGray,Black,178,' 7 '); DELAY(500);
OpenWindow(60,13,72,24,LightBlue,Blue,240,' 8 '); DELAY(500);
OpenWindow( 6,15,75,19,White+Blink,Black,3,' 9 ');
GoToXY(22,2); WAIT;
CloseWindow; {9} DELAY(500); {DEMO}
CloseWindow; {8} DELAY(500);
CloseWindow; {7} DELAY(500);
CloseWindow; {6} DELAY(500);
CloseWindow; {5} DELAY(500);
CloseWindow; {4} DELAY(500);
CloseWindow; {3} DELAY(500);
CloseWindow; {2} DELAY(500);
CloseWindow; {1} DELAY(1000);
OpenWindow(2,11,30,20,Yellow,Blue,1,'');
AtSay(2,2,'Well, this isn''t pretty!');
AtSay(2,3,'To clear a portion of a');
AtSay(2,4,'screen or window use the');
AtSay(2,5,'CLEAR() procedure...');
AtSay(2,7,''); WAIT;
CloseWindow;
CLEAR(2,5,79,20); {DEMO}
ReverseVideo; {DEMO}
CLEAR(1,22,80,24);
Center(23,'MORE CRT TRICKS'); {DEMO}
CENTER(6,'This is what the REVERSEVIDEO procedure did to me!');
RestoreVideo; {DEMO}
CENTER(7,'This is what the RESTOREVIDEO procedure did to me.');
GoToXY(28,8); WAIT; CLEAR(14,6,70,8);
Center(7,'The CENTER() procedure centers long lines of text on the screen');
DELAY(1000);
Center(8,'It also centers shorter lines like this one'); DELAY(1000);
Center(9,'And me too!'); DELAY(1000);
OpenWindow(5,11,50,17,White,Green,1,'');
Center(2,'It works in windows');
GoToXY(2,4); Wait;
CloseWindow;
CLEAR(5,7,70,9);
ReverseVideo; CENTER(23,'CURSOR MANIPULATION'); RestoreVideo;
{ demonstrate cursor manipulation }
CursorOff; {DEMO}
AtSay(26,10,'Heh...Where''s the cursor?'); Delay(2000);
CursorOn; {DEMO}
SetCursor(0,StopScan); {DEMO}
AtSay(23,11,'Isn''t this a bit over doing it?'); Delay(2000);
RestoreCursor; {DEMO}
CLEAR(23,10,70,11);
SayAttr:=30; {DEMO}
AtSay(23,10,'PRESS A KEY TO CHANGE CURSOR SIZE');
SayAttr:=7;
AtSay(15,12,'Notice the various cursor sizes/shapes available:');
FOR Any:=StopScan DOWNTO 1 DO
BEGIN
SetCursor(0,Any); {Variations on the theme}
C:=ReadKey;
END;
CursorOn; {Reset to system default}
CursorSave;
FOR Any:=StopScan-1 DOWNTO 0 DO
BEGIN
SetCursor(Any,StopScan); {More variations}
C:=ReadKey;
END;
CursorOn; CursorSave;
CLEAR(15,10,70,12);
ReverseVideo; CENTER(23,' STRING ROUTINES '); RestoreVideo;
AtSay(8,9,'NOTE: You can use the WordStar/dBase/Turbo editing keys');
AnyS:='Please enter a line of text in lower case and press Enter:';
AtSayGetStrLen(8,12,'',AnyS,Length(AnyS)); {DEMO}
AtSay(8,14,'This demonstrates the UpperCase() Function:');
AnyS:=UpperCase(AnyS); {DEMO}
AtSay(8,15,AnyS);
GoToXY(8,17); WAIT;
CLEAR(2,10,79,17);
AnyS:='PLEASE ENTER A LINE OF TEXT IN UPPER CASE AND PRESS ENTER:';
AtSayGetStrLen(8,12,'',AnyS,Length(AnyS));
AtSay(8,14,'This demonstrates the LowerCase() Function:');
AnyS:=LowerCase(AnyS); {DEMO}
AtSay(8,15,AnyS);
GoToXY(8,17); WAIT;
CLEAR(2,9,79,17);
AtSay(3,8,'The sentance that you entered was:');
AtSay(3,9,AnyS);
AtSay(3,11,'After NoBlanks() takes care of your line it looks like this:');
NoBlanks(AnyS); {DEMO}
AtSay(3,12,AnyS);
GoToXY(3,15); WAIT;
CLEAR(2,8,79,15);
AnyS:='Please enter a line of text in ANY case and press Enter:';
AtSayGetStrLen(8,12,'',AnyS,Length(AnyS));
GetWordCount(AnyS,B); {DEMO}
OpenWindow(2,5,39,20,White,Green,1,' FORWARD ');
FOR Any:=1 TO B DO WRITELN(NextWord(AnyS)); {DEMO}
OpenWindow(40,5,79,20,White,Red,1,' BACKWARDS ');
FOR Any:=B DOWNTO 1 DO WRITELN(NthWord(AnyS,Any)); {DEMO}
WAIT;
CloseWindow; {backwards}
CloseWindow; {forward}
CLEAR(8,11,75,12);
ReverseVideo; CENTER(23,' AtSayGet DEMO '); RestoreVideo;
AtSay(10, 7,'The AtSayGet unit provides the functional equivalence of the');
AtSay(10, 8,'dBase: @ Line,Row SAY "prompt" GET [PICTURE] [RANGE]');
AtSay(10, 9,'command. A full range of editing keys are employed. See the');
AtSay(10,10,'ATSAYGET.DOC file for details.');
AtSayGetBoolean(4,12,'Continue?',Cont); {DEMO}
WRITELN;
IF NOT Cont THEN
BEGIN
AtSay(14,12,'I insist!'); Delay(2000);
END;
Clear(4,7,75,12); AnyS:='';
REPEAT
AtSay(4,7,'Do not leave this field blank, or else!'); {you won't ever finish}
AtSayGetStrLen(4,8,'What is your name?',AnyS,30); {DEMO}
UNTIL NOT IsBlank(AnyS); {DEMO}
CLEAR(4,7,75,8);
AtSayGetWord (4, 8,'What is your age? ',W,2); {DEMO}
AtSayGetStrPic(4, 9,'What is your phone',Phone,'(999) 999-9999'); {DEMO}
AtSayGetInt (4,10,'Enter an Integer ',I,5); {DEMO}
I:=0;
{DEMO of TRIM() function follows}
AtSay(4,12,Concat('O.K. ',TRIM(AnyS),', let''s not have any negative numbers!'));
{the following shows some of the ASGRange procedures}
AtSayGetIntRange(4,13,'What do you owe on your car?',I,6,0,MaxInt); {DEMO}
AtSayGetLongIntRange(4,14,'What is owing on your house?',LI,7,0,250000); {DEMO}
AtSayGetRealRange(4,15,'What are your living costs? ',AR,10,2,500,5000); {DEMO}
GoToXY(4,19); Wait;
CLEAR(4,8,75,19);
ReverseVideo; CENTER(23,'DEVICE FUNCTIONS'); RestoreVideo;
OpenWindow(13,10,68,18,LightGray,Blue,3,' DEVICE FUNCTIONS ');
Cont:=True;
WHILE Cont DO
BEGIN
ClrScr; WRITELN;
FOR W:=0 TO 2 DO
BEGIN
WRITE(' Your printer #',W+1:2,' is ');
IF NOT PrinterOnLine(W) {DEMO}
THEN
BEGIN
TextColor(White); WRITE('NOT '); TextColor(LightGray);
END;
WRITELN('on-line');
END;
AtSayGetBoolean(2,6,'Try again?',Cont);
END;
ClrScr;
AnyS:='BLUEBAG.DOC '; Cont:=True;
WHILE Cont DO
BEGIN
ClrScr;
AtSayGetStrLen(2,2,'Enter a file name',AnyS,12); GoToXY(2,4);
WRITE(Trim(AnyS));
IF OnFile(AnyS) THEN WRITELN(' is on file.') ELSE WRITELN(' is NOT on file.');
{DEMO ^}
AtSayGetBoolean(2,5,'Try again?',Cont);
END;
ClrScr; Cont:=True;
AtSayGetBoolean(2,3,'Read the documentation now?',Cont); WRITELN;
IF Cont THEN
BEGIN
IF OnFile('BLUEBAG.DOC') OR OnFile('ATSAYGET.DOC') THEN
BEGIN
OpenWindow(1,1,80,24,LightGray,Black,1,' DOCUMENTATION ');
IF OnFile('BLUEBAG.DOC') THEN
BEGIN
ASSIGN(Doc,'BLUEBAG.DOC'); RESET(Doc); I:=1;
WHILE NOT EOF(Doc) DO
BEGIN
Readln(Doc,AnyS); WRITELN(AnyS); INC(I);
IF I=21 THEN
BEGIN
WRITE(' '); WAIT; GoToXY(1,WhereY); ClrEol; I:=1;
END;
END;
CLOSE(Doc); WRITE(' '); WAIT; ClrScr;
END
ELSE
BEGIN
WRITELN(' BLUEBAG.DOC IS NOT ON FILE.'); WRITE(' '); WAIT;
END;
ClrScr;
IF OnFile('ATSAYGET.DOC') THEN
BEGIN
ASSIGN(Doc,'ATSAYGET.DOC'); RESET(Doc); I:=1;
WHILE NOT EOF(Doc) DO
BEGIN
Readln(Doc,AnyS); WRITELN(AnyS); INC(I);
IF I=21 THEN
BEGIN
WRITE(' '); WAIT; GoToXY(1,WhereY); ClrEol; I:=1;
END;
END;
CLOSE(Doc); WRITE(' '); WAIT; ClrScr;
END
ELSE
BEGIN
WRITELN(' ATSAYGET.DOC IS NOT ON FILE.'); WRITE(' '); WAIT;
END;
CloseWindow;
END
ELSE
BEGIN
WRITELN(' Rats, both document files are missing!'); Wait;
END;
END;
CloseWindow; {device}
{show some of the date features}
ReverseVideo; CENTER(23,'BLUEBAG DATE DEMO'); RestoreVideo;
OpenWindow(12,5,68,19,LightGray,Blue,4,' DATE FEATURES ');
ClrScr; AllOK:=False;
Dt2:=SysDate; {DEMO}
Ds2:=DateToDateString(Dt2); {DEMO}
WRITELN(' Today is ',NameOfDay(DayOfWeek(Dt2)),', ',NameOfMonth(MonthOfYear(Dt2)),
' ',COPY(Ds2,3,2),', ',COPY(Ds2,5,4)); {DEMO of 2 functions}
REPEAT
BigDt:=' / / ';
AtSayGetStrPic(2,2,'Enter Birth Day as Mo/Dy/Year:',BigDt,'99/99/9999');
WRITELN;
Ds1:=StripDateString(BigDt); {DEMO}
Dt1:=DateStringToDate(Ds1); {DEMO}
IF Dt1<>BadDate THEN AllOK:=True ELSE
BEGIN
WRITELN(' You entered an invalid date. Please try again.');
WRITE(' '); WAIT; CLEAR(1,2,48,4);
END;
UNTIL AllOK;
WRITELN(' You were born on a ',NameOfDay(DayOfWeek(Dt1)));
WRITELN(' Gosh, that was ',DaysBetween(Dt1,Dt2),' days ago!');
Any:=Trunc((Dt2-Dt1) / 365.25);
WRITE(' You were ',Any,' years old ');
WRITELN((Dt2-Dt1)-Trunc(Any*365.25),' days ago.'); Dt1:=0;
AtSayGetLongIntRange(2,7,'Enter some number of days hence: ',Dt1,6,1,999999);
WRITELN;
IncDate(Dt2,Dt1); {DEMO}
Ds2:=DateToDateString(Dt2);
BigDt:=DelimitDateString(DS2); {DEMO}
WRITELN(' The date that is ',Dt1,' days from now is ',BigDt);
WRITELN(' That will be a ',NameOfDay(DayOfWeek(Dt2)),' in ',NameOfMonth(MonthOfYear(Dt2)));
WRITELN;
WRITELN(' These date routines are only usefull until ',
DelimitDateString(DateToDateString(3652499)));
WRITELN(' Sorry.'); WRITE(' '); WAIT;
CloseWindow; {Date Features}
ReverseVideo; CENTER(23,'FULL SCREEN EDITING'); RestoreVideo;
{the following demonstrates the procedures in the ReadASG.TPU ... Look
at the code in RASGDEMO.INC for details of usage }
OpenWindow(1,4,80,21,LightGray,Black,2,'');
Init;
REPEAT
ClrScr;
AtSay(5,1,'The full screen can be edited using cursor & tab keys.');
IF NOT AddInfo THEN
BEGIN {editing a file record}
BlankInfo; READ(InfoFile,InfoRec);
IF EOF(InfoFile) THEN AddInfo:=True;
SEEK(InfoFile,FilePos(InfoFile)-1);
END
ELSE
BEGIN
BlankInfo;
AtSayGetBoolean(5,3,'Adding a business record?',InfoRec.Business);
END;
IF InfoRec.Business THEN
BEGIN
ReadPage(2);
OpenWindow(20,5,60,11,White,Red,1,' FINANCIAL INFORMATION ');
ReadPage(3);
CloseWindow; {financial information}
SayAttr:=7; OrgAttr:=7;
END
ELSE ReadPage(1);
WRITE(InfoFile,InfoRec);
IF AddInfo THEN AtSayGetBoolean(2,16,'Add a record?',More)
ELSE AtSayGetBoolean(2,16,'Edit next record?',More);
IF NOT More THEN
BEGIN
CLOSE(InfoFile); Cont:=False;
END;
UNTIL NOT Cont;
FOR C1:=3 DOWNTO 1 DO FreeASGHeapPage(C1);
A1:=0; A2:=0; C1:=0; C2:=0; FillChar(CA,SizeOf(CA),0);
ClrScr;
WRITELN('The following demonstrates how to reuse an ASG Page. It also gives an example');
WRITELN('of how to add fields to a page at runtime depending upon variable criteria...');
WRITELN('See the program CVP.EXE in CVP22.ARC located in BPA0 for a usefull applic''n.');
{re-set ASG attributes}
OrgAttr:=7; SayAttr:=7; GetAttr:=113; EndAttr:=15;
AtSayGetWordRange(1,5,'Enter a number of columns from 2 to 5:',C2,1,2,5);
AtSayGetWordRange(1,6,'Enter a number of rows from 2 to 5 :',C1,1,2,5);
MakeASGHeapPage(1,C1*C2); {you will add Rows*columns of fields to the page}
FOR A1:=1 TO C1 DO FOR A2:=1 TO C2 DO
IF A2=1 THEN AddASGW(1,1,A1+10,'Enter numbers',@CA[A1,A2],2)
ELSE AddASGW(1,((A2-1)*10+15),A1+10,'',@CA[A1,A2],2);
AtSay(15,9,'The screen below can be edited using cursor & tab keys.');
ReadPage(1);
FreeASGHeapPage(1); {this isn't really necessary as ReadASG frees all pages
as part of its exit code}
CloseWindow;
{the following demonstrates the RealToEnglish procedure}
RANDOMIZE; CqNum:=Random(400)+100; TotPd:=0;
IntroScript;
DONE:=False; InReal:=45;
REPEAT
OpenWindow(2,8,79,20,Black,Green,1,'');
ShowCheque; EndAttr:=33;
AtSayGetRealRange(65,5,'$',InReal,9,2,1,999999.99);
RealToEnglish(InReal,OutStr); { <-- THIS IS THE PROCEDURE BEING DEMONSTRATED}
TextAttr:=33; GoToXY(1,7); WRITELN(OutStr:75);
WriteAnotherCheque;
INC(CqNum); TotPd:=TotPd+InReal;
CloseWindow; {cheque}
WRITELN(' Cheque #',CqNum-1:4,' $',InReal:10:2);
InReal:=0;
UNTIL DONE;
PatheticPlea;
TextAttr:=7;
END.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
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/