Być może, komuś się jeszcze przyda. Na przykład jako inspiracja by zaimplementować to w innym języku programowania lub mikrokontrolerze z wyświetlaczem...
Program oczywiście ma niedociągnięcia, z czego najważniejsza to brak buforowania ekranu oraz przywracania jego fragmentów.
Kod: Zaznacz cały
DECLARE FUNCTION MenuSystem (MenuBar$(), MenuBoxes$())
DEFINT A-Z
DIM Menu$(10) 'max. 10 menu w listwie
DIM PopMenu$(10, 30) '10 menu z 30 pozycjami
Menu$(1) = "Pliki": Menu$(2) = "Edycja"
Menu$(3) = "Szukaj": Menu$(4) = "Zapytanie"
Menu$(5) = "Raport": Menu$(6) = "Pomoc"
Menu$(7) = "Informacje"
PopMenu$(1, 1) = "Nowa baza"
PopMenu$(1, 2) = "Ładuj bazę ..."
PopMenu$(1, 3) = "Dołącz z bazy ..."
PopMenu$(1, 4) = "Zapisz bazę"
PopMenu$(1, 5) = "Zapisz bazę jako ..."
PopMenu$(1, 6) = "-" 'linia oddzielająca
PopMenu$(1, 7) = "Wyjście z programu"
PopMenu$(2, 1) = "Edycja struktury"
PopMenu$(2, 2) = "Kopiuj strukturę z ..."
PopMenu$(2, 3) = "-"
PopMenu$(2, 4) = "Wyczyść rekord"
PopMenu$(2, 5) = "Kopiuj rekord"
PopMenu$(2, 6) = "Usuń rekord"
PopMenu$(2, 7) = "-"
PopMenu$(2, 8) = "Porządkuj bazę danych ..."
PopMenu$(3, 1) = "Szukaj ..."
PopMenu$(3, 2) = "Szukaj następnego"
PopMenu$(3, 3) = "Zamień ..."
PopMenu$(3, 4) = "-"
PopMenu$(3, 5) = "Idź do ..."
PopMenu$(4, 1) = "Utwórz zapytanie ..."
PopMenu$(4, 2) = "Popraw zapytanie ..."
PopMenu$(4, 3) = "Zapytaj teraz"
PopMenu$(5, 1) = "Utwórz raport ..."
PopMenu$(5, 2) = "Przedstaw raport"
PopMenu$(5, 3) = "Drukuj raport ..."
PopMenu$(6, 1) = "Głowna strona pomocy"
PopMenu$(6, 2) = "Indeks haseł"
PopMenu$(6, 3) = "Pomoc na temat"
PopMenu$(6, 4) = "-"
PopMenu$(6, 5) = "Jak używać pomocy"
PopMenu$(7, 1) = "O Ali która miała kota"
PopMenu$(7, 2) = "O Policjancie który ma pałę"
PopMenu$(7, 3) = "O 40 krasnoludkach i jednym transwestycie"
SCREEN 0
Wybor = MenuSystem(Menu$(), PopMenu$())
SELECT CASE Wybor
CASE 701: PRINT "Była sobie Ala, miała małego kotka."
PRINT "Resztę przeczytaj w instrukcji obsługi"
PRINT "Strona 10, wiersz 39"
CASE 107: END
END SELECT
DEFSNG A-Z
FUNCTION MenuSystem (MenuBar$(), MenuBoxes$())
DEFINT A-Z
MenuSystem = 0 'wartość początkowa funkcji (zwracana gdy pomijane menu)
MaxWidth = 1 'maksymalna szerokość menu
MaxMenu = 1 'ilość pozycji w listwie (obliczana!)
CurMenu = 1 'bieżące menu
CurItem = 1 'bieżąca pozycja w menu
CurColumn = 1 'kolumna w której wyświetlane jest menu
CLS
GOSUB PokazListwe
GOSUB ObliczDl
GOSUB PokazMenu2
DO
'klawisze obslugi MenuBox
DO
Key$ = INKEY$
LOOP UNTIL Key$ <> ""
SELECT CASE Key$
CASE CHR$(0) + "H"
CurItem = CurItem - 1
IF LEFT$(MenuBoxes$(CurMenu, CurItem), 1) = "-" THEN CurItem = CurItem - 1
IF CurItem < 1 THEN CurItem = 1
GOSUB PokazMenu
CASE CHR$(0) + "P"
CurItem = CurItem + 1
IF LEFT$(MenuBoxes$(CurMenu, CurItem), 1) = "-" THEN CurItem = CurItem + 1
IF CurItem > MaxItem THEN CurItem = MaxItem
GOSUB PokazMenu
CASE CHR$(0) + "K"
CurMenu = CurMenu - 1: IF CurMenu < 1 THEN CurMenu = 1
COLOR , 0: CLS
GOSUB PokazListwe: GOSUB ObliczDl: GOSUB PokazMenu2
CASE CHR$(0) + "M"
CurMenu = CurMenu + 1: IF CurMenu > MaxMenu THEN CurMenu = MaxMenu
COLOR , 0: CLS
GOSUB PokazListwe: GOSUB ObliczDl: GOSUB PokazMenu2
CASE CHR$(13)
MenuSystem = CurItem + 100 * CurMenu
EXIT FUNCTION
CASE CHR$(27)
'return zero
EXIT FUNCTION
CASE ELSE: SOUND 1400, .5
END SELECT
LOOP
ObliczDl:
MaxWidth = 1: Item = 1
'oblicz długość najdłuższej pozycji z menu i ilość pozycji
WHILE MenuBoxes$(CurMenu, Item) <> ""
CurWidth = LEN(MenuBoxes$(CurMenu, Item))
IF (CurWidth > MaxWidth) THEN MaxWidth = CurWidth
Item = Item + 1
WEND
MaxItem = Item - 1: CurItem = 1 'przypisuje ilość pozycji
RETURN
PokazListwe:
Item = 1: CurColumn = 4: Column = 4
LOCATE 1, 1, 0: COLOR 0, 7: PRINT SPACE$(80)
LOCATE 1, 4, 0
WHILE MenuBar$(Item) <> ""
IF (Item = CurMenu) THEN
COLOR 14, 2: CurColumn = Column
ELSE
COLOR 0, 7
END IF
PRINT " "; MenuBar$(Item); " ";
Column = Column + LEN(MenuBar$(Item)) + 2: Item = Item + 1
MaxMenu = Item - 1
WEND
COLOR 7, 0
RETURN
PokazMenu2:
'sprawdza czy menu zmieści się na ekranie
MenuTo = CurColumn + MaxWidth + 5
IF (MenuTo > 80) THEN
CurColumn = CurColumn + (80 - MenuTo)
'obliczono nową pozycję
END IF
PokazMenu:
LOCATE 2, CurColumn, 0
COLOR 0, 7: PRINT " "; CHR$(218); STRING$(MaxWidth + 2, CHR$(196)); CHR$(191); " "
FOR Item = 1 TO MaxItem
LOCATE Item + 2, CurColumn, 0: COLOR 0, 7
IF LEFT$(MenuBoxes$(CurMenu, Item), 1) = "-" THEN
PRINT " "; CHR$(195); STRING$(MaxWidth + 2, CHR$(196)); CHR$(180); " ";
ELSE
PRINT " "; CHR$(179);
IF (Item = CurItem) THEN COLOR 14, 2 ELSE COLOR 0, 7
PRINT " "; MenuBoxes$(CurMenu, Item); SPACE$(MaxWidth - LEN(MenuBoxes$(CurMenu, Item)) + 1);
COLOR 0, 7: PRINT CHR$(179); " ";
END IF
COLOR 7, 0: PRINT
NEXT Item
LOCATE Item + 2, CurColumn, 0: COLOR 0, 7
PRINT " "; CHR$(192); STRING$(MaxWidth + 2, CHR$(196)); CHR$(217); " ";
COLOR 7, 0: PRINT
RETURN
END FUNCTION