home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 11 / dtp / bezmal.pas < prev    next >
Pascal/Delphi Source File  |  1990-10-04  |  8KB  |  288 lines
  1. {$A+,B-,D+,E-,F+,I-,L+,N-,O-,R-,S-,V-}
  2. {$M 16384,0,655360}
  3. (* ------------------------------------------------------ *)
  4. (*                       BEZMAL.PAS                       *)
  5. (*     Programm zur Demonstration der Unit BEZIER.PAS     *)
  6. (*                Turbo Pascal 5.0 und 5.5                *)
  7. (*                   (c) 1990 TOOLBOX                     *)
  8. (* ------------------------------------------------------ *)
  9.  
  10. PROGRAM BezDemo;
  11.  
  12. USES Graph, Crt, Bezier, txKeys;
  13.  
  14. CONST BGIPath            = '';
  15.       CursorOK : BOOLEAN = TRUE;
  16.  
  17. VAR   i                 : WORD;
  18.       GD, GM, AnzPunkte : INTEGER;
  19.       Punkte            : BezPoints;
  20.       x, y, MaxY        : INTEGER;
  21.       DemoLineColor,
  22.       StartColor,
  23.       StuetzColor,
  24.       BezierColor       : WORD;
  25.       Taste             : KeyRec;
  26.       EndPoint          : PointType;
  27.  
  28. PROCEDURE InitGrafik;
  29. BEGIN
  30.   DetectGraph(GD, GM);
  31.   CASE GD OF
  32.     MCGA,
  33.     CGA: BEGIN
  34.            GM            := CGAC0;
  35.            StartColor    := 3;
  36.            StuetzColor   := 2;
  37.            BezierColor   := 1;
  38.            DemoLineColor := 2;
  39.          END;
  40.     EGA,
  41.     EGA64,
  42.     VGA: BEGIN
  43.            StartColor    := Yellow;
  44.            StuetzColor   := LightRed;
  45.            BezierColor   := White;
  46.            DemoLineColor := Green;
  47.          END;
  48.     HercMono:
  49.          BEGIN
  50.            StartColor    := 1;
  51.            StuetzColor   := 1;
  52.            BezierColor   := 1;
  53.            DemoLineColor := 1;
  54.          END;
  55.   END;
  56.   InitGraph(GD, GM, BGIPath);
  57.   SetTextStyle(DefaultFont, HorizDir, 1);
  58.   SetTextJustify(CenterText, TopText);
  59.   MaxY:=GetMaxY - 3 * TextHeight('X');
  60.   SetColor(BezierColor);
  61.   Rectangle(0, 0, GetMaxX, MaxY);
  62.   Rectangle(0, MaxY, GetMaxX, GetMaxY);
  63.   SetViewPort(1, 1, GetMaxX-1, MaxY-1, TRUE);
  64. END;
  65.  
  66. PROCEDURE CloseGrafik;
  67. BEGIN
  68.   CloseGraph;
  69. END;
  70.  
  71. PROCEDURE Schrift(Zeile1, Zeile2: STRING);
  72. { schreibt Text am unteren Bildschirmrand }
  73. BEGIN
  74.   SetViewPort(1, MaxY+1, GetMaxX-1, GetMaxY-1, ClipOn);
  75.   ClearViewPort;
  76.   SetColor(StartColor);
  77.   OutTextXY(GetMaxX DIV 2, 1, Zeile1);
  78.   OutTextXY(GetMaxX DIV 2,
  79.             3*TextHeight('X') DIV 2+1, Zeile2);
  80.   SetViewPort(1, 1, GetMaxX-1, MaxY-1, ClipOn);
  81. END;
  82.  
  83. PROCEDURE Add(VAR Source: INTEGER; Min, Max: INTEGER;
  84.               Step: SHORTINT; Wrap: BOOLEAN);
  85.  { Add erhöht oder erniedrigt die als "Source" übergebene
  86.    Variable. Min und Max sind die erlaubten Grenzen, Wrap
  87.    schaltet das Wrapping bei Über- und Unterschreitung
  88.    der zulässigen Minimal- oder Maximalwerte ein und aus   }
  89. VAR
  90.   WrapNoetig : BOOLEAN;
  91.   SourceAlt  : BYTE;
  92. BEGIN
  93.   WrapNoetig := (Source+Step > Max) OR (Source+Step < Min);
  94.   CASE WrapNoetig OF
  95.     TRUE:   IF Wrap THEN
  96.               IF Step > 0 THEN
  97.                 Source := Min
  98.               ELSE
  99.                 Source := Max
  100.             ELSE
  101.               IF Step > 0 THEN
  102.                 Source := Max
  103.               ELSE
  104.                 Source := Min;
  105.     FALSE:  Inc(Source, Step);
  106.   END;
  107. END;
  108.  
  109. PROCEDURE Cursor(VAR x, y: INTEGER; VAR OK: BOOLEAN);
  110.          { Fadenkreuz-Cursor; übergibt die
  111.            Bildschirm-Koordinaten in den Variablen x und y }
  112. VAR
  113.   ch         : CHAR;
  114.   XAlt, YAlt : INTEGER;
  115. CONST
  116.   Step: BYTE = 2;
  117.  
  118.   PROCEDURE Draw;                    { zeichnet den Cursor }
  119.   BEGIN
  120.     Line(0, y, GetMaxX, y);
  121.     Line(x, 0, x, MaxY);
  122.   END;
  123.  
  124. BEGIN
  125.   XAlt:=x;                  { Original-Koordinaten sichern }
  126.   YAlt:=y;
  127.   SetWriteMode(XORPut);
  128.   SetColor(BezierColor);
  129.   REPEAT
  130.     Draw;
  131.     ScanKey(Taste);
  132.     Draw;
  133.     CASE Taste.Typ OF
  134.       KeyLinks  : Add(x, 0, GetMaxX, -Step, TRUE);
  135.       KeyRechts : Add(x, 0, GetMaxX, Step, TRUE);
  136.       KeyOben   : Add(y, 0, MaxY, -Step, TRUE);
  137.       KeyUnten  : Add(y, 0, MaxY, Step, TRUE);
  138.       KeySpace  : IF Step = 2 THEN   { Schrittweite ändern }
  139.                     Step := 15
  140.                   ELSE
  141.                     Step := 2;
  142.     END;
  143.   UNTIL Taste.Typ IN [KeyReturn, KeyEsc];
  144.   OK := (Taste.Typ = KeyReturn);
  145.   IF NOT OK THEN BEGIN              { Mit <Esc> verlassen: }
  146.     x:=XAlt;           { Original-Koordinaten restaurieren }
  147.     y:=YAlt;
  148.   END;
  149.   SetWriteMode(CopyPut);
  150. END;
  151.  
  152. PROCEDURE ShowPoint(x, y : INTEGER; Color: WORD);
  153.                 { zeichnet die Markierungen für die Punkte }
  154. BEGIN
  155.  SetColor(Color);
  156.  Circle(Round(x), Round(y), 6);
  157.  PutPixel(Round(x), Round(y), Color);
  158. END;
  159.  
  160. PROCEDURE GetPoint(VAR x, y: INTEGER; Index, Color: WORD);
  161.    { Eingabe der einzelnen Punkte mittels Fadenkreuzcursor }
  162. CONST
  163.   OK: BOOLEAN = FALSE;
  164. BEGIN
  165.   REPEAT
  166.     Cursor(x, y, OK);
  167.     IF NOT OK THEN BEGIN             { Abbruch durch <ESC> }
  168.       CloseGrafik;
  169.       Halt;
  170.     END;
  171.   UNTIL OK;
  172.   ShowPoint(x, y, Color);
  173.   Punkte[Index].x := x;
  174.   Punkte[Index].y := y;
  175. END;
  176.  
  177. PROCEDURE DoDemo;                 { Hauptprozedur für Demo }
  178. VAR
  179.   ch    : CHAR;
  180.   Index : INTEGER;
  181. CONST
  182.   Step  : BYTE = 5;
  183.  
  184.   PROCEDURE ZeichneKurve(Farbe : WORD);
  185.   VAR
  186.     i : BYTE;
  187.   BEGIN
  188.     SetColor(Farbe);
  189.     SetLineStyle(SolidLn, 0, ThickWidth);
  190.     FOR i:=1 TO AnzPunkte DO BEGIN
  191.                      { Punkte an die Unit BEZIER übergeben }
  192.       BezDat^.TempPoints^[1]^[i].x := Punkte[i].x;
  193.       BezDat^.TempPoints^[1]^[i].y := Punkte[i].y;
  194.     END;
  195.     BezDoBeziere;                         { Kurve zeichnen }
  196.     SetLineStyle(SolidLn, 0, NormWidth);
  197.   END;
  198.  
  199. BEGIN
  200.   Index:=2;
  201.   ZeichneKurve(BezierColor);
  202.   REPEAT
  203.     x:=Round(Punkte[Index].x);
  204.     y:=Round(Punkte[Index].y);
  205.     IF GD = HercMono THEN
  206.       SetLineStyle(SolidLn, 0, ThickWidth);
  207.     ShowPoint(x, y, BezierColor);
  208.     SetLineStyle(SolidLn, 0, NormWidth);
  209.     ShowPoint(Round(Punkte[1].x),
  210.               Round(Punkte[1].y),StartColor);
  211.     ShowPoint(Round(Punkte[AnzPunkte].x),
  212.               Round(Punkte[AnzPunkte].y), StartColor);
  213.     ScanKey(Taste);
  214.     IF GD = HercMono THEN
  215.       SetLineStyle(SolidLn, 0, ThickWidth);
  216.     ShowPoint(x, y, 0);
  217.     SetLineStyle(SolidLn, 0, NormWidth);
  218.     CASE Taste.Typ OF
  219.  
  220.       KeyLinks..KeyUnten:
  221.       BEGIN
  222.         ZeichneKurve(0);              { alte Kurve löschen }
  223.         CASE Taste.Typ OF
  224.           KeyLinks:  Add(x, 0, GetMaxX, -Step, TRUE);
  225.           KeyRechts: Add(x, 0, GetMaxX, Step, TRUE);
  226.           KeyOben:   Add(y, 0, MaxY, -Step, TRUE);
  227.           KeyUnten:  Add(y, 0, MaxY, Step, TRUE);
  228.         END;
  229.         Punkte[Index].x := x;
  230.         Punkte[Index].y := y;
  231.         ZeichneKurve(BezierColor);            { neue Kurve }
  232.       END;
  233.  
  234.       KeySpace:                      { Schrittweite ändern }
  235.        IF Step = 5 THEN Step := 15
  236.                    ELSE Step := 5;
  237.  
  238.       Zeichen:
  239.         CASE Taste.Zeichen OF
  240.           '+': BEGIN             { nächsten Punkt anwählen }
  241.                  ShowPoint(Round(Punkte[Index].x),
  242.                    Round(Punkte[Index].y), StuetzColor);
  243.                  Add(Index, 2, AnzPunkte-1, 1, TRUE);
  244.                END;
  245.           '-': BEGIN              { vorigen Punkt anwählen }
  246.                  ShowPoint(Round(Punkte[Index].x),
  247.                    Round(Punkte[Index].y), StuetzColor);
  248.                  Add(Index, 2, AnzPunkte-1, -1, TRUE);
  249.                END;
  250.         END;
  251.     END;
  252.   UNTIL Taste.Typ = KeyEsc;
  253.   FOR i := 1 TO AnzPunkte DO
  254.     ShowPoint(Round(Punkte[i].x),
  255.               Round(Punkte[i].y), 0);
  256.   ZeichneKurve(BezierColor);
  257. END;
  258.  
  259. BEGIN
  260.   AnzPunkte := 4;
  261.   InitGrafik;
  262.   BezInitBezier(AnzPunkte);
  263.   EndPoint.x := GetMaxX DIV 2;
  264.   EndPoint.y := MaxY DIV 2;
  265.   x := EndPoint.x;
  266.   y := EndPoint.y;
  267.  
  268.   REPEAT
  269.     Schrift('Start- und Endpunkt definieren',
  270.             '<SPACE> Schrittweite <ESC> Abbruch');
  271.     GetPoint(EndPoint.x, EndPoint.y, 1, StartColor);
  272.     x := EndPoint.x;
  273.     y := EndPoint.y;
  274.     GetPoint(x, y, AnzPunkte, StartColor);
  275.     EndPoint.x := x;
  276.     EndPoint.y := y;
  277.     Schrift('Stützpunkte definieren',
  278.             '<SPACE> Schrittweite <ESC> Abbruch');
  279.     FOR i := 2 TO AnzPunkte - 1 DO
  280.       GetPoint(x, y, i, StuetzColor);
  281.     Schrift('Stützpunkte verschieben mit <CURSOR>',
  282.             '<+/-> Punkt wählen <SPACE> Schrittweite');
  283.     DoDemo;
  284.   UNTIL FALSE;
  285.   BezDisposeBezier;
  286. END.
  287.  
  288.