pixler/include/ui.bm

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 _mousex<x+w and _mousey<y+h) then
        drawtextinput x,y,w,h,__text,0
        exit function
    end if
    drawtextinput x,y,w,h,__text,1
    if not mouseclicked then exit function
    'text=""
    cursor=len(text)+1
    dim relativex as integer
    do
        keyin=inkey$
        if len(keyin)=2 then
            select case asc(right$(keyin,1))
                case 75 ' Left Arrow
                    if cursor>1 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 _mousex<x+w and _mousey<y+h) then
                relativex=_mousex-x
                cursor=(relativex\8)+1
                if cursor<1 then cursor=1
                if cursor>len(text)+1 then cursor=len(text)+1
            else
                done=-1
            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 clickregion(x as integer,y as integer,w as integer,h as integer)
    if _mousex>x and _mousey>y and _mousex<x+w and _mousey<y+h then
        if mouseclicked then clickregion=-1
        if rmouseclicked then clickregion=-2
    end if
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 _mousex<x+w and _mousey<y+h then
        drawbutton x,y,w,h,caption,1
        if mouseclicked then button=-1
    else
        drawbutton x,y,w,h,caption,0
    end if
end function

function buttonhold (x as integer,y as integer,w as integer,h as integer,caption as string)
    if _mousex>x and _mousey>y and _mousex<x+w and _mousey<y+h then
        drawbutton x,y,w,h,caption,1
        if _mousebutton(1)then buttonhold=-1
    else
        drawbutton x,y,w,h,caption,0
    end if
end function

function imagebutton (x as integer,y as integer,w as integer,h as integer,iconhandle as long)
    if _mousex>x and _mousey>y and _mousex<x+w and _mousey<y+h then
        drawimagebutton x,y,w,h,iconhandle,1
        if mouseclicked then imagebutton=-1
        if rmouseclicked then imagebutton=-2
    else
        drawimagebutton x,y,w,h,iconhandle,0
    end if
end function

function imagebuttonhold (x as integer,y as integer,w as integer,h as integer,iconhandle as long)
    if _mousex>x and _mousey>y and _mousex<x+w and _mousey<y+h then
        drawimagebutton x,y,w,h,iconhandle,1
        if _mousebutton(1) then imagebuttonhold=-1
    else
        drawimagebutton x,y,w,h,iconhandle,0
    end if
end function


function checkbox (x as integer,y as integer,state as integer)
    if _mousex>x and _mousey>y and _mousex<x+16 and _mousey<y+16 then
        drawcheckbox x,y,2+state
        if mouseclicked then checkbox=(state+1) mod 2:exit function
    else
        drawcheckbox x,y,0+state
    end if
    checkbox=state
end function

function link(x,y,label as string)
    dim w as integer
    w=len(label)*8
    if _mousex>x and _mousey>y and _mousex<x+w and _mousey<y+16 then
        drawlink x,y,label,1
        if mouseclicked then link=-1
    else
        drawlink x,y,label,0
    end if
end function

function slider(x as long,y as long,w as long,value as single)
    dim tmpval as single
    tmpval=value
    if _mousex>x and _mousey>y-5 and _mousex<x+w and _mousey<y+15 then
        drawslider x,y,w,value,1
        if _mousebutton(1) then
            tmpval=((_mousex-x)/w)*100
        end if
    else
        drawslider x,y,w,value,0
    end if
    if tmpval<0 then tmpval=0
    if tmpval>100 then tmpval=100
    slider=tmpval
end function

function vscrollbar(x as long,y as long,h as long,value as single)
    dim tmpval as single
    tmpval=value
    if buttonhold(x,y,23,23,"U") then tmpval=tmpval-1
    if buttonhold(x,h-23,23,23,"D") then tmpval=tmpval+1
    tmpval=vbar(x,y+23,h-46,tmpval)
    if tmpval<0 then tmpval=0
    if tmpval>100 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<x+23 and _mousey<y+h then
        drawvbar x,y,h,value,1
        if _mousebutton(1) then tmpval=((_mousey-y)/(h))*100
    else
        drawvbar x,y,h,value,0
    end if
    vbar=tmpval
end function

function hscrollbar(x as long,y as long,w as long,value as single)
    dim tmpval as single
    tmpval=value
    if button(x,y,23,23,"L") then tmpval=tmpval-1
    if button(x+w-23,y,23,23,"R") then tmpval=tmpval+1
    tmpval=hbar(x+23,y,w-46,tmpval)
    if tmpval<0 then tmpval=0
    if tmpval>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 drawslider(x as long,y as long,w as long,value as single,state as integer)
    dim handlex as long
    handlex=x+(w*(value/100))
    color backgroundcolor1
    line (x,y+4)-(x+w,y+6),,bf
    if state=1 then color highlightcolor else color textcolor
    line (x,y+4)-(x+w,y+6),,b
    if state=1 then
        color highlightcolor
    else
        color textcolor
    end if
    line (handlex-5,y-2)-(handlex+5,y+12),,bf
    color backgroundcolor1
    line (handlex-5,y-2)-(handlex+5,y+12),,b
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