home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 22 / vsms / extvsm2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-01-04  |  8.8 KB  |  332 lines
  1. (* ----------------------------------------------------- *)
  2. (*                      EXTVSM2.PAS                      *)
  3. (*                                                       *)
  4. (* ■ VSMCrt: Erlaubt das (fast komplett) analoge arbeiten*)
  5. (*   zur Unit Crt. Ausnahme: AssignCrt wurde nicht neu   *)
  6. (*   implementiert.                                      *)
  7. (*                                                       *)
  8. (*           (c) 1991 by R.Reichert & toolbox            *)
  9. (* ----------------------------------------------------- *)
  10. UNIT EXTVSM2;
  11.  
  12. INTERFACE
  13.  
  14. USES Crt, ScrObj, ExtVSM;
  15.  
  16. CONST
  17.   Screen    = 0;
  18.  
  19. TYPE
  20.   ScreenObjPtr = ScrObj.ScreenObjPtr;
  21.   ScreenObj    = ScrObj.ScreenObj;
  22.   VSMCrtPtr    = ^VSMCrt;
  23.   VSMCrt       = OBJECT (ExtVSManager)
  24.     TA, NV,                         { TextAttr, NormVideo }
  25.     TextCol,
  26.     TextBack,
  27.     x, y   : BYTE;
  28.     WinMin,
  29.     WinMax : WORD;
  30.  
  31.     CONSTRUCTOR Init (Screen : ScreenObjPtr);
  32.     PROCEDURE ClrScr;                              VIRTUAL;
  33.     PROCEDURE ClrEol;                              VIRTUAL;
  34.     PROCEDURE DelLine;                             VIRTUAL;
  35.     PROCEDURE InsLine;                             VIRTUAL;
  36.     PROCEDURE HighVideo;                           VIRTUAL;
  37.     PROCEDURE NormVideo;                           VIRTUAL;
  38.     PROCEDURE LowVideo;                            VIRTUAL;
  39.     PROCEDURE Delay (Ms : WORD);                   VIRTUAL;
  40.     PROCEDURE Sound (Hz : WORD);                   VIRTUAL;
  41.     PROCEDURE NoSound;                             VIRTUAL;
  42.     PROCEDURE Window (x1, y1, x2, y2 : BYTE);      VIRTUAL;
  43.     PROCEDURE Write (Str : STRING);                VIRTUAL;
  44.     PROCEDURE Writeln (Str : STRING);              VIRTUAL;
  45.     PROCEDURE GotoXY (NewX, NewY : BYTE);          VIRTUAL;
  46.     PROCEDURE SetTextAttr (NewTA : BYTE);          VIRTUAL;
  47.     PROCEDURE SetTextColor (TC : BYTE);            VIRTUAL;
  48.     PROCEDURE SetTextBackGround (TB:BYTE);         VIRTUAL;
  49.     PROCEDURE SetCheckBreak (CB : BOOLEAN);        VIRTUAL;
  50.     PROCEDURE ScrollUp; { INTERN ! }               VIRTUAL;
  51.  
  52.     FUNCTION TextAttr : BYTE;                      VIRTUAL;
  53.     FUNCTION TextColor : BYTE;                     VIRTUAL;
  54.     FUNCTION TextBackGround : BYTE;                VIRTUAL;
  55.     FUNCTION WhereX : BYTE;                        VIRTUAL;
  56.     FUNCTION WhereY : BYTE;                        VIRTUAL;
  57.     FUNCTION KeyPressed : BOOLEAN;                 VIRTUAL;
  58.     FUNCTION ReadKey : CHAR;                       VIRTUAL;
  59.     FUNCTION CheckBreak : BOOLEAN;                 VIRTUAL;
  60.     FUNCTION GetWinMinX : BYTE;                    VIRTUAL;
  61.     FUNCTION GetWinMinY : BYTE;                    VIRTUAL;
  62.     FUNCTION GetWinMaxX : BYTE;                    VIRTUAL;
  63.     FUNCTION GetWinMaxY : BYTE;                    VIRTUAL;
  64.   END;
  65.  
  66. IMPLEMENTATION
  67.  
  68. CONSTRUCTOR VSMCrt.Init (Screen : ScreenObjPtr);
  69. BEGIN
  70.   IF ExtVSManager.Init (Screen) THEN BEGIN
  71.     TextCol := LightGray;
  72.     TextBack:= Black;
  73.     SetTextAttr (LightGray);
  74.     WinMin := 1 + 1 SHL 8;
  75.     WinMax := GetXLength + GetYLength SHL 8;
  76.     GotoXY (Crt.WhereX, Crt.WhereY);
  77.     NV := Hi (VScreens^[VSAkt]^.
  78.               VSMem^[Pred (y)*GetXLength*2+x*2]);
  79.     { Attribut an Cursorposition speichern (für NormVideo)}
  80.   END ELSE
  81.     Fail;
  82. END;
  83.  
  84. PROCEDURE VSMCrt.ClrScr;
  85. BEGIN
  86.   FillPart (Lo (WinMin), Hi (WinMin),
  87.             Lo (WinMax), Hi (WinMax),
  88.             TA, ' ');
  89.   GotoXY (1, 1);
  90. END;
  91.  
  92. PROCEDURE VSMCrt.ClrEol;
  93. BEGIN
  94.   FillPart (x, y, Lo (WinMax), y, TA, ' ');
  95. END;
  96.  
  97. PROCEDURE VSMCrt.DelLine;
  98.   VAR i : BYTE;
  99. BEGIN
  100.   FOR i :=  (Hi (WinMin)+y) TO Hi (WinMax) DO
  101.     CopyPart (Lo (WinMin), i, Lo (WinMax), i,
  102.               Lo (WinMin), Pred (i),
  103.               VSAkt, VSAkt);
  104.   FillPart (Lo (WinMin), Hi (WinMax),
  105.             Lo (WinMax), Hi (WinMax), TA, ' ');
  106. END;
  107.  
  108. PROCEDURE VSMCrt.InsLine;
  109.   VAR i : BYTE;
  110. BEGIN
  111.   FOR i := Hi (WinMax) DOWNTO Pred (Hi (WinMin)+y) DO
  112.     CopyPart (Lo (WinMin), Pred (i), Lo (WinMax), Pred (i),
  113.               Lo (WinMin), i,
  114.               VSAkt, VSAkt);
  115.   FillPart (Lo (WinMin), i, Lo (WinMax), i, TA, ' ');
  116. END;
  117.  
  118. PROCEDURE VSMCrt.HighVideo;
  119. BEGIN
  120.   SetTextColor (White);
  121. END;
  122.  
  123. PROCEDURE VSMCrt.NormVideo;
  124. BEGIN
  125.   SetTextAttr (NV);
  126. END;
  127.  
  128. PROCEDURE VSMCrt.LowVideo;
  129. BEGIN
  130.   SetTextColor (LightGray);
  131. END;
  132.  
  133. PROCEDURE VSMCrt.Delay (Ms : WORD);
  134. BEGIN
  135.   Crt.Delay (Ms);
  136. END;
  137.  
  138. PROCEDURE VSMCrt.Sound (Hz : WORD);
  139. BEGIN
  140.   Crt.Sound (Hz);
  141. END;
  142.  
  143. PROCEDURE VSMCrt.NoSound;
  144. BEGIN
  145.   Crt.NoSound;
  146. END;
  147.  
  148. PROCEDURE VSMCrt.Window (x1, y1, x2, y2 : BYTE);
  149.   VAR h : BYTE;
  150. BEGIN
  151.   IF x1<1 THEN x1 := 1;
  152.   IF y1<1 THEN y1 := 1;
  153.   IF x2>GetXLength THEN x2 := GetXLength;
  154.   IF y2>GetYLength THEN y2 := GetYLength;
  155.   IF NOT (x1<=x2) THEN BEGIN
  156.     h := x1;  x1 := x2;  x2 := h;
  157.   END;
  158.   IF NOT (y1<=y2) THEN BEGIN
  159.     h := y1;  y1 := y2;  y2 := h;
  160.   END;
  161.   WinMin := x1 + y1 SHL 8;
  162.   WinMax := x2 + y2 SHL 8;
  163.   GotoXY (1, 1);
  164. END;
  165.  
  166. PROCEDURE VSMCrt.Write (Str : STRING);
  167.   VAR s1 : STRING;
  168. BEGIN
  169.   REPEAT
  170.     s1 := Copy (Str, 1, Succ (Succ (Lo (WinMax)-
  171.                         Lo (WinMin) - x)));
  172.     Delete (Str, 1, Length (S1));
  173.     WriteStr (Pred (Lo (WinMin) + x),
  174.               Pred (Hi (WinMin) + y), TA, S1);
  175.     IF Str<>'' THEN
  176.       GotoXY (1, Succ (y));
  177.   UNTIL Str='';
  178.   GotoXY (x+Length (S1), y);
  179. END;
  180.  
  181. PROCEDURE VSMCrt.Writeln (Str : STRING);
  182. BEGIN
  183.   Write (Str);
  184.   GotoXY (1, Succ (y))
  185. END;
  186.  
  187. (* ----------------------------------------------------- *)
  188. (* GotoXY setzt den Cursor neu. Dazu sind allerdings ein *)
  189. (* paar Berechnungen nötig: Für "NewX" wird geprüft, ob  *)
  190. (* es im zulässigen Bereich liegt, wenn nein, ob es      *)
  191. (* gleich null ist, oder sonst ("rechts vom Fenster")    *)
  192. (* wird umgerechnet, "NewY" auch angepasst (Spezialfall: *)
  193. (* wenn Cursor in letzte Spalte einer anderen Zeile kommt*)
  194. (* also z.B. Fenster 10 Zeichen breit ist und NewX=20).  *)
  195. (* Danach wird auch "NewY" umgerechnet und schliesslich  *)
  196. (* der Cursor mit "GotoXY" aus der Unit Crt gesetzt      *)
  197. (* (sofern "richtiger" Bildschirm aktiv ist).            *)
  198. (* ------------------------------------------------------*)
  199. PROCEDURE VSMCrt.GotoXY (NewX, NewY : BYTE);
  200.   VAR i, WinXL, WinYL : BYTE;
  201. BEGIN
  202.   WinXL := Succ (Lo (WinMax)-Lo (WinMin));
  203.   WinYL := Succ (Hi (WinMax)-Hi (WinMin));
  204.   {--------------- Neues X berechnen ---------------------}
  205.   IF (NewX>=1) AND (NewX<=WinXL) THEN
  206.     x := NewX
  207.   ELSE
  208.     IF NewX<1 THEN
  209.       x := 1
  210.     ELSE BEGIN
  211.       x := NewX MOD WinXL;
  212.       IF x=0 THEN BEGIN
  213.         x := WinXL;
  214.         Inc (NewY, Pred (NewX DIV WinXL));
  215.       END ELSE
  216.         Inc (NewY, NewX DIV WinXL);
  217.     END;
  218.   {--------------- Neues Y berechnen ---------------------}
  219.   IF (NewY>=1) AND (NewY<=WinYL) THEN
  220.     y := NewY
  221.   ELSE
  222.     IF NewY<1 THEN
  223.       y := 1
  224.     ELSE BEGIN
  225.       ScrollUp;
  226.       y := WinYL;
  227.     END;
  228.  
  229.   IF VSAkt=Screen THEN
  230.     Crt.GotoXY (Pred (Lo (WinMin)+x),
  231.                 Pred (Hi (WinMin)+y));
  232. END;
  233.  
  234. PROCEDURE VSMCrt.SetTextAttr (NewTA : BYTE);
  235. BEGIN
  236.   TA := NewTA;
  237. END;
  238.  
  239. PROCEDURE VSMCrt.SetTextColor (TC : BYTE);
  240. BEGIN
  241.   TextCol := TC;
  242.   SetTextAttr (TextCol MOD 16 + (TextBack MOD 8) SHL 4);
  243. END;
  244.  
  245. PROCEDURE VSMCrt.SetTextBackGround (TB : BYTE);
  246. BEGIN
  247.   Textback := TB;
  248.   SetTextAttr (TextCol MOD 16 + (TextBack MOD 8) SHL 4);
  249. END;
  250.  
  251. PROCEDURE VSMCrt.SetCheckBreak (CB : BOOLEAN);
  252. BEGIN
  253.   Crt.CheckBreak := CB;
  254. END;
  255.  
  256. PROCEDURE VSMCrt.ScrollUp;
  257.   VAR i : BYTE;
  258. BEGIN
  259.   FOR i := Succ (Hi (WinMin)) TO Hi (WinMax) DO
  260.     CopyPart (Lo (WinMin), i, Lo (WinMax), i,
  261.               Lo (WinMin), Pred (i),
  262.               VSAkt, VSAkt);
  263.   FillPart (Lo (WinMin), Hi (WinMax),
  264.             Lo (WinMax), Hi (WinMax), TA, ' ');
  265. END;
  266.  
  267.  
  268. FUNCTION VSMCrt.TextAttr : BYTE;
  269. BEGIN
  270.   TextAttr := TA;
  271. END;
  272.  
  273. FUNCTION VSMCrt.TextColor : BYTE;
  274. BEGIN
  275.   TextColor := TextCol;
  276. END;
  277.  
  278. FUNCTION VSMCrt.TextBackGround : BYTE;
  279. BEGIN
  280.   TextBackGround := TextBack;
  281. END;
  282.  
  283. FUNCTION VSMCrt.WhereX : BYTE;
  284. BEGIN
  285.   WhereX := x;
  286. END;
  287.  
  288. FUNCTION VSMCrt.WhereY : BYTE;
  289. BEGIN
  290.   WhereY := y;
  291. END;
  292.  
  293. FUNCTION VSMCrt.KeyPressed : BOOLEAN;
  294. BEGIN
  295.   KeyPressed := Crt.KeyPressed;
  296. END;
  297.  
  298. FUNCTION VSMCrt.ReadKey : CHAR;
  299. BEGIN
  300.   ReadKey := Crt.ReadKey;
  301. END;
  302.  
  303. FUNCTION VSMCrt.CheckBreak : BOOLEAN;
  304. BEGIN
  305.   CheckBreak := Crt.CheckBreak;
  306. END;
  307.  
  308. FUNCTION VSMCrt.GetWinMinX : BYTE;
  309. BEGIN
  310.   GetWinMinX := Lo (WinMin);
  311. END;
  312.  
  313. FUNCTION VSMCrt.GetWinMinY : BYTE;
  314. BEGIN
  315.   GetWinMinY := Hi (WinMin);
  316. END;
  317.  
  318. FUNCTION VSMCrt.GetWinMaxX : BYTE;
  319. BEGIN
  320.   GetWinMaxX := Lo (WinMax);
  321. END;
  322.  
  323. FUNCTION VSMCrt.GetWinMaxY : BYTE;
  324. BEGIN
  325.   GetWinMaxY := Hi (WinMax);
  326. END;
  327.  
  328. END.
  329. (* -------------------------------------------------- *)
  330. (*              Ende von EXTVSM2.PAS                  *)
  331. (* -------------------------------------------------- *)
  332.