set display mode 640,480,32 sync on sync rate 0 create bitmap 1,640,480 Max = 100 REM setup Button & Text colors. dim color(2) dim bColor$(Max) dim tColor$(Max) dim blink$(Max) bColor$(0) = "155,155,155" tColor$(0) = "000,000,255" dim Buttons(Max,5) dim Text$(Max) REM Current buttons on screen. Button = -1 MenuX = 500 MenuY = 300 cX = 500 cY = 200 do cls rgb(40,80,120) if State = 0 then gosub State0 if State = 1 then gosub State1 copy bitmap 1,0 sync loop State0: ink rgb(80,100,180),0 : box 0,0,639,32 : ink rgb(255,255,255),0 if button = -1 center text 320,0,"- Start by clicking the 'Create Button'." center text 320,16,"- Reposition the Menu boxes by clicking and draging the blue tab." else center text 320,0,"- Resize button using BottomRight Cornor. - Position button with Mouse or Arrow keys." center text 320,16,"- 'Delete Button' will erase the last button created. - RightClick the button to modify the text." endif gosub UpdateMouse gosub ButtonsDraw gosub ButtonsCheck gosub MainMenuDraw gosub MainMenuCheck gosub ColorDraw gosub ColorCheck return State1: ink rgb(80,100,180),0 box 0,0,639,32 ink rgb(255,255,255),0 center text 320,0,"- Position Text with LeftClick. - Use the ColorBox to modify TextColor." center text 320,16,"- Press ReturnKey when done." gosub UpdateMouse gosub ButtonsDraw gosub MainMenuDraw ColorT = 1 gosub ColorDraw gosub ColorCheck if mc = 1 & KeyM = 0 KeyM = 1 mx2 = mx-Buttons(cB,4) my2 = my-Buttons(cB,5) endif if KeyM = 1 Buttons(cB,4) = mx-mx2 Buttons(cB,5) = my-my2 endif Blink$(cB) = Blinker() Text$(cB) = Typing(Text$(cB),0,0) if returnkey() = 1 State = 0 Blink$(cB) = "" endif return ColorDraw: REM Updates the menu position. Move menu with click & drag. Check = CheckArea(cX-3,cY-8,cX+82,cY-1,1) if Check = 1 if KeyM = 0 mx2 = mx-cX my2 = my-cY KeyM = 9 endif endif if KeyM = 9 cX = mx-mx2 cY = my-my2 endif REM Draws the Blue menu box. ink rgb(100,120,200),0 box cX-3,cY-8,cX+103,cY+3*16-1 return ColorCheck: if button > -1 if ColorT = 0 r = val(left$(bColor$(cB),3)) g = val(right$(left$(bColor$(cB),7),3)) b = val(right$(bColor$(cB),3)) endif if ColorT = 1 r = val(left$(tColor$(cB),3)) g = val(right$(left$(tColor$(cB),7),3)) b = val(right$(tColor$(cB),3)) endif else r = 0 g = 0 b = 0 endif Check = menu(cX,cY,30,16,"Red,Grn,Blu",1) Check = menu(cX+45,cY,20,16,str$(r)+","+str$(g)+","+str$(b),1) Check = menu(cX+31,cY,10,16,"<,<,<",1) if KeyM = 0 or KeyM = 22 if check = 1 & r > 0 then r = r - 1: KeyM = 22 if check = 2 & g > 0 then g = g - 1: KeyM = 22 if check = 3 & b > 0 then b = b - 1: KeyM = 22 endif Check = menu(cX+69,cY,10,16,">,>,>",1) if KeyM = 0 or KeyM = 22 if check = 1 & r < 255 then r = r + 1: KeyM = 22 if check = 2 & g < 255 then g = g + 1: KeyM = 22 if check = 3 & b < 255 then b = b + 1: KeyM = 22 endif ink rgb(255,255,255),0 box cX+84,cY+10,cX+84+16,cY+10+16 ink rgb(r,g,b),0 box cX+85,cY+11,cX+84+15,cY+10+15 if button > -1 r$ = right$("00"+str$(r),3)+"," g$ = right$("00"+str$(g),3)+"," b$ = right$("00"+str$(b),3) if ColorT = 0 then bColor$(cB) = r$+g$+b$ if ColorT = 1 then tColor$(cB) = r$+g$+b$ endif ColorT = 0 return ButtonsDraw: REM Draws the Buttons if Button > -1 for z = 0 to Button x1 = Buttons(z,0) y1 = Buttons(z,1) x2 = Buttons(z,2) y2 = Buttons(z,3) r = val(left$(bColor$(z),3)) g = val(right$(left$(bColor$(z),7),3)) b = val(right$(bColor$(z),3)) ink 0,0 box x1-1,y1-1,x1+x2+1,y1+y2+1 ink rgb(r,g,b),0 box x1,y1,x1+x2,y1+y2 lBox(x1+x2-3,y1+y2-3,x1+x2+1,y1+y2+1,0) tx = Buttons(z,4) ty = Buttons(z,5) r = val(left$(tColor$(z),3)) g = val(right$(left$(tColor$(z),7),3)) b = val(right$(tColor$(z),3)) ink rgb(r,g,b),0 text tx,ty,Text$(z)+Blink$(z) next z endif return ButtonsCheck: if Button > -1 for z = 0 to Button x1 = Buttons(z,0) y1 = Buttons(z,1) x2 = Buttons(z,2) y2 = Buttons(z,3) tx = Buttons(z,4) ty = Buttons(z,5) Check = CheckArea(x1+x2-3,y1+y2-3,x1+x2+1,y1+y2+1,1) if Check = 1 & KeyM = 0 mx2 = x1 my2 = y1 KeyM = 8 endif Check = CheckArea(x1-1,y1-1,x1+x2+2,y1+y2+2,0) if Check = 1 LBox(x1-2,y1-2,x1+x2+2,y1+y2+2,rgb(255,255,255)) mc = mouseclick() if mc = 1 & KeyM = 0 mx2 = mx-x1 my2 = my-y1 mx3 = mx-tx my3 = my-ty KeyM = 11 Cb = z endif if mc = 2 MenuX2 = mx + (rnd(6)-3)*10 MenuY2 = my State = 1 Cb = z endif endif next z endif REM Mouse reposition Text if KeyM = 8 Buttons(cB,2) = mx-mx2 Buttons(cB,3) = my-my2 endif REM Mouse repostion Button if KeyM = 11 Buttons(cB,0) = mx-mx2 Buttons(cB,1) = my-my2 Buttons(cB,4) = mx-mx3 Buttons(cB,5) = my-my3 endif REM Keys reposition Button KeyA = Keys(1) if KeyA = 1 then Buttons(cB,1) = Buttons(cB,1) - 1:Buttons(cB,5) = Buttons(cB,5) - 1 if KeyA = 2 then Buttons(cB,0) = Buttons(cB,0) - 1:Buttons(cB,4) = Buttons(cB,4) - 1 if KeyA = 3 then Buttons(cB,0) = Buttons(cB,0) + 1:Buttons(cB,4) = Buttons(cB,4) + 1 if KeyA = 4 then Buttons(cB,1) = Buttons(cB,1) + 1:Buttons(cB,5) = Buttons(cB,5) + 1 return MainMenuDraw: REM Updates the menu position. Move menu with click & drag. Check = CheckArea(MenuX-3,MenuY-8,MenuX+103,MenuY-1,1) if Check = 1 & KeyM = 0 if KeyM = 0 mx2 = mx-MenuX my2 = my-MenuY KeyM = 10 endif endif if KeyM = 10 MenuX = mx-mx2 MenuY = my-my2 endif REM Draws the Blue menu box. ink rgb(100,120,200),0 box MenuX-3,MenuY-8,MenuX+103,MenuY+3*18-1 REM Options Check = menu(MenuX,MenuY,100,18,"Create Button,Delete Button,Save & Exit",1) return MainMenuCheck: REM Create Button if Check = 1 & KeyM = 0 KeyM = 1 Button = Button + 1 cB = Button Buttons(cB,0) = 320-25 Buttons(cB,1) = 240-8 Buttons(cB,2) = 75 Buttons(cB,3) = 16 Buttons(cB,4) = 320-23 Buttons(cB,5) = 240-8 bColor$(cB) = "155,155,155" tColor$(cB) = "100,100,255" Text$(cB) = "Button " + str$(cB+1) endif REM Delete Button if Check = 2 & KeyM = 0 KeyM = 1 if button > 0 then button = button - 1 endif REM Save & Exit if Check = 3 & KeyM = 0 KeyM = 1 if button > -1 then gosub Save endif return UpdateMouse: mx = mousex() my = mousey() mc = mouseclick() if mc = 0 then KeyM = 0 return Save: c$ = "," if file exist("Codes.dba") = 1 then delete file "Codes.dba" open to write 1,"Codes.dba" write string 1,"sync on" write string 1,"sync rate 0" write string 1,"create bitmap 1,640,480" write string 1,"" write string 1,"do" write string 1," cls " + str$(rgb(40,80,120)) write string 1," gosub Buttons" write string 1," copy bitmap 1,0" write string 1," sync" write string 1,"loop" write string 1,"" write string 1,"Buttons:" for z = 0 to button x1 = Buttons(z,0) y1 = Buttons(z,1) x2 = Buttons(z,2) y2 = Buttons(z,3) tx = Buttons(z,4) ty = Buttons(z,5) br = val(left$(bColor$(z),3)) bg = val(right$(left$(bColor$(z),7),3)) bb = val(right$(bColor$(z),3)) tr = val(left$(tColor$(z),3)) tg = val(right$(left$(tColor$(z),7),3)) tb = val(right$(tColor$(z),3)) write string 1," REM Button "+str$(z) write string 1," ink 0,0" write string 1," box "+str$(x1-1)+c$+str$(y1-1)+c$+str$(x1+x2+1)+c$+str$(y1+y2+1) write string 1," ink rgb("+str$(br)+c$+str$(bg)+c$+str$(bb)+"),0" write string 1," box "+str$(x1)+c$+str$(y1)+c$+str$(x1+x2)+c$+str$(y1+y2) write string 1," ink rgb("+str$(tr)+c$+str$(tg)+c$+str$(tb)+"),0" write string 1," text "+str$(tx)+c$+str$(ty)+c$+chr$(34)+Text$(z)+chr$(34) write string 1," Check = CheckArea("+str$(x1-1)+c$+str$(y1-1)+c$+str$(x1+x2+2)+c$+str$(y1+y2+2)+",1)" write string 1," if Check = 1" write string 1," ink rgb(255,255,255),0" write string 1," center text 320,0,"+chr$(34)+"You Clicked "+Text$(z)+chr$(34) write string 1," endif" next z write string 1,"return" write string 1,"" write string 1," REM Mode0=MouseOver, Mode1=LeftClick, Mode3=RightClick" write string 1,"Function CheckArea(x1,y1,x2,y2,mode)" write string 1," retval = 0" write string 1," mx = mousex()" write string 1," my = mousey()" write string 1," mc = mouseclick()" write string 1," if mx > x1-1 & mx < x2+1 & my > y1-1 & my < y2+1" write string 1," if mode = 0 then retval = 1" write string 1," if mode = 1 & mc = 1 then retval = 1" write string 1," if mode = 2 & mc = 2 then retval = 1" write string 1," endif" write string 1,"EndFunction retval" close file 1 ink 0,0 box 160,240-9,320+163,240+32 ink rgb(255,255,255),0 center text 320,240,"Saved to file: Codes.dba" copy bitmap 1,0 sync end return REM ------------------------------------------------------------------------ REM Functions Section REM Draws a Line box Function lBox(x,y,l,h,c) ink c,0 box x,y,l,y box x,y,x,h box x,h,l,h box l,y,l,h EndFunction REM Mode0 = Keys Only REM Mode1 = Mouse Only Function Menu(x,y,l,h,Menu$,Mode) dim MenuList$(20) retval = 0 count = 0 rows = 0 repeat g$ = "" i$ = "" repeat count = count + 1 g$ = mid$(Menu$,count) if g$ <> "," then i$ = i$ + g$ until g$ = "," or count > len(Menu$) MenuList$(rows) = i$ rows = rows + 1 until count > len(Menu$) if mode = 0 repeat keys = Keys(1) if keys = 1 then retval = retval - 1 if keys = 4 then retval = retval + 1 if retval < 0 then retval = rows-1 if retval > rows-1 then retval = 0 for lp = 0 to rows-1 MenuBox(x,y+lp*h,l,h) ink rgb(0,0,0),0 : center text x+l/2,y+lp*h+7,MenuList$(lp) next lp pointer(x,y+retval*32) copy bitmap 1,0 sync until returnkey() = 1 retval = retval + 1 endif if mode = 1 for lp = 0 to rows-1 MenuBox(x,y+lp*h,l,h) ink rgb(0,0,0),0 : center text x+l/2,y+lp*h,MenuList$(lp) check = CheckArea(x,y+lp*h,x+l+2,y+lp*h+h,1) if check = 1 then retval = lp+1 next lp endif EndFunction retval REM Draws a small Blue box. Function Pointer(x,y) ink rgb(0,0,255),0 box x,y,x+10,y+10 endFunction REM X,Y,Length,Height Function MenuBox(x,y,l,h) ink rgb(10,10,10),0 : box x-2,y-2,x+l+2,y+h-2 ink rgb(230,230,230),0 : box x-1,y-1,x+l+1,y+h-3 ink rgb(180,180,180),0 : box x,y,x+l,y+h-4 EndFunction REM Mode0 = MouseOver REM Mode1 = LeftClick REM Mode2 = RightClick. Function CheckArea(x1,y1,x2,y2,mode) retval = 0 mx = mousex() my = mousey() mc = mouseclick() if mx > x1-1 & mx < x2+1 & my > y1-1 & my < y2+1 if mode = 0 then retval = 1 if mode = 1 & mc = 1 then retval = 1 if mode = 2 & mc = 2 then retval = 1 endif EndFunction retval REM Mode0 = Continuous Return REM Mode1 = Single Return Function Keys(mode) retval = 0 if leftkey() = 1 if mode = 0 then retval = 2 if mode = 1 & KeyL = 0 then retval = 2 KeyL = 1 else KeyL = 0 endif if rightkey() = 1 if mode = 0 then retval = 3 if mode = 1 & KeyR = 0 then retval = 3 KeyR = 1 else KeyR = 0 endif if upkey() = 1 if mode = 0 then retval = 1 if mode = 1 & KeyU = 0 then retval = 1 KeyU = 1 else KeyU = 0 endif if downkey() = 1 if mode = 0 then retval = 4 if mode = 1 & KeyD = 0 then retval = 4 KeyD = 1 else KeyD = 0 endif EndFunction retval Function Typing(TypingMod$,TypingL,TypingMode) REM TypingLimit: zero will make it unlimited suposively. REM TypingMode0 = All Letters REM Typingmode1 = Numbers Only if TypingL = 0 Then TypingL = 1000 TypingI$ = inkey$() if TypingI$ = "" then TypingG$ = "" if asc(TypingI$) <> 8 then KeyTyping = 0 if asc(TypingI$) = 8 if KeyTyping = 0 TypingC = 0 if len(TypingMod$) > 0 TypingMod$ = left$(TypingMod$,len(TypingMod$)-1) endif endif KeyTyping = 1 TypingI$="" inc TypingC,1 if TypingC > 6 then KeyTyping = 0 endif z = asc(TypingI$) if TypingMode = 1 & z > 57 or TypingMode = 1 & z < 48 then TypingI$="" if TypingMode = 0 & z > 127 or TypingMode = 0 & z < 32 then TypingI$="" if TypingG$ <> TypingI$ & len(TypingMod$) < TypingL then TypingMod$=TypingMod$+TypingI$ TypingG$ = TypingI$ EndFunction TypingMod$ Function Blinker() Blink = Blink + 1 if Blink > 3 Blink = 0 if Blinker$ = "" then Blinker$ = "|" else Blinker$ = "" endif EndFunction Blinker$