Turbo Toolbox/Turbo_Toolbox.iso/dtx9302/tvision/tvpas/xmenus.pas

Pascal/Delphi Source File | 1992-11-10 | 22.5 KB | 840 lines

(* ------------------------------------------------------ *)
(*                       XMENUS.PAS                       *)
(*                                                        *)
(*   Routinen und Objekte für erweiterte Menüfunktionen   *)
(*        (C) 1992 by Christian Ohr & DMV-Verlag          *)
(* ------------------------------------------------------ *)
{$R-,S-,I-,B-,D-,L-,V-,A+,F+,O+,X+}


UNIT XMenus;


INTERFACE


USES Objects, Views, Drivers, Menus, App;


CONST
  cmPinMenuOpen  = 130;
  cmPinMenuClose = 131;
  cmPin          = 132;
  cmOwnerCloses  = 133;

  cWinMenuView   =  #9#10#11#12#13#14;
  cWinStatusLine =  #9#10#11#12#13#14;


TYPE

  (* Wird ein Menüpunkt der Menüzeile mit der rechten     *)
  (* Maustaste angeklickt, so wird das zugehörige Unter-  *)
  (* menü in den Desktop eingefügt. Näheres siehe bei     *)
  (* tPinMenuBox. Wird ein Menü normal geöffnet, so wird  *)
  (* eine tRipMenuBox erzeugt.                            *)

  pRipMenuBar = ^tRipMenuBar;
  tRipMenuBar = OBJECT(tMenuBar)
    Rip : BOOLEAN;
    CONSTRUCTOR Init (VAR Bounds: tRect; AMenu: pMenu);
    CONSTRUCTOR Load (VAR S: tStream);
    PROCEDURE HandleEvent (VAR Event: tEvent); VIRTUAL;
    FUNCTION NewSubView(VAR Bounds: tRect; AMenu: pMenu;
                        AParentMenu: pMenuView)
                        : pMenuView; VIRTUAL;
    FUNCTION NewPinView (VAR Bounds: tRect; AMenu: pMenu)
                        : pMenuView; VIRTUAL;
    PROCEDURE Store (VAR S: tStream); VIRTUAL;
  END;


  (* Wird ein Menüpunkt der Menübox, hinter dem sich ein  *)
  (* weiteres Untermenü verbirgt, mit der rechten Maus-   *)
  (* taste angeklickt, so wird ein Untermenü vom Typ      *)
  (* tPinMenuBox erzeugt und in den Desktop eingefügt.    *)
  (* Wird normal angeklickt, so ist d. Untermenü wiederum *)
  (* vom Typ tRipMenuBox.                                 *)

  pRipMenuBox = ^tRipMenuBox;
  tRipMenuBox = OBJECT(tMenuBox)
    Rip : BOOLEAN;
    CONSTRUCTOR Init(VAR Bounds: tRect; AMenu: pMenu;
                     AParentMenu: pMenuView);
    CONSTRUCTOR Load (VAR S: tStream);
    PROCEDURE GetEvent (VAR Event: tEvent); VIRTUAL;
    PROCEDURE HandleEvent (VAR Event: tEvent); VIRTUAL;
    FUNCTION NewSubView (VAR Bounds: tRect; AMenu: pMenu;
                         AParentMenu: pMenuView)
                         : pMenuView; VIRTUAL;
    FUNCTION NewPinView (VAR Bounds: tRect; AMenu: pMenu)
                        : pMenuView; VIRTUAL;
    PROCEDURE Store (VAR S: tStream); VIRTUAL;
  PRIVATE
    PM: tPoint;
  END;


  (* Diese tPinMenuBox ist frei auf dem Bildschirm ver-   *)
  (* schiebbar. Sie kann durch Anklicken d.Schließbuttons *)
  (* oder mit ESCape wieder geschlossen werden. Eine      *)
  (* tPinMenuBox drängelt sich immer v. alle nichtmodalen *)
  (* View-Objekte auf dem Desktop.                        *)

  pPinMenuBox = ^tPinMenuBox;
  tPinMenuBox = OBJECT(tRipMenuBox)
    MyOwner: pView;
    CONSTRUCTOR Init (VAR Bounds: tRect; AMenu: pMenu;
                      AnOwner: pView);
    CONSTRUCTOR Load (VAR S: tStream);
    PROCEDURE Draw; VIRTUAL;
    PROCEDURE HandleEvent (VAR Event: tEvent); VIRTUAL;
    FUNCTION NewPinView (VAR Bounds: tRect; AMenu: pMenu)
                        : pMenuView; VIRTUAL;
    PROCEDURE Store (VAR S: tStream); VIRTUAL;
  END;


  (* tWinRipMenuBar korrigiert die Farben der MenuBar     *)
  (* innerhalb des Windows.                               *)

  pWinRipMenuBar = ^tWinRipMenuBar;
  tWinRipMenuBar = OBJECT(tRipMenuBar)
    FUNCTION GetPalette: pPalette; VIRTUAL;
    FUNCTION NewSubView(VAR Bounds: tRect; AMenu: pMenu;
                        AParentMenu: pMenuView)
                        : pMenuView; VIRTUAL;
  END;


  (* tWinRipMenuBox achtet darauf, daß d. Menü nicht oben *)
  (* aus dem Fenster herausgeschoben wird, falls d. Platz *)
  (* in der Vertikalen nicht ausreicht. Außerdem wird die *)
  (* Farbe der Window-Palette angepaßt.                   *)

  pWinRipMenuBox = ^tWinRipMenuBox;
  tWinRipMenuBox = OBJECT(tRipMenuBox)
    CONSTRUCTOR Init (VAR Bounds: tRect; aMenu: pMenu;
                      aParentMenu: pMenuView);
    FUNCTION GetPalette: pPalette; VIRTUAL;
    FUNCTION NewSubView (VAR Bounds: tRect; AMenu: pMenu;
                         AParentMenu: pMenuView)
                         : pMenuView; VIRTUAL;
  END;

  (* tWinStatusLine korrigiert die Farben der StatusLine  *)
  (* innerhalb des Windows.                               *)

  pWinStatusLine = ^tWinStatusLine;
  tWinStatusLine = OBJECT(tStatusLine)
    FUNCTION GetPalette: pPalette; VIRTUAL;
  END;


  (* Wenn beim Öffnen einer tAltF3MenuBox doppelt geklickt*)
  (* wurde, wird ein Betätigen der Tastenkombination Alt- *)
  (* F3 simuliert.                                        *)

  pAltF3MenuBox = ^tAltF3MenuBox;
  tAltF3MenuBox = OBJECT(tMenuBox)
    PROCEDURE GetEvent (VAR Event: tEvent); VIRTUAL;
  END;


