home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 19 / pal / paleddi2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-08-01  |  5.4 KB  |  203 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      PALEDDI2.PAS                      *)
  3. (*        Paletten-Editor für EGA- und VGA-Karten         *)
  4. (*                  Turbo Pascal ab 5.0                   *)
  5. (*           (c) 1990 Gerald Arend & TOOLBOX              *)
  6. (* ------------------------------------------------------ *)
  7.  
  8. {$DEFINE VGA}       { Für EGA-Karten $DEFINE EGA eingeben! }
  9. {$B-,D-,F-,I-,L-,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 VGACOL2.INC}
  24. {$ELSE}
  25. {$I EGACOL2.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)*sinw;
  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.     ch:=#0;
  138.     REPEAT
  139.       Timer:=0;
  140.       Add(n, 1, 7, 1, TRUE);
  141.       CASE n OF
  142.         1: DrawFigur(2, 0, -1, 2);
  143.         2: DrawFigur(-1, 2, -1, 1);
  144.         3: DrawFigur(1, 1, 1, 1);
  145.         4: DrawFigur(-3, 2, 0, -2);
  146.         5: DrawFigur(1, -2, 1, 2);
  147.         6: DrawFigur(0, 1, 1, 1);
  148.         7: DrawFigur(-1, 2, 1, 1);
  149.       END;
  150.       REPEAT
  151.         Inc(Timer);
  152.                            { Die Farben der Palette
  153.                              werden zyklisch vertauscht... }
  154.         Hilfe:=Farben.Colors[1];
  155.         FOR x:=2 TO MaxColors DO
  156.           Farben.Colors[Pred(x)]:=Farben.Colors[x];
  157.         Farben.Colors[MaxColors]:=Hilfe;
  158.                               { ...und auf einen Schlag die
  159.                                 ganze Palette neu gesetzt! }
  160.         SetAllPalette(Farben);
  161.       UNTIL (Timer>DelayTime) or KeyPressed;
  162.       IF KeyPressed THEN
  163.       BEGIN
  164.         ch:=ReadKey;
  165.         IF ch=#0 THEN
  166.           ch:=ReadKey;
  167.       END;
  168.     UNTIL ch=#27; { Ein Druck auf <Esc> beendet den Zauber }
  169.   END;
  170.  
  171. BEGIN
  172.   ClearDevice;
  173.   GetAspectRatio(XAsp, YAsp);
  174.   SetWriteMode(CopyPut);
  175.    SetLineStyle(SolidLn, 0, ThickWidth);
  176.   GetPalette(Farben);
  177.   FarbenAlt:=Farben;            { Original-Palette sichern }
  178.   x0:=GetMaxX DIV 2;
  179.   y0:=GetMaxY DIV 2;
  180.   ri:=GetMaxY DIV 5;
  181.   ra:=GetMaxY DIV 2-2;
  182.   Cycle;
  183.   ClearDevice;
  184.   SetAllPalette(FarbenAlt);
  185.   SetWriteMode(XORPut);
  186.   SetLineStyle(SolidLn, 0, NormWidth);
  187. END;
  188.  
  189. { Hauptprogramm }
  190. BEGIN
  191. {$IFDEF VGA}
  192.   StartGrafik(VGA, VGAHi);
  193. {$ELSE}
  194.   StartGrafik(EGA, EGAHi);
  195. {$ENDIF}
  196.   InitPalette;
  197.   REPEAT
  198.     DrawBars;
  199.     ChangeColors;
  200.   UNTIL Ende;
  201.   RestoreCrtMode;
  202. END.
  203.