Keskustelu: Koodit: QB: Menusysteemi

'QBasic-Menusysteemi
'Vaatii QBasicin käynnistämisen /L -parametrilla ja hiiren
'Tekijä Antti Laaksonen

CONST TAUSTAVARI = 7  'taustan väri
CONST TEKSTIVARI = 0  'tavallisen tekstin väri
CONST TEKSTIHVARI = 8 'himmennetyn tekstin väri
CONST TEKSTIVVARI = 7 'tekstin väri valittuna
CONST PNVARI = 15     'pikanäppäinmerkinnän väri
CONST VVARI = 0       'valitun kohdan väri

TYPE RegType
   ax AS INTEGER
   bx AS INTEGER
   cx AS INTEGER
   dx AS INTEGER
   BP AS INTEGER
   SI AS INTEGER
   DI AS INTEGER
   FLAGS AS INTEGER
END TYPE

TYPE tmenu
  tyyppi AS INTEGER       '0=päämenu, 1=alamenu, 2=merkittävä alamenu
  teksti AS STRING * 20   'menukohdan teksti
  tila AS INTEGER         '0=tavallinen, 1=himmennetty, 2=näkymätön, 3=valittu
END TYPE

DIM SHARED menu(1 TO 100) AS tmenu 'kaikki menukohdat sisältävä taulukko
DIM SHARED menut%, vi%, vvi%, vai% 'menukohtien määrä, valittu menu,
                                   'viimeksi valittu menu, ja menu,
                                   'jonka päällä hiiri on
DIM SHARED lx%, ly%                'hiiren paikka

DIM SHARED o AS RegType
DIM SHARED i AS RegType

lukui% = 0
DO
  lukui% = lukui% + 1
  ON ERROR RESUME NEXT
  READ menu(lukui%).tyyppi, menu(lukui%).teksti, menu(lukui%).tila
  IF ERR <> 0 THEN EXIT DO
LOOP
ERR = 0
menut% = lukui% - 1


CLS
PiirraYlaMenu


x = AlustaHiiri(onko%, napit%)
IF onko% <> -1 THEN GOTO virhe

NaytaHiiri 1


DO
  a = LueHiiri(n%, x%, y%)
  lx% = INT(80 / 639 * x%) + 1 'lasketaan x ja y
  ly% = INT(25 / 199 * y%) + 1 'tekstitilan kohtana

  IF n% = 1 THEN Napsautus

  PiirraAlaMenu

  'Tähän väliin kirjoitetaan itse ohjelma
  COLOR 7, 0
  LOCATE 23, 50: PRINT "https://www.ohjelmointiputka.net"

LOOP


END

virhe:
PRINT "Hiirtä ei löytynyt!"
END
RESUME

'Menudata muodossa tyyppi, teksti, tila ks. TYPE tmenu
DATA 0, Ohjelma, 0
DATA 1, Piippaa, 0
DATA 1, Sulje, 0
DATA 0, Esimerkki, 0
DATA 1, Kohta1, 0
DATA 1, -, 0
DATA 1, Himmennetty, 1
'pelkkä - tekee väliviivan

FUNCTION AlustaHiiri (onko%, napit%)
  i.ax = 0

  CALL INTERRUPT(&H33, i, o)

  onko% = o.ax
  napit% = o.bx
END FUNCTION

FUNCTION HaeMenu (nimi$)
  FOR j = 1 TO menut%
    IF RTRIM$(menu(j).teksti) = nimi$ THEN
      HaeMenu = j
      EXIT FUNCTION
    END IF
  NEXT
END FUNCTION

FUNCTION LueHiiri (nappi%, x%, y%)
  i.ax = 3
  CALL INTERRUPT(&H33, i, o)
  nappi% = o.bx
  x% = o.cx
  y% = o.dx
END FUNCTION