CONST
  rRipMenuBar: tStreamRec = (
    ObjType: 1300;
    VmtLink: Ofs(TypeOf(tRipMenuBar)^);
    Load:    @tRipMenuBar.Load;
    Store:   @tRipMenuBar.Store
  );
  rRipMenuBox: tStreamRec = (
    ObjType: 1301;
    VmtLink: Ofs(TypeOf(tRipMenuBox)^);
    Load:    @tRipMenuBox.Load;
    Store:   @tRipMenuBox.Store
  );
  rPinMenuBox: tStreamRec = (
    ObjType: 1302;
    VmtLink: Ofs(TypeOf(tPinMenuBox)^);
    Load:    @tPinMenuBox.Load;
    Store:   @tPinMenuBox.Store
  );
  rWinRipMenuBar: tStreamRec = (
    ObjType: 1310;
    VmtLink: Ofs(TypeOf(tWinRipMenuBar)^);
    Load:    @tWinRipMenuBar.Load;
    Store:   @tWinRipMenuBar.Store
  );
  rWinRipMenuBox: tStreamRec = (
    ObjType: 1311;
    VmtLink: Ofs(TypeOf(tWinRipMenuBox)^);
    Load:    @tWinRipMenuBox.Load;
    Store:   @tWinRipMenuBox.Store
  );
  rAltF3MenuBox: tStreamRec = (
    ObjType: 1312;
    VmtLink: Ofs(TypeOf(tAltF3MenuBox)^);
    Load:    @tAltF3MenuBox.Load;
    Store:   @tAltF3MenuBox.Store
  );
  rWinStatusLine: tStreamRec = (
    ObjType: 1320;
    VmtLink: Ofs(TypeOf(tWinStatusLine)^);
    Load:    @tWinStatusLine.Load;
    Store:   @tWinStatusLine.Store
  );


