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