SUB Napsautus
  'aktivoituu, kun hiirtä painetaan

  'jos valittiin joku päämenuista...
  IF ly% = 1 THEN
    kohta = 4
    FOR j = 1 TO menut%
      IF menu(j).tyyppi = 0 AND menu(j).tila <> 2 THEN
        vkohta = kohta
        mt$ = RTRIM$(menu(j).teksti)
        kohta = kohta + LEN(mt$) + 2
        IF vkohta <= lx% + 1 AND kohta >= lx% - 1 THEN
          vi% = j
          PiirraAlaMenu
        END IF
      END IF
    NEXT
  END IF

  'tähän tulee, mitä eri valikkokomennoista tapahtuu
  IF vai% <> 0 THEN
    SELECT CASE vai%
    CASE HaeMenu("Piippaa")
      BEEP
    CASE HaeMenu("Sulje")
      END
    END SELECT
    vi% = 0
  END IF
END SUB

SUB NaytaHiiri (tapa%)
  i.ax = tapa%
  CALL INTERRUPT(&H33, i, o)
END SUB

SUB PiirraAlaMenu
  IF vi% <> vvi% THEN COLOR 0, 0: CLS : PiirraYlaMenu
  kohta = 4
  FOR j = 1 TO menut%
    IF menu(j).tyyppi = 0 AND menu(j).tila <> 2 THEN
      vkohta = kohta
      mt$ = RTRIM$(menu(j).teksti)
      kohta = kohta + LEN(mt$) + 2
      IF j = vi% THEN
        uj% = j
        COLOR TEKSTIVARI, TAUSTAVARI
        LOCATE 2, vkohta - 1: PRINT "┌" + STRING$(20, "Ä") + "┐"
        vai% = 0
        hp% = 0
        FOR k = 3 TO 10
          uj% = uj% + 1
          IF menu(uj%).tyyppi = 0 THEN EXIT FOR
          IF menu(uj%).tila <> 2 THEN
            IF RTRIM$(menu(uj%).teksti) = "-" THEN
              LOCATE k - kp%, vkohta - 1
              PRINT "├" + STRING$(20, "Ä") + "┤"
            ELSE
              LOCATE k - kp%, vkohta - 1: PRINT "│";
              IF menu(uj%).tila = 1 THEN
                COLOR TEKSTIHVARI, TAUSTAVARI
              END IF
              IF ly% = k AND lx% >= vkohta AND lx% < vkohta + 20 THEN
                IF menu(uj%).tila = 1 THEN
                  COLOR TEKSTIHVARI, TAUSTAVARI
                ELSE
                  COLOR TEKSTIVVARI, VVARI
                END IF
                vai% = uj%
              END IF
              PRINT menu(uj%).teksti;
              COLOR TEKSTIVARI, TAUSTAVARI
              PRINT "│"
            END IF
          ELSE
            kp% = kp% + 1
          END IF
        NEXT
        LOCATE k - kp%, vkohta - 1: PRINT "└" + STRING$(20, "─") + "┘"
      END IF
    END IF
  NEXT
  vvi% = vi%
END SUB

SUB PiirraYlaMenu
  LOCATE 1
  COLOR TEKSTIVARI, TAUSTAVARI
  PRINT STRING$(2, " ")
  kohta = 3
  FOR j = 1 TO menut%
    IF menu(j).tyyppi = 0 AND menu(j).tila <> 2 THEN
      IF menu(j).tila = 1 THEN
        COLOR TEKSTIHVARI, TAUSTAVARI
      ELSEIF j = vi% THEN
        COLOR TEKSTIVVARI, VVARI
      ELSE
        COLOR TEKSTIVARI, TAUSTAVARI
      END IF
      LOCATE 1, kohta
      mt$ = " " + RTRIM$(menu(j).teksti) + " "
      PRINT mt$
      kohta = kohta + LEN(mt$)
    END IF
  NEXT
  COLOR TEKSTIHVARI, TAUSTAVARI
  LOCATE 1, kohta
  PRINT STRING$(80 - kohta, " ")
END SUB

SUB RajaaHiiri (xp%, xs%, yp%, ys%)
  i.ax = 7
  i.cx = xp%
  i.dx = xs%
  CALL INTERRUPT(&H33, i, o)
  i.ax = 8
  i.cx = yp%
  i.dx = ys%
  CALL INTERRUPT(&H33, i, o)
END SUB