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

Pascal/Delphi Source File | 1991-01-04 | 10.2 KB | 329 lines

(* ----------------------------------------------------- *)
(*                      MNUSCHED.PAS                     *)
(*                                                       *)
(* ■ MenuScheduler: Implementiert die für vertikale und  *)
(*   horizontale Menüs gemeinsamen Methoden.             *)
(* ■ SlideBarMenu: Ein horizontales Menü, das nur Ein-   *)
(*   träge vom Type "SlideBarItem" aufnimmt. Soll als    *)
(*   "Mainmenu" im Pulldownmenü gebraucht werden.        *)
(* ■ PopUpMenu: Ein vertikales Menü, das alle Typen von  *)
(*   Einträgen annimmt, die von "PopUpItem" abstammen.   *)
(*   Gedacht als "Submenu" im Pulldownmenü; könnte auch  *)
(*   als eigenständiges Menü gebraucht werden. Init      *)
(*   müssen die Koordinaten für den Rahmen angegeben     *)
(*   werden, auch hier findet keinerlei Überprüfung der  *)
(*   Koordinaten statt.                                  *)
(*                                                       *)
(*           (c) 1991 by R.Reichert & toolbox            *)
(* ----------------------------------------------------- *)
UNIT MnuSched;

INTERFACE

USES Stuff, MouKey,   WinVSM, Windows,
     Lists, SAASched, MnuItems;

CONST                                      { ReturnCodes: }
  SchOk        = 0;  { alles Ok                           }
  SchEvNotMine = 1;  { Event nicht meins                  }
  SchActNext   = 2;  { aktiviere nächsten Scheduler       }
  SchActPrev   = 3;  { aktiviere vorhergehenden Scheduler }
  SchEvAccepted= 4;  { Event akzeptiert                   }

  ActNextSubMenu = 5;  { aktiviere vorhergehend. Untermenü}
  ActPrevSubMenu = 6;  { aktiviere nächstes Untermenü     }
  ActSubMenu     = 7;  { aktiviere aktuelles Untermenü    }

  MenuSelected   = 8;  { Menü - ExeItem gewählt           }
  MenuCanceled   = 9;  { Menü - mit ESC abgebrochen, aber
                         Einträge vom Typ "SwitchItem"
                         können trotzem verändert sein,
                         also immer abfragen              }
  MenuItDirectSel= 10; { Menü - DirectExeItem wurde ange-
                         wählt                            }

TYPE
  MenuSchedulerPtr = ^MenuScheduler;
  MenuScheduler    = OBJECT (SAAScheduler)

    ItemList : DListCollectionPtr;

    CONSTRUCTOR Init;
    PROCEDURE Clear;                               VIRTUAL;
    PROCEDURE Display;                             VIRTUAL;
    PROCEDURE Add (NewItem : MenuItemPtr);         VIRTUAL;
    PROCEDURE CheckEvent (VAR Ev : EventObj);      VIRTUAL;
    PROCEDURE SetActive;                           VIRTUAL;
    PROCEDURE SetPassive;                          VIRTUAL;
    FUNCTION GetResult : BYTE;
    FUNCTION GetItemNr (n:BYTE) : MenuItemPtr;     VIRTUAL;
    DESTRUCTOR Done;                               VIRTUAL;
  END;

  SlideBarMenuPtr = ^SlideBarMenu;
  SlideBarMenu    = OBJECT (MenuScheduler)

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

  PopUpMenuPtr = ^PopUpMenu;
  PopUpMenu    = OBJECT (MenuScheduler)
    Win : WindowPtr;

    CONSTRUCTOR Init (x1, y1,
                      x2, y2 : BYTE;
                      VSM    : WExtVSMPtr);
    PROCEDURE Open;
    PROCEDURE Close;
    PROCEDURE CheckEvent (VAR Ev : EventObj);      VIRTUAL;
  END;

IMPLEMENTATION

(* ───────────────────────────────────────────────────── *)
(*             Implementation von MenuScheduler          *)
(* ───────────────────────────────────────────────────── *)
CONSTRUCTOR MenuScheduler.Init;
BEGIN
  SAAScheduler.Init;
  ActiveItem := 1;
  ItemList := New (DListCollectionPtr, Init);
  IF ItemList=NIL THEN
    Fail;
