home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 03 / grdlagen / extvsm2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-12-07  |  8.4 KB  |  314 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      EXTVSM2.PAS                       *)
  3. (*   Das Objekt VSMCrt stellt Methoden und Variablen      *)
  4. (*   zur Verfügung, die es erlauben, analog zur Unit      *)
  5. (*   Crt zu arbeiten (also Write, Writeln, TextAttr       *)
  6. (*   etc).                                                *)
  7. (*           (c) 1991 Raimond Reichert & TOOLBOX          *)
  8. (* ------------------------------------------------------ *)
  9. UNIT ExtVSM2;
  10.  
  11. INTERFACE
  12.  
  13. USES
  14.   ExtVSM,            (* toolbox 2'91 und aktuelle Databox *)
  15.   Crt;
  16.  
  17. CONST
  18.   Screen    = 0;              (* Konstante für Bildschirm *)
  19.  
  20. TYPE
  21.   VSMCrtPtr = ^VSMCrt;
  22.   VSMCrt    = OBJECT (ExtVSManager)
  23.  
  24.     TA, NV, TextCol, TextBack, x, y : BYTE;
  25.     WinMin, WinMax                  : WORD;
  26.  
  27.     CONSTRUCTOR Init(XL, YL : BYTE);
  28.     PROCEDURE ClrScr;                               VIRTUAL;
  29.     PROCEDURE ClrEol;                               VIRTUAL;
  30.     PROCEDURE DelLine;                              VIRTUAL;
  31.     PROCEDURE InsLine;                              VIRTUAL;
  32.     PROCEDURE HighVideo;                            VIRTUAL;
  33.     PROCEDURE NormVideo;                            VIRTUAL;
  34.     PROCEDURE LowVideo;                             VIRTUAL;
  35.     PROCEDURE Delay(Ms : WORD);                     VIRTUAL;
  36.     PROCEDURE Sound(Hz : WORD);                     VIRTUAL;
  37.     PROCEDURE NoSound;                              VIRTUAL;
  38.     PROCEDURE Window(x1, y1, x2, y2 : BYTE);        VIRTUAL;
  39.     PROCEDURE Write(Str : STRING);                  VIRTUAL;
  40.     PROCEDURE WriteLn(Str : STRING);                VIRTUAL;
  41.     PROCEDURE GotoXY(NewX, NewY : BYTE);            VIRTUAL;
  42.     PROCEDURE SetTextAttr(NewTA : BYTE);            VIRTUAL;
  43.     PROCEDURE SetTextColor(TC : BYTE);              VIRTUAL;
  44.     PROCEDURE SetTextBackGround(TB : BYTE);         VIRTUAL;
  45.     PROCEDURE SetCheckBreak(CB : BOOLEAN);          VIRTUAL;
  46.  
  47.     (* --- intern: -------------------------------------- *)
  48.     PROCEDURE ScrollUp;                             VIRTUAL;
  49.     (* -------------------------------------------------- *)
  50.  
  51.     FUNCTION  TextAttr : BYTE;                      VIRTUAL;
  52.     FUNCTION  TextColor : BYTE;                     VIRTUAL;
  53.     FUNCTION  TextBackGround : BYTE;                VIRTUAL;
  54.     FUNCTION  WhereX : BYTE;                        VIRTUAL;
  55.     FUNCTION  WhereY : BYTE;                        VIRTUAL;
  56.     FUNCTION  KeyPressed : BOOLEAN;                 VIRTUAL;
  57.     FUNCTION  ReadKey : CHAR;                       VIRTUAL;
  58.     FUNCTION  CheckBreak : BOOLEAN;                 VIRTUAL;
  59.     FUNCTION  GetWinMinX : BYTE;                    VIRTUAL;
  60.     FUNCTION  GetWinMinY : BYTE;                    VIRTUAL;
  61.     FUNCTION  GetWinMaxX : BYTE;                    VIRTUAL;
  62.     FUNCTION  GetWinMaxY : BYTE;                    VIRTUAL;
  63.   END;
  64.  
  65. IMPLEMENTATION
  66.  
  67.   CONSTRUCTOR VSMCrt.Init(XL, YL : BYTE);
  68.   BEGIN
  69.     ExtVSManager.Init(XL, YL);
  70.     TextCol  := LightGray;
  71.     TextBack := Black;
  72.     SetTextAttr(LightGray);
  73.     Window(1, 1, GetXLength, GetYLength);
  74.     GotoXY(Crt.WhereX, Crt.WhereY);
  75.     NV := Hi(VScreens^[VSAkt]^.VSMem^[Pred(y) *
  76.              GetXLength * 2 + x * 2]);
  77.     { Attribut an Cursorposition speichern (für NormVideo) }
  78.   END;
  79.  
  80.   PROCEDURE VSMCrt.ClrScr;
  81.   BEGIN
  82.     FillPart(Lo(WinMin), Hi(WinMin),
  83.              Lo(WinMax), Hi(WinMax), TA, ' ');
  84.     GotoXY(1, 1);
  85.   END;
  86.  
  87.   PROCEDURE VSMCrt.ClrEol;
  88.   BEGIN
  89.     FillPart(x, y, Lo(WinMax), y, TA, ' ');
  90.   END;
  91.  
  92.   PROCEDURE VSMCrt.DelLine;
  93.   VAR
  94.     i : BYTE;
  95.   BEGIN
  96.     FOR i := (Hi(WinMin) + y) TO Hi(WinMax) DO
  97.       CopyPart(Lo(WinMin), i, Lo(WinMax), i,
  98.               Lo(WinMin), Pred(i), VSAkt, VSAkt);
  99.     FillPart(Lo(WinMin), Hi(WinMax),
  100.              Lo(WinMax), Hi(WinMax), TA, ' ');
  101.   END;
  102.  
  103.   PROCEDURE VSMCrt.InsLine;
  104.   VAR
  105.     i : BYTE;
  106.   BEGIN
  107.     FOR i := Hi(WinMax) DOWNTO Pred(Hi(WinMin) + y) DO
  108.       CopyPart(Lo(WinMin), Pred(i), Lo(WinMax), Pred(i),
  109.                Lo(WinMin), i, VSAkt, VSAkt);
  110.     FillPart (Lo(WinMin), i, Lo(WinMax), i, TA, ' ');
  111.   END;
  112.  
  113.   PROCEDURE VSMCrt.HighVideo;
  114.   BEGIN
  115.     SetTextColor(White);
  116.   END;
  117.  
  118.   PROCEDURE VSMCrt.NormVideo;
  119.   BEGIN
  120.     SetTextAttr(NV);
  121.   END;
  122.  
  123.   PROCEDURE VSMCrt.LowVideo;
  124.   BEGIN
  125.     SetTextColor(LightGray);
  126.   END;
  127.  
  128.   PROCEDURE VSMCrt.Delay(Ms : WORD);
  129.   BEGIN
  130.     Crt.Delay(Ms);
  131.   END;
  132.  
  133.   PROCEDURE VSMCrt.Sound(Hz : WORD);
  134.   BEGIN
  135.     Crt.Sound(Hz);
  136.   END;
  137.  
  138.   PROCEDURE VSMCrt.NoSound;
  139.   BEGIN
  140.     Crt.NoSound;
  141.   END;
  142.  
  143.   PROCEDURE VSMCrt.Window(x1, y1, x2, y2 : BYTE);
  144.   VAR
  145.     h : BYTE;
  146.   BEGIN
  147.     IF x1 < 1 THEN x1 := 1;
  148.     IF y1 < 1 THEN y1 := 1;
  149.     IF x2 > GetXLength THEN x2 := GetXLength;
  150.     IF y2 > GetYLength THEN y2 := GetYLength;
  151.     IF NOT (x1 <= x2) THEN BEGIN
  152.       h := x1;  x1 := x2;  x2 := h;
  153.     END;
  154.     IF NOT (y1 <= y2) THEN BEGIN
  155.       h := y1;  y1 := y2;  y2 := h;
  156.     END;
  157.     WinMin := x1 + y1 SHL 8;
  158.     WinMax := x2 + y2 SHL 8;
  159.     GotoXY(1, 1);
  160.   END;
  161.  
  162.   PROCEDURE VSMCrt.Write(Str : STRING);
  163.   (* Der zu schreibende String wird, falls nötig, aufge-  *)
  164.   (* teilt und die einzelnen Teilstrings ausgegeben.      *)
  165.   VAR
  166.     s1 : STRING;
  167.   BEGIN
  168.     REPEAT
  169.       s1 := Copy(Str, 1, Succ(Succ(Lo(WinMax)-
  170.                                    Lo(WinMin) - x)));
  171.       Delete(Str, 1, Length(S1));
  172.       WriteStr(Pred(Lo(WinMin) + x),
  173.                Pred(Hi(WinMin) + y), TA, S1);
  174.       IF Str <> '' THEN GotoXY(1, Succ(y));
  175.     UNTIL Str = '';
  176.     GotoXY(x + Length(S1), y);
  177.   END;
  178.  
  179.   PROCEDURE VSMCrt.WriteLn(Str : STRING);
  180.   BEGIN
  181.     Write(Str);
  182.     GotoXY(1, Succ(y));
  183.   END;
  184.  
  185.   PROCEDURE VSMCrt.GotoXY(NewX, NewY : BYTE);
  186.   VAR
  187.     i, WinXL, WinYL : BYTE;
  188.   BEGIN
  189.     WinXL := Succ(Lo(WinMax) - Lo(WinMin));
  190.     WinYL := Succ(Hi(WinMax) - Hi(WinMin));
  191.  
  192.     (* --------------- Neues X berechnen ---------------- *)
  193.     IF (NewX >= 1) AND (NewX <= WinXL) THEN
  194.       x := NewX
  195.     ELSE IF NewX < 1 THEN
  196.       x := 1
  197.     ELSE BEGIN
  198.       x := NewX MOD WinXL;
  199.       IF x = 0 THEN BEGIN
  200.         x := WinXL;
  201.         Inc(NewY, Pred(NewX DIV WinXL));
  202.       END ELSE
  203.         Inc(NewY, NewX DIV WinXL);
  204.     END;
  205.     (* --------------- Neues Y berechnen ---------------- *)
  206.     IF (NewY >= 1) AND (NewY <= WinYL) THEN
  207.       y := NewY
  208.     ELSE IF NewY < 1 THEN
  209.       y := 1
  210.     ELSE BEGIN
  211.       ScrollUp;
  212.       y := WinYL;
  213.     END;
  214.     (* --------------- Cursor setzen -------------------- *)
  215.     IF VSAkt = Screen THEN
  216.       Crt.GotoXY(Pred(Lo(WinMin)+x), Pred(Hi(WinMin)+y));
  217.   END;
  218.  
  219.   PROCEDURE VSMCrt.SetTextAttr(NewTA : BYTE);
  220.   BEGIN
  221.     TA := NewTA;
  222.   END;
  223.  
  224.   PROCEDURE VSMCrt.SetTextColor(TC : BYTE);
  225.   BEGIN
  226.     TextCol := TC;
  227.     SetTextAttr(TextCol MOD 16 + (TextBack MOD 8) SHL 4);
  228.   END;
  229.  
  230.   PROCEDURE VSMCrt.SetTextBackGround (TB : BYTE);
  231.   BEGIN
  232.     Textback := TB;
  233.     SetTextAttr(TextCol MOD 16 + (TextBack MOD 8) SHL 4);
  234.   END;
  235.  
  236.   PROCEDURE VSMCrt.SetCheckBreak(CB : BOOLEAN);
  237.   BEGIN
  238.     Crt.CheckBreak := CB;
  239.   END;
  240.  
  241.   PROCEDURE VSMCrt.ScrollUp;
  242.   VAR
  243.     i : BYTE;
  244.   BEGIN
  245.     FOR i := Succ(Hi(WinMin)) TO Hi(WinMax) DO
  246.       CopyPart(Lo(WinMin), i, Lo(WinMax), i,
  247.                Lo(WinMin), Pred(i), VSAkt, VSAkt);
  248.     FillPart(Lo(WinMin), Hi(WinMax),
  249.              Lo(WinMax), Hi(WinMax), TA, ' ');
  250.   END;
  251.  
  252.   FUNCTION VSMCrt.TextAttr : BYTE;
  253.   BEGIN
  254.     TextAttr := TA;
  255.   END;
  256.  
  257.   FUNCTION VSMCrt.TextColor : BYTE;
  258.   BEGIN
  259.     TextColor := TextCol;
  260.   END;
  261.  
  262.   FUNCTION VSMCrt.TextBackGround : BYTE;
  263.   BEGIN
  264.     TextBackGround := TextBack;
  265.   END;
  266.  
  267.   FUNCTION VSMCrt.WhereX : BYTE;
  268.   BEGIN
  269.     WhereX := x;
  270.   END;
  271.  
  272.   FUNCTION VSMCrt.WhereY : BYTE;
  273.   BEGIN
  274.     WhereY := y;
  275.   END;
  276.  
  277.   FUNCTION VSMCrt.KeyPressed : BOOLEAN;
  278.   BEGIN
  279.     KeyPressed := Crt.KeyPressed
  280.   END;
  281.  
  282.   FUNCTION VSMCrt.ReadKey : CHAR;
  283.   BEGIN
  284.     ReadKey := Crt.ReadKey;
  285.   END;
  286.  
  287.   FUNCTION VSMCrt.CheckBreak : BOOLEAN;
  288.   BEGIN
  289.     CheckBreak := Crt.CheckBreak;
  290.   END;
  291.  
  292.   FUNCTION VSMCrt.GetWinMinX : BYTE;
  293.   BEGIN
  294.     GetWinMinX := Lo(WinMin);
  295.   END;
  296.  
  297.   FUNCTION VSMCrt.GetWinMinY : BYTE;
  298.   BEGIN
  299.     GetWinMinY := Hi(WinMin);
  300.   END;
  301.  
  302.   FUNCTION VSMCrt.GetWinMaxX : BYTE;
  303.   BEGIN
  304.     GetWinMaxX := Lo(WinMax);
  305.   END;
  306.  
  307.   FUNCTION VSMCrt.GetWinMaxY : BYTE;
  308.   BEGIN
  309.     GetWinMaxY := Hi(WinMax);
  310.   END;
  311.  
  312. END.
  313. (* ------------------------------------------------------ *)
  314. (*                Ende von EXTVSM2.PAS                    *)