function textinput$ (x as integer,y as integer,w as integer,h as integer,__text as string) dim text as string, keyin as string dim cursor as integer, done as integer text=__text if not (_mousex>x and _mousey>y AND _mousex1 then cursor=cursor-1 case 77 ' Right Arrow if cursor<=len(text) then cursor=cursor+1 case 71 ' Home Key cursor=1 case 79 ' End Key cursor=len(text)+1 case 83 ' Delete Key if cursor<=len(text) then text=left$(text,cursor-1)+mid$(text,cursor+1) end if end select elseif LEN(keyin)=1 then select case asc(keyin) case 22 ' Ctrl + V (Paste) text=left$(text,cursor-1)+_clipboard$+mid$(text,cursor) cursor=cursor+len(pasteData) case 32 to 126 ' Regular Typing text=left$(text,cursor-1)+keyin+mid$(text,cursor) cursor=cursor+1 case 8 ' Backspace if cursor>1 THEN text=left$(text,cursor-2)+mid$(text,cursor) cursor=cursor-1 end if case 13 ' Enter done=-1 case 27 ' Escape (Cancel) text=__text done=-1 end select end if while _mouseinput: wend if _mousebutton(1) then IF (_mousex>x and _mousey>y AND _mousexlen(text)+1 then cursor=len(text)+1 else done=-1 ' Clicked outside, exit focus end if end if drawtextinput x,y,w,h,text,cursor _limit 60 _display loop until done textinput=text end function sub drawtextinput (x as integer,y as integer,w as integer,h as integer,text as string,state as integer) dim outtext as string dim charWidth as integer:charWidth = 8 dim cursorX as integer,textX as integer,textY as integer if state>0 then color backgroundcolor1 else color backgroundcolor2 end if line(x,y)-(x+w,y+h),,bf if state>0 then color highlightcolor ELSE color textcolor end if line(x,y)-(x+w,y+h),,b _printmode _keepbackground outtext=right$(text,min(w/charWidth,len(text))) textX=2+x textY=1+y+h/2-8 _printstring(textX,textY),outtext if state>0 then if int(timer*2) mod 2=0 then dim relativeCursor as integer relativeCursor=state-(len(text)-len(outtext)) if relativeCursor>=1 and relativeCursor<=len(outtext)+1 then cursorX=textX+(relativeCursor-1)*charWidth line(cursorX,textY)-(cursorX,textY+14),highlightcolor end if end if end if end sub function min(a,b) if a<=b then min=a else min=b end function function button (x as integer,y as integer,w as integer,h as integer,caption as string) if _mousex>x and _mousey>y and _mousexx and _mousey>y and _mousexx and _mousey>y and _mousexx and _mousey>y and _mousexx and _mousey>y and _mousexx and _mousey>y and _mousex100 then tmpval=100 vscrollbar=tmpval end function function vbar(x as long,y as long,h as long,value as single) dim tmpval as single tmpval=value if _mousex>x and _mousey>y and _mousex 100 then tmpval = 100 hscrollbar = tmpval end function function hbar(x as long, y as long, w as long, value as single) dim tmpval as single tmpval = value if _mousex > x and _mousey > y and _mousex < x + w and _mousey < y + 23 then drawhbar x, y, w, value, 1 if _mousebutton(1) then tmpval=((_mousex-x)/(w))*100 else drawhbar x, y, w, value, 0 end if hbar = tmpval end function sub drawbutton(x as integer,y as integer,w as integer,h as integer,caption as string, state as integer) if state and 2 then color backgroundcolor1 line (x,y)-(x+w,y+h),,bf else color backgroundcolor2 line (x,y)-(x+w,y+h),,bf end if if state and 1 then color highlightcolor line (x,y)-(x+w,y+h),,b else color textcolor line (x,y)-(x+w,y+h),,b end if _printmode _keepbackground _printstring (1+x+w/2-len(caption)*8/2,1+y+h/2-8),caption end sub sub drawimagebutton(x as integer,y as integer,w as integer,h as integer,iconhandle as long, state as integer) if state and 2 then color backgroundcolor2 line (x,y)-(x+w,y+h),,bf _putimage (x,y),iconhandle else color backgroundcolor2 line (x,y)-(x+w,y+h),,bf _putimage (x,y),iconhandle end if if state and 1 then color highlightcolor line (x,y)-(x+w,y+h),,b else color textcolor line (x,y)-(x+w,y+h),,b end if end sub sub drawcheckbox(x,y,state) if state and 2 then color highlightcolor line (x,y)-(x+16,y+16),&hffdddddd,b else color textcolor line (x,y)-(x+16,y+16),&hffbbbbbb,b end if if state and 1 then color textcolor line (x+3,y+3)-(x+13,y+13),,bf end if end sub sub drawframe(x,y,w,h,label as string) end sub sub drawlink(x,y,label as string,state as integer) if state=1 then color highlightcolor else color textcolor end if _printstring (x,y),label end sub sub drawhline(x,y,w) line (x,y)-(x+w,y),backgroundcolor1 line (x,y+1)-(x+w,y+1),backgroundcolor2 end sub sub drawvbar(x as long,y as long,h as long,value as single, state as integer) if state and 2 then color backgroundcolor2 line (x,y)-(x+23,y+h),,bf else color backgroundcolor2 line (x,y)-(x+23,y+h),,bf end if if state and 1 then color highlightcolor line (x,y)-(x+23,y+h),,b else color textcolor line (x,y)-(x+23,y+h),,b end if dim indicator as long indicator=((h-23) / 100)*value line (x+1,y+indicator)-step(21,21),,bf end sub sub drawhbar(x as long, y as long, w as long, value as single, state as integer) color backgroundcolor2 line (x, y)-(x + w, y + 23),, bf if state and 1 then color highlightcolor line (x, y)-(x + w, y + 23),, b else color textcolor line (x, y)-(x + w, y + 23),, b end if dim indicator as long indicator = ((w - 23) / 100) * value line (x + indicator, y + 1)-step(21, 21),, bf end sub sub textcolor (value as long) ignore=__interncolors(1,1,value) end sub sub highlightcolor (value as long) ignore=__interncolors(1,2,value) end sub sub backgroundcolor1 (value as long) ignore=__interncolors(1,3,value) end sub sub backgroundcolor2 (value as long) ignore=__interncolors(1,4,value) end sub function textcolor () textcolor=__interncolors(2,1,ignore) end function function highlightcolor () highlightcolor=__interncolors(2,2,ignore) end function function backgroundcolor1 () backgroundcolor1=__interncolors(2,3,ignore) end function function backgroundcolor2 () backgroundcolor2=__interncolors(2,4,ignore) end function function __interncolors(mode as integer, object as integer, value as long) static textc as long static highc as long static bgrc1 as long static bgrc2 as long static linc as long static init as long if init=0 then textc=&hffbbbbbb highc=&hffdddddd bgrc1=&hff282828 bgrc2=&hff282828 linc =&hffdddddd init =-1 end if if mode=1 then select case object case 1 textc=value case 2 highc=value case 3 bgrc1=value case 4 bgrc2=value end select end if if mode=2 then select case object case 1 __interncolors=textc case 2 __interncolors=highc case 3 __interncolors=bgrc1 case 4 __interncolors=bgrc2 end select end if end function