(* Einfügen v. Menüpunkten. Der Menüpunkt Item (kann auch *)
(* ein komplettes Submenu sein) wird hinter dem Menüpunkt *)
(* Behind in die Menüstruktur eingefügt                   *)

PROCEDURE PutItem (Item, Behind: pMenuItem);


(* Ausklinken von Menüpunkten. Der Menüpunkt nach Behind  *)
(* wird aus d. Menüstruktur genommen. Um einen bestimmten *)
(* Punkt auszufügen, ist ein Aufruf erforderlich wie etwa *)
(* RemoveItem(FindBeforeItem(FirstMenu, cmRemove, TRUE)); *)

FUNCTION  DeleteItem (Behind: pMenuItem): pMenuItem;


(* Löschen von Menüpunkten. Handelt es sich bei Item um   *)
(* e. komplettes Untermenü wird dieses inklusive weiterer *)
(* Untermenüs rekursiv aus dem Speicher geworfen          *)

PROCEDURE FreeItem (Item: pMenuItem);


(* Finden des aktuellen Menüpunkts. Diese Funktion gibt   *)
(* die Adresse des aktuellen Menüpunkts zurück. Aufrufbsp.*)
(*   RemoveItem(FindDefaultItem(FirstMenu, cmThisCmd));   *)
(* Dieser Aufruf bewirkt, das der Nachfolger d. gewählten *)
(* Menüpunkts aus der Menüstruktur ausgeklinkt wird.      *)

FUNCTION  FindDefaultItem (Start: pMenu; Cmd: WORD)
                          : pMenuItem;


(* Sucht ab dem Eintrag Start einen Menüpunkt mit dem     *)
(* Kommando Cmd. Näheres siehe FindBeforeItem             *)

FUNCTION  FindItem (Start: POINTER; Cmd: WORD;
                    Recurs: BOOLEAN): pMenuItem;


(* Sucht ab dem Eintrag Start (Menüpunkt, Submenü oder    *)
(* pMenu-Typ) dem Vorgänger des Menüpunkts m. d. Kommando *)
(* Cmd. Ist Recurs TRUE, so werden auch alle gefundenen   *)
(* Submenus abgeklappert. Da das erste Recordelement von  *)
(* tMenu und tMenuItem jeweils ein Zeiger auf d. nächsten *)
(* Menüpunkt ist, kann für beide Typen d. gleiche Routine *)
(* verwendet werden.                                      *)

FUNCTION  FindBeforeItem (Start: POINTER; Cmd: WORD;
                          Recurs: BOOLEAN): pMenuItem;


(* Sucht ab dem Eintrag Start ein Untermenü mit dem Namen *)
(* Name. Näheres siehe FindBeforeSubMenu                  *)

FUNCTION  FindSubMenu (Start: POINTER; Name: tMenuStr;
                       Recurs: BOOLEAN): pMenuItem;


(* Sucht ab dem Eintrag Start (Menüpunkt, Submenü oder    *)
(* pMenu-Typ) dem Vorgänger des Menüpunkts mit dem Namen  *)
(* Name. Ist Recurs TRUE, so werden auch alle gefundenen  *)
(* Submenüs abgeklappert.                                 *)

FUNCTION  FindBeforeSubMenu (Start: POINTER; Name: tMenuStr;
                             Recurs: BOOLEAN): pMenuItem;


(* Gibt die Startadresse der aktuellen Menüleiste zurück  *)

FUNCTION  FirstMenu: pMenu;


(* ------------------------------------------------------ *)
(* Prozeduren zum alternativen Aufbau von Menüstrukturen  *)
(* ------------------------------------------------------ *)

PROCEDURE StartMenuAt (Menu: pMenu);
PROCEDURE AddSub (Name: tMenuStr; AHelpCtx: WORD);
PROCEDURE AddItem (Name, param: tMenuStr; KeyCode,
                   Command, AHelpCtx: WORD);
PROCEDURE AddLine;
PROCEDURE CloseSub (Name: tMenuStr);



PROCEDURE RegisterXMenus;


IMPLEMENTATION


VAR
  FirstMenuRec : pMenu;
  CurrentItem  : pMenuItem;
  CurrentMenu  : pMenu;



(* ------------------------------------------------------ *)
(*                      tRipMenuBar                       *)
(* ------------------------------------------------------ *)


CONSTRUCTOR tRipMenuBar.Init(VAR Bounds: tRect;
                             AMenu: pMenu);
