home *** CD-ROM | disk | FTP | other *** search
/ Inside Multimedia 1995 August / IMM0895.BIN / magazin / optix / disk1 / optxppac.set / MENUE.OPT < prev    next >
Text File  |  1995-03-22  |  8KB  |  393 lines
  1.  
  2. def(x)
  3. def(y)
  4. def(i)
  5. def(j)
  6. def(flag)
  7. def(dum1)
  8. def(dum2)
  9. def(dum3)
  10. def(dum4)
  11. def(back)
  12. defs(dum$)
  13. defs(dum1$)
  14. defs(dum2$)
  15. defs(text$,'')
  16. defs(dither$,'')
  17. defs(char$,'')
  18. def(taste)
  19.  
  20. def(index%)
  21. def(index2%)
  22. def(start%,1)
  23. def(start2%,9)
  24. def(anzahl%,7)
  25. def(anzahl2%,4)
  26. defaw(mflag&,30)
  27. defas(mfeld$,30,30)
  28. rem Textfeld einrichten
  29.  
  30. include('dither.inc')
  31.  
  32. procedure checktaste
  33.   taste:=readkey
  34.   back:=0
  35.   if taste=left
  36.     dec(x,5)
  37.   endif
  38.   if taste=right
  39.     inc(x,5)
  40.   endif
  41.   if taste=up
  42.     dec(y,5)
  43.   endif
  44.   if taste=down
  45.     inc(y,5)
  46.   endif
  47.   if taste>0
  48.     cursmove(x,y)
  49.   endif
  50.   if taste=13
  51.     back:=-1
  52.   endif
  53. return
  54.  
  55. procedure max(wert,max)
  56.   rem liefert i.d.Global 'back' den größeren der beiden Werte (wert od. max)
  57.   back:=wert
  58.   if wert<=max
  59.     back:=max
  60.   endif
  61. return
  62.  
  63. procedure min(wert,min)
  64.   rem liefert i.d.Global 'back' den kleineren der beiden Werte (wert od. min)
  65.   back:=wert
  66.   if wert>=min
  67.     back:=min
  68.   endif
  69. return
  70.  
  71. procedure menue(pm1,mmx,mxl,myo,mxr,myu)
  72.   rem
  73.   rem ###############################################
  74.   rem
  75.   rem 'MENUE' erzeugt ein bewegliches Menü (POPUP od. PULLDOWN).
  76.   rem
  77.   rem ################################################
  78.   rem
  79.   rem Pm1  = Index des Menüpunktes (Textfeldindex), der an erster
  80.   rem        Stelle erscheinen soll. Die Texte müssen ab Index 0
  81.   rem        im Textfeld stehen.
  82.   rem Mmx  = Anzahl der Menüpunkte, die ab 'Pm1' dargestellt
  83.   rem        werden sollen. Der Menü-Index liegt immer im
  84.   rem        Bereich von 1 bis 'Mmx%'.
  85.   rem Mxl, Myo, Mxr, Myu
  86.   rem      = Rahmenkoordinaten, innerhalb derer das Menü dargestellt
  87.   rem        werden soll. Passt das Menü nicht in den Rahmen, liegt
  88.   rem        die linke, obere Ecke des Menüs immer auf der
  89.   rem        linken, oberen Ecke des Rahmens.
  90.   rem
  91.   rem        Die globale Rückgabevariable 'return' enthält nach Abschlu₧
  92.   rem        den Index des gewählten Menüpunktes im Textfeld (Index
  93.   rem        des Punktes im aktuellen Menü plus Startindex 'Pm1' !).
  94.   rem
  95.   rem        Im numerischen Parallelfeld 'mflag' muß für jeden Menü-
  96.   rem        Eintrag ein Flag gesetzt sein (=1), ob er aktiv (wählbar)
  97.   rem        sein soll. Falls nicht, wird der Punkt inaktiv (grau)
  98.   rem        dargestellt. Dieser Menüpunkt kann dann nicht angewählt werden.
  99.   rem
  100.   rem        Nach Rückkehr ist Sysfont 3 eingestellt
  101.  
  102.   locals(msk,xkox,ykoy,yi,mi,mxl2,mxr2,myo2,myu2)
  103.  
  104.   for mi:=0 To mmx-1 do
  105.     dum$:=mfeld$[mi+Pm1]
  106.     len(dum$,msk)
  107.     max(msk,back)
  108.   next(mi)
  109.  
  110.   msk :=mousek
  111.   xkox:=mousex
  112.   if msk=2
  113.     mxl2:=xkox-(back*8+20*2)/2
  114.   else
  115.     mxl2:=xkox
  116.   endif
  117.   bound(mxl2,mxl,mxr-back*8-20*2)
  118.   mxr2:=mxl2+back*8+20*2
  119.   if msk=2
  120.     myo2:=mousey-10
  121.   else
  122.     myo2:=myo
  123.   endif
  124.   bound(myo2,myo,myu-18+mmx*18)
  125.   myu2:=myo2+(18+mmx*18)
  126.  
  127.   min(mxl,mxl2)
  128.   mxl:=back
  129.   min(myo,myo2)
  130.   myo:=back
  131.   scrtobuf
  132.   cursoff
  133.  
  134.   viewport(mxl2,myo2,mxr2,myu2)
  135.   rem *** cbox(8,8,0) // 'einpixeln' ***
  136.   cbox(0,8,0)
  137.   decviewport
  138.   plateau(7,0)
  139.   viewport(mxl2+6,myo2+6,mxr2-6,myu2-6)
  140.   cbox(0,1,0)
  141.   plateau(0,9)
  142.   setbcolor(0)
  143.   setcolor(15)
  144.   sysfont(1,1)
  145.  
  146.   for mi:=0 to mmx-1 do
  147.     viewport(mxl2+13,myo2-6+mi*18+17,mxr2-13,myo2+6+mi*18+18)
  148.     cbox(0,7,0)
  149.     setcolor(15)
  150.     plateau(15,0)
  151.     if mflag&[mi+pm1]=on
  152.       setcolor(15)
  153.       printat(mxl2+21,myo2+mi*18+13,mfeld$[mi+pm1])
  154.       setcolor(1)
  155.       printat(mxl2+22,myo2+mi*18+14,mfeld$[mi+pm1])
  156.     else
  157.       setcolor(8)
  158.       printat(mxl2+22,myo2+mi*18+14,mfeld$[mi+pm1])
  159.     endif
  160.   next(mi)
  161.  
  162.   setcolor(12)
  163.   sysfont(3,0)
  164.  
  165.   curson(mousex,mousey)
  166.  
  167.   repeat
  168.  
  169.     x:=mousex
  170.     y:=mousey
  171.     checktaste
  172.     xkox:=mousex
  173.     ykoy:=mousey
  174.     msk:=mousek
  175.     max(1,(ykoy-(myo2-8))/18)
  176.     yi:=back
  177.     flag:=0
  178.  
  179.     inbox(mxl2+12,myo2-8,mxr2-13,myu2-6,dum1)
  180.     if dum1=true
  181.  
  182.       if yi<=mmx
  183.         flag:=1
  184.  
  185.         if mflag&[yi+pm1-1]=on
  186.           cursoff
  187.           noise(190,0)
  188.           viewport(mxl2+13,myo2-7+yi*18,mxr2-13,myo2+6+yi*18)
  189.           cbox(13,0,0)
  190.           copywin(mxl2+15,myo2-6+yi*18,mxr2-16,myo2+3+yi*18)
  191.           loadwin(mxl2+16,myo2-5+yi*18,8,10)
  192.           curson(mousex,mousey)
  193.         endif
  194.  
  195.         repeat
  196.           checktaste
  197.           msk:=mousek
  198.           if back:=-1
  199.             msk:=1
  200.           endif
  201.           if mousex<mxl2+12
  202.             msk:=-1
  203.           endif
  204.           if mousex>mxr2-13
  205.             msk:=-1
  206.           endif
  207.  
  208.           back:=(mousey-(myo2-8))/18
  209.           if yi<>back
  210.             msk:=-1
  211.           endif
  212.         until msk<>0
  213.  
  214. :menurepeat2exit
  215.  
  216.         if mflag&[yi+pm1-1]=on
  217.           cursoff
  218.           viewport(mxl2+13,myo2-7+yi*18,mxr2-13,myo2+6+yi*18)
  219.           cbox(13,0,0)
  220.           copywin(mxl2+16,myo2-4+yi*18,mxr2-15,myo2+4+yi*18)
  221.           loadwin(mxl2+15,myo2-5+yi*18,8,10)
  222.           curson(mousex,mousey)
  223.         else
  224.           msk:=0
  225.         endif
  226.  
  227.       endif
  228.     endif
  229.  
  230.     if flag=0
  231.       yi:=0
  232.     endif
  233.  
  234.     inbox(mxl2,myo2,mxr2,myu2,flag)
  235.     if flag=0
  236.       if mousek>0
  237.         rem       // EXIT, nur falls Mausklick außerhalb
  238.         goto('menurepeat1exit')
  239.       endif
  240.     endif
  241.  
  242.     if msk>0
  243.       if yi>0
  244.         if yi<=mmx
  245.           goto('menurepeat1exit')
  246.         endif
  247.       endif
  248.     endif
  249.  
  250.   until mousek=2
  251.  
  252. :menurepeat1exit
  253.  
  254.   mi:=yi
  255.   max(mxl2,0)
  256.   dum1:=back
  257.   max(myo2,0)
  258.   dum2:=back
  259.   min(mxr2,639)
  260.   dum3:=back
  261.   min(myu2,479)
  262.   dum4:=back
  263.   cursoff
  264.   back:=mi-1
  265.   viewport(dum1,dum2,dum3,dum4)
  266.   rem ***  restorebox(8,0)  // 'auspixeln' ***
  267.   restorebox(0,0)
  268.   curson(mousex,mousey)
  269.  
  270. return
  271.  
  272. begin
  273.  
  274.   readfont(1,'hel15x29.fnt')
  275.   font(1)
  276.   new(mfeld$)
  277.   new(mflag&)
  278.  
  279.   rem *** 'aktiviert'-Flags setzen
  280.   for i:=1 to 30 do
  281.     mflag&[i]:=1
  282.   next(i)
  283.   mflag&[1] :=0
  284.   mflag&[5] :=0
  285.   mflag&[6] :=0
  286.   mflag&[8] :=0
  287.   mflag&[9] :=0
  288.   mflag&[10]:=0
  289.  
  290.   rem *** Textfeld-Einträge setzen
  291.   mfeld$[1] :='----------'
  292.   mfeld$[2] :='SPEICHERN'
  293.   mfeld$[3] :='LADEN'
  294.   mfeld$[4] :='LÖSCHEN'
  295.   mfeld$[5] :='KOPIEREN'
  296.   mfeld$[6] :='----------'
  297.   mfeld$[7] :='QUIT'
  298.   mfeld$[8] :='----------'
  299.   mfeld$[9] :='Testmenü2'
  300.   mfeld$[10]:='-------------'
  301.   mfeld$[11]:='Irgendwas1'
  302.   mfeld$[12]:='Irgendwas2'
  303.  
  304.   clearscreen(4)
  305.  
  306.   dither(0,20,120,7,16,3)
  307.   copywin(20,120,23,310)
  308.   for i:=0 to 7 do
  309.     loadwin(24+i*4,120,0,0)
  310.   next(i)
  311.   copywin(20,120,51,310)
  312.   for i:=0 to 17 do
  313.     loadwin(52+32*i,120,0,0)
  314.   next(i)
  315.   textcolor(0)
  316.   textbcolor(8)
  317.   setcolor(15)
  318.   setbcolor(0)
  319.   viewport(20,120,628,312)
  320.   plateau(15,0)
  321.   incviewport
  322.   plateau(15,0)
  323.   textcofs(2)
  324.   writestyle(3)
  325.   textshadow(3,3)
  326.   printc(320,180,'PopUp/PullDown-Menu')
  327.  
  328.   viewport(220,215,338,245)
  329.   cbox(0,7,0)
  330.   plateau(15,0)
  331.   printc(280,230,'Menu 1')
  332.   viewport(340,215,480,245)
  333.   cbox(0,7,0)
  334.   plateau(15,0)
  335.   printc(410,230,'Menu 2')
  336.   curson(mousex,mousey)
  337.   x:=mousex
  338.   y:=mousey
  339.  
  340.   font(0)
  341.   sysfont(3,1)
  342.   setcolor(0)
  343.   printc(320,202,'(rechte Maustaste=POPUP)')
  344.   setcolor(15)
  345.  
  346.   repeat
  347.     repeat
  348.       checktaste
  349.       inbox(340,215,480,245,dum1)
  350.       if dum1=true
  351.         menue(start2%,anzahl2%,340,215,480,245)
  352.         index2%:=back
  353.       endif
  354.       inbox(220,215,338,245,dum1)
  355.       if dum1=true
  356.         menue(start%,anzahl%,220,215,338,245)
  357.         index%:=back
  358.       endif
  359.       if mousek=2
  360.         menue(start%,anzahl%,mousex,mousey,mousex,mousey)
  361.         index%:=back
  362.       endif
  363.     until index%>0
  364.     if index%+start%=2
  365.       mflag&[index%+start%+1]:=on
  366.       mflag&[index%+start%]:=off
  367.       printat(1,1,'gewählt: Speichern     ')
  368.     endif
  369.     if index%+start%=3
  370.       mflag&[index%+start%]:=off
  371.       mflag&[index%+start%-1]:=on
  372.       printat(1,1,'gewählt: Laden         ')
  373.     endif
  374.     if index%+start%=4
  375.       printat(1,1,'gewählt: Löschen       ')
  376.     endif
  377.     if index%+start%=5
  378.       printat(1,1,'gewählt: Kopieren      ')
  379.     endif
  380.     if index%+start%=7
  381.       printat(1,1,'gewählt: Quit          ')
  382.     endif
  383.     str(index%,3,dum$)
  384.     printat(1,32,'Menüindex : '+dum$)
  385.   until (index%+start%)=7
  386.  
  387.  
  388. end
  389.  
  390.  
  391.  
  392.  
  393.