END;

PROCEDURE MenuScheduler.Clear;
BEGIN
  IF NOT Displayed THEN BEGIN
    ItemList^.Clear;
    ItemNum := 0;  ActiveItem := 0;
  END;
END;

PROCEDURE MenuScheduler.Display;
BEGIN
  SAAScheduler.Display;
  MenuItemPtr (ItemList^.GotoFirstData)^.Display;
  WHILE NOT (ItemList^.IsOnLast) DO
    MenuItemPtr (ItemList^.GotoNextData)^.Display;
END;

PROCEDURE MenuScheduler.Add (NewItem : MenuItemPtr);
BEGIN
  IF (NewItem<>NIL) AND (NOT Displayed) THEN BEGIN
    ItemList^.Put (NewItem);
    Inc (ItemNum);
  END;
END;

PROCEDURE MenuScheduler.CheckEvent (VAR Ev : EventObj);
  VAR i, Answer : WORD;
      SearchAct : BOOLEAN;
BEGIN
  ReturnCode := SchEvNotMine;
  IF (NOT Displayed) THEN Exit;
  SearchAct := FALSE;
  IF (ReturnCode=SchEvNotMine) THEN BEGIN
    IF Active THEN BEGIN
      WITH MenuItemPtr (ItemList^.GetActData)^ DO BEGIN
        CheckEvent (Ev);
        Answer := GetReturnCode;
      END;
      IF Answer<>ItEvNotMine THEN
        CASE Answer OF
          ItEvAccepted : ReturnCode := SchEvAccepted;
          ItDirectSelected : ReturnCode := MenuItDirectSel;
          ItSelected : ReturnCode := MenuSelected;
          ItActNext :
            BEGIN
              WITH MenuItemPtr (ItemList^.
                     GotoNextData)^ DO BEGIN
                SetActive;
                IF GetReturnCode=ItFinish THEN BEGIN
                  MenuItemPtr (ItemList^.
                    GotoNextData)^.SetActive;
                  Inc (ActiveItem);
                END;
              END;
              Inc (ActiveItem);
              IF ActiveItem>ItemNum THEN
                ActiveItem := 1;
              ReturnCode := SchEvAccepted;
            END;
          ItActPrev :
            BEGIN
              WITH MenuItemPtr (ItemList^.
                     GotoPrevData)^ DO BEGIN
                SetActive;
                IF GetReturnCode=ItFinish THEN BEGIN
                  MenuItemPtr (ItemList^.
                    GotoPrevData)^.SetActive;
                  Dec (ActiveItem);
                END;
              END;
              Dec (ActiveItem);
              IF ActiveItem<1 THEN
              ActiveItem := ItemNum;
              ReturnCode := SchEvAccepted;
            END;
        END
      ELSE
        IF (Ev.EventType=EvKeyPressed) AND
           (Ev.Key=ESC) THEN BEGIN
          MenuItemPtr (ItemList^.GetActData)^.SetPassive;
          ReturnCode := MenuCanceled;
        END ELSE
          SearchAct := TRUE;
    END;

    IF (ActiveItem=0) OR (SearchAct) THEN BEGIN
      i := 1;  Answer := 0;
      WITH ItemList^ DO BEGIN
        MenuItemPtr (GotoFirstData)^.SetMenu (Active);
        MenuItemPtr (GetActData)^.CheckEvent (Ev);
        Answer := MenuItemPtr (GetActData)^.GetReturnCode;
        WHILE (NOT (IsOnLast)) AND
              (Answer=ItEvNotMine) DO BEGIN
          MenuItemPtr (GotoNextData)^.SetMenu (Active);
          MenuItemPtr (GetActData)^.CheckEvent (Ev);
          Answer := MenuItemPtr (GetActData)^.GetReturnCode;
          Inc (i);
        END;
        IF (Answer=ItEvAccepted) OR
           (Answer=ItSelected) THEN BEGIN
          IF SearchAct THEN
            GetItemNr (ActiveItem)^.SetPassive;
          SetActNodeTo (i);
          ActiveItem := i;
          IF Answer=ItEvAccepted THEN
            Self.ReturnCode := SchEvAccepted
          ELSE
            Self.ReturnCode := MenuSelected;
          {^^^ sonst wird der von ItemList gesetzt }
          MenuItemPtr (GetActData)^.SetActive;
          SetActive;
        END ELSE BEGIN
          IF (Answer=ItDirectSelected) THEN BEGIN
            ReturnCode := MenuItDirectSel;
            ActiveItem := i;
          END;
          SetActNodeTo (ActiveItem);
        END;
      END;
    END;
  END;