BEGIN
  tMenuBar.Init(Bounds, AMenu);
  Rip := TRUE;
END;


CONSTRUCTOR tRipMenuBar.Load (VAR S: tStream);
BEGIN
  tMenuBar.Load(S);
  S.Read(Rip, SizeOf(BOOLEAN));
END;


PROCEDURE tRipMenuBar.HandleEvent (VAR Event: tEvent);
VAR
  P: tPoint;
  R: tRect;
  Item: pMenuItem;
BEGIN
  IF Rip AND (Event.What = evMouseDown) AND
     (Event.Buttons = mbRightButton) THEN
    IF (Menu <> NIL) AND (Menu^.Items <> NIL) THEN BEGIN

      (* Herausfinden, welcher Menüpunkt angeklickt wurde *)
      MakeLocal(Event.Where, P);
      Item := pMenuItem(Menu);
      REPEAT
        GetItemRect(Item^.Next, R);
        Item := Item^.Next;
      UNTIL (Item = NIL) OR R.Contains(P);

      (* Neues pMenu erzeugen und an pPinMenuBox leiten *)
      IF Item <> NIL THEN BEGIN
        MakeGlobal(R.A, R.A);
        Desktop^.MakeLocal(R.A, R.A);
        R.Move(-1, 1);
        Desktop^.Insert(NewPinView(R, Item^.SubMenu));
      END;
      ClearEvent(Event);
    END;

  tMenuBar.HandleEvent(Event);
END;


FUNCTION tRipMenuBar.NewSubView(VAR Bounds: tRect;
                     AMenu: pMenu; AParentMenu : pMenuView)
                     : pMenuView;
BEGIN
  NewSubView := New(pRipMenuBox, Init(
                    Bounds, AMenu, AParentMenu));
END;


FUNCTION tRipMenuBar.NewPinView (VAR Bounds: tRect;
                  AMenu: pMenu): pMenuView;
BEGIN
  NewPinView := New(pPinMenuBox, Init(Bounds, AMenu,Owner));
END;


PROCEDURE tRipMenuBar.Store (VAR S: tStream);
BEGIN
  tMenuBar.Store(S);
  S.Write(Rip, SizeOf(BOOLEAN));
END;



(* ------------------------------------------------------ *)
(*                      tRipMenuBox                       *)
(* ------------------------------------------------------ *)


CONSTRUCTOR tRipMenuBox.Init(VAR Bounds: tRect;
               AMenu: pMenu; AParentMenu: pMenuView);
BEGIN
  tMenuBox.Init(Bounds, AMenu, AParentMenu);
  Rip := TRUE;
END;


CONSTRUCTOR tRipMenuBox.Load (VAR S: tStream);
BEGIN
  tMenuBox.Load(S);
  S.Read(Rip, SizeOf(BOOLEAN));
END;


PROCEDURE tRipMenuBox.GetEvent (VAR Event: tEvent);
BEGIN
  tMenuBox.GetEvent(Event);
  IF Rip AND (Event.What = evMouseDown) AND
    (Event.Buttons = mbRightButton) THEN BEGIN
    PM := Event.Where;
    ClearEvent(Event);
    Event.What := evCommand;
    Event.Command := cmPin;
  END;
END;


PROCEDURE tRipMenuBox.HandleEvent (VAR Event: tEvent);
VAR
  R: tRect;
  Item: pMenuItem;
BEGIN
  IF Event.Command = cmPin THEN BEGIN
    MakeLocal(PM, PM);
    Item := pMenuItem(Menu);
    REPEAT
      GetItemRect(Item^.Next, R);
      Item := Item^.Next;
    UNTIL (Item = NIL) OR R.Contains(PM);

    IF (Item <> NIL) AND (Item^.Command = 0) THEN BEGIN
      MakeGlobal(PM, R.A);
      Desktop^.MakeLocal(R.A, R.A);
      Desktop^.Insert(NewPinView(R, Item^.SubMenu));
      ClearEvent(Event);
    END;
  END;

  tMenuBox.HandleEvent(Event);
END;


FUNCTION tRipMenuBox.NewSubView(VAR Bounds: tRect;
           AMenu: pMenu; AParentMenu: pMenuView): pMenuView;
BEGIN
  NewSubView := New(pRipMenuBox, Init(
                    Bounds, AMenu, AParentMenu));
END;


