home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 19 / chngcol / chngcol.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1990-07-31  |  7.3 KB  |  236 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    CHNGCOL.PAS                         *)
  3. (*                    ChangeColor                         *)
  4. (*                 Turbo Pascal ab 5.0                    *)
  5. (*           (c) 1990 Gerald Arend & TOOLBOX              *)
  6. (* ------------------------------------------------------ *)
  7. {$B-,D-,I-,L-,O-,R-,S-,V-}
  8. {$M 16384,0,655360}
  9.  
  10. PROGRAM ChangeColor;
  11.  
  12. USES Crt, Graph, LoadPCX, Dos;
  13.  
  14. VAR
  15.   n: BYTE;
  16.   name: STRING;
  17.  
  18. PROCEDURE ChangeColors;      { Farben interaktiv verändern }
  19. TYPE
  20.   RGBRec = RECORD
  21.              RedVal, GreenVal, BlueVal: BYTE;
  22.            END;
  23. VAR
  24.   R: Registers;
  25.   VGAFarben, VGAFarbenAlt: ARRAY[0..15] OF RGBRec;
  26.   n, x: BYTE;
  27.   del: WORD;
  28.   ch: CHAR;
  29.   Farben, FarbenAlt: PaletteType;
  30.   ShowOtherColor: BOOLEAN;
  31.  
  32. CONST
  33.   Step = 1;
  34.   BlinkDelay: ARRAY[FALSE..TRUE] OF WORD = (60, 300);
  35.                  { Blinkgeschwindigkeit der angewählten Farbe }
  36.  
  37.   PROCEDURE Add(VAR Source: BYTE; Min, Max: INTEGER;
  38.                 Step: SHORTINT; Wrap: BOOLEAN);
  39.    { Add erhöht oder erniedrigt die als "Source" übergebene
  40.      Variable. Min und Max sind die erlaubten Grenzen, Wrap
  41.      schaltet das Wrapping bei Über- und Unterschreitung
  42.      der zulässigen Minimal- oder Maximalwerte ein und aus   }
  43.   VAR
  44.     WrapNoetig: BOOLEAN;
  45.     SourceAlt: BYTE;
  46.   BEGIN
  47.     WrapNoetig:=(Source+Step>Max) OR (Source+Step<Min);
  48.     CASE WrapNoetig OF
  49.       TRUE:   IF Wrap THEN
  50.                 IF Step>0 THEN
  51.                   Source:=Min
  52.                 ELSE
  53.                   Source:=Max
  54.               ELSE
  55.                 IF Step>0 THEN
  56.                   Source:=Max
  57.                 ELSE
  58.                   Source:=Min;
  59.       FALSE:  Inc(Source, Step);
  60.     END;
  61.   END;
  62.  
  63.   PROCEDURE SavePalette;
  64.   VAR
  65.     F : FILE;
  66.     i, j, c: BYTE;
  67.   BEGIN
  68.   { Die Prozeduren EGA2PCX und VGA2PCX aus PCXTOOLS.PAS arbeiten
  69.     leider nicht immer problemlos mit der BGI-Grafik zusammen;
  70.     daher hier die entsprechenden Routinen für BGI }
  71.  
  72.     IF EGAOnly THEN
  73.       FOR i:=0 TO MaxColors DO
  74.       BEGIN                         { EGA-Farben schreiben }
  75.         WITH Header DO
  76.         BEGIN
  77.           c:=BYTE(Farben.Colors[i]);
  78.           Palette[i, 0]:=
  79.             ((c AND 32) SHR 5) OR ((c AND 4) SHR 1);
  80.           Palette[i, 1]:=
  81.             ((c AND 16) SHR 4) OR (c AND 2);
  82.           Palette[i, 2]:=
  83.             ((c AND 8) SHR 3) OR ((c AND 1) SHL 1);
  84.         END;
  85.         FOR j:=0 TO 2 DO
  86.           CASE Header.Palette[i, j] OF
  87.             1: Header.Palette[i, j]:=85;
  88.             2: Header.Palette[i, j]:=170;
  89.             3: Header.Palette[i, j]:=225;
  90.           END;
  91.       END
  92.     ELSE
  93.       FOR j:=0 TO 15 DO             { VGA-Farben schreiben }
  94.       BEGIN
  95.         c:=Farben.Colors[j];
  96.         Header.Palette[j, 0]:=VGAFarben[c].RedVal SHL 2;
  97.         Header.Palette[j, 1]:=VGAFarben[c].GreenVal SHL 2;
  98.         Header.Palette[j, 2]:=VGAFarben[c].BlueVal SHL 2;
  99.       END;
  100.  
  101.     Assign(F, name);
  102.     Reset(F, 1);
  103.     BlockWrite(F, Header, 128);
  104.     Close(F);
  105.   END;
  106.  
  107. BEGIN
  108.   IF NOT EGAOnly THEN
  109.     EGAOnly:=(gd IN [EGA, EGA64, EGAMono]);
  110.   n:=0;
  111.   ShowOtherColor:=FALSE;
  112.   GetPalette(Farben);
  113.   IF NOT EGAOnly THEN
  114.   BEGIN
  115.     FOR n:=0 TO MaxColors DO
  116.     BEGIN                             { Farbwerte einlesen }
  117.       R.AH:=$10;
  118.       R.AL:=$15;
  119.       R.BX:=n;
  120.       Intr($10, R);
  121.       WITH VGAFarben[n] DO          { alte Palette sichern / VGA }
  122.       BEGIN
  123.         RedVal:=R.DH;
  124.         GreenVal:=R.ch;
  125.         BlueVal:=R.CL;
  126.       END;
  127.     END;
  128.     VGAFarbenAlt:=VGAFarben;
  129.   END
  130.   ELSE
  131.     FarbenAlt:=Farben;               { alte Palette sichern / EGA }
  132.   REPEAT
  133.     REPEAT
  134.       del:=0;
  135.       REPEAT                        { Farbe blinken lassen }
  136.         Delay(1);
  137.         Inc(del);
  138.       UNTIL (del>BlinkDelay[ShowOtherColor]) OR KeyPressed;
  139.       ShowOtherColor:=NOT ShowOtherColor;
  140.       IF ShowOtherColor THEN    { Paletteneintrag neu setzen }
  141.         IF EGAOnly THEN
  142.           SetPalette(n, Farben.Colors[n])
  143.         ELSE
  144.           WITH VGAFarben[n] DO
  145.             SetRGBPalette(Farben.Colors[n], RedVal,
  146.                           GreenVal, BlueVal)
  147.       ELSE
  148.         IF EGAOnly THEN                 { Blinkfarbe setzen }
  149.           SetPalette(n, Abs(NOT Farben.Colors[n]))
  150.         ELSE
  151.           WITH VGAFarben[n] DO
  152.             SetRGBPalette(Farben.Colors[n], NOT RedVal,
  153.                           NOT GreenVal, NOT BlueVal)
  154.     UNTIL KeyPressed;
  155.     ch:=ReadKey;
  156.     IF EGAOnly THEN       { neuen Paletteneintrag darstellen }
  157.       SetPalette(n, Farben.Colors[n])
  158.     ELSE
  159.       WITH VGAFarben[n] DO
  160.         SetRGBPalette(Farben.Colors[n], RedVal,
  161.                       GreenVal, BlueVal);
  162.     CASE ch OF
  163.       #0:  BEGIN
  164.              ch:=ReadKey;
  165.              CASE ch OF
  166.                #75: Add(n, 0, MaxColors, -1, TRUE);   { <- }
  167.                #77: Add(n, 0, MaxColors, 1, TRUE);    { -> }
  168.              END;
  169.            END;
  170.       '+': IF EGAOnly THEN        { Farbwert EGA verändern }
  171.              IF Farben.Colors[n]<63 THEN
  172.                Inc(Farben.Colors[n])
  173.              ELSE
  174.                Farben.Colors[n]:=0;
  175.       '-': IF EGAOnly THEN        { Farbwert EGA verändern }
  176.              IF Farben.Colors[n]>0 THEN
  177.                Dec(Farben.Colors[n])
  178.              ELSE
  179.                Farben.Colors[n]:=63;
  180.       'r': IF NOT EGAOnly THEN    { VGA Rot erhöhen }
  181.              Add(VGAFarben[n].RedVal, 0, 63, Step, TRUE);
  182.       'g': IF NOT EGAOnly THEN    { VGA Grün erhöhen }
  183.              Add(VGAFarben[n].GreenVal, 0, 63, Step, TRUE);
  184.       'b': IF NOT EGAOnly THEN    { VGA Blau erhöhen }
  185.              Add(VGAFarben[n].BlueVal, 0, 63, Step, TRUE);
  186.       'R': IF NOT EGAOnly THEN    { VGA Rot vermindern }
  187.              Add(VGAFarben[n].RedVal, 0, 63, -Step, TRUE);
  188.       'G': IF NOT EGAOnly THEN    { VGA Grün vermindern }
  189.              Add(VGAFarben[n].GreenVal, 0, 63, -Step, TRUE);
  190.       'B': IF NOT EGAOnly THEN    { VGA Blau vermindern }
  191.              Add(VGAFarben[n].BlueVal, 0, 63, -Step, TRUE);
  192.       's',
  193.       'S': SavePalette;           { Palette in PCX-File schreiben }
  194.       'a',
  195.       'A': IF EGAOnly THEN        { Alte Palette wiederherstellen }
  196.            BEGIN
  197.              Farben:=FarbenAlt;
  198.              SetAllPalette(FarbenAlt);
  199.            END
  200.            ELSE
  201.            BEGIN
  202.              VGAFarben:=VGAFarbenAlt;
  203.              FOR x:=0 TO MaxColors DO
  204.                WITH VGAFarben[n] DO
  205.                  SetRGBPalette(Farben.Colors[n], RedVal,
  206.                                GreenVal, BlueVal);
  207.            END;
  208.       #27: Exit;                  { <Esc>: Programm verlassen }
  209.     END;
  210.     IF EGAOnly THEN               { Veränderten Paletteneintrag setzen }
  211.       SetPalette(n, Farben.Colors[n])
  212.     ELSE
  213.       WITH VGAFarben[n] DO
  214.         SetRGBPalette(Farben.Colors[n], RedVal,
  215.                       GreenVal, BlueVal);
  216.   UNTIL FALSE;
  217. END;
  218.  
  219. BEGIN
  220.   IF ParamCount >= 1 THEN
  221.   BEGIN
  222.     name := ParamStr(1);
  223.     IF (ParamStr(2)='/E') OR (ParamStr(2)='/e') THEN
  224.       EGAOnly:=TRUE;
  225.   END
  226.   ELSE
  227.     Halt;
  228.   IF Pos('.', name) = 0 THEN name := name + '.PCX';
  229.   LoadPCXScreen(name);
  230.   IF PCXError THEN
  231.     Halt;
  232.   ChangeColors;
  233.   RestoreCrtMode;
  234. END.
  235. (* ------------------------------------------------------ *)
  236. (*                Ende von CHNGCOL.PAS                    *)