home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 01 / tricks / zykloid.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1990-10-29  |  3.4 KB  |  116 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    ZYKLOID.PAS                         *)
  3. (*                  Turbo Pascal 5.5                      *)
  4. (*           (c) 1990 Alfons Vogel & TOOLBOX              *)
  5. (* ------------------------------------------------------ *)
  6. USES Graph, Crt;
  7.  
  8. VAR
  9.   Gd, Gm, LochStep, LochStart,
  10.   LochEnde, X0, Y0, ZRing, ZRad : INTEGER;
  11.   RRing, RRad, WRing, WRad,
  12.   StepRing, StepRad, ZwoPi,
  13.   XStart, YStart, XP, YP        : REAL;
  14.   ch                            : CHAR;
  15.  
  16. PROCEDURE StartGrafik;             { Grafik initialisieren }
  17. BEGIN
  18.   DetectGraph(Gd, Gm);
  19.   InitGraph(Gd, Gm, '');
  20.   IF GraphResult<>0 THEN BEGIN
  21.     Write(^G, 'Fehler beim Initialisieren der BGI-Grafik!');
  22.     Halt(2);
  23.   END;
  24.   X0 := GetMaxX DIV 2;
  25.   Y0 := GetMaxY DIV 2;
  26.   RRing := GetMaxY DIV 2;
  27.   LochStep := 2;
  28. END;
  29.  
  30. PROCEDURE Input;                 { Eingabe aller Parameter }
  31. VAR
  32.   ch: CHAR;
  33. BEGIN
  34.   RestoreCrtMode;
  35.   ClrScr;
  36.   Window(20, 3, 60, 20);
  37.   WriteLn('Z Y K L O I D');
  38.   WriteLn('=============');
  39.   WriteLn;
  40.   WriteLn('(c) 1990 Alfons Vogel & TOOLBOX');
  41.   WriteLn;
  42.   Write('Anzahl Zähne Ring [Ende = 0]: ');
  43.   ReadLn(ZRing);
  44.   IF ZRing = 0 THEN Halt(0);
  45.   Write('Anzahl Zähne Rad            : ');
  46.   ReadLn(ZRad);
  47.   Write('Loch-Nr. Start              : ');
  48.   ReadLn(LochStart);
  49.   Write('Loch-Nr. Ende               : ');
  50.   ReadLn(LochEnde);
  51.   SetGraphMode(Gm);
  52. END;
  53.  
  54. PROCEDURE Zeichnen;
  55. VAR
  56.   AnzStepRing, c, d, x: INTEGER;
  57.   PRadX, PRadY        : REAL;
  58.   XAsp, YAsp          : WORD;
  59.   RUmX, RUmY          : REAL;
  60. BEGIN
  61.   SetBkColor(0);
  62.   ClearDevice;
  63.   GetAspectRatio(XAsp, YAsp);     { Verzerrung ausgleichen }
  64.   RRad := RRing * ZRad / ZRing;
  65.   RUmY := RRing - RRad;
  66.   RUmX := RUmY * YAsp / XAsp;
  67.   AnzStepRing := 5 * ((2 * ZRing) DIV ZRad);
  68.   StepRing := Pi / AnzStepRing;    { Winkelschritt im Ring }
  69.   StepRad := -StepRing * (ZRing / ZRad - 1);  { Winkel Rad }
  70.   FOR x := LochStart TO LochEnde DO BEGIN
  71.     SetColor(1 + x MOD GetMaxColor);
  72.     PRadY := RRad - LochStep * 2 * x - 8;    { Mittelpunkt }
  73.     PRadX := PRadY *YAsp / XAsp;             { des Rads    }
  74.     IF PRadX < 0 THEN Exit;
  75.     XStart := X0 + RUmX * Sin(0) + PRadX * Sin(0); { Start }
  76.     YStart := Y0 - RUmY * Cos(0) - PRadY * Cos(0);
  77.     MoveTo(Round(XStart), Round(YStart));
  78.     WRing := 0;
  79.     WRad := 0;
  80.     d := 0;
  81.     REPEAT                       { einzelne Kurve zeichnen }
  82.       FOR c := 1 TO 2 * AnzStepRing DO BEGIN  { ein Umlauf }
  83.         Inc(d);
  84.         WRad := StepRad * d;                  { Winkel Rad }
  85.         WRing := StepRing * c;            { Winkel im Ring }
  86.         XP := X0 + RUmX * Sin(WRing) + PRadX * Sin(WRad);
  87.         YP := Y0 - RUmY * Cos(WRing) - PRadY * Cos(WRad);
  88.         LineTo(Round(XP), Round(YP));
  89.         IF KeyPressed THEN BEGIN          { Unterbrechung? }
  90.           ch := ReadKey;
  91.           IF ch = #27 THEN BEGIN
  92.             RestoreCrtMode;
  93.             Halt(0);
  94.           END;
  95.         END;
  96.       END;
  97.     UNTIL (Abs(XStart-XP) < 0.01) AND         { Startpunkt }
  98.           (Abs(YStart-YP) < 0.01);            {  erreicht? }
  99.   END;
  100.   Write(^G);
  101. END;
  102.  
  103. BEGIN
  104.   ZwoPi := 2 * Pi;
  105.   StartGrafik;
  106.   REPEAT
  107.     Input;
  108.     Zeichnen;
  109.     ch := ReadKey;
  110.   UNTIL ch = #27;
  111.   RestoreCrtMode;
  112. END.
  113. (* ------------------------------------------------------ *)
  114. (*                Ende von ZYKLOID.PAS                    *)
  115.  
  116.