FUNCTION tRipMenuBox.NewPinView (VAR Bounds: tRect;
                  AMenu: pMenu): pMenuView;
BEGIN
  NewPinView := New(pPinMenuBox, Init(Bounds, AMenu,Owner));
END;


PROCEDURE tRipMenuBox.Store (VAR S: tStream);
BEGIN
  tMenuBox.Store(S);
  S.Write(Rip, SizeOf(BOOLEAN));
END;



(* ------------------------------------------------------ *)
(*                      tPinMenuBox                       *)
(* ------------------------------------------------------ *)

CONSTRUCTOR tPinMenuBox.Init (VAR Bounds: tRect;
             AMenu: pMenu; AnOwner: pView);
BEGIN
  IF AMenu <> NIL THEN BEGIN
    tRipMenuBox.Init(Bounds, AMenu, NIL);
    MyOwner := AnOwner;
    MoveTo(Bounds.A.X, Bounds.A.Y);
    Options := Options AND NOT ofSelectable; {OR ofTopSelect;}
    Message(Application, evBroadcast, cmPinMenuOpen, @Self);
  END;
END;


CONSTRUCTOR tPinMenuBox.Load (VAR S: tStream);
BEGIN
  tRipMenuBox.Load(S);
  GetPeerViewPtr(S, MyOwner);
END;