END;

PROCEDURE MenuScheduler.SetActive;
BEGIN
  IF Displayed THEN BEGIN
    SAAScheduler.SetActive;
    ItemList^.SetActNodeTo (ActiveItem);
    MenuItemPtr (ItemList^.GetActData)^.SetActive;
  END;
END;

PROCEDURE MenuScheduler.SetPassive;
BEGIN
  IF Displayed THEN BEGIN
    SAAScheduler.SetPassive;
    ItemList^.SetActNodeTo (ActiveItem);
    MenuItemPtr (ItemList^.GetActData)^.SetPassive;
  END;
END;

FUNCTION MenuScheduler.GetResult;
BEGIN
  GetResult := GetActiveItem;
END;

FUNCTION MenuScheduler.GetItemNr (n : BYTE) : MenuItemPtr;
  VAR i : WORD;
BEGIN
  i := 1;
  GetItemNr := MenuItemPtr (ItemList^.GotoFirstData);
  WHILE (i<ItemNum) AND (i<n) DO BEGIN
    GetItemNr := MenuItemPtr (ItemList^.GotoNextData);
    Inc (i);
  END;
END;

DESTRUCTOR MenuScheduler.Done;
BEGIN
  Dispose (ItemList, Done);
END;

(* ───────────────────────────────────────────────────── *)
(*            Implementation von SlideBarMenu            *)
(* ───────────────────────────────────────────────────── *)
PROCEDURE SlideBarMenu.CheckEvent (VAR Ev : EventObj);
BEGIN
  MenuScheduler.CheckEvent (Ev);
  IF ReturnCode=SchEvNotMine THEN BEGIN
    IF (Ev.EventType=EvKeyPressed) AND
       (Ev.Key=CurDown) THEN
      ReturnCode := ActSubMenu;
  END ELSE
    IF ReturnCode=MenuSelected THEN
      ReturnCode := ActSubMenu;
END;

(* ───────────────────────────────────────────────────── *)
(*               Implementation von PopUpMenu            *)
(* ───────────────────────────────────────────────────── *)
CONSTRUCTOR PopUpMenu.Init (x1, y1,
                            x2, y2 : BYTE;
                            VSM    : WExtVSMPtr);
BEGIN
  IF MenuScheduler.Init THEN BEGIN
    Win := New (WindowPtr, Init (VSM));
    IF Win<>NIL THEN BEGIN
      Win^.SetXY (x1, y1, x2, y2);
      Win^.SetClearWin (On);
      Win^.SetBackColor (MenuFrameColor);
      Win^.SetColors (MenuFrameColor, 0, 0, 0);
      Win^.SetFrame (1);
    END ELSE
      Fail;
  END ELSE
    Fail;
END;

PROCEDURE PopUpMenu.Open;
BEGIN
  Win^.Open;
  IF Win^.IsOpened THEN BEGIN
    Display;
    SetActive;
  END;
END;

PROCEDURE PopUpMenu.Close;
BEGIN
  SetPassive;
  Win^.Close;
END;

PROCEDURE PopUpMenu.CheckEvent (VAR Ev : EventObj);
BEGIN
  MenuScheduler.CheckEvent (Ev);
  IF ReturnCode=MenuCanceled THEN
    Close;
  IF (ReturnCode=SchEvNotMine) AND
     (Ev.EventType=EvKeyPressed) THEN BEGIN
    IF (Ev.Key=CurLeft) THEN BEGIN
      ReturnCode := ActPrevSubMenu;
      Close;
    END;
    IF (Ev.Key=CurRight) THEN BEGIN
      ReturnCode := ActNextSubMenu;
      Close;
    END;
  END;
END;

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