home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 05 / tricks / scrnout.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-02-05  |  3.3 KB  |  126 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     SCRNOUT.PAS                        *)
  3. (* ------------------------------------------------------ *)
  4. UNIT ScrnOut;
  5.  
  6. INTERFACE
  7.  
  8. USES Crt, ScrnStck;
  9.  
  10. CONST
  11.   GelbVorBlau           : INTEGER = Yellow   + 16*Blue;
  12.   BlauVorHellgrau       : INTEGER = Blue     + 16*LightGray;
  13.   DunkelgrauVorHellgrau : INTEGER = DarkGray + 16*LightGray;
  14.   WeissVorRot           : INTEGER = White    + 16*Red;
  15.  
  16. TYPE
  17.   S80 = STRING [80];
  18.   S25 = STRING [25];
  19.  
  20. VAR
  21.   Stack : ScrnStck.KELLER;     (* Für Zwischenbildschirme *)
  22.  
  23.   (* Aus der Unit ScrnStck ist Screen
  24.      (Zeiger auf den Bildspeicherbeginn) bekannt.         *)
  25.  
  26.   PROCEDURE Farbe(Attr : BYTE);
  27.  
  28.   PROCEDURE ColXY(x, y : INTEGER;Attr : BYTE);
  29.  
  30.   PROCEDURE WrtXY(x, y : BYTE; S : S80);
  31.  
  32.   PROCEDURE Hintergrund(x1, y1, x2, y2 : BYTE;
  33.                         Zeichen        : CHAR);
  34.  
  35.   PROCEDURE Rahmen(x1, y1, x2, y2 : BYTE;
  36.                    Schatten       : BOOLEAN);
  37.  
  38.   PROCEDURE OeffneFenster(x1, y1, x2, y2 : INTEGER;
  39.                           Schatten       : BOOLEAN);
  40.  
  41.   PROCEDURE SchliesseFenster;
  42.  
  43.  
  44. IMPLEMENTATION
  45.  
  46.   PROCEDURE Farbe(Attr : BYTE);
  47.   BEGIN
  48.     TextAttr := Attr;
  49.   END;
  50.  
  51.   PROCEDURE ColXY(x, y : INTEGER;Attr : BYTE);
  52.   BEGIN
  53.     Screen^[y,x].Attr := Attr;
  54.   END;
  55.  
  56.   PROCEDURE WrtXY(x, y : BYTE; S : S80);
  57.   VAR
  58.     i : BYTE;
  59.   BEGIN
  60.     FOR i := 1 TO Length(S) DO
  61.        Screen^[y,x-1+i].CH := S[i];
  62.   END;
  63.  
  64.   PROCEDURE Hintergrund(x1, y1, x2, y2 : BYTE;
  65.                         Zeichen        : CHAR);
  66.   VAR
  67.     i, j : BYTE;
  68.   BEGIN
  69.     FOR i := y1 TO y2 DO
  70.       FOR j := x1 TO x2 DO
  71.         Screen^[i,j].CH := Zeichen;
  72.   END;
  73.  
  74.   PROCEDURE Rahmen(x1, y1, x2, y2 : BYTE;
  75.                    Schatten       : BOOLEAN);
  76.   VAR
  77.     i : BYTE;
  78.     k : STRING [6];
  79.   BEGIN
  80.     Window(x1, y1, x2, y2);  ClrScr;
  81.     Window(1, 1, 80, 25);
  82.     k := '┌┐└┘─│';
  83.     WrtXY(x1, y1, k[1]);
  84.     FOR i := x1+1 TO x2-1 DO WrtXY(i, y1, k[5]);
  85.     WrtXY(x2, y1, k[2]);  WrtXY(x1, y2, k[3]);
  86.     FOR i := x1+1 TO x2-1 DO WrtXY(i, y2, k[5]);
  87.     WrtXY(x2, y2, k[4]);
  88.     FOR i := y1+1 TO y2-1 DO BEGIN
  89.       WrtXY(x1, i, k[6]);
  90.       WrtXY(x2, i, k[6]);
  91.     END;
  92.     IF Schatten (* gewünscht *) THEN BEGIN
  93.       FOR i := x1+2 TO x2+2 DO Screen^[y2+1,i].Attr := 8;
  94.       FOR i := y1+1 TO y2   DO Screen^[i,x2+1].Attr := 8;
  95.       FOR i := y1+1 TO y2   DO Screen^[i,x2+2].Attr := 8;
  96.     END;
  97.   END;
  98.  
  99.   PROCEDURE OeffneFenster(x1, y1, x2, y2 : INTEGER;
  100.                           Schatten       : BOOLEAN);
  101.   BEGIN
  102.       (* Lege alten Bildschirm auf den Stack *)
  103.     ScrnStck.PUSH(Stack, Screen^);
  104.       (* Zeichne Rahmen *)
  105.     Rahmen(x1, y1, x2, y2, Schatten)
  106.   END;
  107.  
  108.   PROCEDURE SchliesseFenster;
  109.   VAR
  110.     Scrn : ScrnStck.ElTyp;
  111.   BEGIN
  112.       (* Hole nächstalten Bildschirm vom Stack *)
  113.     ScrnStck.POP(Stack, Scrn);
  114.       (* Aktualisiere den Bildschirm *)
  115.     Screen^ := Scrn;
  116.   END;
  117.  
  118. BEGIN
  119.   ScrnStck.StackInit(Stack);
  120.   IF Mem[$40:$49]=7 THEN        (* Monochrombildschirm *)
  121.      Screen := Ptr($B000,0)
  122.   ELSE Screen := Ptr($B800,0)   (* Colorbildschirm     *)
  123. END.
  124. (* ------------------------------------------------------ *)
  125. (*                  Ende von SCRNOUT.PAS                  *)
  126.