Turbo Toolbox/Turbo_Toolbox.iso/1991/07_08/praxis/oop/saaitems.pas

Pascal/Delphi Source File | 1991-04-16 | 17.0 KB | 600 lines

(* ------------------------------------------------------ *)
(*                      SAAITEMS.PAS                      *)
(*                                                        *)
(*  SAAItem: Dient als Grundobjekt für "SAA-Einträge"     *)
(*   wie Menüeinträge, "Radiobuttons" etc. Implementiert  *)
(*   die grundlegenden Methoden aller Nachkommen.         *)
(*  PushBut, RadioBut und EndBut sind spezialisierte      *)
(*   Erben von SAAItem. Ihre Anwendung demonstriert       *)
(*   "BUTDEMO".                                           *)
(*                                                        *)
(*         (c) 1991 Raimond Reichert & TOOLBOX            *)
(* ------------------------------------------------------ *)
UNIT SAAItems;

INTERFACE

USES Crt, MouKey;

CONST
  HotKeyMarkChar : CHAR = '#';
                             { Markierungszeichen im Namen }
  ItemColor      : BYTE = 29;     { Standardmäßig          }
  HotKeyColor    : BYTE = 27;     { benutzte Farbwerte     }
  EndButActColor : BYTE = 75;     { Aktive Endbutton-Farbe }
  Enter = 13;
  Space = 32; CurUp = 328; CurDown = 336;
                       { ReturnCodes: }
  ItOk         =  0;   { Alles in Ordnung                  }
  ItEvNotMine  =  1;   { Event paßt mir nicht              }
  ItEvAccepted =  2;   { Event angenommen, => weitermachen }
  ItFinish     =  3;   { beenden, Abbruch                  }
  ItSelected   =  4;   { wurde gewählt                     }
  ItActPrev    =  5;   { aktiviere nächstes Item           }
  ItActNext    =  6;   { aktiviere vorhergehendes Item     }

  MaxRadioBut  = 20;   { maximale Anzahl RadioButtons pro  }
                       { Gruppe                            }

TYPE
  SAAItemPtr = ^SAAItem;
  SAAItem    = OBJECT
    Col, HKCol,
    x, y        : BYTE;
    Name        : ^STRING;
    HotKey      : CHAR;
    Active,
    Displayed,
    HKDisplayed : BOOLEAN;
    AltCode     : WORD;
    ReturnCode  : BYTE;

    CONSTRUCTOR Init(nX, nY : BYTE;
                     n      : STRING;
                     AltHKC : WORD);
    PROCEDURE   SetColors(nC, nHKC : BYTE);
    PROCEDURE   SetName(NewName : STRING);          VIRTUAL;
    PROCEDURE   SetAltCode(NewAltHKC : WORD);       VIRTUAL;
    PROCEDURE   Display;                            VIRTUAL;
    PROCEDURE   DisplayHotKey;                      VIRTUAL;
    PROCEDURE   SetDisplayedOff;                    VIRTUAL;
    PROCEDURE   SetActive;                          VIRTUAL;
    PROCEDURE   SetPassive;                         VIRTUAL;
    PROCEDURE   CheckEvent(VAR Ev : EventObj);      VIRTUAL;
    PROCEDURE   CheckMouEv(VAR Ev : EventObj);      VIRTUAL;
    PROCEDURE   CheckKeyEv(VAR Ev : EventObj);      VIRTUAL;
    PROCEDURE   SetXY(NX, NY : BYTE);               VIRTUAL;
    PROCEDURE   SetXYRel(dX, dY : INTEGER);         VIRTUAL;
    PROCEDURE   SaveConfiguration;                  VIRTUAL;
    PROCEDURE   RestoreConfiguration;               VIRTUAL;
    FUNCTION    GetReturnCode : BYTE;               VIRTUAL;
    FUNCTION    GetCol : BYTE;                      VIRTUAL;
    FUNCTION    GetHKCol : BYTE;                    VIRTUAL;
    FUNCTION    GetX : BYTE;                        VIRTUAL;
    FUNCTION    GetY : BYTE;                        VIRTUAL;
    FUNCTION    GetName : STRING;                   VIRTUAL;
    FUNCTION    GetHotKey : CHAR;                   VIRTUAL;
    FUNCTION    GetAltCode : WORD;                  VIRTUAL;
    FUNCTION    IsActive : BOOLEAN;                 VIRTUAL;
    FUNCTION    IsDisplayed : BOOLEAN;              VIRTUAL;
    FUNCTION    IsHKDisplayed : BOOLEAN;            VIRTUAL;
    DESTRUCTOR  Done;                               VIRTUAL;
  END;

  RadioButPtr = ^RadioBut;
  RadioBut    = OBJECT(SAAItem)
    CONSTRUCTOR Init(NX, NY : BYTE;
                     n : STRING;
                     AltHKC : WORD);
    PROCEDURE Display;                              VIRTUAL;
    PROCEDURE SetActive;                            VIRTUAL;
    PROCEDURE SetPassive;                           VIRTUAL;
    PROCEDURE CheckEvent(VAR Ev : EventObj);        VIRTUAL;
  END;

  { Anwendung von NewRadioBut: Siehe "BUTDEMO". }
  FUNCTION NewRadioBut(NX, NY : BYTE;
                       n : STRING;
                       AltHKC : WORD) : RadioButPtr;

