' *** POPCHOIC.LST *** 2nd GFA-Manual, page 8-12 > PROCEDURE pop_choice(x,y,VAR pop.choice$(),pop.choice!()) ' ' *** First call Procedure Pop_choice_init to fill array pop.choice$() ' *** Pop-up menu appears at position (x&,y&) ' *** Activate (and deactivate) choice with mouse-click ' *** If there are more than 10 choices, you'll have to scroll the menu ' *** Press or click right mouse-button on menu-title to get Help-screen ' *** Confirm choices by clicking right button outside menu or press ' *** Choices are returned in Boolean array pop.choice!() ' *** Works in High resolution only! ' ' *** Standard: physbase% x.max& y.max& char.height& char.width& ' *** Procedure: Pop_choice_init [call before using this Procedure!] ' LOCAL n,lines,height,width,xb,yh,x8,i,r$,m0,m1,y_pos,c,f,top,f_pos LOCAL mx,my,mk,screen$,in$,step$,h.x n=DIM?(pop.choice$())-1 ERASE pop.choice!() DIM pop.choice!(n) ' IF n>10 ! width, height and position of box height=260 lines=13 ELSE height=n*20+20 lines=n ENDIF width=LEN(pop.choice$(0)) FOR i=1 TO n width=MAX(LEN(pop.choice$(i)),width) NEXT i width=(width+4)*8 x=MIN(x,x.max-width-16) y=MIN(y,125) x=MAX(x,10) y=MAX(y,20) xb=ADD(x,width) yh=ADD(y,height) x8=ADD(x,8) GET x-3,y-3,xb+3,yh+3,r$ ! save part of screen ' ACLIP 1,0,0,x.max,y.max ! box + text m1=-1 ARECT x-3,y-2,xb+3,yh+2,1,0,V:m1,0 m0=0 ARECT x,SUCC(y),xb,PRED(yh),1,0,V:m0,0 y_pos=y+20 FOR i=1 TO lines HLINE x,y_pos,xb,1,0,V:m1,0 ADD y_pos,20 NEXT i c=width/8-2 IF lines=13 y_pos=y+42 ATEXT x8,y+22,2,STRING$(c,1) ! up arrows ATEXT x8,y+242,2,STRING$(c,2) ! down arrows ELSE y_pos=y+22 ENDIF ATEXT x8+(c-LEN(pop.choice$(0)))*4,y+7,1,pop.choice$(0) ! title FOR i=1 TO MIN(lines,10) ATEXT ADD(x8,MUL((SUB(c,LEN(pop.choice$(i)))),4)),y_pos,2,pop.choice$(i) ADD y_pos,20 NEXT i ' top=0 f=-1 {ADD(XBIOS(14,1),6)}=0 ! clear keyboard-buffer ' REPEAT ! menu-selection loop MOUSE mx,my,mk in$=INKEY$ IF in$=CHR$(0)+CHR$(98) OR (mk=1 AND mx>x AND mxy AND my GRAPHMODE 4 DEFFILL 1,2,4 PBOX 0,0,x.max,y.max GRAPHMODE 1 DEFFILL 0,1 h.x=14 PBOX MUL(SUB(h.x,3),char.width),MUL(4,char.height),MUL(ADD(ADD(h.x,51),LEN(field$)),char.width),MUL(15,char.height) BOX MUL(SUB(h.x,3),char.width),MUL(4,char.height),MUL(ADD(ADD(h.x,51),LEN(field$)),char.width),MUL(15,char.height) {ADD(XBIOS(14,1),6)}=0 ! clear keyboard-buffer WHILE MOUSEK ! mouse released? WEND PRINT AT(h.x+8,6);" Activate choice with left mouse-button" IF lines>10 PRINT AT(h.x+8,8);" Scroll one line with left mouse-click" PRINT AT(h.x+6,10);" Hold right button to scroll to begin/end" ENDIF PRINT AT(h.x,12);" Ready: or right click outside rectangle" PRINT AT(ADD(h.x,17),14);" Press any key" BOX MUL(ADD(h.x,15),char.width),SUB(MUL(13,char.height),2),MUL(ADD(h.x,34),char.width),ADD(MUL(14,char.height),2) REPEAT UNTIL LEN(INKEY$) OR MOUSEK SPUT screen$ in$="" ENDIF ' IF mx>x AND mxy+20 AND myf IF f<>-1 ARECT SUCC(x),y+f*20+2,PRED(xb),y+f*20+18,1,2,V:m1,0 ! normal ENDIF f=TRUNC((my-y)/20) ! new choice ARECT SUCC(x),y+f*20+2,PRED(xb),y+f*20+18,1,2,V:m1,0 ! reverse ENDIF ELSE IF f<>-1 ARECT SUCC(x),y+f*20+2,PRED(xb),y+f*20+18,1,2,V:m1,0 ! normal ENDIF f=-1 ENDIF ' IF mk=1 IF (f>1 AND f<12 AND lines=13) OR (f>0 AND f<11 AND lines<>13) f_pos=f+top ! click on choice IF lines=13 DEC f_pos ENDIF pop.choice!(f_pos)=NOT pop.choice!(f_pos) ! switch IF pop.choice!(f_pos) ARECT SUCC(x),y+f*20+2,PRED(xb),y+f*20+18,1,2,V:m1,0 ATEXT PRED(xb)-8,y+f*20+2,2,CHR$(8) ! mark choice ARECT SUCC(x),y+f*20+2,PRED(xb),y+f*20+18,1,2,V:m1,0 ELSE ARECT PRED(xb)-8,y+f*20+2,PRED(xb),y+f*20+18,1,0,V:m1,0 ! unmark ENDIF WHILE MOUSEK WEND MOUSE mx,my,mk ENDIF ENDIF ' IF lines=13 AND (f=1 OR f=12) AND mk IF f=1 ! scroll down IF top>0 RC_COPY physbase%,SUCC(x),y+40,PRED(width),height-80 TO physbase%,SUCC(x),y+60 ARECT SUCC(x),y+41,PRED(xb),y+59,1,0,V:m0,0 ATEXT x8+(c-LEN(pop.choice$(top)))*4,y+42,2,pop.choice$(top) IF pop.choice!(top) ATEXT PRED(xb)-8,y+42,2,CHR$(8) ! mark ENDIF DEC top ENDIF ELSE IF top+11<=n ! scroll up RC_COPY physbase%,SUCC(x),y+60,PRED(width),height-80 TO physbase%,SUCC(x),y+40 ARECT SUCC(x),y+221,PRED(xb),y+239,1,0,V:m0,0 ATEXT x8+(c-LEN(pop.choice$(top+11)))*4,y+222,2,pop.choice$(top+11) IF pop.choice!(top+11) ATEXT PRED(xb)-8,y+222,2,CHR$(8) ! mark ENDIF INC top ENDIF ENDIF WHILE MOUSEK=1 WEND mk=0 ENDIF ' UNTIL (mk=2 AND f=-1) OR in$=CHR$(13) ! leave menu PUT x-3,y-3,r$ ! restore screen ACLIP 0,0,0,x.max,y.max RETURN > PROCEDURE pop_choice_init(VAR menu$()) ' ' *** Call this Procedure before using Pop_choice ' *** Title en choices are returned in string-array ' LOCAL n,i,pop$ RESTORE pop.data n=-1 REPEAT READ pop$ INC n UNTIL pop$="***" DEC n IF DIM?(menu$()) ERASE menu$() ENDIF DIM menu$(n) RESTORE pop.data FOR i=0 TO n READ menu$(i) NEXT i ' ' *** Menu-title on first DATA-line, followed by the choices pop.data: DATA Menu-title DATA 1st choice,2nd choice,3rd choice,4th choice,5th choice,6th choice DATA 7th choice,8th choice,9th choice,10th choice,11th choice DATA 12th choice,13th choice,14th choice,15th choice DATA *** RETURN ' ********* '