home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 08 / praxis / menu.inc < prev    next >
Encoding:
Text File  |  1989-06-12  |  4.7 KB  |  160 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      MENU.INC                          *)
  3. (*          Dynamische Pulldown Menueverwaltung           *)
  4. (*             (c) 1988 Bernd Ott & TOOLBOX               *)
  5. (* ------------------------------------------------------ *)
  6.  
  7. TYPE OptionTyp = (init, drop, hide, show);
  8.      ParamTyp  = STRING[12];
  9.  
  10. FUNCTION Menu(name : ParamTyp; option : OptionTyp): ParamTyp;
  11.  
  12. CONST highlighton  = 7;
  13.       highlightoff = 15;
  14.       kbdexit      = #252;
  15.       kbdnext      = #32;
  16.       kbdselect    = #13;
  17.  
  18. TYPE  ItemPointerTyp    = ^ItemTyp;
  19.       SubItemPointerTyp = ^SubItemTyp;
  20.  
  21.       ItemTyp = RECORD
  22.                   name  : ParamTyp;
  23.                   next  : ItemPointerTyp;
  24.                   first : SubItemPointerTyp;
  25.                 END;
  26.  
  27.       SubItemTyp = RECORD
  28.                      xpos, ypos : INTEGER;
  29.                      line       : STRING[80];
  30.                      return     : ParamTyp;
  31.                      next       : SubItemPointerTyp;
  32.                    END;
  33.  
  34.       ItemFileTyp = TEXT;
  35.  
  36. VAR   rootpointer,
  37.       hpointer1     : ItemPointerTyp;
  38.       hpointer2     : SubItemPointerTyp;
  39.       itemfile      : ItemFileTyp;
  40.       inchar        : CHAR;
  41.  
  42. PROCEDURE UnchainItem(VAR pointer : ItemPointerTyp);
  43.          { entferne Menuename aus Hauptliste, falls vorhanden }
  44.  
  45.   PROCEDURE UnchainSubItem(VAR first : SubItemPointerTyp);
  46.          { entferne Menuepunkte aus Unterliste }
  47.   BEGIN
  48.     IF first^.next <> hpointer2 THEN
  49.       UnchainSubItem(first^.next);
  50.     Dispose(first);
  51.   END;
  52.  
  53. BEGIN
  54.   IF pointer <> NIL THEN
  55.     IF pointer^.name = name THEN BEGIN
  56.       hpointer1 := pointer;
  57.       hpointer2 := pointer^.first;
  58.       UnchainSubItem(pointer^.first);
  59.       pointer   := pointer^.next;
  60.       Dispose(hpointer1);
  61.     END ELSE
  62.       UnchainItem(pointer^.next);
  63. END;
  64.  
  65. FUNCTION ChainItem(VAR pointer : ItemPointerTyp) : ItemPointerTyp;
  66.  
  67.   FUNCTION ChainSubItem(VAR first : SubItemPointerTyp) : BOOLEAN;
  68.  
  69.   VAR count, error : INTEGER;
  70.   BEGIN
  71.     IF NOT (Eof(ItemFile)) THEN BEGIN
  72.       IF first = NIL THEN BEGIN
  73.         New(first);
  74.         first^.next := NIL;
  75.         count       := 0;
  76.         REPEAT
  77.           first^.line := '';
  78.           Read(ItemFile, inchar);
  79.           REPEAT
  80.             first^.line := first^.line + inchar;
  81.             Read(ItemFile, inchar);
  82.           UNTIL inchar = ',';
  83.           count := Succ(count);
  84.           CASE count OF
  85.             1: Val(first^.line, first^.xpos, error);
  86.             2: Val(first^.line, first^.ypos, error);
  87.             3: first^.return := first^.line;
  88.           END;
  89.         UNTIL EoLn(ItemFile);
  90.         ReadLn(ItemFile);
  91.         hpointer2 := first;
  92.         ChainSubItem := TRUE;
  93.       END ELSE
  94.         ChainSubItem := ChainSubItem(first^.next);
  95.     END ELSE
  96.       ChainSubItem := FALSE;
  97.   END;
  98.  
  99. BEGIN
  100.   IF pointer = NIL THEN BEGIN
  101. {$I-}
  102.   Assign(ItemFile, name);
  103.   Reset(ItemFile);
  104. {$I+}
  105.   IF IOResult = 0 THEN BEGIN
  106.     New(pointer);
  107.     pointer^.name  := name;
  108.     pointer^.next  := NIL;
  109.     pointer^.first := NIL;
  110.     WHILE ChainSubItem(pointer^.first) DO;
  111.     hpointer2^.next := pointer^.first;
  112.     Close(ItemFile);
  113.     ChainItem := pointer;
  114.   END ELSE
  115.     ChainItem := NIL;
  116. END ELSE
  117.   IF pointer^.name = name THEN
  118.     ChainItem := pointer
  119.   ELSE
  120.     ChainItem := ChainItem(pointer^.next);
  121. END;
  122.  
  123. BEGIN
  124.   menu := '';
  125.   CASE option OF
  126.     init : RootPointer := NIL;
  127.     drop : UnchainItem(RootPointer);
  128.     hide : hpointer1 := ChainItem(RootPointer);
  129.     show : BEGIN
  130.              hpointer1 := ChainItem(RootPointer);
  131.              IF hpointer1 <> NIL THEN
  132.                WITH hpointer1^ DO BEGIN
  133.                  hpointer2 := first;
  134.                  REPEAT
  135.                    hpointer2 := hpointer2^.next;
  136.                    GotoXY(hpointer2^.xpos, hpointer2^.ypos);
  137.                    Write(hpointer2^.line);
  138.                  UNTIL hpointer2 = first;
  139.                  REPEAT
  140.                    GotoXY(first^.xpos, first^.ypos);
  141.                    TextColor(highlighton);
  142.                    Write(first^.line);
  143.                    TextColor(highlightoff);
  144.                    Read(KBD, inchar);
  145.                    CASE inchar OF
  146.                      kbdnext : BEGIN
  147.                                  GotoXY(first^.xpos, first^.ypos);
  148.                                  Write(first^.line);
  149.                                  first := first^.next;
  150.                                END;
  151.                      kbdselect : menu := first^.return;
  152.                      kbdexit   : menu := 'exit';
  153.                    END;
  154.                  UNTIL inchar IN [kbdselect, kbdexit];
  155.                END;
  156.            END;
  157.   END;
  158. END;
  159.  
  160.