home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 01 / tricks / ergunit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-10-10  |  2.4 KB  |  96 lines
  1. (* ------------------------------------------------------ *)
  2. (*                       ERGUNIT.PAS                      *)
  3. (*       (c) 1989 Achim Bergmeister  &  TOOLBOX           *)
  4. (* ------------------------------------------------------ *)
  5. UNIT ErgUnit;
  6.  
  7. INTERFACE
  8.  
  9. USES Crt, Dos;
  10.  
  11. TYPE
  12.   s80 = STRING[80];
  13.  
  14.   PROCEDURE Invers;
  15.   PROCEDURE Hell;
  16.   PROCEDURE Normal;
  17.   PROCEDURE Beep;
  18.   PROCEDURE c_off;
  19.   PROCEDURE c_on;
  20.   PROCEDURE Wrtxy(x, y : BYTE; s : s80);
  21.   PROCEDURE Rahmen(x1, y1, x2, y2, art : INTEGER;
  22.                    titel : s80);
  23.  
  24. IMPLEMENTATION
  25.  
  26.   TYPE
  27.     bildschirm = ARRAY [1..25, 1..80] OF
  28.                    RECORD
  29.                      ch : CHAR;  attr : BYTE;
  30.                    END;
  31.   VAR
  32.     screen : ^bildschirm;
  33.     Regs   : Registers;
  34.  
  35.   PROCEDURE Invers; BEGIN textattr := 112; END;
  36.   PROCEDURE Hell;   BEGIN textattr := 15;  END;
  37.   PROCEDURE Normal; BEGIN textattr := 7;   END;
  38.  
  39.   PROCEDURE Beep;
  40.   BEGIN Sound(1000);  Delay(50);  NoSound;  END;
  41.  
  42.   PROCEDURE c_off; (* Cursor aus *)
  43.   BEGIN
  44.     Regs.ax := 1 SHL 8;
  45.     Regs.cx := 48 SHL 8;
  46.     Intr($10, Regs);
  47.   END;
  48.  
  49.   PROCEDURE c_on; (* Cursor ein *)
  50.   BEGIN
  51.     Regs.ax := 1 SHL 8;
  52.     Regs.cx := 12 SHL 8 + 13;
  53.     Intr($10, Regs);
  54.   END;
  55.  
  56.   PROCEDURE Wrtxy(x, y : BYTE; s : s80);
  57.   VAR
  58.     i : BYTE;
  59.   BEGIN
  60.     Dec(x);
  61.     FOR i := 1 TO Length(s) DO BEGIN
  62.       screen^[y,x+i].ch := s[i];
  63.       screen^[y,x+i].attr := textattr;
  64.     END;
  65.   END;
  66.  
  67.   PROCEDURE Rahmen(x1, y1, x2, y2, art : INTEGER;
  68.                    titel : s80);
  69.   VAR
  70.     i : BYTE;  k : STRING[6];
  71.   BEGIN
  72.     CASE art of
  73.       1: k := '┌┐└┘─│';
  74.       2: k := '╔╗╚╝═║';
  75.     END;
  76.     Wrtxy(x1, y1, k[1]);
  77.     FOR i := x1 + 1 TO x2 - 1 DO Wrtxy(i, y1, k[5]);
  78.     Wrtxy(x2, y1, k[2]);  Wrtxy(x1, y2, k[3]);
  79.     FOR i := x1 + 1 TO x2 - 1 DO Wrtxy(i, y2, k[5]);
  80.     Wrtxy(x2, y2, k[4]);
  81.     FOR i := y1 + 1 TO y2 - 1 DO BEGIN
  82.       Wrtxy(x1, i, k[6]);  Wrtxy(x2, i, k[6]);
  83.     END;
  84.     IF (titel <> '') AND (Length(titel) < x2 -x1) THEN BEGIN
  85.       Invers;
  86.       Wrtxy(x1 + ((x2-x1-Length(titel)) DIV 2)+1,y1,titel);
  87.       Normal;
  88.     END;
  89.   END;
  90.  
  91. BEGIN
  92.   IF Mem[$40:$49] = 7 THEN Screen := Ptr($B000, 0)
  93.                       ELSE Screen := Ptr($B800, 0);
  94. END.
  95. (* ------------------------------------------------------ *)
  96. (*               Ende von ERGUNIT.PAS                     *)