home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 02 / hyperkey / tsrwind.inc < prev   
Encoding:
Text File  |  1987-11-10  |  6.2 KB  |  128 lines
  1. (* ----------------------------------------------------------------------- *)
  2. (*                              TSRWIND.PAS                                *)
  3. (*        einfache Window-Management-Routinen fuer die TSR-Toolbox         *)
  4. (* ----------------------------------------------------------------------- *)
  5. CONST WinInit: BOOLEAN = FALSE;  On = TRUE;  Off = FALSE;  VideoEnable = $08;
  6.       MonoScreen = $B000;  ColorScreen = $B800;  Monochrom = 7;  MaxWin = 5;
  7. TYPE  ScrInhalt = ARRAY [1..4000] OF CHAR;
  8.       WinType = RECORD  x1, y1, x2, y2: INTEGER; END;
  9.       Screens = RECORD              (* gespeicherte Bildschirminformation: *)
  10.                   Bild: ScrInhalt;                     (* Bildschirminhalt *)
  11.                   Dim : WinType;                         (* Fenstergroesse *)
  12.                   x, y: INTEGER;                        (* Cursor-Position *)
  13.                   Shape: INTEGER;                            (* Cursorform *)
  14.                 END;
  15. VAR   Win: RECORD
  16.              Dim   : WinType;                   (* aktuelle Fenstergroesse *)
  17.              Tiefe : INTEGER;
  18.              Keller: ARRAY[1..MaxWin] OF ^Screens;
  19.            END;
  20.       ScreenMode  : BYTE      ABSOLUTE $0040:$0049;
  21.       MonoBuffer  : ScrInhalt ABSOLUTE MonoScreen:$0000;
  22.       ColorBuffer : ScrInhalt ABSOLUTE ColorScreen:$0000;
  23.       Adapter     : INTEGER   ABSOLUTE $0040:$0063;
  24.       VideoMode   : BYTE      ABSOLUTE $0040:$0065;
  25.       VideoBuffer : INTEGER;
  26. (* ----------------------------------------------------------------------- *)
  27. PROCEDURE Where_Cursor (VAR x, y: INTEGER);
  28. VAR  Active_Page : BYTE ABSOLUTE $0040:$0062;          (* Video Page Index *)
  29.      Crt_Pages   : ARRAY[0..7] OF INTEGER ABSOLUTE $0040:$0050 ;
  30. BEGIN
  31.    x := Crt_Pages[active_page];                (* absolute Cursor-Position *)
  32.    y := Hi(x)+1;  x := Lo(x)+1;
  33. END;
  34. (* ----------------------------------------------------------------------- *)
  35. PROCEDURE Video (On: BOOLEAN);
  36. BEGIN
  37.   IF On THEN Port[Adapter+4] := (VideoMode OR VideoEnable)
  38.   ELSE Port[Adapter+4] := (VideoMode - VideoEnable)
  39. END;
  40. (* ----------------------------------------------------------------------- *)
  41. PROCEDURE InitWindow;
  42. BEGIN
  43.   IF ScreenMode = Monochrom THEN VideoBuffer := MonoScreen
  44.   ELSE VideoBuffer := ColorScreen;
  45.   WITH Win.Dim DO BEGIN  x1 := 1;  y1 := 1;  x2 := 80;  y2 := 25  END;
  46.   Win.Tiefe := 0;  WinInit := TRUE;
  47. END;
  48. (* ----------------------------------------------------------------------- *)
  49. PROCEDURE WinFrame (x1, y1, x2, y2, Style, TxtColor, BckColor: INTEGER);
  50. VAR x, y, i, Ver, Hor, Elo, Ero, Elu, Eru: INTEGER;
  51. BEGIN
  52.   IF ScreenMode = Monochrom THEN BEGIN  TxtColor := 7;  BckColor := 0;  END;
  53.   Window(x1,y1,x2,y2);
  54.   TextColor(TxtColor) ;                       (* Style = 0 ==> kein Rahmen *)
  55.   TextBackground(BckColor);                (* Style = 1 ==> einfache Linie *)
  56.   IF Style=1 THEN BEGIN                    (* Style = 2 ==> doppelte Linie *)
  57.     Ver := 196;  Hor := 179;             (* Ecken links/rechts/oben/unten: *)
  58.     Elo := 218;  Ero := 191;  Elu := 192;  Eru := 217;
  59.   END
  60.   ELSE BEGIN
  61.     Ver := 205; Hor := 186; Elo := 201; Ero := 187; Elu := 200; Eru := 188;
  62.   END;
  63.   IF Style <> 0 THEN BEGIN
  64.     GotoXY(1,1);  Write(Chr(Elo));
  65.     FOR i := 2 TO x2-x1 DO Write(Chr(Ver));
  66.     Write(Chr(Ero));
  67.     FOR i := 2 TO y2-y1 DO BEGIN
  68.       GotoXY(1,i); Write(Chr(Hor)); GotoXY(x2-x1+1,i); Write(Chr(Hor));
  69.     END;
  70.     GotoXY(1,y2-y1+1);  Write(Chr(Elu));
  71.     FOR i := 2 TO x2-x1 DO Write(Chr(Ver));
  72.     Window (1,1,80,25); GotoXY (x2,y2);
  73.     Write(Chr(Eru)); Window(x1+1,y1+1,x2-1,y2-1);
  74.   END;
  75. END;
  76. (* ----------------------------------------------------------------------- *)
  77. PROCEDURE MkWindow (x1, y1, x2, y2, Style: INTEGER;
  78.                     TxtColor:BYTE; BckColor, BrdColor: INTEGER);
  79. VAR dummy: INTEGER;  Regs : Regs8088_;
  80. BEGIN
  81.   IF NOT WinInit THEN InitWindow;
  82.   WITH Win DO Tiefe := Tiefe+1;
  83.   IF Win.Tiefe > MaxWin THEN BEGIN   (* zuviel Fenster! Programm abbrechen *)
  84.     WriteLn('FEHLER: Zuviele Fenster offen! ');  Halt;
  85.   END;
  86.   Video(Off);
  87.   WITH Win DO BEGIN
  88.     New(Keller[Tiefe]);            (* alten Bildinhalt auf Keller schieben *)
  89.     IF ScreenMode = 7 THEN Keller[Tiefe]^.Bild := MonoBuffer
  90.     ELSE Keller[Tiefe]^.Bild := ColorBuffer;
  91.     Keller[Tiefe]^.Dim := Dim;     (* Groesse u. Cursor auf Keller sichern *)
  92.     Where_Cursor (Keller[Win.Tiefe]^.x, Keller[Win.Tiefe]^.y);
  93.     Regs.AH := 3;  Intr ($10, Regs);  Keller[Win.Tiefe]^.Shape := Regs.CX;
  94.   END ;
  95.   Video(On) ;
  96.   IF (x2 > 80) THEN                              (* Koordinatenkorrekturen *)
  97.     BEGIN  dummy := x2-80;  x1 := x1-dummy;  x2 := x2-dummy;  END;
  98.   IF (y2 > 25) THEN
  99.     BEGIN  dummy := y2-25;  y1 := y1-dummy;  y2 := y2-dummy;  END;
  100.   WinFrame(x1, y1, x2, y2, Style, TxtColor, BrdColor);
  101.   GotoXY(1,1); TextColor(TxtColor); TextBackground(BckColor); ClrScr;
  102.   Win.Dim.x1 := x1+1;  Win.Dim.y1 := y1+1;
  103.   Win.Dim.x2 := x2-1;  Win.Dim.y2 := y2-1;
  104. END;
  105. (* ----------------------------------------------------------------------- *)
  106. PROCEDURE RmWindow;
  107. VAR act_color: BYTE;  x, y: INTEGER;  Regs :Regs8088_;
  108. BEGIN
  109.   Video(Off);
  110.   WITH Win DO BEGIN       (* alter Bildinhalt zurueck und Keller freigeben *)
  111.     IF ScreenMode = 7 THEN MonoBuffer := Keller[Tiefe]^.Bild
  112.     ELSE ColorBuffer := Keller[Tiefe]^.Bild;
  113.     Dispose(Keller[Tiefe]);
  114.     Video(On);              (* altes Fenster u. Cursor-Position reaktiven: *)
  115.     Dim := Keller[Tiefe]^.Dim;  Window(Dim.x1,Dim.y1,Dim.x2,Dim.y2);
  116.     Regs.AH := 2;                        Regs.BH := Mem[$40:$62];
  117.     Regs.DL := pred (Keller[Tiefe]^.x);  Regs.DH := pred (Keller[Tiefe]^.y);
  118.     Intr ($10, Regs);                               (* alte Cursorposition *)
  119.     Regs.AH := 1;  Regs.CX := Keller[Tiefe]^.Shape;
  120.     Intr ($10, Regs);                                (* alte Cursorgroesse *)
  121.     Where_Cursor(x,y);  act_color := Mem[VideoBuffer:((x-1+(y-1)*80)*2)+1];
  122.     TextColor(act_color AND $0F);   TextBackground(act_color DIV 16);
  123.     Tiefe := Tiefe-1;
  124.   END ;
  125. END;
  126. (* ----------------------------------------------------------------------- *)
  127. (*                              TSRWIND.PAS                                *)
  128.