TYPE
  RadioButArray   = ARRAY [1..MaxRadioBut] OF RadioButPtr;
  RadioButtonsPtr = ^RadioButtons;
  RadioButtons    = OBJECT(SAAItem)
    Act, Num : BYTE;
    Buttons  : RadioButArray;

    CONSTRUCTOR Init(NewButtons : RadioButArray;
                     ButNum     : BYTE);
    PROCEDURE   Display;                            VIRTUAL;
    PROCEDURE   DisplayHotKey;                      VIRTUAL;
    PROCEDURE   SetXY(NX, NY : BYTE);               VIRTUAL;
    PROCEDURE   SetXYRel(DX, dY : INTEGER);         VIRTUAL;
    PROCEDURE   SetActive;                          VIRTUAL;
    PROCEDURE   SetPassive;                         VIRTUAL;
    PROCEDURE   CheckEvent(VAR Ev : EventObj);      VIRTUAL;
    FUNCTION    GetSelected : BYTE;                 VIRTUAL;
    DESTRUCTOR  Done;                               VIRTUAL;
  END;

  PushButPtr = ^PushBut;
  PushBut    = OBJECT(SAAItem)
    SaveFl, On : BOOLEAN;

    CONSTRUCTOR Init(NX, NY : BYTE;
                     n      : STRING;
                     AltHKC : WORD;
                     nOn    : BOOLEAN);
    PROCEDURE   Display;                            VIRTUAL;
    PROCEDURE   SetActive;                          VIRTUAL;
    PROCEDURE   CheckEvent(VAR Ev : EventObj);      VIRTUAL;
    PROCEDURE   SaveConfiguration;                  VIRTUAL;
    PROCEDURE   RestoreConfiguration;               VIRTUAL;
    FUNCTION    GetState : BOOLEAN;                 VIRTUAL;
  END;

  EndButPtr = ^EndBut;
  EndBut    = OBJECT(SAAItem)
    SpecificRC,
    ActCol     : BYTE;
    HotKeyCode : WORD;

    CONSTRUCTOR Init(NX, NY : BYTE;
                     n      : STRING;
                     AltHKC : WORD;
                     NewHK  : WORD;
                     SpecRC : BYTE);
    PROCEDURE   SetColors(nC, nHKC, nAC : BYTE);
    PROCEDURE   SetActive;                          VIRTUAL;
    PROCEDURE   SetPassive;                         VIRTUAL;
    PROCEDURE   CheckEvent(VAR Ev : EventObj);      VIRTUAL;
    FUNCTION    GetSpecRC : BYTE;                   VIRTUAL;
  END;


