home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 14 / pc / sgraph.pas next >
Encoding:
Pascal/Delphi Source File  |  1989-03-22  |  4.0 KB  |  149 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     SGRAPH.PAS                         *)
  3. (*        Grafik für Amstrad CGA 16 Farben HiRes          *)
  4. (*        (c) 1989  Lorenz Holländer  &  TOOLBOX          *)
  5. (* ------------------------------------------------------ *)
  6. UNIT SGraph;
  7.  
  8. INTERFACE  USES Crt, Dos, Graph;
  9.  
  10. VAR GraphDriver : INTEGER;
  11.     GraphMode   : INTEGER;
  12.     MaxX, MaxY  : WORD;           { Bildschirm-Koordinaten }
  13.     MaxColor    : WORD;           { 15 höchste Farbnummer }
  14.     ActColor    : WORD;           { Farbe von 0 bis 15 }
  15.  
  16. PROCEDURE HiRes;
  17. PROCEDURE ClearDevice;            { Bildschirm löschen }
  18. PROCEDURE SetBorderColor(Farbe : BYTE);
  19. PROCEDURE SetColor(Farbe : WORD);
  20. PROCEDURE PutPixel(x, y : INTEGER; pixel : WORD);
  21. PROCEDURE Bar(x1, y1, x2, y2 : INTEGER);
  22. PROCEDURE Circle(x, y : INTEGER; radius : WORD);
  23. PROCEDURE FloodFill(x, y : INTEGER; border : WORD);
  24. FUNCTION  GetPixel(x, y : INTEGER) : WORD;
  25.  
  26. IMPLEMENTATION
  27.  
  28. PROCEDURE HiRes;        { Initialisierung des Grafikpakets }
  29. BEGIN
  30.   DirectVideo := FALSE;
  31.   GraphDriver := CGA;
  32.   GraphMode   := CGAhi;
  33.   InitGraph(GraphDriver, GraphMode, '');
  34.   MaxColor := 15;            { höchste erlaubte Farbnummer }
  35.   MaxX := GetMaxX;   { Maximal-Koordinaten des Bildschirms }
  36.   MaxY := GetMaxY;
  37.   port[$3d9] := $0F;          { VDU ColorSelectRegister $0F}
  38.                               { 16 Farben im CGA Hiresmode }
  39.   ActColor := 1;
  40. END;
  41.  
  42. PROCEDURE SetBorderColor(Farbe : BYTE);
  43. VAR regs : Registers;
  44. BEGIN
  45.   regs.ah := 5;
  46.   Regs.al := Farbe;
  47.   Intr($15, regs);
  48. END;
  49.  
  50. PROCEDURE SetReadRegister(Plane : BYTE);
  51. VAR regs : Registers;
  52. BEGIN
  53.   regs.ah := 4;
  54.   Regs.al := Plane;
  55.   Intr($15, regs);
  56. END;
  57.  
  58. PROCEDURE SetWriteRegister(Farbe : BYTE);
  59.                        { setzt die Farbebene zum Schreiben }
  60. VAR regs : Registers;
  61. BEGIN
  62.   regs.ah := 3;
  63.   regs.al := Farbe;
  64.   Intr($15, regs);
  65. END;
  66.  
  67. PROCEDURE ClearDevice;                { Bildschirm löschen }
  68. BEGIN
  69.   port[$3dd] := $0f;
  70.   graph.cleardevice;          { Löschroutine aus GRAPH.TPU }
  71. END;
  72.  
  73. PROCEDURE SetColor(Farbe : WORD);
  74. VAR regs : Registers;
  75. BEGIN
  76.   SetWriteRegister(Farbe);
  77.   ActColor := Farbe;
  78.     { globale Variable wird auf die aktuelle Farbe gesetzt }
  79. END;
  80.  
  81. PROCEDURE PutPixel(x, y : INTEGER; pixel : WORD);
  82. VAR regs : Registers;  i, k : BYTE;
  83. BEGIN
  84.   FOR i := 0 TO 3 DO BEGIN
  85.     k := 1 SHL i;
  86.     SetReadRegister(i);
  87.     SetWriteRegister(k);
  88.     IF (pixel AND k) = 0 THEN Graph.PutPixel(x, y, 0)
  89.                          ELSE Graph.PutPixel(x, y, 1);
  90.   END;
  91. END;
  92.  
  93. PROCEDURE Bar(x1, y1, x2, y2 : INTEGER);
  94. VAR regs : Registers;  i, k : BYTE;
  95.     FillStyle : FillSettingsType;
  96. BEGIN
  97.   GetFillSettings(FillStyle);
  98.   FOR i := 0 TO 3 DO BEGIN
  99.     k := 1 SHL i;
  100.     SetReadRegister(i);
  101.     SetWriteRegister(k);
  102.     IF (ActColor AND k) = 0 THEN BEGIN
  103.       SetFillStyle(FillStyle.Pattern, 0);
  104.       Graph.Bar(x1, y1, x2, y2)
  105.     END ELSE BEGIN
  106.       SetFillStyle(FillStyle.Pattern, 1);
  107.       Graph.Bar(x1, y1, x2, y2);
  108.     END;
  109.   END;
  110. END;
  111.  
  112. PROCEDURE Circle(x, y : INTEGER; radius : WORD);
  113. VAR regs : Registers;  i, k : BYTE;
  114. BEGIN
  115.   FOR i := 0 TO 3 DO BEGIN
  116.     k := 1 SHL i;
  117.     SetReadRegister(i);
  118.     SetWriteRegister(k);
  119.     IF (ActColor AND k) <> 0 THEN
  120.       Graph.Circle(x, y, radius);
  121.   END;
  122. END;
  123.  
  124. PROCEDURE FloodFill(x, y : INTEGER; border : WORD);
  125. VAR i, k : BYTE;
  126. BEGIN
  127.   FOR i := 0 TO 3 DO BEGIN
  128.     k := 1 SHL i;
  129.     SetReadRegister(i);
  130.     SetWriteRegister(k);
  131.     IF (Actcolor AND k) <> 0 THEN
  132.       Graph.FloodFill(x, y, border);
  133.   END;
  134. END;
  135. { Randbegrenzung muß in der Farbe actcolor vorhanden sein! }
  136.  
  137. FUNCTION GetPixel(x, y : INTEGER) : WORD;
  138. VAR i, k : BYTE;  f : ARRAY [0..3] OF WORD;
  139. BEGIN
  140.   FOR i := 0 TO 3 DO BEGIN
  141.     SetReadRegister(i);
  142.     f[i] := Graph.GetPixel(x, y);
  143.   END;
  144.   GetPixel := f[0] + 2*f[1] + 4*f[2] + 8*f[3];
  145. END;
  146.  
  147. END.
  148. (* ------------------------------------------------------ *)
  149. (*                Ende von SGRAPH.PAS                     *)