home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 10 / praxis / pal_eddi.pas < prev    next >
Pascal/Delphi Source File  |  1990-07-11  |  5KB  |  200 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      PAL-EDDI.PAS                      *)
  3. (*        Paletten-Editor für EGA- und VGA-Karten         *)
  4. (*               Turbo Pascal Version 5.5                 *)
  5. (*           (c) 1990 Gerald Arend & TOOLBOX              *)
  6. (* ------------------------------------------------------ *)
  7.  
  8. {$DEFINE VGA}      { Für EGA-Karten $DEFINE EGA eingeben! }
  9. {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  10.  
  11. PROGRAM Pal_Eddi;
  12.  
  13. USES Crt, Graph;
  14.  
  15. PROCEDURE ShowValue(x, y: INTEGER; Wert: LONGINT;
  16.                     Laenge: BYTE); FORWARD;
  17. PROCEDURE DrawFrame(n: BYTE; y: INTEGER); FORWARD;
  18. PROCEDURE Add(VAR Source: BYTE; Min, Max: INTEGER;
  19.               Step: SHORTINT; Wrap: BOOLEAN); FORWARD;
  20. PROCEDURE CycleDemo; FORWARD;
  21.  
  22. {$IFDEF VGA}
  23. {$I VGACOLOR.INC}
  24. {$ELSE}
  25. {$I EGACOLOR.INC}
  26. {$ENDIF}
  27.  
  28. PROCEDURE StartGrafik(GD, GM: INTEGER);
  29. BEGIN
  30.   InitGraph(GD, GM, '');
  31.   IF GraphResult<>0 THEN
  32.   BEGIN
  33.     RestoreCrtMode;
  34.     Writeln(^G, 'Ich konnte die Grafik nicht starten '+
  35.             '- Fehler ', GrError:3, ': ',
  36.             GraphErrorMsg(GrError));
  37.     Writeln('Steht der BGI-Treiber EGAVGA.BGI im gleichen '+
  38.             'Verzeichnis?');
  39.     Halt;
  40.   END;
  41.   SetTextStyle(DefaultFont, HorizDir, 1);
  42.   SetTextJustify(LeftText, BottomText);
  43.   SetColor(MaxColors);
  44.   SetWriteMode(XORPut);
  45.   TBreite:=TextWidth('X');
  46.   THoehe:=TextHeight('X');
  47. END;
  48.  
  49. PROCEDURE ShowValue(x, y: INTEGER; Wert: LONGINT;
  50.                     Laenge: BYTE);
  51.     { Zeigt eine Zahl im Grafikmodus auf dem Bildschirm an }
  52. VAR
  53.   ValStr: STRING[20];
  54. BEGIN
  55.   Str(Wert:Laenge, ValStr);
  56.   SetColor(0);
  57.   SetFillStyle(SolidFill, 0);
  58.   Bar(x,                             { Hintergrund löschen }
  59.       y-TextHeight('X'),
  60.       x+Laenge*TextWidth('X'),
  61.       y);
  62.   SetColor(MaxColors);
  63.   OutTextXY(x, y, ValStr);
  64. END;
  65.  
  66. PROCEDURE Add(VAR Source: BYTE; Min, Max: INTEGER;
  67.               Step: SHORTINT; Wrap: BOOLEAN);
  68.  { Add erhöht oder erniedrigt die als "Source" übergebene
  69.    Variable. Min und Max sind die erlaubten Grenzen, Wrap
  70.    schaltet das Wrapping bei Über- und Unterschreitung
  71.    der zulässigen Minimal- oder Maximalwerte ein und aus   }
  72. VAR
  73.   WrapNoetig: BOOLEAN;
  74.   SourceAlt: BYTE;
  75. BEGIN
  76.   WrapNoetig:=(Source+Step>Max) OR (Source+Step<Min);
  77.   CASE WrapNoetig OF
  78.     TRUE:   IF Wrap THEN
  79.               IF Step>0 THEN
  80.                 Source:=Min
  81.               ELSE
  82.                 Source:=Max
  83.             ELSE
  84.               IF Step>0 THEN
  85.                 Source:=Max
  86.               ELSE
  87.                 Source:=Min;
  88.     FALSE:  Inc(Source, Step);
  89.   END;
  90. END;
  91.  
  92. PROCEDURE DrawFrame(n: BYTE; y: INTEGER);
  93.                { Zeichnet ein Rechteck um die aktive Farbe }
  94. BEGIN
  95.   Rectangle(Succ(n)*GetMaxX DIV (MaxColors+2),
  96.             2*TextHeight('X'),
  97.             (n+2)*GetMaxX DIV (MaxColors+2)-1, y);
  98. END;
  99.  
  100. PROCEDURE CycleDemo;                       { Color-Cycling }
  101. VAR
  102.   x0, y0, ri, ra: INTEGER;
  103.   Farben, FarbenAlt: PaletteType;
  104.   ch: CHAR;
  105.   Aktuell: BYTE;
  106.   Hilfe: SHORTINT;
  107.   w, sinw, cosw: REAL;
  108.   XAsp, YAsp: WORD;
  109.  
  110.   PROCEDURE DrawFigur(xfi, yfi, xfa, yfa: SHORTINT);
  111.                                 { Zeichnet die Linienfigur }
  112.   VAR
  113.     x: INTEGER;
  114.   BEGIN
  115.     ClearDevice;
  116.     FOR x:=0 TO 300 DO
  117.     BEGIN
  118.       SetColor(x MOD MaxColors+1);
  119.       w:=x*Pi/150;
  120.       sinw:=Sin(w);
  121.       cosw:=Cos(w);
  122.       Line(x0+Round(ri*cosw*xfi*(YAsp DIV XAsp)),
  123.            y0+Round(ri*sinw*yfi),
  124.            x0+Round(ra*sinw*xfa*(YAsp DIV XAsp)),
  125.            y0+Round(ra*cosw*yfa));
  126.     END;
  127.   END;
  128.  
  129.   PROCEDURE Cycle;           { eigentliche Cycling-Routine }
  130.   VAR
  131.     x, n: BYTE;
  132.     Timer: WORD;
  133.   CONST
  134.     DelayTime = 500;   { Wie lange soll jedes Demo laufen? }
  135.   BEGIN
  136.     n:=0;
  137.     REPEAT
  138.       Timer:=0;
  139.       Add(n, 1, 5, 1, TRUE);
  140.       CASE n OF
  141.         1: DrawFigur(1, 1, 1, 1);
  142.         2: DrawFigur(-2, 1, 0, -1);
  143.         3: DrawFigur(2, -2, -0, 1);
  144.         4: DrawFigur(0, 1, 1, 1);
  145.         5: DrawFigur(-1, 1, 1, 1);
  146.       END;
  147.       REPEAT
  148.         Inc(Timer);
  149.                            { Die Farben der Palette
  150.                              werden zyklisch vertauscht... }
  151.         Hilfe:=Farben.Colors[1];
  152.         FOR x:=2 TO MaxColors DO
  153.           Farben.Colors[Pred(x)]:=Farben.Colors[x];
  154.         Farben.Colors[MaxColors]:=Hilfe;
  155.                               { ...und auf einen Schlag die
  156.                                 ganze Palette neu gesetzt! }
  157.         SetAllPalette(Farben);
  158.       UNTIL (Timer>DelayTime) or KeyPressed;
  159.       IF KeyPressed THEN
  160.       BEGIN
  161.         ch:=ReadKey;
  162.         IF ch=#0 THEN
  163.           ch:=ReadKey;
  164.       END;
  165.     UNTIL ch=#27; { Ein Druck auf <Esc> beendet den Zauber }
  166.   END;
  167.  
  168. BEGIN
  169.   ClearDevice;
  170.   GetAspectRatio(XAsp, YAsp);
  171.   SetWriteMode(CopyPut);
  172.   SetLineStyle(SolidLn, 0, ThickWidth);
  173.   GetPalette(Farben);
  174.   FarbenAlt:=Farben;            { Original-Palette sichern }
  175.   x0:=GetMaxX DIV 2;
  176.   y0:=GetMaxY DIV 2;
  177.   ri:=GetMaxY DIV 5;
  178.   ra:=GetMaxY DIV 2-2;
  179.   Cycle;
  180.   ClearDevice;
  181.   SetAllPalette(FarbenAlt);
  182.   SetWriteMode(XORPut);
  183.   SetLineStyle(SolidLn, 0, NormWidth);
  184. END;
  185.  
  186. { Hauptprogramm }
  187. BEGIN
  188. {$IFDEF VGA}
  189.   StartGrafik(VGA, VGAHi);
  190. {$ELSE}
  191.   StartGrafik(EGA, EGAHi);
  192. {$ENDIF}
  193.   InitPalette;
  194.   REPEAT
  195.     DrawBars;
  196.     ChangeColors;
  197.   UNTIL Ende;
  198.   RestoreCrtMode;
  199. END.
  200.