IMPLEMENTATION

  FUNCTION NewRadioBut(NX, NY : BYTE;
                       n      : STRING;
                       AltHKC : WORD) : RadioButPtr;
  BEGIN
    NewRadioBut := New(RadioButPtr,
                       Init(NX, NY, n, AltHKC));
  END;

  PROCEDURE WriteStr(x, y, Attr : BYTE; s : STRING);
  VAR
    ox, oy : BYTE;
  BEGIN
    ox := WhereX; oy := WhereY; GotoXY(x, y);
    TextAttr := Attr; Write(s); GotoXY(ox, oy);
  END;

  CONSTRUCTOR SAAItem.Init(NX, NY : BYTE;
                           n      : STRING;
                           AltHKC : WORD);
  BEGIN
    Col    := ItemColor;
    HKCol  := HotKeyColor;
    x      := NX;
    y      := NY;
    Active := FALSE; HKDisplayed := FALSE;
    ReturnCode := 0; Displayed := FALSE;
    AltCode := AltHKC;
    Name    := NIL; SetName(n);
    IF Name = NIL THEN FAIL;
  END;

  PROCEDURE SAAItem.SetColors(NC, NHKC : BYTE);
  BEGIN
    Col := NC; HKCol := NHKC;
  END;

  PROCEDURE SAAItem.SetName(NewName : STRING);
  VAR
    i : BYTE;
  BEGIN
    IF Name <> NIL THEN
      FreeMem(Name, Succ(Length(Name^)));
    i := Pos(HotKeyMarkChar, NewName);
    IF i > 0 THEN BEGIN
      Delete(NewName, i, 1);
      HotKey := NewName[i];
    END ELSE
      HotKey := #0;
    GetMem(Name, Succ(Length(NewName)));
    IF Name <> NIL THEN
      Name^ := NewName;
  END;

  PROCEDURE SAAItem.SetAltCode(NewAltHKC : WORD);
  BEGIN AltCode := NewAltHKC; END;

  PROCEDURE SAAItem.Display;
  BEGIN
    Mouse^.Hide;
    WriteStr(x, y, Col, Name^);
    Mouse^.Show;
    Displayed := TRUE;
    IF HKDisplayed THEN
      DisplayHotKey;
  END;

  PROCEDURE SAAItem.DisplayHotKey;
  BEGIN
    IF (HotKey <> #0) AND Displayed THEN BEGIN
      Mouse^.Hide;
      WriteStr(Pred(x+Pos(HotKey, Name^)), y,
               HKCol, HotKey);
      Mouse^.Show;
      HKDisplayed := TRUE;
    END;
  END;

  PROCEDURE SAAItem.SetDisplayedOff;
  BEGIN Displayed := FALSE; END;

  PROCEDURE SAAItem.SetActive;
  BEGIN Active := TRUE; Display; END;

  PROCEDURE SAAItem.SetPassive;
  BEGIN Active := FALSE; END;

  PROCEDURE SAAItem.CheckEvent(VAR Ev : EventObj);
  BEGIN
    ReturnCode := ItEvNotMine;
    IF Displayed THEN
      IF (Ev.EventType AND EvMouAll) > 0 THEN
        CheckMouEv(Ev)
      ELSE
        CheckKeyEv(Ev);
  END;

  PROCEDURE SAAItem.CheckMouEv(VAR Ev : EventObj);

    FUNCTION EvInArea : BOOLEAN;
    BEGIN
      EvInArea := (Ev.x >= x) AND(Ev.y = y) AND
                  (Ev.x < x+Length(Name^))
    END;

  BEGIN
    IF EvInArea THEN
      IF EvHand^.MouReleased(Ev) THEN
        ReturnCode := ItSelected
      ELSE
        IF (EvHand^.MouPressed(Ev)) OR
        (Ev.Buttons > 0) THEN BEGIN
          SetActive;
          ReturnCode := ItEvAccepted;
        END;
  END;

  PROCEDURE SAAItem.CheckKeyEv(VAR Ev : EventObj);
  VAR
    HK1, HK2 : BYTE;
  BEGIN
    IF Ev.EventType = EvKeyPressed THEN BEGIN
      IF (HKDisplayed) THEN BEGIN
        HK1 := Ord(HotKey); HK2 := 0;
        IF (HK1 > 64) AND (HK2 <  91) THEN HK2 := HK1+32;
        IF (HK1 > 96) AND (HK2 < 123) THEN HK2 := HK1-32;
        IF (Ev.Key = HK1) OR (Ev.Key = HK2) OR
           (Ev.Key = AltCode) THEN BEGIN
          SetActive;
          ReturnCode := ItSelected;
        END;
      END;
    END;
  END;

  PROCEDURE SAAItem.SetXY(NX, NY : BYTE);
  BEGIN
    x := NX; y := NY;
    IF Displayed THEN BEGIN
      SetDisplayedOff; Display;
    END;
  END;

  PROCEDURE SAAItem.SetXYRel(DX, dY : INTEGER);
  BEGIN SetXY(x+DX, y+dY); END;

  PROCEDURE SAAItem.SaveConfiguration;
  BEGIN
    { SAAItem enthält keine konkreten Daten zum Retten }
  END;

  PROCEDURE SAAItem.RestoreConfiguration;
  BEGIN END;

  FUNCTION SAAItem.GetReturnCode : BYTE;
  BEGIN
    GetReturnCode := ReturnCode; ReturnCode := 0;
  END;

  FUNCTION SAAItem.GetCol : BYTE;
  BEGIN GetCol := Col; END;

  FUNCTION SAAItem.GetHKCol : BYTE;
  BEGIN GetHKCol := HKCol; END;

  FUNCTION SAAItem.GetX : BYTE;
  BEGIN GetX := x; END;

  FUNCTION SAAItem.GetY : BYTE;
  BEGIN GetY := y; END;

  FUNCTION SAAItem.GetName : STRING;
  BEGIN GetName := Name^; END;

  FUNCTION SAAItem.GetHotKey : CHAR;
  BEGIN GetHotKey := HotKey; END;

  FUNCTION SAAItem.GetAltCode : WORD;
  BEGIN GetAltCode := AltCode; END;

  FUNCTION SAAItem.IsActive : BOOLEAN;
  BEGIN IsActive := Active; END;

  FUNCTION SAAItem.IsDisplayed : BOOLEAN;
  BEGIN IsDisplayed := Displayed; END;

  FUNCTION SAAItem.IsHKDisplayed : BOOLEAN;
  BEGIN IsHKDisplayed := HKDisplayed; END;

  DESTRUCTOR SAAItem.Done;
  BEGIN
    FreeMem(Name, Succ(Length(Name^)));
  END;

  CONSTRUCTOR RadioBut.Init(NX, NY : BYTE;
                            n      : STRING;
                            AltHKC : WORD);
  BEGIN
    IF n[1] <> ' ' THEN n := ' '+n;
    IF NOT SAAItem.Init(NX, NY, '( )'+n, AltHKC) THEN
      FAIL;
  END;

  PROCEDURE RadioBut.Display;
  BEGIN
    SAAItem.Display;
    Mouse^.Hide;
    IF Active THEN BEGIN
      Mouse^.Hide;
      WriteStr(Succ(x), y, ItemColor, '■');
      Mouse^.Show;
    END;
  END;

  PROCEDURE RadioBut.SetActive;
  BEGIN
    SAAItem.SetActive; GotoXY(Succ(x), y);
  END;

  PROCEDURE RadioBut.SetPassive;
  BEGIN
    SAAItem.SetPassive; Display;
  END;

  PROCEDURE RadioBut.CheckEvent(VAR Ev : EventObj);
  BEGIN
    SAAItem.CheckEvent(Ev);
    IF ReturnCode = ItSelected THEN
      ReturnCode := ItEvAccepted;
    IF (ReturnCode = ItEvNotMine) AND(Active) AND
       (Ev.EventType = EvKeyPressed) THEN
      IF Ev.Key = CurUp THEN BEGIN
        SetPassive;
        ReturnCode := ItActPrev;
      END ELSE
        IF Ev.Key = CurDown THEN BEGIN
          SetPassive;
          ReturnCode := ItActNext;
        END;
  END;

  CONSTRUCTOR RadioButtons.Init(NewButtons : RadioButArray;
                                ButNum : BYTE);
  VAR
    i : BYTE;
  BEGIN
    FOR i := 1 TO ButNum DO Buttons[i] := NewButtons[i];
    Num := ButNum;
    Act := 1;
  END;

  PROCEDURE RadioButtons.Display;
  VAR
    i : BYTE;
  BEGIN
    Buttons[Act]^.SetActive;
  { ein Button ist wg. Markierungszeichen immer aktiv,
    aber die Gruppe ist es nicht  (s. SetPassive)  }
    FOR i := 1 TO Num DO
      Buttons[i]^.Display;
    Displayed := TRUE;
  END;

  PROCEDURE RadioButtons.DisplayHotKey;
  VAR
    i : BYTE;
  BEGIN
    FOR i := 1 TO Num DO
      Buttons[i]^.DisplayHotKey;
    HKDisplayed := TRUE;
  END;

  PROCEDURE RadioButtons.SetXY(NX, NY : BYTE);
  BEGIN SetXYRel(NX-x, NY-y); END;

  PROCEDURE RadioButtons.SetXYRel(DX, dY : INTEGER);
  VAR
    i : BYTE;
  BEGIN
    FOR i := 1 TO Num DO
      Buttons[i]^.SetXYRel(DX, dY);
    x := x+DX; y := y+dY;
  END;

  PROCEDURE RadioButtons.SetActive;
  BEGIN
    Buttons[Act]^.SetActive;
    Active := TRUE;
  END;

  PROCEDURE RadioButtons.SetPassive;
  BEGIN
    Active := FALSE;
  { sonst verschwindet das Markierungszeichen; nur die
    Gruppe ist passiv }
  END;

  PROCEDURE RadioButtons.CheckEvent(VAR Ev : EventObj);
  VAR
    i : BYTE;
  BEGIN
    Buttons[Act]^.CheckEvent(Ev);
    CASE Buttons[Act]^.GetReturnCode OF
      ItActNext :
        BEGIN
          INC(Act);
          IF Act > Num THEN Act := 1;
          Buttons[Act]^.SetActive;
          ReturnCode := ItEvAccepted;
        END;
      ItActPrev :
        BEGIN
          DEC(Act);
          IF Act < 1 THEN Act := Num;
          Buttons[Act]^.SetActive;
          ReturnCode := ItEvAccepted;
        END;
      ItEvAccepted : ReturnCode := ItEvAccepted;
      ItEvNotMine :
        BEGIN
          ReturnCode := ItEvNotMine;
          FOR i := 1 TO Num DO BEGIN
            Buttons[i]^.CheckEvent(Ev);
            IF (Buttons[i]^.GetReturnCode <>
                ItEvNotMine) THEN BEGIN
              Buttons[Act]^.SetPassive;
              Act := i;
              Buttons[Act]^.SetActive;
              ReturnCode := ItEvAccepted;
            END;
          END;
        END;
    END;
  END;

  FUNCTION RadioButtons.GetSelected : BYTE;
  BEGIN GetSelected := Act; END;

  DESTRUCTOR RadioButtons.Done;
  VAR
    i : BYTE;
  BEGIN
    FOR i := 1 TO Num DO DISPOSE(Buttons[i], Done);
  END;

  CONSTRUCTOR PushBut.Init(NX, NY : BYTE;
                           n : STRING;
                           AltHKC : WORD;
                           nOn : BOOLEAN);
  BEGIN
    IF n[1] <> ' ' THEN n := ' '+n;
    IF SAAItem.Init(NX, NY, '[ ]'+n, AltHKC) THEN
      On := nOn
    ELSE FAIL;
  END;

  PROCEDURE PushBut.Display;
  BEGIN
    SAAItem.Display;
    IF On THEN BEGIN
      Mouse^.Hide;
      WriteStr(Succ(x), y, ItemColor, 'X');
      Mouse^.Show;
    END;
  END;

  PROCEDURE PushBut.SetActive;
  BEGIN
    SAAItem.SetActive; GotoXY(Succ(x), y);
  END;

  PROCEDURE PushBut.CheckEvent(VAR Ev : EventObj);
  BEGIN
    SAAItem.CheckEvent(Ev);
    IF (ReturnCode = ItSelected) OR
       ((ReturnCode = ItEvNotMine) AND
       (Ev.EventType = EvKeyPressed) AND
       (Ev.Key = Space) AND Active) THEN BEGIN
      On         := NOT On;
      ReturnCode := ItEvAccepted;
      Display;
    END;
  END;

  PROCEDURE PushBut.SaveConfiguration;
  BEGIN SaveFl := On; END;

  PROCEDURE PushBut.RestoreConfiguration;
  BEGIN On := SaveFl; END;

  FUNCTION PushBut.GetState : BOOLEAN;
  BEGIN GetState := On; END;

  CONSTRUCTOR EndBut.Init(NX, NY : BYTE;
                          n      : STRING;
                          AltHKC : WORD;
                          NewHK  : WORD;
                          SpecRC : BYTE);
  BEGIN
    SpecificRC := SpecRC;
    IF n[1] <> ' ' THEN n := ' '+n;
    IF n[Length(n)] <> ' ' THEN n := n+' ';
    IF SAAItem.Init(NX, NY, '<' +n + '>', AltHKC) THEN BEGIN
      HotKeyCode := NewHK; ActCol := EndButActColor;
    END ELSE
      FAIL;
  END;

  PROCEDURE EndBut.SetColors(NC, NHKC, NAC : BYTE);
  BEGIN
    SAAItem.SetColors(NC, NHKC);
    ActCol := NAC;
  END;

  PROCEDURE EndBut.SetActive;
  BEGIN
    SAAItem.SetActive; Mouse^.Hide;
    WriteStr(x, y, EndButActColor, Name^);
    Mouse^.Show; GotoXY(x+2, y);
  END;

  PROCEDURE EndBut.SetPassive;
  BEGIN
    SAAItem.SetPassive; Display;
  END;

  PROCEDURE EndBut.CheckEvent(VAR Ev : EventObj);
  BEGIN
    SAAItem.CheckEvent(Ev);
    IF (ReturnCode = ItSelected) OR
       ((ReturnCode = ItEvNotMine) AND
        (Ev.EventType = EvKeyPressed) AND
       ((Ev.Key = HotKeyCode) OR
       ((Ev.Key = Enter) AND Active))) THEN BEGIN
      SetActive; ReturnCode := ItFinish;
    END;
  END;

  FUNCTION EndBut.GetSpecRC : BYTE;
  BEGIN GetSpecRC := SpecificRC; END;

END.
(* ----------------------------------------------------- *)
(*                Ende von SAAITEMS.PAS                  *)