Turbo Toolbox/Turbo_Toolbox.iso/1991/09_10/oop/saaitems.pas

Pascal/Delphi Source File | 1991-06-12 | 17.2 KB | 595 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) '91 by R.Reichert & TOOLBOX             *)
(* ----------------------------------------------------- *)
UNIT SAAItems;

INTERFACE

USES Crt, MouKey;

CONST                             { Markierungszeichen im Namen }
  HotKeyMarkChar : CHAR = '#';
  ItemColor : BYTE = 29;          { Standardmässig }
  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 passt mir nicht            }
  ItEvAccepted = 2;               { Event angenommen, => weitermachen}
  ItFinish = 3;                   { beenden, Abbruch                 }
  ItSelected = 4;                 { wurde gewählt                    }
  ItActPrev = 5;                  { aktiviere nächsten Item          }
  ItActNext = 6;                  { aktiviere vorhergehenden 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 immer aktiv, wg dem Markierungszeichen,
    aber die Gruppe ist nicht immer aktiv (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                  *)
(* ----------------------------------------------------- *)