home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ATSAY5.ZIP / DEMO.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1993-01-04  |  6.2 KB  |  199 lines
  1. PROGRAM Demo;
  2. {demonstrate BlueBag and AtSayGet TPU'S}
  3.  
  4. {$V-}
  5. USES
  6.  CRT,
  7.  AtSayGet,
  8.  BlueBag;
  9.  
  10. TYPE
  11.  PhoneType = STRING[14];
  12.  
  13. VAR
  14.  D1,D2 : DateType;
  15.  Doc   : TEXT;
  16.  Change: LONGINT;
  17.  AnyS  : STRING;
  18.  
  19. CONST
  20.  Cont  : BOOLEAN=True;
  21.  Phone : PhoneType='(   )    -    ';
  22.  AR    : REAL=0.0;
  23.  LI    : LONGINT=0;
  24.  I     : INTEGER=0;
  25.  W     : WORD=0;
  26.  
  27. BEGIN
  28.  ClrScr;
  29.  ReverseVideo;  {DEMO}
  30.  GoToXY(15, 5); WRITE('AtSayGet and BlueBag TPU Demo');
  31.  RestoreVideo;  {DEMO}
  32.  GoToXY(16, 6); WRITE('Oh look -- Reverse video!'); DELAY(3000);
  33.  CursorOff;     {DEMO}
  34.  GoToXY(17,10); WRITE('Heh...Where''s the cursor?');
  35.  Delay(3000);
  36.  CursorOn;      {DEMO}
  37.  SetCursor(0,StopScan);  {DEMO}
  38.  GoToXY(14,11); WRITE('Isn''t this a bit over doing it?');
  39.  Delay(3000);
  40.  RestoreCursor; {DEMO}
  41.  GoToXY(1,20);
  42.  WRITELN('After showing the WAIT function we will look at other goodies in windows.');
  43.  WAIT;          {DEMO}
  44.  OpenWindow(20,1,75,15,Yellow,Blue,Single,' DATE FUNCTIONS ',RAM); {DEMO}
  45.  D1:='890101'; D2:=''; Change:=0;
  46.  WRITELN('DEMONSTRATING THE INCDAYS FUNCTION:');
  47.  WRITELN('----------------------------------');
  48.  WRITELN('This New Years day was  ',D1);
  49.  WRITE('Enter a number of days: '); READLN(Change);
  50.  WRITE('The date that is ',Change,' days ');
  51.  IF Change>=0 THEN WRITE('after ') ELSE WRITE('before ');
  52.  WRITELN(D1,' is ',IncDate(D1,Change));                            {DEMO}
  53.  WRITELN;
  54.  D1:=''; D2:='890101'; Change:=0;
  55.  WRITELN('DEMONSTRATING THE DAYSBETWEEN FUNCTION:');
  56.  WRITELN('--------------------------------------');
  57.  WRITE('What is todays date [YrMoDy] '); READLN(D2);
  58.  WRITE('When were you born? [YrMoDy] '); READLN(D1);
  59.  WRITELN('My God! That was ',DaysBetween(D1,D2),' days ago!');     {DEMO}
  60.  WAIT;
  61.  OpenWindow(5,5,70,12,White,Red,Double,' STRING ROUTINES ',Disk); {DEMO}
  62.  WRITELN;
  63.  WRITELN('Before we move along I must comment on the grinding disks:');
  64.  WRITELN('The image below this window was just saved to disk! Not the');
  65.  WRITELN('fastest way but someone may see a use for it.');
  66.  WRITELN;
  67.  WAIT;
  68.  ClrScr;
  69.  WRITELN('OK. Let''s test the SPACE() procedure.');
  70.  WRITELN('I will code "SPACE(30); WRITELN(''CENTER'')" so watch:');
  71.  SPACE(30); WRITELN('CENTER');     {DEMO}
  72.  WRITELN; WAIT;
  73.  ClrScr;
  74.  WRITELN('Please enter a line of text in lower case & press Enter:');
  75.  READLN(AnyS);
  76.  WRITELN('This demonstrates the UpperCase Function -');
  77.  WRITELN(UpperCase(AnyS));         {DEMO}
  78.  WAIT;
  79.  ClrScr;
  80.  WRITELN('After NoBlanks() takes care of your line it looks like this:');
  81.  NoBlanks(AnyS); {DEMO}
  82.  WRITELN(AnyS);
  83.  WAIT; WRITELN;
  84.  WRITELN('The Trim() Function also works but it''s hard to');
  85.  WRITELN('demonstrate visually. You will find many uses for it.');
  86.  WAIT;
  87.  OpenWindow(1,1,50,22,Black,LightGray,32,' SCREEN TRICKS ',RAM);
  88.  WRITELN('Here goes DrawBox()!'); Wait;
  89.  DrawBox(1,4,47,19,1); Delay(500);   {DEMO}
  90.  DrawBox(5,2,22,12,2); Delay(500);
  91.  DrawBox(10,15,40,18,240); Delay(500);
  92.  DrawBox(15,5,45,20,219);
  93.  GoToXY(1,18); WAIT;
  94.  AnyS:='This big line of text will fill the screen.';
  95.  FOR Change:=1 TO 20 DO WRITELN(AnyS);
  96.  WRITELN('Now to test the Clear() procedure...'); WAIT;
  97.  Clear(2,2,30,11);  {DEMO}
  98.  GoToXY(4,4); WRITE('Clear() works!');
  99.  GoToXY(4,5); WAIT;
  100.  OpenWindow(10,12,80,20,White+Blink,Green,1,' AtSayGet PROCEDURES ',RAM);
  101.  DEC(TextAttr,Blink);
  102.  WRITELN('The AtSayGet unit provides the functional equivilance of the');
  103.  WRITELN('dBase @ Line,Row SAY "prompt" GET <variable> [PICTURE "template"]');
  104.  WRITELN('command. A full range of editing keys are employed. See the');
  105.  WRITELN('ATSAYGET.DOC file for details.');
  106.  AtSayGetBoolean(2,6,'Continue?',Cont);  {DEMO}
  107.  WRITELN;
  108.  IF Cont THEN WRITE('O.K.') ELSE WRITE('I insist!');
  109.  Delay(2000);
  110.  ClrScr; AnyS:='';
  111.  AtSayGetStrLen(2,2,'What is your name?',AnyS,30);  {DEMO}
  112.  AtSayGetWord(2,3,'What is your age? ',W,2);        {DEMO}
  113.  AtSayGetStrPic(2,5,'What is your phone',Phone,'(999) 999-9999');  {DEMO}
  114.  ClrScr;
  115.  WRITELN('O.K. ',TRIM(AnyS),', this is a skill testing question'); {DEMO}
  116.  WRITELN('involving negative numbers...');
  117.  AtSayGetInt(2,4,'What do you owe on your car?',I,6);      {DEMO}
  118.  AtSayGetLongInt(2,5,'What is owing on your house?',LI,7); {DEMO}
  119.  AtSayGetReal(2,6,'What are your monthly expenses to the cent?',AR,10,2); {DEMO}
  120.  WRITELN; WAIT;
  121.  OpenWindow(20,15,75,22,White,Black,240,' DEVICE FUNCTIONS ',RAM);
  122.  Cont:=True;
  123.  WHILE Cont DO
  124.  BEGIN
  125.   GoToXY(2,2); ClrEol;
  126.   WRITE(Trim(AnyS),', your printer #1 is ');
  127.   IF PrinterOnLine(1) THEN WRITE('on-line.') ELSE WRITE('NOT on-line.'); {DEMO}
  128.   AtSayGetBoolean(2,5,'Try again?',Cont);
  129.   IF Cont THEN CLEAR(1,3,48,5);
  130.  END;
  131.  ClrScr;
  132.  AnyS:='BLUEBAG.DOC '; Cont:=True;
  133.  WHILE Cont DO
  134.  BEGIN
  135.   AtSayGetStrLen(2,2,'Enter a file name',AnyS,12); WRITELN;
  136.   IF OnFile(AnyS) THEN WRITELN(Trim(AnyS),' is on file.')  {DEMO}
  137.    ELSE WRITELN(Trim(AnyS),' is NOT on file.');
  138.   AtSayGetBoolean(2,5,'Try again?',Cont);
  139.   IF Cont THEN CLEAR(1,3,48,5);
  140.  END;
  141.  ClrScr; Cont:=True;
  142.  AtSayGetBoolean(2,3,'Read the documentation now?',Cont); WRITELN;
  143.  IF Cont THEN
  144.  BEGIN
  145.   IF OnFile('BLUEBAG.DOC') OR OnFile('ATSAYGET.DOC') THEN
  146.   BEGIN
  147.    OpenWindow(1,1,80,24,LightGray,Black,1,' DOCUMENTATION ',RAM);
  148.    IF OnFile('BLUEBAG.DOC') THEN
  149.    BEGIN
  150.     ASSIGN(Doc,'BLUEBAG.DOC'); RESET(Doc); I:=1;
  151.     WHILE NOT EOF(Doc) DO
  152.     BEGIN
  153.      Readln(Doc,AnyS); WRITELN(AnyS); INC(I);
  154.      IF I=21 THEN
  155.      BEGIN
  156.       WAIT; GoToXY(1,WhereY); ClrEol; I:=1;
  157.      END;
  158.     END;
  159.     CLOSE(Doc);  WAIT;  ClrScr;
  160.    END
  161.    ELSE
  162.    BEGIN
  163.     WRITELN('BLUEBAG.DOC IS NOT ON FILE.'); WAIT;
  164.    END;
  165.    ClrScr;
  166.    IF OnFile('ATSAYGET.DOC') THEN
  167.    BEGIN
  168.     ASSIGN(Doc,'ATSAYGET.DOC'); RESET(Doc); I:=1;
  169.     WHILE NOT EOF(Doc) DO
  170.     BEGIN
  171.      Readln(Doc,AnyS); WRITELN(AnyS); INC(I);
  172.      IF I=21 THEN
  173.      BEGIN
  174.       WAIT; GoToXY(1,WhereY); ClrEol; I:=1;
  175.      END;
  176.     END;
  177.     CLOSE(Doc);  WAIT;  ClrScr;
  178.    END
  179.    ELSE
  180.    BEGIN
  181.     WRITELN('ATSAYGET.DOC IS NOT ON FILE.'); WAIT;
  182.    END;
  183.    CloseWindow;
  184.   END;
  185.  END;
  186.  CloseWindow;       {DEMO}
  187.  Delay(500);
  188.  CloseWindow;
  189.  Delay(500);
  190.  CloseWindow;
  191.  Delay(500);
  192.  CloseWindow;
  193.  Delay(500);
  194.  CloseWindow;
  195.  WRITELN; WRITELN;
  196.  WRITELN('Well, I guess that is about it. 101 uses though.');
  197. END.
  198.  
  199.