PROCEDURE tPinMenuBox.Draw;
BEGIN
  tRipMenuBox.Draw;
  WriteChar(3, 0, '[', 1, 1);
  WriteChar(4, 0, #254, 3, 1);
  WriteChar(5, 0, ']', 1, 1);
END;


PROCEDURE tPinMenuBox.HandleEvent (VAR Event: tEvent);
VAR
  Limits: tRect;
  P: tPoint;

  PROCEDURE ClosePinMenu;
  BEGIN
    Message(Application, evBroadcast, cmPinMenuClose,@Self);
    Free;
  END;

BEGIN
  CASE Event.What OF
    evMouseDown:
      BEGIN
        MakeLocal(Event.Where, P);
        IF P.Y = 0 THEN BEGIN
          IF (P.X > 2) AND (P.X < 6) THEN
            ClosePinMenu ELSE
          BEGIN
            Owner^.GetExtent(Limits);
            (* Nur bis zur Menüzeile verschiebbar *)
            Inc(Limits.A.Y, Pred(Size.Y));
            DragView(Event, dmDragMove, Limits,
                     Limits.A, Limits.B);
          END;
          ClearEvent(Event);
        END;
      END;
    evKeyDown:
      IF Event.KeyCode = kbEsc THEN BEGIN
        ClosePinMenu;
        ClearEvent(Event);
      END;
    evBroadcast:
      CASE Event.Command OF
        cmOwnerCloses:
          IF pView(Event.InfoPtr) = MyOwner THEN
            ClosePinMenu;
        cmCommandSetChanged:
          DrawView;
        cmReceivedFocus:
          IF NOT pView(Event.InfoPtr)^.GetState(sfModal)
            THEN MakeFirst;
      END;
  END;
  tRipMenuBox.HandleEvent(Event);
END;


FUNCTION tPinMenuBox.NewPinView (VAR Bounds: tRect;
                  AMenu: pMenu) : pMenuView;
BEGIN
  NewPinView := New(pPinMenuBox, Init(Bounds, AMenu,
                                      MyOwner));
END;


PROCEDURE tPinMenuBox.Store (VAR S: tStream);
BEGIN
  tRipMenuBox.Store(S);
  PutPeerViewPtr(S, MyOwner);
END;



(* ------------------------------------------------------ *)
(*                     tWinRipMenuBar                     *)
(* ------------------------------------------------------ *)


FUNCTION tWinRipMenuBar.GetPalette: pPalette;
CONST
  P: STRING[Length(cWinMenuView)] = cWinMenuView;
BEGIN
  GetPalette := @P;
END;


FUNCTION tWinRipMenuBar.NewSubView(VAR Bounds: tRect;
           AMenu: pMenu; AParentMenu: pMenuView): pMenuView;
BEGIN
  NewSubView := New(pWinRipMenuBox, Init(
                    Bounds, AMenu, AParentMenu));
END;



(* ------------------------------------------------------ *)
(*                    tWinRipMenuBox                      *)
(* ------------------------------------------------------ *)

CONSTRUCTOR tWinRipMenuBox.Init (VAR Bounds: tRect;
                    aMenu: pMenu; aParentMenu: pMenuView);

VAR
  W, H, L: INTEGER;
  P: pMenuItem;
  R: tRect;
BEGIN
  W := 10; H := 2;
  IF AMenu <> NIL THEN BEGIN
    P := AMenu^.Items;
    WHILE P <> NIL DO BEGIN
      IF P^.Name <> NIL THEN BEGIN
        L := CStrLen(P^.Name^) + 6;
        IF P^.Command = 0 THEN
          Inc(L, 3) ELSE
          IF P^.Param <> NIL THEN
            Inc(L, CStrLen(P^.Param^) + 2);
        IF L > W THEN W := L;
      END;
      Inc(H);
      P := P^.Next;
    END;
  END;
  R.Copy(Bounds);
  IF R.A.X + W < R.B.X THEN
    R.B.X := R.A.X + W ELSE BEGIN
      R.A.X := Pred(R.B.X - W);
      R.B.X := Pred(R.B.X);
    END;
  IF R.A.Y + H < R.B.Y THEN
    R.B.Y := R.A.Y + H ELSE
    R.B.Y := Pred(R.B.Y);
  tMenuView.Init(R);
  State := State OR sfShadow;
  Options := Options OR ofPreProcess;
  Menu := AMenu;
  ParentMenu := AParentMenu;

END;


FUNCTION tWinRipMenuBox.GetPalette: pPalette;
CONST
  P: STRING[Length(cWinMenuView)] = cWinMenuView;
BEGIN
  GetPalette := @P;
END;


FUNCTION tWinRipMenuBox.NewSubView(VAR Bounds: tRect;
          AMenu: pMenu; AParentMenu: pMenuView): pMenuView;
BEGIN
  NewSubView := New(pWinRipMenuBox, Init(
                    Bounds, AMenu, AParentMenu));
END;



(* ------------------------------------------------------ *)
(*                    tWinStatusLine                      *)
(* ------------------------------------------------------ *)


FUNCTION tWinStatusLine.GetPalette: pPalette;
CONST
  P: STRING[Length(cWinStatusLine)] = cWinStatusLine;
BEGIN
  GetPalette := @P;
END;



(* ------------------------------------------------------ *)
(*                    tAltF3MenuBox                       *)
(* ------------------------------------------------------ *)


PROCEDURE tAltF3MenuBox.GetEvent (VAR Event: tEvent);
BEGIN
  tMenuBox.GetEvent(Event);
  IF (Event.What = evMouseDown) AND Event.DOUBLE THEN BEGIN
    Event.What := evKeyDown;
    Event.KeyCode := kbAltF3;
  END;
END;




PROCEDURE PutItem (Item, Behind: pMenuItem);
BEGIN
  IF (Item <> NIL) AND (Behind <> NIL) THEN BEGIN
    Item^.Next := Behind^.Next;
    Behind^.Next := Item;
  END;
END;


FUNCTION DeleteItem (Behind: pMenuItem): pMenuItem;
BEGIN
  IF Behind <> NIL THEN BEGIN
    DeleteItem := Behind^.Next;
    Behind^.Next := Behind^.Next^.Next
  END ELSE DeleteItem := NIL;
END;


PROCEDURE FreeItem (Item: pMenuItem);
BEGIN
  IF Item <> NIL THEN
    IF Item^.Command <> 0 THEN
      Dispose(Item) ELSE
      DisposeMenu(Item^.SubMenu);
END;


FUNCTION FindDefaultItem (Start: pMenu; Cmd: WORD)
                          : pMenuItem;
VAR
  Item: pMenuItem;
  Menu: pMenu;
BEGIN
  IF Start <> NIL THEN BEGIN
    Menu := Start;
    Item := Menu^.Default;
    WHILE (Item <> NIL) AND (Item^.Command <> Cmd) DO
      IF Item^.Command = 0 THEN BEGIN
        Menu := Item^.SubMenu;
        Item := Menu^.Default
      END ELSE Item := NIL;
  END;
  FindDefaultItem := Item
END;


FUNCTION FindItem (Start: POINTER; Cmd: WORD;
                   Recurs: BOOLEAN): pMenuItem;
VAR
  Item: pMenuItem;
BEGIN
  Item := FindBeforeItem(Start, Cmd, Recurs);
  IF Item <> NIL THEN
    FindItem := Item^.Next ELSE
    FindItem := NIL;
END;


FUNCTION FindBeforeItem (Start: POINTER; Cmd: WORD;
                         Recurs: BOOLEAN): pMenuItem;
VAR
  SubItem, Item: pMenuItem;
BEGIN
  IF Start <> NIL THEN BEGIN
    Item := Start;
    WHILE (Item^.Next <> NIL) AND
          (Item^.Next^.Command <> Cmd) DO
      IF (Item^.Next^.Command = 0) AND
         (Item^.Next^.Name <> NIL) AND Recurs THEN BEGIN
        SubItem := FindBeforeItem(Item^.Next^.SubMenu, Cmd,
                                  Recurs);
        IF SubItem^.Next <> NIL THEN
          Item := SubItem ELSE
          Item := Item^.Next;
      END ELSE Item := Item^.Next;
    FindBeforeItem := Item
  END ELSE FindBeforeItem := NIL;
END;


FUNCTION FindSubMenu (Start: POINTER; Name: tMenuStr;
                      Recurs: BOOLEAN): pMenuItem;
VAR
  Item: pMenuItem;
BEGIN
  Item := FindBeforeSubMenu(Start, Name, Recurs);
  IF Item <> NIL THEN
    FindSubMenu := Item^.Next ELSE
    FindSubMenu := NIL;
END;


FUNCTION FindBeforeSubMenu (Start: POINTER; Name: tMenuStr;
                             Recurs: BOOLEAN): pMenuItem;
VAR
  SubItem, Item: pMenuItem;
BEGIN
  IF Start <> NIL THEN BEGIN
    Item := Start;
    WHILE (Item^.Next <> NIL) AND
          (Item^.Next^.Name^ <> Name) DO
      IF (Item^.Next^.Command = 0) AND
         (Item^.Next^.Name <> NIL) AND Recurs THEN BEGIN
        SubItem := FindBeforeSubMenu(Item^.Next^.SubMenu,
                                     Name, Recurs);
        IF SubItem^.Next <> NIL THEN
          Item := SubItem ELSE
          Item := Item^.Next;
      END ELSE Item := Item^.Next;
    FindBeforeSubMenu := Item
  END ELSE FindBeforeSubMenu := NIL;
END;


FUNCTION FirstMenu: pMenu;
BEGIN
  IF MenuBar <> NIL THEN
    FirstMenu := MenuBar^.Menu ELSE
    FirstMenu := NIL;
END;



PROCEDURE StartMenuAt (Menu: pMenu);
BEGIN
  FirstMenuRec := Menu;
  CurrentMenu := FirstMenuRec;
  CurrentItem := pMenuItem(FirstMenuRec);
END;


PROCEDURE AddSub (Name: tMenuStr; AHelpCtx: WORD);
BEGIN
  PutItem(NewSubMenu(Name, AHelpCtx, NewMenu(NIL), NIL),
          CurrentItem);
  CurrentMenu^.Default := CurrentMenu^.Items;
  CurrentMenu := CurrentItem^.Next^.SubMenu;
  CurrentItem := pMenuItem(CurrentMenu);
END;


PROCEDURE AddItem (Name, Param: tMenuStr; KeyCode,
                       Command, AHelpCtx: WORD);
BEGIN
  PutItem(NewItem(Name, Param, KeyCode, Command, AHelpCtx,
          NIL), CurrentItem);
  CurrentMenu^.Default := CurrentMenu^.Items;
  CurrentItem := CurrentItem^.Next;
END;


PROCEDURE AddLine;
BEGIN
  PutItem(NewLine(NIL), CurrentItem);
  CurrentItem := CurrentItem^.Next;
END;


PROCEDURE CloseSub (Name: tMenuStr);
BEGIN
  CurrentItem := FindSubMenu(FirstMenuRec, Name, TRUE);
END;


PROCEDURE RegisterXMenus;
BEGIN
  RegisterType(rRipMenuBar);
  RegisterType(rRipMenuBox);
  RegisterType(rPinMenuBox);
  RegisterType(rWinRipMenuBar);
  RegisterType(rWinRipMenuBox);
  RegisterType(rAltF3MenuBox);
  RegisterType(rWinStatusLine);
END;


END.


(* ------------------------------------------------------ *)
(*                 Ende von XMENUS.PAS                    *)