home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 09 / grafik6 / grafsys.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-03-25  |  6.9 KB  |  199 lines
  1. (*-------------------------------------------------------------------------*)
  2. (*                             GRAFSYS.PAS                                 *)
  3. (*   Grafik-Initialisierungs- und -Abschlussprozeduren, Punkt- und Farb-   *)
  4. (*                       setzung fuer die Grafikserie                      *)
  5. (*                                                                         *)
  6. (* Hier implementiert mit Turbo-Pascal auf einem MS-DOS Rechner mit der    *)
  7. (* Color-Graphikkarte CGA                                                  *)
  8. (*-------------------------------------------------------------------------*)
  9. (*                        Zeichenfarbe setzen:                             *)
  10.  
  11. PROCEDURE Set_Pen_Color (color: Sys_Colors);
  12.  
  13. BEGIN
  14.   Pen_Color := Color;
  15.   HiResColor(color);
  16. END;
  17.  
  18. (*-------------------------------------------------------------------------*)
  19. (*                      Hintergrundfarbe setzen:                           *)
  20.  
  21. PROCEDURE Set_Background (color: Sys_Colors);
  22.  
  23. BEGIN
  24.   GraphBackground(color);
  25. END;
  26.  
  27. (*-------------------------------------------------------------------------*)
  28. (*                        Grafikmodus aktivieren:                          *)
  29.  
  30. PROCEDURE Enter_Graphic;
  31.  
  32. BEGIN
  33.   HiRes;                       (* Aufloesung hier 640x200 Punkte, 2 Farben *)
  34.   Set_Background(Black);                      (* Farbbezeichner sind in    *)
  35.   Set_Pen_Color(White);                       (* Turbo-Pascal vordefiniert *)
  36.   Pen_Xpos := 0;                 (* 'Zeichenstift' auf definierte Position *)
  37.   Pen_Ypos := 0;
  38. END;
  39.  
  40. (*-------------------------------------------------------------------------*)
  41. (*                       Grafikmodus verlassen:                            *)
  42.  
  43. PROCEDURE Exit_Graphic;
  44.  
  45. BEGIN
  46.   TextMode;
  47. END;
  48.  
  49. (*-------------------------------------------------------------------------*)
  50. (*   Punkt auf die vom System vorgegebenen Bildschirmkoordinaten setzen:   *)
  51.  
  52. PROCEDURE Point_System (x: x_Koord_Sys; y: y_Koord_Sys);
  53.  
  54. BEGIN
  55.   Plot(x, y, Ord(Pen_Color>0));
  56. END;
  57.  
  58. (*-------------------------------------------------------------------------*)
  59. (* Punkt aus unserem Koordinatensystem (Ursprung (0,0) links unten!) in
  60.    Bildschirmkoordinaten uebertragen. Falls beide Systeme gleich, sollten
  61.    aus Geschwindigkeitsgruenden die Fallunterscheidung sowie die Additionen
  62.    von 'ScreenXmin_Sys' und 'ScreenYmin_Sys' weggelassen werden!           *)
  63.  
  64. PROCEDURE Point (x: x_Koord; y: y_Koord);
  65.  
  66. BEGIN
  67.   IF Origin_is_Top THEN
  68.     Point_System(x + ScreenXmin_Sys, ScreenYmax - y + ScreenYmin_Sys)
  69.   ELSE
  70.     Point_System(x + ScreenXmin_Sys, y + ScreenYmin_Sys);
  71.   Pen_Xpos := x;
  72.   Pen_Ypos := y;
  73. END;
  74.  
  75. (*-------------------------------------------------------------------------*)
  76. (* Point-SWAP fuer die Graphikserie. Vertauscht die Koord. zweier Punkte.  *)
  77.  
  78. PROCEDURE point_swap (VAR x1, y1, x2, y2: INTEGER);
  79.  
  80. VAR hilf: INTEGER;
  81.  
  82. BEGIN
  83.   hilf := x1;  x1 := x2;  x2 := hilf;
  84.   hilf := y1;  y1 := y2;  y2 := hilf;
  85. END;
  86.  
  87. (*-------------------------------------------------------------------------*)
  88. (*   Punkt auf den vom System vorgegebenen Bildschirm-Koordinaten testen:  *)
  89. (*   TRUE, wenn Punkt die akt. Farbe von Pen_Color hat, sonst FALSE!       *)
  90. (*   Hier muß die entsprechende Funktion der verw. Implementation entspr.  *)
  91. (*   gegen die Turbo Pascal-Funktion ausgetauscht werden!                  *)
  92.  
  93. function GetPixel_System (x: x_Koord_Sys;
  94.                           y: y_Koord_Sys;
  95.                           Color: Sys_Colors): boolean;
  96.  
  97. begin
  98.   GetPixel_System := (GetDotColor(x,y) > 0) AND (Color = Pen_Color)
  99. end;
  100.  
  101. (*-------------------------------------------------------------------------*)
  102. (*              Punkt unseres Koordinaten-Systems testen:                  *)
  103.  
  104. function GetPixel (x: x_Koord; y: y_Koord; Color: Sys_Colors): boolean;
  105.  
  106. begin
  107.   if Origin_is_Top then
  108.     GetPixel := GetPixel_System(x + ScreenXmin_Sys,
  109.                                 ScreenYmax - Y + ScreenYmin_Sys,
  110.                                 Color)
  111.   else
  112.     GetPixel := GetPixel_System(x + ScreenXmin_Sys,
  113.                                 y + ScreenYmin_Sys,
  114.                                 color)
  115. end;
  116.  
  117.  
  118. (*-------- Erweiterung zu GRAFSYS.PAS um Fensterinhalte speichern und ---- *)
  119. (*                         rekonstruieren zu können.                       *)
  120.  
  121.    (*------------------- Systemabhaengiger Teil --------------------------*)
  122.    (* Implementation für Turbo Pascal auf MS-DOS Rechner mit CGA-Karte.   *)
  123.    (*      !!!! GRAPH.P muss im Hauptprogramm included werden !!!!        *)
  124.  
  125.    procedure StoreArea(x1 : x_Koord_Sys;
  126.                        y1 : y_Koord_Sys;
  127.                        x2 : x_Koord_Sys;
  128.                        y2 : y_Koord_Sys;
  129.                        var Inhalt : WinBackGround );
  130.  
  131.    begin
  132.      (* Ggf. pruefen, ob noch genug Platz auf dem Heap vorhanden ist ! *)
  133.      new(Inhalt);   (* Speicherplatz anfordern *)
  134.      GetPic(Inhalt^,x1,y1,x2,y2)   (* <--- Hier anpassen *)
  135.    end;
  136.  
  137.  
  138.  
  139.    procedure RestoreArea(var Inhalt : WinBackGround;
  140.                          x : x_Koord_Sys;
  141.                          y : y_Koord_Sys             );
  142.  
  143.    begin
  144.      PutPic(Inhalt^,x,y);  (* <--- Hier anpassen *)
  145.      Dispose(Inhalt)
  146.    end;
  147.  
  148.    (*                                                                     *)
  149.    (*-------------- Ende des systemabhaengigen Teils ---------------------*)
  150.  
  151.  
  152.  
  153. procedure StoreViewport( x1 : x_Koord;            (* Viewport- *)
  154.                          y1 : y_Koord;            (* Ausschnitt *)
  155.                          x2 : x_Koord;
  156.                          y2 : y_Koord;
  157.                          var Inhalt : WinBackground );
  158.  
  159. begin
  160.   if Origin_is_Top then
  161.     StoreArea(x1 + ScreenXmin_Sys,
  162.               ScreenYmax - y1 + ScreenYmin_Sys,
  163.               x2 + ScreenXmin_Sys,
  164.               ScreenYmax - y2 + ScreenYmin_Sys,
  165.               Inhalt                                                 )
  166.   else
  167.     StoreArea(x1 + ScreenXmin_Sys, y1 + ScreenYmin_Sys,
  168.               x2 + ScreenXmin_Sys, y2 + ScreenYmin_Sys,
  169.               Inhalt                                     )
  170.  end;
  171.  
  172.  
  173. procedure RestoreViewport( var Inhalt : WinBackground;
  174.                            x : x_Koord; y : y_Koord    );
  175.                            (* Untere linke Ecke *)
  176.  
  177. begin
  178.   if Origin_is_Top then
  179.     RestoreArea(Inhalt,
  180.                 x + ScreenXmin_Sys, ScreenYmax - y + ScreenYmin_Sys )
  181.   else
  182.     RestoreArea(Inhalt,
  183.                 x + ScreenXmin_Sys, y + ScreenYmin_Sys)
  184. end;
  185.  
  186. (*------------ Prozedur zum Vertauschen zweier Werte ---------------------*)
  187.  
  188. procedure RealSwap( var a,b : real ); (* Zum vertauschen zweier Realwerte *)
  189.  
  190. var hilf : real;
  191.  
  192. begin
  193.   hilf := a;  a := b;  b := hilf
  194. end;
  195.  
  196.  
  197. (*-------------------------------------------------------------------------*)
  198. (*                          Ende von GRAFSYS.PAS                           *)
  199.