home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ASG53.ZIP / DEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-12-03  |  13.9 KB  |  401 lines
  1. {BlueBag,  AtSayGet  &  ReadASG unit demonstration.  Each new feature demon-
  2.  strated in the source code  is followed by the word DEMO so you can examine
  3.  how it is used. Not all the procedures are demonstrated but there is a good
  4.  representation.  Read the *.DOC files for a listing of all of the available
  5.  functions and procedures.}
  6.  
  7. PROGRAM Demo;
  8.  
  9. {$V-}
  10. USES
  11.  CRT,     { For TPCRT get source code and recompile }
  12.  BlueBag,
  13.  AtSayGet,
  14.  ReadASG;
  15.  
  16. TYPE
  17.  PhoneType = STRING[14];
  18.  
  19. VAR
  20.  AllOK : BOOLEAN;
  21.  B     : BYTE;
  22.  C     : CHAR;
  23.  DS1,
  24.  DS2   : DateString;
  25.  Dt1,
  26.  Dt2   : Date;
  27.  BigDt : DelimitedDate;
  28.  Change: LONGINT;
  29.  Str10 : STRING[10];
  30.  AnyS  : STRING;
  31.  Doc   : TEXT;
  32.  Any   : WORD;
  33.  
  34. CONST
  35.  Cont  : BOOLEAN  =True;
  36.  Phone : PhoneType='(   )    -    ';
  37.  AR    : REAL     =0.0;
  38.  LI    : LONGINT  =0;
  39.  I     : INTEGER  =0;
  40.  W     : WORD     =0;
  41.  
  42. {$I RASGDEMO.INC} { <--- LOOK AT THIS TO SEE HOW READASG.TPU IS USED}
  43. {$I R2ENGLSH.INC}
  44.  
  45. BEGIN
  46.  TextAttr:=7; ClrScr;
  47.  OrgAttr:=7; SayAttr:=7; GetAttr:=30; EndAttr:=15;
  48.  DrawBox(23,1,55,3,3); {DEMO}
  49.  AtSay(25,2,'AtSayGet and BlueBag TPU Demo');  {DEMO}
  50.  DrawBox(1,4,80,21,2);
  51.  AtSay(3,5,'If you like boxes but find them a fuss you''ll love DrawBox()');
  52.  AtSay(3,7,'We have regular boxes...');
  53.  DrawBox(28,7,38,10,1);   Delay(500);
  54.  DrawBox(41,7,51,10,2);   Delay(500);
  55.  DrawBox(54,7,64,10,3);   Delay(500);
  56.  DrawBox(67,7,77,10,4);   Delay(500);
  57.  AtSay(3,12,'and lots of others.....');
  58.  DrawBox(28,12,38,15,176);   Delay(500);
  59.  DrawBox(41,12,51,15,177);   Delay(500);
  60.  DrawBox(54,12,64,15,178);   Delay(500);
  61.  DrawBox(67,12,77,15,219);   Delay(500);
  62.  DrawBox(28,17,38,20,36);    Delay(500);
  63.  DrawBox(41,17,51,20,63);    Delay(500); INC(TextAttr,Blink);
  64.  DrawBox(54,17,64,20,248);   Delay(500); DEC(TextAttr,Blink);
  65.  DrawBox(67,17,77,20,240);   Delay(500);
  66.  AtSay(2,23,'Sometimes it''s nice to halt everything and just WAIT for the user to');
  67.  GoToXY(2,24);
  68.  WAIT;          {DEMO}
  69.  OpenWindow(20,7,78,20,White,Red,1,' WINDOWS '); {DEMO}
  70.  WRITELN; WRITELN;
  71.  WRITELN(' The image below this window was just saved on the heap.');
  72.  WRITELN(' You may have up to  9  windows active at any time. When');
  73.  WRITELN(' you close a window the saved image that was below it is');
  74.  WRITELN(' quickly restored to the screen and the space it took on');
  75.  WRITELN(' the heap is returned to DOS.');
  76.  WRITELN; WRITELN;
  77.  WRITE(' '); WAIT;
  78.  OpenWindow( 3, 1,15,12,LightGray,Blue,2,' 2 ');    DELAY(500);
  79.  OpenWindow(10, 3,22,14,Yellow,Magenta,3,' 3 ');    DELAY(500);
  80.  OpenWindow(20, 5,32,16,White,Blue,4,' 4 ');        DELAY(500);
  81.  OpenWindow(30, 7,42,18,Black,LightGray,176,' 5 '); DELAY(500);
  82.  OpenWindow(40, 9,52,20,White,Green,177,' 6 ');     DELAY(500);
  83.  OpenWindow(50,11,62,22,LightGray,Black,178,' 7 '); DELAY(500);
  84.  OpenWindow(60,13,72,24,LightBlue,Blue,240,' 8 ');  DELAY(500);
  85.  OpenWindow( 6,15,75,19,White+Blink,Black,3,' 9 ');
  86.  GoToXY(22,2); WAIT;
  87.  CloseWindow; {9}  DELAY(500);      {DEMO}
  88.  CloseWindow; {8}  DELAY(500);
  89.  CloseWindow; {7}  DELAY(500);
  90.  CloseWindow; {6}  DELAY(500);
  91.  CloseWindow; {5}  DELAY(500);
  92.  CloseWindow; {4}  DELAY(500);
  93.  CloseWindow; {3}  DELAY(500);
  94.  CloseWindow; {2}  DELAY(500);
  95.  CloseWindow; {1}  DELAY(1000);
  96.  OpenWindow(2,11,30,20,Yellow,Blue,1,'');
  97.  AtSay(2,2,'Well, this isn''t pretty!');
  98.  AtSay(2,3,'To clear a portion  of a');
  99.  AtSay(2,4,'screen or window use the');
  100.  AtSay(2,5,'CLEAR() procedure...');
  101.  AtSay(2,7,''); WAIT;
  102.  CloseWindow;
  103.  CLEAR(2,5,79,20);  {DEMO}
  104.  ReverseVideo;      {DEMO}
  105.  CLEAR(1,22,80,24);
  106.  Center(23,'MORE CRT TRICKS'); {DEMO}
  107.  CENTER(6,'This is what the REVERSEVIDEO procedure did to me!');
  108.  RestoreVideo;      {DEMO}
  109.  CENTER(7,'This is what the RESTOREVIDEO procedure did to me.');
  110.  GoToXY(28,8); WAIT; CLEAR(14,6,70,8);
  111.  Center(7,'The CENTER() procedure centers long lines of text on the screen');
  112.  DELAY(1000);
  113.  Center(8,'It also centers shorter lines like this one'); DELAY(1000);
  114.  Center(9,'And me too!'); DELAY(1000);
  115.  OpenWindow(5,11,50,17,White,Green,1,'');
  116.  Center(2,'It works in windows');
  117.  GoToXY(2,4); Wait;
  118.  CloseWindow;
  119.  CLEAR(5,7,70,9);
  120.  ReverseVideo; CENTER(23,'CURSOR MANIPULATION'); RestoreVideo;
  121.  { demonstrate cursor manipulation }
  122.  CursorOff;              {DEMO}
  123.  AtSay(26,10,'Heh...Where''s the cursor?'); Delay(2000);
  124.  CursorOn;               {DEMO}
  125.  SetCursor(0,StopScan);  {DEMO}
  126.  AtSay(23,11,'Isn''t this a bit over doing it?'); Delay(2000);
  127.  RestoreCursor;          {DEMO}
  128.  CLEAR(23,10,70,11);
  129.  SayAttr:=30;            {DEMO}
  130.  AtSay(23,10,'PRESS A KEY TO CHANGE CURSOR SIZE');
  131.  SayAttr:=7;
  132.  AtSay(15,12,'Notice the various cursor sizes/shapes available:');
  133.  FOR Any:=StopScan DOWNTO 1 DO
  134.  BEGIN
  135.   SetCursor(0,Any);  {Variations on the theme}
  136.   C:=ReadKey;
  137.  END;
  138.  CursorOn;      {Reset to system default}
  139.  CursorSave;
  140.  FOR Any:=StopScan-1 DOWNTO 0 DO
  141.  BEGIN
  142.   SetCursor(Any,StopScan);  {More variations}
  143.   C:=ReadKey;
  144.  END;
  145.  CursorOn; CursorSave;
  146.  CLEAR(15,10,70,12);
  147.  ReverseVideo; CENTER(23,'  STRING ROUTINES  '); RestoreVideo;
  148.  AtSay(8,9,'NOTE: You can use the WordStar/dBase/Turbo editing keys');
  149.  AnyS:='Please enter a line of text in lower case and press Enter:';
  150.  AtSayGetStrLen(8,12,'',AnyS,Length(AnyS)); {DEMO}
  151.  AtSay(8,14,'This demonstrates the UpperCase() Function:');
  152.  AnyS:=UpperCase(AnyS);       {DEMO}
  153.  AtSay(8,15,AnyS);
  154.  GoToXY(8,17); WAIT;
  155.  CLEAR(2,10,79,17);
  156.  AnyS:='PLEASE ENTER A LINE OF TEXT IN UPPER CASE AND PRESS ENTER:';
  157.  AtSayGetStrLen(8,12,'',AnyS,Length(AnyS));
  158.  AtSay(8,14,'This demonstrates the LowerCase() Function:');
  159.  AnyS:=LowerCase(AnyS);       {DEMO}
  160.  AtSay(8,15,AnyS);
  161.  GoToXY(8,17); WAIT;
  162.  CLEAR(2,9,79,17);
  163.  AtSay(3,8,'The sentance that you entered was:');
  164.  AtSay(3,9,AnyS);
  165.  AtSay(3,11,'After NoBlanks() takes care of your line it looks like this:');
  166.  NoBlanks(AnyS); {DEMO}
  167.  AtSay(3,12,AnyS);
  168.  GoToXY(3,15); WAIT;
  169.  CLEAR(2,8,79,15);
  170.  AnyS:='Please enter a line of text in ANY case and press Enter:';
  171.  AtSayGetStrLen(8,12,'',AnyS,Length(AnyS));
  172.  GetWordCount(AnyS,B);  {DEMO}
  173.  OpenWindow(2,5,39,20,White,Green,1,' FORWARD ');
  174.  FOR Any:=1 TO B DO WRITELN(NextWord(AnyS));         {DEMO}
  175.  OpenWindow(40,5,79,20,White,Red,1,' BACKWARDS ');
  176.  FOR Any:=B DOWNTO 1 DO WRITELN(NthWord(AnyS,Any)); {DEMO}
  177.  WAIT;
  178.  CloseWindow; {backwards}
  179.  CloseWindow; {forward}
  180.  CLEAR(8,11,75,12);
  181.  ReverseVideo; CENTER(23,' AtSayGet DEMO '); RestoreVideo;
  182.  AtSay(10, 7,'The AtSayGet unit provides the functional equivalence of the');
  183.  AtSay(10, 8,'dBase:   @ Line,Row SAY "prompt" GET <var> [PICTURE] [RANGE]');
  184.  AtSay(10, 9,'command. A full range of editing keys are employed.  See the');
  185.  AtSay(10,10,'ATSAYGET.DOC file for details.');
  186.  AtSayGetBoolean(4,12,'Continue?',Cont);  {DEMO}
  187.  WRITELN;
  188.  IF NOT Cont THEN
  189.  BEGIN
  190.   AtSay(14,12,'I insist!'); Delay(2000);
  191.  END;
  192.  Clear(4,7,75,12); AnyS:='';
  193.  REPEAT
  194.   AtSay(4,7,'Do not leave this field blank, or else!'); {you won't ever finish}
  195.   AtSayGetStrLen(4,8,'What is your name?',AnyS,30); {DEMO}
  196.  UNTIL NOT IsBlank(AnyS);                           {DEMO}
  197.  CLEAR(4,7,75,8);
  198.  AtSayGetWord  (4, 8,'What is your age? ',W,2);      {DEMO}
  199.  AtSayGetStrPic(4, 9,'What is your phone',Phone,'(999) 999-9999');   {DEMO}
  200.  AtSayGetInt   (4,10,'Enter an Integer  ',I,5);      {DEMO}
  201.  I:=0;
  202.  {DEMO of TRIM() function follows}
  203.  AtSay(4,12,Concat('O.K. ',TRIM(AnyS),', let''s not have any negative numbers!'));
  204.  {the following shows some of the ASGRange procedures}
  205.  AtSayGetIntRange(4,13,'What do you owe on your car?',I,6,0,MaxInt);      {DEMO}
  206.  AtSayGetLongIntRange(4,14,'What is owing on your house?',LI,7,0,250000); {DEMO}
  207.  AtSayGetRealRange(4,15,'What are your living costs? ',AR,10,2,500,5000); {DEMO}
  208.  GoToXY(4,19); Wait;
  209.  CLEAR(4,8,75,19);
  210.  ReverseVideo; CENTER(23,'DEVICE FUNCTIONS'); RestoreVideo;
  211.  OpenWindow(13,10,68,18,LightGray,Blue,3,' DEVICE FUNCTIONS ');
  212.  Cont:=True;
  213.  WHILE Cont DO
  214.  BEGIN
  215.   ClrScr; WRITELN;
  216.   FOR W:=0 TO 2 DO
  217.   BEGIN
  218.    WRITE(' Your printer #',W+1:2,' is ');
  219.    IF NOT PrinterOnLine(W)  {DEMO}
  220.    THEN
  221.    BEGIN
  222.     TextColor(White); WRITE('NOT '); TextColor(LightGray);
  223.    END;
  224.    WRITELN('on-line');
  225.   END;
  226.   AtSayGetBoolean(2,6,'Try again?',Cont);
  227.  END;
  228.  ClrScr;
  229.  AnyS:='BLUEBAG.DOC '; Cont:=True;
  230.  WHILE Cont DO
  231.  BEGIN
  232.   ClrScr;
  233.   AtSayGetStrLen(2,2,'Enter a file name',AnyS,12); GoToXY(2,4);
  234.   WRITE(Trim(AnyS));
  235.   IF OnFile(AnyS) THEN WRITELN(' is on file.') ELSE WRITELN(' is NOT on file.');
  236.   {DEMO ^}
  237.   AtSayGetBoolean(2,5,'Try again?',Cont);
  238.  END;
  239.  ClrScr; Cont:=True;
  240.  AtSayGetBoolean(2,3,'Read the documentation now?',Cont); WRITELN;
  241.  IF Cont THEN
  242.  BEGIN
  243.   IF OnFile('BLUEBAG.DOC') OR OnFile('ATSAYGET.DOC') THEN
  244.   BEGIN
  245.    OpenWindow(1,1,80,24,LightGray,Black,1,' DOCUMENTATION ');
  246.    IF OnFile('BLUEBAG.DOC') THEN
  247.    BEGIN
  248.     ASSIGN(Doc,'BLUEBAG.DOC'); RESET(Doc); I:=1;
  249.     WHILE NOT EOF(Doc) DO
  250.     BEGIN
  251.      Readln(Doc,AnyS); WRITELN(AnyS); INC(I);
  252.      IF I=21 THEN
  253.      BEGIN
  254.       WRITE(' '); WAIT; GoToXY(1,WhereY); ClrEol; I:=1;
  255.      END;
  256.     END;
  257.     CLOSE(Doc); WRITE(' '); WAIT; ClrScr;
  258.    END
  259.    ELSE
  260.    BEGIN
  261.     WRITELN(' BLUEBAG.DOC IS NOT ON FILE.'); WRITE(' '); WAIT;
  262.    END;
  263.    ClrScr;
  264.    IF OnFile('ATSAYGET.DOC') THEN
  265.    BEGIN
  266.     ASSIGN(Doc,'ATSAYGET.DOC'); RESET(Doc); I:=1;
  267.     WHILE NOT EOF(Doc) DO
  268.     BEGIN
  269.      Readln(Doc,AnyS); WRITELN(AnyS); INC(I);
  270.      IF I=21 THEN
  271.      BEGIN
  272.       WRITE(' '); WAIT; GoToXY(1,WhereY); ClrEol; I:=1;
  273.      END;
  274.     END;
  275.     CLOSE(Doc); WRITE(' '); WAIT; ClrScr;
  276.    END
  277.    ELSE
  278.    BEGIN
  279.     WRITELN(' ATSAYGET.DOC IS NOT ON FILE.'); WRITE(' '); WAIT;
  280.    END;
  281.    CloseWindow;
  282.   END
  283.   ELSE
  284.   BEGIN
  285.    WRITELN(' Rats, both document files are missing!'); Wait;
  286.   END;
  287.  END;
  288.  CloseWindow; {device}
  289.  
  290.  {show some of the date features}
  291.  ReverseVideo; CENTER(23,'BLUEBAG DATE DEMO'); RestoreVideo;
  292.  OpenWindow(12,5,68,19,LightGray,Blue,4,' DATE FEATURES ');
  293.  ClrScr; AllOK:=False;
  294.  Dt2:=SysDate;  {DEMO}
  295.  Ds2:=DateToDateString(Dt2);  {DEMO}
  296.  WRITELN(' Today is ',NameOfDay(DayOfWeek(Dt2)),', ',NameOfMonth(MonthOfYear(Dt2)),
  297.          ' ',COPY(Ds2,3,2),', ',COPY(Ds2,5,4));  {DEMO of 2 functions}
  298.  REPEAT
  299.   BigDt:='  /  /    ';
  300.   AtSayGetStrPic(2,2,'Enter Birth Day as Mo/Dy/Year:',BigDt,'99/99/9999');
  301.   WRITELN;
  302.   Ds1:=StripDateString(BigDt);  {DEMO}
  303.   Dt1:=DateStringToDate(Ds1);   {DEMO}
  304.   IF Dt1<>BadDate THEN AllOK:=True ELSE
  305.   BEGIN
  306.    WRITELN(' You entered an invalid date. Please try again.');
  307.    WRITE(' '); WAIT; CLEAR(1,2,48,4);
  308.   END;
  309.  UNTIL AllOK;
  310.  WRITELN(' You were born on a ',NameOfDay(DayOfWeek(Dt1)));
  311.  WRITELN(' Gosh, that was ',DaysBetween(Dt1,Dt2),' days ago!');
  312.  Any:=Trunc((Dt2-Dt1) / 365.25);
  313.  WRITE(' You were ',Any,' years old ');
  314.  WRITELN((Dt2-Dt1)-Trunc(Any*365.25),' days ago.'); Dt1:=0;
  315.  AtSayGetLongIntRange(2,7,'Enter some number of days hence: ',Dt1,6,1,999999);
  316.  WRITELN;
  317.  IncDate(Dt2,Dt1);  {DEMO}
  318.  Ds2:=DateToDateString(Dt2);
  319.  BigDt:=DelimitDateString(DS2);  {DEMO}
  320.  WRITELN(' The date that is ',Dt1,' days from now is ',BigDt);
  321.  WRITELN(' That will be a ',NameOfDay(DayOfWeek(Dt2)),' in ',NameOfMonth(MonthOfYear(Dt2)));
  322.  WRITELN;
  323.  WRITELN(' These date routines are only usefull until ',
  324.           DelimitDateString(DateToDateString(3652499)));
  325.  WRITELN(' Sorry.'); WRITE(' '); WAIT;
  326.  CloseWindow; {Date Features}
  327.  ReverseVideo; CENTER(23,'FULL SCREEN EDITING'); RestoreVideo;
  328.  {the following demonstrates the procedures in the ReadASG.TPU ... Look
  329.   at the code in RASGDEMO.INC for details of usage }
  330.  OpenWindow(1,4,80,21,LightGray,Black,2,'');
  331.  Init;
  332.  REPEAT
  333.   ClrScr;
  334.   AtSay(5,1,'The full screen can be edited using cursor & tab keys.');
  335.   IF NOT AddInfo THEN
  336.   BEGIN {editing a file record}
  337.    BlankInfo; READ(InfoFile,InfoRec);
  338.    IF EOF(InfoFile) THEN AddInfo:=True;
  339.    SEEK(InfoFile,FilePos(InfoFile)-1);
  340.   END
  341.   ELSE
  342.   BEGIN
  343.    BlankInfo;
  344.    AtSayGetBoolean(5,3,'Adding a business record?',InfoRec.Business);
  345.   END;
  346.   IF InfoRec.Business THEN
  347.   BEGIN
  348.    ReadPage(2);
  349.    OpenWindow(20,5,60,11,White,Red,1,' FINANCIAL INFORMATION ');
  350.    ReadPage(3);
  351.    CloseWindow; {financial information}
  352.    SayAttr:=7; OrgAttr:=7;
  353.   END
  354.   ELSE ReadPage(1);
  355.   WRITE(InfoFile,InfoRec);
  356.   IF AddInfo THEN AtSayGetBoolean(2,16,'Add a record?',More)
  357.    ELSE AtSayGetBoolean(2,16,'Edit next record?',More);
  358.   IF NOT More THEN
  359.   BEGIN
  360.    CLOSE(InfoFile); Cont:=False;
  361.   END;
  362.  UNTIL NOT Cont;
  363.  
  364.  FOR C1:=3 DOWNTO 1 DO FreeASGHeapPage(C1);
  365.  A1:=0; A2:=0; C1:=0; C2:=0; FillChar(CA,SizeOf(CA),0);
  366.  ClrScr;
  367.  WRITELN('The following demonstrates how to reuse an ASG Page. It also gives an example');
  368.  WRITELN('of how to add fields to a page at runtime depending upon variable criteria...');
  369.  WRITELN('See the program CVP.EXE in CVP22.ARC located in BPA0 for a usefull applic''n.');
  370.  {re-set ASG attributes}
  371.  OrgAttr:=7; SayAttr:=7; GetAttr:=113; EndAttr:=15;
  372.  AtSayGetWordRange(1,5,'Enter a number of columns from 2 to 5:',C2,1,2,5);
  373.  AtSayGetWordRange(1,6,'Enter a number of rows from 2 to 5   :',C1,1,2,5);
  374.  MakeASGHeapPage(1,C1*C2); {you will add Rows*columns of fields to the page}
  375.  FOR A1:=1 TO C1 DO FOR A2:=1 TO C2 DO
  376.   IF A2=1 THEN AddASGW(1,1,A1+10,'Enter numbers',@CA[A1,A2],2)
  377.   ELSE AddASGW(1,((A2-1)*10+15),A1+10,'',@CA[A1,A2],2);
  378.  AtSay(15,9,'The screen below can be edited using cursor & tab keys.');
  379.  ReadPage(1);
  380.  FreeASGHeapPage(1); {this isn't really necessary as ReadASG frees all pages
  381.                       as part of its exit code}
  382.  CloseWindow;
  383.  {the following demonstrates the RealToEnglish procedure}
  384.  RANDOMIZE; CqNum:=Random(400)+100; TotPd:=0;
  385.  IntroScript;
  386.  DONE:=False; InReal:=45;
  387.  REPEAT
  388.   OpenWindow(2,8,79,20,Black,Green,1,'');
  389.   ShowCheque; EndAttr:=33;
  390.   AtSayGetRealRange(65,5,'$',InReal,9,2,1,999999.99);
  391.   RealToEnglish(InReal,OutStr); { <-- THIS IS THE PROCEDURE BEING DEMONSTRATED}
  392.   TextAttr:=33; GoToXY(1,7); WRITELN(OutStr:75);
  393.   WriteAnotherCheque;
  394.   INC(CqNum); TotPd:=TotPd+InReal;
  395.   CloseWindow; {cheque}
  396.   WRITELN(' Cheque #',CqNum-1:4,' $',InReal:10:2);
  397.   InReal:=0;
  398.  UNTIL DONE;
  399.  PatheticPlea;
  400.  TextAttr:=7;
  401. END.