Turbo Toolbox/Turbo_Toolbox.iso/spezial/22/saa/mnuitems.pas

Pascal/Delphi Source File | 1991-01-04 | 16.7 KB | 575 lines

(* ----------------------------------------------------- *)
(*                      MNUITEMS.PAS                     *)
(*                                                       *)
(* ■ MenuItem: Erweitert SAAItem um HelpString; prüft, ob*)
(*   Enter gedrückt wurde, übernimmt Darstellung.        *)
(* ■ PopUpItem: Prüft zusätzlich nur, ob Cursor hoch oder*)
(*   runter gedrückt wurde.                              *)
(* ■ ExeItem: "Ausführbarer" Item, Item, der bei seiner  *)
(*   Wahl Aktion auslösen soll; falls gewählt, ReturnCode*)
(*   ItSelected.                                         *)
(* ■ DirectExeItem: Enthält zusätzlich Tastaturcode, mit *)
(*   dem der Item direkt, ohne dass er oder sein "Über-  *)
(*   menü" aktiv sind, ReturnCode=ItDirectSelected.      *)
(* ■ SwitchItem: Item, der On oder Off sein kann, gibt   *)
(*   den ReturnCode ItEvAccepted zurück.                 *)
(* ■ GlobalSwitchItem: Ändert direkt Flag ausserhalb des *)
(*   Objekts, enthält also einen Zeiger darauf.          *)
(* ■ LineItem: Keinerlei "Wahl" mit Tastatur möglich,    *)
(*   falls mit Maus gewählt wird, ReturnCode=ItFinish.   *)
(* ■ SlideBarItem: Für horizontales Menu, prüft nur, ob  *)
(*   Pfeil links oder rechts oder Enter gedrückt wurde.  *)
(*   Dient als Item, bei dessesn Wahl ein PopUpMenu ge-  *)
(*   öffnet wird, ReturnCode=ItSelected.                 *)
(*                                                       *)
(*           (c) 1991 by R.Reichert & toolbox            *)
(* ----------------------------------------------------- *)
UNIT MnuItems;

INTERFACE

USES Stuff, MouKey, WinVSM, SAAItemD;

CONST
  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 vorhergehenden Item    }
  ItActNext       = 6; { aktiviere nächsten Item          }
  ItDirectSelected= 7; { Item des Typs DirectExeItem wurde
                         angewählt                        }

  MenuHotKeyCol   : BYTE = $0F;
  MenuItemColor   : BYTE = $07;
  ActiveItemColor : BYTE = $70;
  HelpStrColor    : BYTE = $07;
  UnenabledItemCol: BYTE = $01;
  SwitchChrColor  : BYTE = $07;
  MenuFrameColor  : BYTE = $07;

TYPE
  BooleanPtr = ^Boolean;

  MenuItemPtr = ^MenuItem;
  MenuItem = OBJECT (SAAItem)

    MenuActive : BOOLEAN;
    ActCol,
    HelpCol,
    hx, hy     : BYTE;
    HelpStr    : ^STRING;

    CONSTRUCTOR Init (nx, ny : BYTE;
                      N      : STRING;
                      AltHKC : WORD;
                      nhx,nhy: BYTE;
                      H      : STRING;
                      NewVSM : WExtVSMPtr);
    PROCEDURE SetColors (NC, NHKC, NAC, NHC : BYTE);
    PROCEDURE SetMenu (Act : BOOLEAN);             VIRTUAL;
    PROCEDURE Display;                             VIRTUAL;
    PROCEDURE SetPassive;                          VIRTUAL;
    PROCEDURE CheckKeyEv (VAR Ev : EventObj);      VIRTUAL;

    FUNCTION GetActCol : BYTE;                     VIRTUAL;
    FUNCTION GetHelpCol: BYTE;                     VIRTUAL;
    FUNCTION GetHelpX : BYTE;                      VIRTUAL;
    FUNCTION GetHelpY : BYTE;                      VIRTUAL;
    FUNCTION GetHelpStr : STRING;                  VIRTUAL;
    DESTRUCTOR Done;                               VIRTUAL;
  END;

  PopUpItemPtr = ^PopUpItem;
  PopUpItem    = OBJECT (MenuItem)
    PROCEDURE CheckKeyEv (VAR Ev : EventObj);      VIRTUAL;
  END;

  ExeItemPtr = ^ExeItem;
  ExeItem    = OBJECT (PopUpItem)

    UnAblCol: BYTE;
    Enabled : BOOLEAN;

    CONSTRUCTOR Init (nx, ny : BYTE;
                      N      : STRING;
                      AltHKC : WORD;
                      nhx,nhy: BYTE;
                      H      : STRING;
                      NEnabled: BOOLEAN;
                      NewVSM : WExtVSMPtr);
    PROCEDURE SetColors (NC, NHKC, NAC, NHC, NUC : BYTE);
    PROCEDURE Display;                             VIRTUAL;
    PROCEDURE CheckEvent (VAR Ev : EventObj);      VIRTUAL;
    PROCEDURE SetActive;                           VIRTUAL;
    PROCEDURE SetEnabled (On : BOOLEAN);           VIRTUAL;

    FUNCTION GetEnabled : BOOLEAN;                 VIRTUAL;
    FUNCTION GetUnenabledCol : BYTE;               VIRTUAL;
  END;

  DirectExeItemPtr = ^DirectExeItem;
  DirectExeItem    = OBJECT (ExeItem)

    DirectCode : WORD;

    CONSTRUCTOR Init (nx, ny : BYTE;
                      N      : STRING;
                      AltHKC : WORD;
                      DC     : WORD;
                      nhx,nhy: BYTE;
                      H      : STRING;
                      NEnabl : BOOLEAN;
                      NewVSM : WExtVSMPtr);

    PROCEDURE CheckKeyEv (VAR Ev : EventObj);      VIRTUAL;
  END;

  SwitchItemPtr = ^SwitchItem;
  SwitchItem    = OBJECT (PopUpItem)

    SwChrCol : BYTE;
    On       : BOOLEAN;
    SaveFl   : BOOLEAN;

    CONSTRUCTOR Init (nx, ny : BYTE;
                      N      : STRING;
                      AltHKC : WORD;
                      nhx,nhy: BYTE;
                      H      : STRING;
                      NOn    : BOOLEAN;
                      NewVSM : WExtVSMPtr);
    PROCEDURE SetColors (NC, NHKC, NAC, NHC, NSC : BYTE);
    PROCEDURE Display;                             VIRTUAL;
    PROCEDURE CheckEvent (VAR Ev : EventObj);      VIRTUAL;
    PROCEDURE SaveConfiguration;                   VIRTUAL;
    PROCEDURE RestoreConfiguration;                VIRTUAL;

    FUNCTION GetState : BOOLEAN;                   VIRTUAL;
    FUNCTION GetSwChrCol : BYTE;                   VIRTUAL;
  END;

  GlobalSwitchItemPtr = ^GlobalSwitchItem;
  GlobalSwitchItem    = OBJECT (SwitchItem)

    OnPtr : BooleanPtr;

    CONSTRUCTOR Init (nx, ny : BYTE;
                      N      : STRING;
                      AltHKC : WORD;
                      nhx,nhy: BYTE;
                      H      : STRING;
                      NOnPtr : BooleanPtr;
                      NewVSM : WExtVSMPtr);
    PROCEDURE CheckEvent (VAR Ev : EventObj);      VIRTUAL;
    PROCEDURE SaveConfiguration;                   VIRTUAL;
    PROCEDURE RestoreConfiguration;                VIRTUAL;

    FUNCTION GetState : BOOLEAN;                   VIRTUAL;
  END;

  LineItemPtr = ^LineItem;
  LineItem = OBJECT (PopUpItem)

    FrameCol : BYTE;

    CONSTRUCTOR Init (x1,y1,x2 : BYTE;
                      NewVSM   : WExtVSMPtr);
    PROCEDURE SetColors (NFC : BYTE);
    PROCEDURE Display;                             VIRTUAL;
    PROCEDURE SetActive;                           VIRTUAL;
    PROCEDURE CheckEvent (VAR Ev : EventObj);      VIRTUAL;
  END;

  SlideBarItemPtr = ^SlideBarItem;
  SlideBarItem    = OBJECT (MenuItem)
    PROCEDURE CheckKeyEv (VAR Ev : EventObj);      VIRTUAL;
  END;

IMPLEMENTATION

(* ───────────────────────────────────────────────────── *)
(*                Implementation von MenuItem            *)
(* ───────────────────────────────────────────────────── *)
CONSTRUCTOR MenuItem.Init (nx, ny : BYTE;
                           N      : STRING;
                           AltHKC : WORD;
                           nhx,nhy: BYTE;
                           H      : STRING;
                           NewVSM : WExtVSMPtr);
BEGIN
  IF N[1]<>' ' THEN N := ' '+N;
  IF SAAItem.Init (nx, ny, N, AltHKC, NewVSM) THEN BEGIN
    ActCol := ActiveItemColor;  HelpCol := HelpStrColor;
    HKCol := MenuHotKeyCol;     Col := MenuItemColor;
    hx := nhx;  hy := nhy;
    GetMem (HelpStr, Succ (Length (H)));  HelpStr^ := H;
  END ELSE
    Fail
END;

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

PROCEDURE MenuItem.SetMenu (Act : BOOLEAN);
BEGIN
  MenuActive := Act;
END;

PROCEDURE MenuItem.Display;
BEGIN
  SAAItem.Display;
  SAAItem.DisplayHotKey;
  Mouse^.Hide;
  IF Active THEN BEGIN
    VSM^.FillPart (hx, hy, VSM^.GetXLength, hy,
                   HelpCol, ' ');
    VSM^.WriteStr (hx, hy, HelpCol, HelpStr^);
  END;
  IF Active THEN
    VSM^.FillPartAttr (x, y, Pred (x+Length (Name^)), y,
                       ActCol);
  Mouse^.Show;
END;

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

PROCEDURE MenuItem.CheckKeyEv (VAR Ev : EventObj);
BEGIN
  ReturnCode := ItEvNotMine;
  SAAItem.CheckKeyEv (Ev);
  IF (ReturnCode=ItEvNotMine) AND
     (Ev.EventType=EvKeyPressed) AND
     (Ev.Key=Enter) AND (Active) THEN
    ReturnCode := ItSelected;
END;

FUNCTION MenuItem.GetActCol : BYTE;
BEGIN
  GetActCol := ActCol;
END;

FUNCTION MenuItem.GetHelpCol: BYTE;
BEGIN
  GetHelpCol := HelpCol;
END;

FUNCTION MenuItem.GetHelpX : BYTE;
BEGIN
  GetHelpX := Hx;
END;

FUNCTION MenuItem.GetHelpY : BYTE;
BEGIN
  GetHelpY := hy;
END;

FUNCTION MenuItem.GetHelpStr : STRING;
BEGIN
  GetHelpStr := HelpStr^;
END;

DESTRUCTOR MenuItem.Done;
BEGIN
  SAAItem.Done;
  IF HelpStr<>NIL THEN
    FreeMem (HelpStr, Succ (Length (HelpStr^)));
END;

(* ───────────────────────────────────────────────────── *)
(*              Implementation von PopUpItem             *)
(* ───────────────────────────────────────────────────── *)
PROCEDURE PopUpItem.CheckKeyEv (VAR Ev : EventObj);
BEGIN
  IF MenuActive THEN BEGIN
    MenuItem.CheckKeyEv (Ev);
    IF (ReturnCode=ItEvNotMine) AND
       (Ev.EventType=EvKeyPressed) AND
       (Active) THEN BEGIN
      IF Ev.Key=CurUp THEN BEGIN
        SetPassive;
        ReturnCode := ItActPrev;
      END ELSE
        IF Ev.Key=CurDown THEN BEGIN
          SetPassive;
          ReturnCode := ItActNext;
        END;
    END
  END ELSE
    ReturnCode := ItEvNotMine;
END;

(* ───────────────────────────────────────────────────── *)
(*              Implementation von ExeItem               *)
(* ───────────────────────────────────────────────────── *)
CONSTRUCTOR ExeItem.Init (nx, ny : BYTE;
                          N      : STRING;
                          AltHKC : WORD;
                          nhx,nhy: BYTE;
                          H      : STRING;
                          NEnabled: BOOLEAN;
                          NewVSM : WExtVSMPtr);
BEGIN
  IF PopUpItem.Init (nx, ny, N, AltHKC,
                     nhx, nhy, H, NewVSM) THEN BEGIN
    Enabled := NEnabled;  UnAblCol := UnenabledItemCol;
  END ELSE
    Fail;
END;

PROCEDURE ExeItem.SetColors (NC,NHKC,NAC,NHC,NUC:BYTE);
BEGIN
  PopUpItem.SetColors (NC, NHKC, NAC, NHC);
  UnAblCol := NUC;
END;

PROCEDURE ExeItem.Display;
BEGIN
  IF Enabled THEN
    PopUpItem.Display
  ELSE BEGIN
    Mouse^.Hide;
    VSM^.WriteStr (x, y, UnAblCol, Name^);
    Mouse^.Show;
  END;
END;

PROCEDURE ExeItem.CheckEvent (VAR Ev : EventObj);
BEGIN
  IF Enabled THEN PopUpItem.CheckEvent (Ev)
             ELSE ReturnCode := ItEvNotMine;
END;

PROCEDURE ExeItem.SetActive;
BEGIN
  IF Enabled THEN PopUpItem.SetActive;
END;

PROCEDURE ExeItem.SetEnabled (On : BOOLEAN);
BEGIN
  Enabled := On;
END;

FUNCTION ExeItem.GetEnabled : BOOLEAN;
BEGIN
  GetEnabled := Enabled;
END;

FUNCTION ExeItem.GetUnenabledCol : BYTE;
BEGIN
  GetUnenabledCol := UnAblCol;
END;

(* ───────────────────────────────────────────────────── *)
(*            Implementation von DirectExeItem           *)
(* ───────────────────────────────────────────────────── *)
CONSTRUCTOR DirectExeItem.Init (nx, ny : BYTE;
                                N      : STRING;
                                AltHKC : WORD;
                                DC     : WORD;
                                nhx,nhy: BYTE;
                                H      : STRING;
                                NEnabl : BOOLEAN;
                                NewVSM : WExtVSMPtr);
BEGIN
  IF ExeItem.Init (nx,ny,N,AltHKC,
                   nhx,nhy,H,NEnabl,NewVSM) THEN
    DirectCode := DC
  ELSE
    Fail;
END;

PROCEDURE DirectExeItem.CheckKeyEv (VAR Ev : EventObj);
BEGIN
  IF MenuActive THEN
    ExeItem.CheckKeyEv (Ev)
  ELSE
    IF (ReturnCode=ItEvNotMine) AND
       (Ev.EventType=EvKeyPressed) AND
       (Ev.Key=DirectCode) THEN BEGIN
      ReturnCode := ItDirectSelected;
    END;
END;

(* ───────────────────────────────────────────────────── *)
(*             Implementation von SwitchItem             *)
(* ───────────────────────────────────────────────────── *)
CONSTRUCTOR SwitchItem.Init (nx, ny : BYTE;
                             N      : STRING;
                             AltHKC : WORD;
                             nhx,nhy: BYTE;
                             H      : STRING;
                             NOn    : BOOLEAN;
                             NewVSM : WExtVSMPtr);
BEGIN
  IF PopUpItem.Init (nx, ny, N, AltHKC,
                     nhx, nhy, H, NewVSM) THEN BEGIN
    On := NOn;  SwChrCol := SwitchChrColor;
  END ELSE
    Fail;
END;

PROCEDURE SwitchItem.SetColors
            (NC, NHKC, NAC, NHC, NSC : BYTE);
BEGIN
  PopUpItem.SetColors (NC, NHKC, NAC, NHC);
  SwChrCol := NSC;
END;

PROCEDURE SwitchItem.Display;
BEGIN
  PopUpItem.Display;
  Mouse^.Hide;
  IF Active THEN BEGIN
    IF On THEN VSM^.WriteChr (x, y, ActCol, '√')
          ELSE VSM^.WriteChr (x, y, ActCol, ' ');
  END ELSE
    IF On THEN VSM^.WriteChr (x, y, Col, '√')
          ELSE VSM^.WriteChr (x, y, Col, ' ');
  Mouse^.Show;
END;

PROCEDURE SwitchItem.CheckEvent (VAR Ev : EventObj);
BEGIN
  PopUpItem.CheckEvent (Ev);
  IF ReturnCode=ItSelected THEN BEGIN
    On := NOT On;
    Display;
    ReturnCode := ItEvAccepted;
  END;
END;

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

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

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

FUNCTION SwitchItem.GetSwChrCol : BYTE;
BEGIN
  GetSwChrCol := SwChrCol;
END;

(* ───────────────────────────────────────────────────── *)
(*           Implementation von GlobalSwitchItem         *)
(* ───────────────────────────────────────────────────── *)
CONSTRUCTOR GlobalSwitchItem.Init (nx, ny : BYTE;
                                   N      : STRING;
                                   AltHKC : WORD;
                                   nhx,nhy: BYTE;
                                   H      : STRING;
                                   NOnPtr : BooleanPtr;
                                   NewVSM : WExtVSMPtr);
BEGIN
  IF SwitchItem.Init (nx, ny, N, AltHKC,
                      nhx, nhy, H,
                      NOnPtr^, NewVSM) THEN
    OnPtr := NOnPtr
  ELSE
    Fail;
END;

PROCEDURE GlobalSwitchItem.CheckEvent (VAR Ev : EventObj);
BEGIN
  SwitchItem.CheckEvent (Ev);
  IF (ReturnCode=ItEvAccepted) THEN
    OnPtr^ := On;
END;

PROCEDURE GlobalSwitchItem.SaveConfiguration;
BEGIN
  SaveFl := OnPtr^;
END;

PROCEDURE GlobalSwitchItem.RestoreConfiguration;
BEGIN
  OnPtr^ := SaveFl;
END;

FUNCTION GlobalSwitchItem.GetState : BOOLEAN;
BEGIN
  GetState := OnPtr^;
END;

(* ───────────────────────────────────────────────────── *)
(*               Implementation von LineItem             *)
(* ───────────────────────────────────────────────────── *)
CONSTRUCTOR LineItem.Init (x1,y1,x2 : BYTE;
                           NewVSM   : WExtVSMPtr);
  VAR i : INTEGER;
      s : STRING;
BEGIN
  s := '';
  FOR i := 1 TO Pred (x2-x1) DO
    S := s+'─';
  S := '├'+S+'┤';  FrameCol := MenuFrameColor;
  HelpStr := NIL;
  IF NOT SAAItem.Init (x1,y1,S,0,NewVSM) THEN
    Fail;
END;

PROCEDURE LineItem.SetColors (NFC : BYTE);
BEGIN
  FrameCol := NFC;
END;

PROCEDURE LineItem.Display;
BEGIN
  Mouse^.Hide;
  VSM^.WriteStr (x, y, FrameCol, Name^);
  Mouse^.Show;
END;

PROCEDURE LineItem.SetActive;
BEGIN
  ReturnCode := ItFinish;
END;

PROCEDURE LineItem.CheckEvent (VAR Ev : EventObj);
BEGIN
  PopUpItem.CheckEvent (Ev);
  IF ReturnCode=ItSelected THEN
    ReturnCode := ItFinish;
END;

(* ───────────────────────────────────────────────────── *)
(*            Implementation von SlideBarItem            *)
(* ───────────────────────────────────────────────────── *)
PROCEDURE SlideBarItem.CheckKeyEv (VAR Ev : EventObj);
BEGIN
  MenuItem.CheckKeyEv (Ev);
  IF (ReturnCode=ItEvNotMine) AND
     (Ev.EventType=EvKeyPressed) AND
     (Active) THEN
    IF Ev.Key=CurLeft THEN BEGIN
      SetPassive;
      ReturnCode := ItActPrev;
    END ELSE
      IF Ev.Key=CurRight THEN BEGIN
        SetPassive;
        ReturnCode := ItActNext;
      END;
END;

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