home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l039 / 1.img / EXAMPLEX / WINDOW.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-03-18  |  3.0 KB  |  137 lines
  1. program TestWindow;
  2. {$C-}
  3. {
  4.               WINDOW DEMONSTRATION PROGRAM  Version 1.00A
  5.  
  6.        This program demonstrates the use of windows on the IBM PC
  7.        and true compatibles.
  8.  
  9.        PSEUDO CODE
  10.        1.  MakeWindow        - draws window boxes on the screen
  11.        2.  repeat
  12.              UpdateWindow 1  - scrolls the window contents up or
  13.                                down for each window.
  14.              UpdateWindow 2
  15.              UpdateWindow 3
  16.            until a key is pressed
  17.        3.  Reset to full screen window
  18.  
  19.        INSTRUCTIONS
  20.        1.  Compile this program using the TURBO.COM compiler.
  21.        2.  Type any key to exit the program.
  22. }
  23.  
  24.  
  25. const  Windows    = 3;
  26.        Wtab       : array [1..Windows,1..5] of Integer  { X0,Y0,X1,Y1,LineNo }
  27.                   = ( ( 5,  2,  35, 11,  1),
  28.                       (45,  2,  75, 11,  1),
  29.                       ( 5, 15,  75, 23,  1) );
  30.        Up         = true;
  31.        Down       = false;
  32.  
  33. type   MaxString  = string [255];
  34.  
  35. var    I          : Integer;
  36.        Ch         : char;
  37.  
  38.  
  39. procedure Frame(UpperLeftX, UpperLeftY, LowerRightX, LowerRightY: Integer);
  40. var  I : Integer;
  41.  
  42. begin {Frame}
  43.   GotoXY(UpperLeftX, UpperLeftY);
  44.   Write(chr(218));
  45.   for I := (UpperLeftX + 1) to (LowerRightX - 1) do
  46.   begin
  47.     Write(chr(196));
  48.   end;
  49.   Write(chr(191));
  50.   for I := (UpperLeftY + 1) to (LowerRightY - 1) do
  51.   begin
  52.     GotoXY(UpperLeftX , I);  Write(chr(179));
  53.     GotoXY(LowerRightX, I);  Write(chr(179));
  54.   end;
  55.   GotoXY(UpperLeftX, LowerRightY);
  56.   Write(chr(192));
  57.   for I := (UpperLeftX + 1) to (LowerRightX - 1) do
  58.   begin
  59.     Write(chr(196));
  60.   end;
  61.   Write(chr(217));
  62. end; {Frame}
  63.  
  64.  
  65. procedure MakeScreen;
  66.  
  67. begin
  68.   ClrScr;
  69.   GotoXY(15,25);
  70.   Write('TURBO PASCAL Window Demo  -  Press any key to stop');
  71.   for I := 1 to Windows do
  72.   begin
  73.     Frame(Wtab[I,1] - 1, Wtab[I,2] - 1, Wtab[I,3] + 1, Wtab[I,4] + 1);
  74.   end;
  75. end; {MakeScreen}
  76.  
  77.  
  78. function RandomStr(Len: Integer): MaxString;
  79. var   S: MaxString;
  80.       I: integer;
  81.  
  82. begin
  83.   S[0] := Chr(Len);
  84.   for Len := 1 to Len do
  85.   begin
  86.     repeat
  87.       I := Random(255)
  88.     until not (Chr(I) in[^@,^G,^H,^J,^M]);
  89.     S[Len] := Chr(I);
  90.   end;
  91.   RandomStr := S;
  92. end;  {RandomStr}
  93.  
  94.  
  95. procedure SelectWindow(Win: Integer);
  96.  
  97. begin
  98.   Window(Wtab[Win,1], Wtab[Win,2], Wtab[Win,3], Wtab[Win,4])
  99. end; {SelectWindow}
  100.  
  101.  
  102. procedure UpdateWindow (Win,StringLen: integer;Scroll: boolean);
  103.  
  104. begin
  105.   LowVideo;
  106.   SelectWindow(Win);
  107.   GotoXY(1,1);
  108.   if Scroll then
  109.   begin
  110.     DelLine;
  111.     GotoXY(1, Wtab[Win,4] - Wtab[Win,2] + 1);
  112.   end
  113.   else
  114.     InsLine;
  115.   Write('Line ', Wtab[Win,5]:5,' ',chr(219),' ',RandomStr(StringLen));
  116.   Wtab[Win,5] := Succ(Wtab[Win,5]);
  117.   NormVideo;
  118. end; {UpdateWindow}
  119.  
  120.  
  121. procedure DrawWindows;
  122. begin
  123.   repeat
  124.     UpdateWindow(1,15,Up);
  125.     UpdateWindow(2,15,Up);
  126.     UpdateWindow(3,55,Down);
  127.   until KeyPressed;
  128.   Window(1,1,80,25);
  129.   GotoXY(1,24);
  130. end; {DrawWindows}
  131.  
  132.  
  133. begin { Program body }
  134.   MakeScreen;
  135.   DrawWindows;
  136. end.
  137.