home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 12 / grdlagen / attribut.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-08-09  |  3.4 KB  |  129 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     ATTRIBUT.PAS                       *)
  3. (*              Attribute setzen in beliebigen            *)
  4. (*          Bereichen des Bildschirms im Textmodus        *)
  5. (*          Direktes Beschreiben des VideoSpeichers       *)
  6. (*         (c)  1989  Lorenz Holländer  &  TOOLBOX        *)
  7. (* ------------------------------------------------------ *)
  8. UNIT Attribut;
  9.  
  10. INTERFACE USES Crt, Dos;
  11.  
  12. VAR
  13.   DisplayRam : ARRAY [1..2000] OF WORD ABSOLUTE $B800:$0000;
  14.                                   { Monochrome $B000:$0000 }
  15.  
  16. FUNCTION  MakeAttr(Vordergrund, Hintergrund : BYTE) : BYTE;
  17. FUNCTION  PickAttr(x, y : BYTE) : BYTE;
  18. FUNCTION  PickChr(x, y : BYTE) : CHAR;
  19. PROCEDURE WrtAttr(x, y : BYTE; At : BYTE);
  20. PROCEDURE WrtChr(x, y : BYTE; Ch : CHAR);
  21. PROCEDURE WrtStr(x, y : BYTE; St : STRING);
  22. PROCEDURE FillChr(x1, y1, x2, y2 : BYTE; Ch : CHAR);
  23. PROCEDURE FillAttr(x1, y1, x2, y2, At : BYTE);
  24. PROCEDURE Desktop(z, At : BYTE);
  25.  
  26. IMPLEMENTATION
  27.  
  28. FUNCTION MakeAttr(Vordergrund, Hintergrund : BYTE) : BYTE;
  29. BEGIN
  30.   Vordergrund := Vordergrund MOD 16;
  31.   Hintergrund := Hintergrund MOD 8;
  32.   MakeAttr := Vordergrund + (Hintergrund SHL 4);
  33. END;
  34.  
  35. FUNCTION PickAttr(x, y : BYTE) : BYTE;
  36. VAR
  37.   Pos : WORD;
  38. BEGIN
  39.   Pos := (y - 1) * 80 + x;
  40.   PickAttr := Hi(DisplayRam[Pos]);              { Attribut }
  41. END;
  42.  
  43. FUNCTION PickChr(x, y : BYTE) : CHAR;
  44. VAR
  45.   Pos : WORD;
  46. BEGIN
  47.   Pos := (y - 1) * 80 + x;         { Berechnet das Zeichen }
  48.   PickChr := Chr(Lo(DisplayRam[Pos]));
  49. END;
  50.  
  51. PROCEDURE WrtAttr(x, y : BYTE; At : BYTE);
  52. VAR
  53.   Pos : WORD;
  54. BEGIN
  55.   Pos := (y - 1) * 80 + x;
  56.   DisplayRam[Pos] := Lo(DisplayRam[Pos]) + At SHL 8;
  57.               { Ändert das Attribut / Text bleibt erhalten }
  58. END;
  59.  
  60. PROCEDURE WrtChr(x, y : BYTE; Ch : CHAR);
  61. VAR
  62.   c   : BYTE;
  63.   Pos : WORD;
  64. BEGIN
  65.   Pos := (y - 1) * 80 + x;
  66.   c   := Ord(Ch);
  67.   DisplayRam[Pos] := c + Hi(DisplayRam[Pos]) SHL 8;
  68. END;
  69.  
  70. PROCEDURE WrtStr(x, y : BYTE; St : STRING);
  71. VAR
  72.   l, c : BYTE;
  73.   Pos  : WORD;
  74. BEGIN
  75.   Pos := (y - 1) * 80 + x - 1;
  76.   IF Length(St)>0 THEN
  77.     FOR l := 1 TO Length(St) DO BEGIN
  78.       c := Ord(St[l]);
  79.      DisplayRam[Pos+l] := c + Hi(DisplayRam[Pos+l]) SHL 8;
  80.   END;
  81. END;
  82.  
  83. PROCEDURE FillChr(x1, y1, x2, y2 : BYTE; Ch : CHAR);
  84. VAR
  85.   k,j,c : BYTE;
  86.   xpos  : WORD;
  87. BEGIN
  88.   IF (x2 >= x1) AND (y2 >= y1) THEN
  89.     IF (x1 > 0) AND (y2 > 0) THEN
  90.       IF (x2 <= 80) AND (y2 <= 25) THEN BEGIN
  91.         c := Ord(Ch);
  92.         FOR j := y1 TO y2 DO BEGIN
  93.           xpos := (j - 1) * 80 + x1;
  94.           FOR k := 0 TO x2 - x1 DO
  95.             DisplayRam[xpos+k] := c +
  96.                                 Hi(DisplayRam[xpos+k]) SHL 8;
  97.         END;
  98.       END;
  99. END;
  100.  
  101. PROCEDURE FillAttr(x1, y1, x2, y2, At : BYTE);
  102. VAR
  103.   k, j : BYTE;
  104.   xpos : WORD;
  105. BEGIN
  106.   IF (x2 >= x1) AND (y2 >= y1) THEN
  107.     IF (x1 > 0) AND (y2 > 0) THEN
  108.       IF (x2 <= 80) AND (y2 <= 25) THEN BEGIN
  109.         FOR j := y1 TO y2 DO BEGIN
  110.           xpos := (j - 1) * 80 + x1;
  111.           FOR k := 0 TO x2 - x1 DO
  112.             DisplayRam[xpos+k] := Lo(DisplayRam[xpos+k]) +
  113.                                   At SHL 8;
  114.         END;
  115.       END;
  116. END;
  117.  
  118. PROCEDURE Desktop(z, At : BYTE);
  119. VAR
  120.   k : INTEGER;
  121. BEGIN
  122.   FOR k := 81 TO 1920 DO DisplayRam[k] := z + At SHL 8;
  123. END;
  124.  
  125. END.
  126. (* ------------------------------------------------------ *)
  127. (*               Ende von ATTRIBUT.PAS                    *)
  128.  
  129.