home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 19 / pal / egacol2.inc next >
Encoding:
Text File  |  1990-08-01  |  7.0 KB  |  225 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      EGACOL2.INC                       *)
  3. (*      Include-Datei zu PALEDDI2.PAS für EGA-Karten      *)
  4. (*             Turbo Pascal Version ab 5.0                *)
  5. (*           (c) 1990 Gerald Arend & TOOLBOX              *)
  6. (* ------------------------------------------------------ *)
  7.  
  8. CONST                   { Konstanten für Bit-Verknüpfungen }
  9.   AndBits: ARRAY[1..6] OF BYTE = (1, 2, 4, 8, 16, 32);
  10.   OrBits: ARRAY[1..6] OF BYTE = (62, 61, 59, 55, 47, 31);
  11.  
  12. VAR
  13.   EGAFarben: ARRAY[0..MaxColors] OF BYTE;        { Palette }
  14.   SchriftY: ARRAY[1..7] OF INTEGER;
  15.   Step: BYTE;
  16.   StepX, StepY, WertX, WertY: INTEGER;
  17.   Ende: BOOLEAN;
  18.   TBreite, THoehe: WORD;
  19.  
  20. PROCEDURE DrawBars;         { Farbbalken und Info erzeugen }
  21. VAR
  22.   n, m: BYTE;
  23.   s: STRING[4];
  24. CONST
  25.   Bezeichnung: STRING[24] = '1:B+2:G+3:R+4:B-5:G-6:R-';
  26. BEGIN
  27.   SetFillStyle(SolidFill, MaxColors);
  28.   Bar(0, 0, GetMaxX, 2*TextHeight('X')-1);
  29.   SetTextStyle(DefaultFont, HorizDir, 1);
  30.   SetTextJustify(CenterText, TopText);
  31.   SetColor(0);
  32.   OutTextXY(GetMaxX DIV 2, 2, 'toolbox Pal-Eddi  '+
  33.     'EGA-Modus 640 x 350, 16 Farben aus einer '+
  34.     'Palette von 64');
  35.   SetTextJustify(LeftText, BottomText);
  36.   SetColor(MaxColors);
  37.   SetWriteMode(XORPut);
  38.   TBreite:=TextWidth('X');
  39.   THoehe:=TextHeight('X');
  40.   FOR n:=1 TO 6 DO
  41.   BEGIN
  42.     SchriftY[n]:=GetMaxY DIV 2+(n+3)*THoehe*4 DIV 3;
  43.     s:=Copy(Bezeichnung, Succ(Pred(n)*4), 4);
  44.     OutTextXY(0, SchriftY[n], s);
  45.   END;
  46.   SchriftY[7]:=SchriftY[6]+2*THoehe;
  47.   OutTextXY(0, SchriftY[7], 'Wert');
  48.   OutTextXY(0, GetMaxY-4*THoehe,
  49.             '<F1>...<F6>  Bit umschalten');
  50.   OutTextXY(0, GetMaxY-2*THoehe,
  51.             #24#47#25+'          Farbwert ändern');
  52.   OutTextXY(GetMaxX DIV 2, GetMaxY-2*THoehe,
  53.             '<C>  Color-Cycling-Demo');
  54.   OutTextXY(0, GetMaxY,
  55.             '<S>          Turbo-Pascal-Prozedur erzeugen');
  56.   OutTextXY(0, SchriftY[1]-3*THoehe, 'Nr.');
  57.   Step:=1;
  58.   StepX:=GetMaxX DIV 2+13*TBreite;
  59.   StepY:=GetMaxY-4*THoehe;
  60.   OutTextXY(GetMaxX DIV 2, StepY,
  61.             'Schrittweite:      <+> / <->');
  62.   ShowValue(StepX, StepY, Step, 3);
  63.   FOR n:=0 TO MaxColors DO
  64.   BEGIN
  65.     SetColor(MaxColors);
  66.     Str(n:2, s);
  67.     OutTextXY(Succ(n)*GetMaxX DIV (MaxColors+2),
  68.               SchriftY[1]-3*THoehe, ' #'+s);
  69.     FOR m:=1 TO 6 DO
  70.       IF EGAFarben[n] AND AndBits[m]>0 THEN
  71.         OutTextXY(Succ(n)*GetMaxX DIV (MaxColors+2),
  72.                   SchriftY[m], '  1')
  73.       ELSE
  74.         OutTextXY(Succ(n)*GetMaxX DIV (MaxColors+2),
  75.                   SchriftY[m], '  0');
  76.     Str(EGAFarben[n]:3, s);
  77.     OutTextXY(Succ(n)*GetMaxX DIV (MaxColors+2),
  78.               SchriftY[7], s);
  79.     SetColor(n);
  80.     SetFillStyle(SolidFill, n);
  81.     Bar(Succ(n)*GetMaxX DIV (MaxColors+2), 2*THoehe,
  82.        (n+2)*GetMaxX DIV (MaxColors+2), GetMaxY div 2);
  83.   END;
  84. END;
  85.  
  86. PROCEDURE InitPalette;                 { Palette speichern }
  87. VAR
  88.   n: BYTE;
  89.   Palette: PaletteType;
  90. BEGIN
  91.   GetPalette(Palette);
  92.   FOR n:=0 TO MaxColors DO
  93.     EGAFarben[n]:=Palette.Colors[n];
  94. END;
  95.  
  96. PROCEDURE Palette2Disk; { Palette als Prozedur abspeichern }
  97. VAR
  98.   n: BYTE;
  99.   Datei: TEXT;
  100. CONST
  101.   DateiName: STRING[12] = 'PALETTE.ASC';
  102. BEGIN
  103. {$I-}
  104.   Assign(Datei, DateiName);
  105.   Rewrite(Datei);
  106. {$I+}
  107.   IF IOResult<>0 THEN
  108.   BEGIN
  109.     Write(^G);
  110.     Exit;
  111.   END;
  112.   Writeln(Datei, 'PROCEDURE PaletteSetzen;');
  113.   Writeln(Datei, 'CONST');
  114.   Writeln(Datei, '  EGAFarben: PaletteType =');
  115.   Writeln(Datei, '    (Size: 15;');
  116.   Write(Datei, '     Colors: (');
  117.   FOR n:=0 TO MaxColors DO
  118.   BEGIN
  119.     Write(Datei, EGAFarben[n]:2);
  120.     IF n<MaxColors THEN
  121.       Write(Datei, ', ')
  122.     ELSE
  123.       Writeln(Datei, '));');
  124.   END;
  125.   Writeln(Datei, 'BEGIN');
  126.   Writeln(Datei, '  SetAllPalette(EGAFarben);');
  127.   Writeln(Datei, 'END;');
  128.   Writeln(Datei);
  129.   Close(Datei);
  130. END;
  131.  
  132. PROCEDURE ChangeColors;      { Farben interaktiv verändern }
  133. VAR
  134.   x: INTEGER;
  135.   n, m: BYTE;
  136.   ch: CHAR;
  137.  
  138.   PROCEDURE ToggleBit(VAR Wert: BYTE; Stelle: BYTE);
  139.                             { Ein einzelnes Bit umschalten }
  140.   BEGIN
  141.     IF Wert AND AndBits[Stelle]=0 THEN
  142.       Wert:=Wert OR AndBits[Stelle]
  143.     ELSE
  144.       Wert:=Wert AND OrBits[Stelle];
  145.   END;
  146.  
  147. BEGIN
  148.   n:=0;
  149.   Ende:=FALSE;
  150.   SetColor(MaxColors);
  151.   DrawFrame(n, SchriftY[7]+10);
  152.   REPEAT
  153.     x:=Succ(n)*GetMaxX DIV (MaxColors+2)+TBreite;
  154.     ch:=ReadKey;
  155.     CASE ch OF
  156.       #0:  BEGIN
  157.              ch:=ReadKey;
  158.              CASE ch OF
  159.                #75: BEGIN                             { <- }
  160.                       DrawFrame(n, SchriftY[7]+10);
  161.                       Add(n, 0, MaxColors, -1, TRUE);
  162.                       DrawFrame(n, SchriftY[7]+10);
  163.                     END;
  164.                #77: BEGIN                             { -> }
  165.                       DrawFrame(n, SchriftY[7]+10);
  166.                       Add(n, 0, MaxColors, 1, TRUE);
  167.                       DrawFrame(n, SchriftY[7]+10);
  168.                     END;
  169.                #72,
  170.                #80: BEGIN
  171.                       IF ch=#72 THEN                   { ^ }
  172.                         Add(EGAFarben[n], 0, 63, -Step,
  173.                             TRUE)
  174.                       ELSE                             { v }
  175.                         Add(EGAFarben[n], 0, 63, Step,
  176.                             TRUE);
  177.                                        { Farbwert anzeigen }
  178.                       ShowValue(x, SchriftY[7],
  179.                                 EGAFarben[n], 2);
  180.                       FOR m:=1 TO 6 DO     { Bits anzeigen }
  181.                         IF EGAFarben[n] AND AndBits[m]>0
  182.                         THEN
  183.                           ShowValue(x, SchriftY[m], 1, 2)
  184.                         ELSE
  185.                           ShowValue(x, SchriftY[m], 0, 2);
  186.                     END;
  187.                #59..
  188.                #64: BEGIN { F1...F6: Einzelne Bits togglen }
  189.                       m:=Ord(ch)-58;
  190.                       ToggleBit(EGAFarben[n], m);
  191.                       ShowValue(x, SchriftY[7],
  192.                                 EGAFarben[n], 2);
  193.                       IF EGAFarben[n] AND AndBits[m]>0 THEN
  194.                         ShowValue(x, SchriftY[m], 1, 2)
  195.                       ELSE
  196.                         ShowValue(x, SchriftY[m], 0, 2);
  197.                     END;
  198.              END;
  199.            END;
  200.       '+': BEGIN                    { Schrittweite erhöhen }
  201.              Add(Step, 1, 8, 1, TRUE);
  202.              ShowValue(StepX, StepY, Step, 3);
  203.            END;
  204.       '-': BEGIN                 { Schrittweite vermindern }
  205.              Add(Step, 1, 8, -1, TRUE);
  206.              ShowValue(StepX, StepY, Step, 3);
  207.            END;
  208.       's',
  209.       'S': Palette2Disk;
  210.       'c',
  211.       'C': BEGIN
  212.              CycleDemo;
  213.              Exit;
  214.            END;
  215.       #27: BEGIN
  216.              Ende:=TRUE;
  217.              Exit;
  218.            END;
  219.     END;
  220.     SetPalette(n, EGAFarben[n]);          { Palette setzen }
  221.   UNTIL FALSE;
  222. END;
  223. (* ------------------------------------------------------ *)
  224. (*                 Ende von EGACOL2.INC                   *)
  225.