Turbo Toolbox/Turbo_Toolbox.iso/1990/11/tricks/colmod.pas

Pascal/Delphi Source File | 1990-08-07 | 5.7 KB | 196 lines

(* ------------------------------------------------------ *)
(*                      COLMOD.PAS                        *)
(*    selektieren von Farbattributen aus einer Tabelle    *)
(*            (c) 1990 Sven Selle & TOOLBOX               *)
(* ------------------------------------------------------ *)
UNIT ColMod;            { txCrt }

INTERFACE

TYPE
  ActionProc = PROCEDURE;   { Prozedur bei Farbänderung    }

CONST
  LDeli : CHAR = '[';
  RDeli : CHAR = ']';       { Begrenzer in der Farbtabelle }

VAR
  ActTxtColor,
  ActBckColor  : BYTE;
  ActPressKey  : CHAR;

  PROCEDURE Nothing;
  { Diese Prozedur kann statt einer eigenen Action-Prozedur}
  { ausgegeben werden, wenn man darauf verzichten möchte.  }

  PROCEDURE VGA_BlinkOff;

  PROCEDURE VGA_BlinkOn;
  { schaltet zwischen Blinken und Intensivdarstellung bei  }
  { gesetztem Blinkbit (Hintergrund > 7) um.               }

  PROCEDURE SplitAttr(Attr : BYTE; VAR tc, bc : BYTE);
  { Die Prozedur berechnet aus dem kompletten Farbattribut }
  { die einzelnen Bestandteile.                            }

  PROCEDURE ColorSelect(    x1, y1  : BYTE;
                            AllBits : BOOLEAN;
                            Action  : ActionProc;
                        VAR tc, bc  : BYTE);
  { Erstellt eine Farbtabelle. Wenn "AllBits" = TRUE,      }
  { werden alle 255 Attribute angezeigt, ansonsten nur 127.}
  { "Action" ist eine eigene Prozedur, die nach jedem      }
  { Tastendruck ausgeführt wird.                           }

IMPLEMENTATION

USES Crt, Dos;

  PROCEDURE Nothing;
  BEGIN
    { Diese Prozedur macht rein gar nichts }
  END;

  PROCEDURE VGA_BlinkOff;
  VAR
    Regs : Registers;
  BEGIN
    Regs.ah := $10;
    Regs.al := $03;
    Regs.bl := $00;
    Intr($10, Regs);
  END;

  PROCEDURE VGA_BlinkOn;
  VAR
    Regs : Registers;
  BEGIN
    Regs.ah := $10;
    Regs.al := $03;
    Regs.bl := $01;
    Intr($10, Regs);
  END;

  PROCEDURE SplitAttr(Attr : BYTE; VAR tc, bc : BYTE);
  BEGIN
    tc := attr AND 15;
    bc := attr SHR 4;
  END;

  PROCEDURE ColorSelect(    x1, y1  : BYTE;
                            AllBits : BOOLEAN;
                            Action  : ActionProc;
                        VAR tc, bc  : BYTE);
  VAR
    attr      : BYTE;
    max_Bckgr : BYTE;
    x, y      : BYTE;

    FUNCTION XCoord(attr : BYTE) : BYTE;
    { errechnet aus dem Attribut die x-Position der }
    { Farbanzeige auf dem Bildschirm                }
    BEGIN
      XCoord := Succ(x1) + (3 * (attr DIV 16));
    END;

    FUNCTION YCoord(attr : BYTE) : BYTE;
    BEGIN
      YCoord := Succ(x1) + (attr MOD 16);
    END;

    PROCEDURE WriteXY(x, y       : BYTE;
                      txtc, bckc : BYTE;
                      txt        : STRING);
    { Die Schreibroutine. Statt ihrer kann eine eigene }
    { implementiert werden. Hauptsache, die Parameter  }
    { stimmen halbwegs!                                }
    BEGIN
      GotoXY(x, y);
      TextAttr := txtc + (bckc SHL 4);
      Write(txt);
    END;

  BEGIN
    { An dieser Stelle sollte eine Rahmen-Routine eingefügt}
    { werden, um der Farbtabelle den nötigen Schliff zu    }
    { geben:                                               }
    {   IF AllBits THEN                                    }
    {     Rahmen(x1, y1, x1+49, y1+17)                     }
    {   ELSE                                               }
    {     Rahmen(x1, y1, x1+25, y1+17);                    }

    { Maximale Hintergrundfarbe setzen: }
    IF AllBits THEN max_bckgr := 15
               ELSE max_bckgr := 7;

    { Farbtabelle erstellen }
    FOR x := 0 TO 15 DO
      FOR y := 0 TO max_bckgr DO
        WriteXY(Succ(x1) + (y*3), Succ(y1)+x, x, y, ' x ');

    { Voreinstellungen }
    attr := tc + (bc SHL 4);
    ActTxtColor := tc;
    ActBckColor := bc;
    IF AllBits THEN
      max_bckgr := 240      { 240 + 15 = 255 Attribute }
    ELSE
      max_bckgr := 127;     { 112 + 15 = 127 Attribute }

    REPEAT
      x := XCoord(attr);
      y := yCoord(attr);

      { eingrenzen der gewählten Farbe }
      IF ActBckColor < Yellow THEN BEGIN
        WriteXY(x,   y, White, ActBckColor, LDeli);
        WriteXY(x+2, y, White, ActBckColor, RDeli);
      END ELSE BEGIN
        WriteXY(x,   y, Black, ActBckColor, LDeli);
        WriteXY(x+2, y, Black, ActBckColor, RDeli);
      END;
      WriteXY(Succ(x), y, ActTxtColor, ActBckColor, 'X');

      { eventuelle Anwender-Aktion }
      Action;

      { Bewegen }
      ActPressKey := ReadKey;
      WriteXY(x, y, ActTxtColor, ActBckColor, ' x ');

      CASE ActPressKey OF
        #72, ^E : IF ActTxtColor > Black THEN Dec(attr)
                                         ELSE Inc(attr, 15);
        #80, ^X : IF ActTxtColor < White THEN Inc(attr)
                                         ELSE Dec(attr, 15);
        #75, ^S : IF ActBckColor > Black THEN
                    Dec(attr, 16)
                  ELSE
                    Inc(attr, max_bckgr);
        #77, ^D : IF ActBckColor < LightGray THEN
                    Inc(attr, 16)
                  ELSE
                    Dec(attr, max_bckgr);
        #71, ^A : attr := 0;
        #79, ^F : attr := max_bckgr + 15;
      END;
      SplitAttr(attr, ActTxtColor, ActBckColor);
    UNTIL ActPressKey IN [#13, #27];

    IF ActPressKey = #27 THEN BEGIN
      tc := 255;
      bc := 255;
    END ELSE BEGIN
      tc := ActTxtColor;
      bc := ActBckColor;
    END;
  END;

BEGIN
  ActTxtColor := 0;
  ActBckColor := 0;
  ActPressKey := #0;
END.
(* ------------------------------------------------------ *)
(*                Ende von COLMOD.PAS                     *)