home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / USCX / PTOOLS.ZIP / PTOOLWI3.PAS < prev    next >
Pascal/Delphi Source File  |  1985-05-17  |  5KB  |  140 lines
  1. Program PTOOLWI3;  {Copyright  R D Ostrander
  2.                                Ostrander Data Services
  3.                                5437 Honey Manor Dr
  4.                                Indianapolis  IN  46241
  5.  
  6.      This is a demonstration program for the Turbo Pascal subroutine PTOOLWIN
  7.      for window manipulations. Address any questions to the author at the
  8.      above address.
  9.  
  10.      This demonstrates Version 3.0 of PTOOLWIN.INC aka PTOOLWI3.INC         }
  11.  
  12.  
  13. VAR
  14.  
  15.    ScreenType, Ans : Char;
  16.  
  17. { Constant Values (Parameters) That must be included in your source program }
  18.  
  19. CONST
  20.  
  21.    PTOOLWIN_Number_of_Windows = 10;    { This determines the number of      }
  22.                                        { windows that may be set with the   }
  23.                                        { PTWSet procedure.                  }
  24.                                        { It also determines the number of   }
  25.                                        { windows that may be open at any    }
  26.                                        { one time.                          }
  27.  
  28. {$I PTOOLWI3.INC}  {Include statement for PTOOLWIN functions and parameters }
  29.  
  30. { Internal Routines Begin Here ****************************** }
  31.  
  32.  
  33. Procedure NewScreen;
  34.  
  35. Var
  36.    Screen, Code : Integer;
  37.  
  38. Begin
  39.      Val (Ans, Screen, Code);
  40.      If (Code = 0) and
  41.         (Screen in [1..9]) then
  42.         If (PTOOLWIN_Stack_Size = 9) or
  43.            ((MaxAvail > 0) and (MaxAvail < 4006)) then
  44.            Begin
  45.                 PTWOpen (10);
  46.                 ClrScr;
  47.                 Gotoxy (20,1);
  48.                 Write ('This demonstration program only allows 9 windows.');
  49.                 Gotoxy (20,3);
  50.                 Write ('I will now close the previous window');
  51.                 Delay (3000);
  52.                 PTWClose;
  53.                 PTWClose;
  54.            End
  55.         else
  56.            Begin
  57.                 PTWOpen (Screen);
  58.                 ClrScr;
  59.            End;
  60. End;
  61.  
  62.  
  63. { Main Program Begins Here ********************************** }
  64.  
  65.  
  66. BEGIN
  67.  
  68.  ClrScr;
  69.  Gotoxy (15,7); Write ('Demonstration of PTOOLWIN procedure.');
  70.  Gotoxy (15,9); Write ('PTOOLWIN and this program are copyrights');
  71.  Gotoxy (15,10); Write ('of R D Ostrander');
  72.  Gotoxy (15,11); Write ('   Ostrander Data Services');
  73.  Gotoxy (15,12); Write ('   5437 Honey Manor Dr');
  74.  Gotoxy (15,13); Write ('   Indianapolis  IN  46241');
  75.  Gotoxy (15,14); Write ('and have been placed in the public domain.');
  76.  
  77.  ScreenType := ' ';
  78.  Ans        := ' ';
  79.  
  80.  Gotoxy (10,23);
  81.  Write ('Would you like to have this program run in Color? (Y/N)');
  82.  Gotoxy (10,24);
  83.  Write ('Some Monochrome cards will show shades of grey.        ');
  84.  While not (ScreenType in ['Y', 'N']) do
  85.        Begin
  86.             Read (KBD, ScreenType);
  87.             Write (ScreenType);
  88.             ScreenType := UpCase (ScreenType);
  89.        End;
  90.  
  91.  If ScreenType = 'Y' then
  92.     Begin
  93.          PTWSet (1, 2, 3, 31, 9, 1, 0, 15);
  94.          PTWSet (2, 7, 4, 73, 21, 2, 1, 14);
  95.          PTWSet (3, 40, 1, 80, 25, 0, 2, 13);
  96.          PTWSet (4, 1, 8, 80, 16, -1, 3, 12);
  97.          PTWSet (5, 8, 12, 55, 24, -2, 4, 7);
  98.          PTWSet (6, 1, 10, 45, 20, 1, 5, 12);
  99.          PTWSet (7, 5, 5, 75, 10, 2, 6, 9);
  100.          PTWSet (8, 40, 11, 70, 24, 0, 15, 0);
  101.          PTWSet (9, 1, 1, 80, 25, -2, 1, 10);
  102.          PTWSet (10, 1, 21, 80, 25, -2, 4, 0);
  103.     End
  104.  else
  105.     Begin
  106.          PTWSet (1, 2, 3, 31, 9, 0, 15, 0);
  107.          PTWSet (2, 7, 4, 73, 21, 1, 0, 15);
  108.          PTWSet (3, 40, 1, 80, 25, 2, 0, 15);
  109.          PTWSet (4, 1, 8, 80, 16, -1, 0, 15);
  110.          PTWSet (5, 8, 12, 55, 24, -2, 0, 15);
  111.          PTWSet (6, 1, 10, 45, 20, 1, 15, 0);
  112.          PTWSet (7, 5, 5, 75, 10, 2, 0, 15);
  113.          PTWSet (8, 40, 11, 70, 24, -1, 0, 15);
  114.          PTWSet (9, 1, 1, 80, 25, -2, 0, 15);
  115.          PTWSet (10, 1, 21, 80, 25, 2, 15, 0);
  116.     End;
  117.  
  118.  While Ans <> 'E'do
  119.        Begin
  120.             If Ans <> 'C' then
  121.                Begin
  122.                     Gotoxy (2,2); Write ('Pick a screen - 1 to 9');
  123.                     Gotoxy (2,3); Write (' or "C" to close a screen');
  124.                     Gotoxy (2,4); Write (' or "E" to End           ');
  125.                End;
  126.             Read (KBD, Ans);
  127.             Write (Ans); Gotoxy (WhereX - 1, WhereY);
  128.             Ans := UpCase (Ans);
  129.             If (Ans = 'C') and (PTOOLWIN_Stack_Size > 0) then PTWClose;
  130.             If Ans in ['1'..'9'] then NewScreen;
  131.        End;
  132.  
  133. Window (1,1,80,25);
  134. ClrScr;
  135. Gotoxy (1,24);
  136. TextColor(0);
  137. TextBackground (15);
  138.  
  139. END.
  140.