home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 06 / praxis / menrouts.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-11-14  |  5.0 KB  |  182 lines
  1. (* ------------------------------------------------------ *)
  2. (*                  MENROUTS.PAS                          *)
  3. (*             Routinen für MENUE.PAS                     *)
  4. (*                                                        *)
  5. (*    (C) 1988 by Lutz & Stefan Tandecki & TOOLBOX        *)
  6. (* ------------------------------------------------------ *)
  7.  
  8. UNIT MenRouts;
  9.  
  10. INTERFACE
  11.  
  12. USES Crt, Dos;
  13.  
  14. TYPE WorkString = String[255];
  15.  
  16. FUNCTION Kette(Anzahl, Code: BYTE): WorkString;
  17.  
  18. PROCEDURE Cursor(TopEdge, BottomEdge: BYTE);
  19. PROCEDURE CursorOff;
  20. PROCEDURE CursorOn;
  21. PROCEDURE FillLinePart(Zeile, Spalte, Breite: BYTE);
  22. PROCEDURE InitMergeClip;
  23. PROCEDURE MergeBoxInScreen(SourceX1, SourceY1, SourceX2,
  24.                          SourceY2, DestX1, DestY1: INTEGER);
  25. PROCEDURE ReversAus;
  26. PROCEDURE ReversEin;
  27. PROCEDURE WriteInMergeClip(Spalte, Zeile: BYTE;
  28.                            Arg: WorkString);
  29.  
  30. VAR CGAMode   : BOOLEAN;
  31.     VideoScr1 : ARRAY[1..4000] OF BYTE ABSOLUTE $B000:$0000;
  32.     VideoScr2 : ARRAY[1..4000] OF BYTE ABSOLUTE $B800:$0000;
  33.  
  34. IMPLEMENTATION
  35.  
  36. VAR MergeMem  : ARRAY[1..4000] OF BYTE;
  37.     Reg       : Registers;
  38.  
  39. (* ------------------------------------------------------ *)
  40. (*     Kette - Gibt n gleiche Zeichen zurück.             *)
  41.  
  42. FUNCTION Kette(Anzahl, Code: BYTE): WorkString;
  43. VAR i: BYTE;
  44.  
  45. BEGIN
  46.   FOR i := 1 TO Anzahl DO Kette[i] := Chr(Code);
  47.   Kette[0] := Chr(Anzahl);
  48. END;
  49.  
  50. (* ------------------------------------------------------ *)
  51. (*     Cursor - Bestimmt die Form des Cursors.            *)
  52.  
  53. PROCEDURE Cursor(TopEdge, BottomEdge: BYTE);
  54.  
  55. BEGIN
  56.   WITH Reg DO BEGIN
  57.     ax := 1 SHL 8;
  58.     cx := TopEdge SHL 8 + BottomEdge;
  59.   END;
  60.   Intr($10, Reg);
  61. END;
  62.  
  63. (* ------------------------------------------------------ *)
  64. (*     CursorOn - Schaltet den Cursor (wieder) ein.       *)
  65.  
  66. PROCEDURE CursorOn;
  67.  
  68. BEGIN
  69.   Cursor(11, 13);
  70. END;
  71.  
  72. (* ------------------------------------------------------ *)
  73. (*     CursorOff - Schaltet den Cursor aus.               *)
  74.  
  75. PROCEDURE CursorOff;
  76.  
  77. BEGIN
  78.   Cursor(8, 0);
  79. END;
  80.  
  81. (* ------------------------------------------------------ *)
  82. (*     ReversEin - Bildschirmattribut für revers          *)
  83.  
  84. PROCEDURE ReversEin;
  85.  
  86. BEGIN
  87.   TextColor(Black);  TextBackground(White);
  88. END;
  89.  
  90. (* ------------------------------------------------------ *)
  91. (*     ReversAus - Schaltet das Bildschirmattribut aus.   *)
  92.  
  93. PROCEDURE ReversAus;
  94.  
  95. BEGIN
  96.   NormVideo;
  97. END;
  98.  
  99. (* ------------------------------------------------------ *)
  100. (*     FillLinePart - Füllt Teile der Zeile mit aktuellem *)
  101. (*                    Textattribut.                       *)
  102.  
  103. PROCEDURE FillLinePart(Zeile, Spalte, Breite: BYTE);
  104. VAR i, e : INTEGER;
  105.  
  106. BEGIN
  107.   e := 160 * (Zeile - 1) + 2 * (Spalte - 1);
  108.   FOR i := 1 TO Breite DO
  109.     IF (CGAMode) THEN
  110.       VideoScr1[e + 2 * i] := TextAttr
  111.     ELSE
  112.       VideoScr2[e + 2 * i] := TextAttr;
  113. END;
  114.  
  115. (* ------------------------------------------------------ *)
  116. (*     InitMergeClip - Initialisiert Pseudo-Bildschirm.   *)
  117.  
  118. PROCEDURE InitMergeClip;
  119. VAR x, y: INTEGER;
  120.  
  121. BEGIN
  122.   FOR y := 0 TO 24 DO
  123.     FOR x := 0 TO 79 DO BEGIN
  124.       MergeMem[1 + y * 160 + x * 2] := 32;
  125.       MergeMem[y * 160 + x * 2 + 2] := TextAttr;
  126.     END;
  127. END;
  128.  
  129. (* ------------------------------------------------------ *)
  130. (*     WriteInMergeClip - Schreibt in Pseudo-Bildschirm   *)
  131. (*                        einen übergebenen String.       *)
  132.  
  133. PROCEDURE WriteInMergeClip(Spalte, Zeile: BYTE;
  134.                            Arg: WorkString);
  135. VAR i, e : INTEGER;
  136.  
  137. BEGIN
  138.   e := 1 + 160 * (Zeile - 1) + 2 * (Spalte - 1);
  139.   FOR i := 1 TO Length(Arg) DO
  140.     IF (Arg[i] = #1) THEN
  141.       LowVideo
  142.     ELSE
  143.       If (Arg[i] = #2) THEN
  144.         HighVideo
  145.       ELSE BEGIN
  146.         MergeMem[e]     := Ord(Arg[i]);
  147.         MergeMem[e + 1] := TextAttr;
  148.         e := e + 2;
  149.       END;
  150. END;
  151.  
  152. (* ------------------------------------------------------ *)
  153. (*     MergeBoxInScreen - Blendet einen Bereich des       *)
  154. (*                        Pseudo-Bildschirms in den       *)
  155. (*                        aktuellen Bildschirm ein.       *)
  156.  
  157. PROCEDURE MergeBoxInScreen(SourceX1, SourceY1, SourceX2,
  158.                          SourceY2, DestX1, DestY1: INTEGER);
  159. VAR i, Quelle, Ziel, AnzBytes: INTEGER;
  160.  
  161. BEGIN
  162.   Quelle   := 1 + (SourceY1 - 1) * 160 + (SourceX1 - 1) * 2;
  163.   Ziel     := 1 + (DestY1 - 1) * 160 + (DestX1 - 1) * 2;
  164.   AnzBytes := (SourceX2 - SourceX1) * 2;
  165.   FOR i := SourceY1 TO SourceY2 DO BEGIN
  166.     IF (CGAMode) THEN
  167.       Move(MergeMem[Quelle], VideoScr1[Ziel], AnzBytes)
  168.     ELSE
  169.       Move(MergeMem[Quelle], VideoScr2[Ziel], AnzBytes);
  170.     INC (Quelle, 160);
  171.     INC (Ziel,   160);
  172.   END;
  173. END;
  174.  
  175.  
  176. BEGIN (* Of Unit *)
  177.   IF (Mem[0000:1040] AND $30) = $30 THEN CGAMode := TRUE
  178.                                     ELSE CGAMode := FALSE;
  179. END.
  180.  
  181. (* ------------------------------------------------------ *)
  182. (*                Ende von MENROUTS.PAS                   *)