home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sampler / 03 / ptollwin / ptoolwin.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-12-30  |  4.3 KB  |  139 lines
  1. Program PTOOLWIN;  {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.  
  11. {$I PTOOLWIN.INC}  {Include statement for PTOOLWIN functions and parameters }
  12.  
  13. VAR
  14.  
  15.    ScreenType, Ans : Char;
  16.  
  17.  
  18. { Internal Routines Begin Here ****************************** }
  19.  
  20.  
  21. Procedure NewScreen;
  22.  
  23. Var
  24.    Screen, Code : Integer;
  25.  
  26. Begin
  27.      Val (Ans, Screen, Code);
  28.      If (Code = 0) and
  29.         (Screen in [1..9]) then
  30.         If PTOOLWIN_Stack_Size = 9 then
  31.            Begin
  32.                 PTWOpen (10);
  33.                 ClrScr;
  34.                 Gotoxy (20,1);
  35.                 Write ('This demonstration program only allows 9 windows.');
  36.                 Gotoxy (20,3);
  37.                 Write ('I will now close the previous window');
  38.                 Delay (3000);
  39.                 PTWClose;
  40.                 PTWClose;
  41.            End
  42.         else
  43.            Begin
  44.                 PTWOpen (Screen);
  45.                 ClrScr;
  46.            End;
  47. End;
  48.  
  49.  
  50. { Main Program Begins Here ********************************** }
  51.  
  52.  
  53. BEGIN
  54.  
  55.  ClrScr;
  56.  Gotoxy (15,7); Write ('Demonstration of PTOOLWIN procedure.');
  57.  Gotoxy (15,9); Write ('PTOOLWIN and this program are copyrights');
  58.  Gotoxy (15,10); Write ('of R D Ostrander');
  59.  Gotoxy (15,11); Write ('   Ostrander Data Services');
  60.  Gotoxy (15,12); Write ('   5437 Honey Manor Dr');
  61.  Gotoxy (15,13); Write ('   Indianapolis  IN  46241');
  62.  Gotoxy (15,14); Write ('and have been placed in the public domain.');
  63.  
  64.  ScreenType := ' ';
  65.  Ans        := ' ';
  66.  
  67.  Gotoxy (10,19);
  68.  Write ('Are you using a Monochrome card or Color/Graphics card ? (M/C)');
  69.  Gotoxy (10,20);
  70.  Write ('Compaq uses a Color/Graphics - 3270/PC uses Monochrome!       ');
  71.  While not (Ans in ['M', 'C']) do
  72.        Begin
  73.             Read (KBD, Ans);
  74.             Write (Ans);
  75.             Ans := UpCase (Ans);
  76.        End;
  77.  PTOOLWIN_Screen_Type := Ans;
  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.