home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 12 / tricks / window.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-09-07  |  3.7 KB  |  141 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     WINDOW.PAS                         *)
  3. (*          (c) 1989 Knut Reuther & TOOLBOX               *)
  4. (* ------------------------------------------------------ *)
  5. PROGRAM window_programm;
  6.  
  7. USES
  8.   Crt;
  9.  
  10. CONST
  11.   scrvar = 12;
  12.              { Speicherbedarf der Recordvariablen in Bytes }
  13.  
  14. TYPE
  15.   ScreenZeiger = ^ScreenRecord;
  16.   Coordfeld    = ARRAY[1..4] OF BYTE;
  17.   ymax = 1..25;
  18.   xmax = 1..80;
  19.   ScreenRecord = RECORD
  20.                    coord      : Coordfeld;
  21.                    bytes      : WORD;
  22.                    start      : BYTE;
  23.                    last       : ScreenZeiger;
  24.                    Attr       : BYTE;
  25.                    ScreenSave : WORD;
  26.                  END;
  27. VAR
  28.   lastscreen, newscreen, oldscreen   : ScreenZeiger;
  29.   aktuellcoord                       : Coordfeld;
  30.                                 { aktuelle bildschrimgröße }
  31.   monoscreen  : ARRAY[1..2000] OF WORD ABSOLUTE $b000:0;
  32.   colorscreen : ARRAY[1..2000] OF WORD ABSOLUTE $b800:0;
  33.   ab  : CHAR;
  34.   a   : INTEGER;
  35.  
  36.  
  37.   PROCEDURE WindowInit;
  38.   BEGIN
  39.     lastscreen := NIL;
  40.   END;
  41.  
  42.   PROCEDURE Window(x1 : xmax;  y1 : ymax;  x2 : xmax;
  43.                    y2 : ymax);
  44.   VAR
  45.     menge : WORD;
  46.   BEGIN
  47.     IF (y2 > y1) AND (x2 > x1) THEN BEGIN
  48.       menge := (y2 - y1 + 1) * 160 + scrvar;
  49.       GetMem(newscreen, menge);
  50.       IF (lastscreen = NIL) THEN BEGIN
  51.         newscreen^.last := NIL;
  52.         lastscreen := newscreen;
  53.         aktuellcoord[1] := 1;
  54.         aktuellcoord[2] := 25;
  55.         aktuellcoord[3] := 1;
  56.         aktuellcoord[4] := 80;
  57.       END ELSE BEGIN
  58.         newscreen^.last := lastscreen;
  59.         lastscreen := newscreen;
  60.       END;
  61.       WITH newscreen^ DO BEGIN
  62.         coord := aktuellcoord;
  63.         start := y1;
  64.         bytes := menge-scrvar;
  65.         Attr := TextAttr;
  66.         IF (LastMode = 7) THEN
  67.           Move(monoscreen[(y1-1)*80+1],
  68.                screensave, menge - scrvar)
  69.         ELSE
  70.           Move(colorscreen[(y1-1)*80+1], screensave,
  71.                                          menge - scrvar);
  72.       END;
  73.       Crt.Window(x1, y1, x2, y2);
  74.       aktuellcoord[1] := y1;
  75.       aktuellcoord[2] := y2;
  76.       aktuellcoord[3] := x1;
  77.       aktuellcoord[4] := x2;
  78.     END;
  79.   END;
  80.  
  81.   PROCEDURE closewindow;
  82.   BEGIN
  83.     oldscreen := lastscreen;
  84.     IF (lastscreen<>NIL) THEN BEGIN
  85.       WITH lastscreen^ DO BEGIN
  86.         IF (LastMode=7) THEN
  87.           Move(screensave, monoscreen[(start-1)*80+1],bytes)
  88.         ELSE
  89.           Move(screensave,
  90.                          colorscreen[(start-1)*80+1],bytes);
  91.         Crt.Window(coord[3], coord[1], coord[4], coord[2]);
  92.         TextAttr := Attr;
  93.         lastscreen := last;
  94.         FreeMem(oldscreen, bytes+scrvar);
  95.       END;
  96.     END;
  97.   END;
  98.  
  99. BEGIN
  100.   windowinit;
  101.   TextBackground(Black);
  102.   ClrScr;
  103.   LowVideo;
  104.   FOR a := 1 TO 2000 DO Write('-');
  105.   HighVideo;
  106.   GotoXY(2,10);
  107.   WriteLn(MemAvail);
  108.   Window(1,1,80,5);
  109.   TextBackground(Blue);
  110.   TextColor(11);
  111.   ClrScr;
  112.   WriteLn('dies ist ein Window',
  113.       '12345678901234567890123456789012345678901234567890');
  114.   WriteLn(MemAvail);
  115.   ab := ReadKey;
  116.   Window (10,10,75,15);
  117.   TextBackground(Red);
  118.   ClrScr;
  119.   WriteLn(MemAvail);
  120.   WriteLn('dies ist ein 2.Window');
  121.   ab := ReadKey;
  122.   Window(10,7,60,17);
  123.   TextBackground(Green);
  124.   ClrScr;
  125.   WriteLn(MemAvail);
  126.   WriteLn('dies ist ein 3.Window');
  127.   ab := ReadKey;
  128.   closewindow;
  129.   WriteLn(MemAvail);
  130.   ab := ReadKey;
  131.   closewindow;
  132.   WriteLn(MemAvail);
  133.   ClrScr;
  134.   ab := ReadKey;
  135.   closewindow;
  136.   GotoXY(10,20);
  137.   WriteLn(MemAvail);
  138.   ab := ReadKey;
  139. END.
  140. (* ------------------------------------------------------ *)
  141. (*                  Ende von WINDOW.PAS                   *)