Code archives/Miscellaneous/Another GUI
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
I wrote this ages ago, it's been kicking around on my HDD for ages... 2 files below: GUI.bb and GUI_Demo.bb | |||||
**** GUI.bb Global OK = 2 Global YesNo = 1 Global mxs,mys ;mouse x and y speeds Global WindowR = 187 Global WindowG = 190 Global WindowB = 202 Global TitleR = 69 Global TitleG = 107 Global TitleB = 123 Global TitleTextR = 255 Global TitleTextG = 255 Global TitleTextB = 255 Global WinTextR = 0 Global WinTextG = 0 Global WinTextB = 0 Global WindowContrast = 50 Global ButtonContrast = 20 Type Win Field name$ Field x Field y Field xs Field ys Field held Field obstruted Field mouseover Field activated Field close Field closewarning Field popup Field extra$ End Type Type Button Field winname$ Field label$ Field x Field y Field xs Field ys Field active End Type Type wintext Field winname$ Field wintext$ Field label$ Field x Field y Field centered End Type Type slider Field winname$ Field label$ Field x Field y Field xs Field value# Field showlabel Field held End Type Function NewSlider(winname$,label$,x,y,xs,value#=0,showlabel=True) n.slider = New slider n\winname = winname n\label = label n\x = x n\y = y n\xs = xs n\value = value n\showlabel = showlabel n\held = False End Function Function DrawSlider(x,y,sl.slider,enable) fRect x+5+sl\x,y+15+sl\y,sl\xs-10,2,WindowR,WindowG,WindowB,True Color WinTextR,WinTextG,WinTextB If sl\showlabel Then Text x+sl\x+(sl\xs/2),y+sl\y,sl\label,True If enable And MouseDown(1) = False And sl\held=True Then sl\held=False If drawbutton("",x+(sl\xs*sl\value)-5+sl\x,y+10+sl\y,10,20,sl\held,enable) Then sl\held = True If sl\held = True sl\value = sl\value + (Float(mxs)/sl\xs) If sl\value < 0 Then sl\value = 0 If sl\value > 1 Then sl\value = 1 EndIf End Function Function GetValue#(name$) Winname$ = readitem$(name$,"win") label$ = readitem$(name$,"label") For sl.slider = Each slider If sl\label = label And sl\winname = winname Return sl\value EndIf Next End Function Function newwintext(winname$,label$,wintext$,x,y,centered = False) n.wintext = New wintext n\winname = winname n\wintext = wintext n\label = label n\x = x n\y = y n\centered = centered End Function Function DeleteWindow(winname$) For b.Button = Each Button If b\winname = winname Then Delete b Next For wt.wintext = Each wintext If wt\winname = winname Then Delete wt Next For w.win = Each win If w\name = winname Then Delete w Next For s.slider = Each slider If s\winname = winname Then Delete s Next End Function Function settext(name$,newvalue$) Winname$ = readitem$(name$,"win") label$ = readitem$(name$,"label") For wt.wintext = Each wintext If wt\label = label And wt\winname = winname wt\wintext = newvalue Exit EndIf Next End Function Function getText(name$) Winname$ = readitem$(name$,"win") label$ = readitem$(name$,"label") For wt.wintext = Each wintext If wt\label = label And wt\winname = winname Return wt\wintext EndIf Next End Function Function newwindow(name$,x,y,xs,ys,close,activated=False,closewarning=True,popup=False,extra$="") For w.win = Each win If w\name = name Then Return Next n.win = New win n\name = name$ n\x = x n\y = y n\xs = xs n\ys = ys n\activated = activated n\close = close n\closewarning = closewarning n\popup = popup n\extra = extra If close Then newbutton(name,"x",xs-13,-12,11,11) End Function Function newbutton(winname$,label$,x,y,xs,ys,active = False) n.Button = New Button n\winname = winname n\label = label n\x = x n\y = y n\xs = xs n\ys = ys n\active = active End Function Function drawbutton(label$,x,y,xs,ys,active,enable) If enable And RectsOverlap(x,y,xs,ys,MouseX(),MouseY(),1,1) Then over = True r=WindowR:g=WindowG:b=WindowB If over = True r = Clip(r+ButtonContrast) b = Clip(b+ButtonContrast) g = Clip(g+ButtonContrast) If MouseDown(1) Then active = True EndIf fRect x,y,xs,ys,r,g,b,active Color wintextr,wintextg,wintextb Text x+(xs/2),y+(ys/2),label,True,True If enable = True And over = True And MouseDown(1) Then Return True Else Return False End Function Function togglebutton(name$) win$ = readitem(name,"win") label$ = readitem(name,"but") If win$="?null?" Or label$="?null?" Then Return For b.Button = Each Button If b\winname = win And b\label = label If b\active = False Then b\active = True Else b\active = False EndIf Next End Function Function readitem$(l$,item$) ret$="?null?" item = Lower(item) lb = Instr(Lower(l$),"<"+item+">") rb = Instr(Lower(l$),"</"+item+">") If lb>0 And rb>0 lb = lb + Len("<"+item+">") ret= Mid(l,lb,rb-lb) EndIf Return ret$ End Function Function drawwindows$() mouseheld = False newwin = False mxs = MouseXSpeed() mys = MouseYSpeed() ret$ = "" order1=0 For w.win = Each win w\obstruted = False w\mouseover = False order1=order1+1 ; check to see if the mouse is over part of a window and not obscured If RectsOverlap(w\x,w\y,w\xs,w\ys+15,MouseX(),MouseY(),1,1) w\mouseover = True order2=0 For ww.win = Each win order2=order2+1 If w<>ww And RectsOverlap(ww\x,ww\y,ww\xs,ww\ys+15,MouseX(),MouseY(),1,1) And order1>order2 ww\mouseover = False EndIf Next EndIf ; check to see if a window is obscured at all if so you can't use it order2=0 For ww.win = Each win order2=order2+1 If ww<>w And RectsOverlap(w\x,w\y,w\xs,w\ys+15,ww\x,ww\y,ww\xs,ww\ys+15) And order1<order2 w\obstruted = True EndIf Next ; if you're dragging a window and released the mouse then stop dragging If w\held And MouseDown(1) = False Then w\held=False If w\held = True And mouseheld=False Then mouseheld = True If w\activated = True If w <> Last win Then x=w\x y=w\y xs=w\xs ys=w\ys name$ = w\name close = w\close closewarning = w\closewarning Delete w:newwin = True EndIf EndIf Next ; to get the window on the top, the old one is deleted and a new one is created ; Probably a better way to do this. If newwin = True newwindow(name$,x,y,xs,ys,close,True,closewarning) For ww.win = Each win If ww\name<>name Then ww\activated = False:ww\held=False Next EndIf ret$ = "nothing" For w.win = Each win fRect w\x,w\y+15,w\xs,w\ys,windowr,windowg,windowb fRect w\x,w\y,w\xs,15,titler,titleg,titleb Color titletextr,titletextg,titletextb Text w\x+2,w\y,w\name ; only activate buttons if not obstructed at all If w\obstruted = False And mouseheld = False Then enable = True Else enable = False ; draw buttons For b.Button = Each Button If b\winname = w\name If drawbutton(b\label,w\x+b\x,w\y+b\y+15,b\xs,b\ys,b\active,enable) Then ret$="<win>" + b\winname +"</win><but>"+ b\label+"</but>" EndIf Next ; draw text Color wintextr,wintextg,wintextb For wt.wintext = Each wintext If wt\winname = w\name Text w\x+wt\x,w\y+wt\y+15,wt\wintext,wt\centered EndIf Next ; draw sliders For sl.slider = Each slider If sl\winname = w\name DrawSlider(w\x,w\y,sl.slider,enable) EndIf Next If MouseDown(1) And mouseheld = False And w\mouseover = True And w\activated = False Then w\activated = True If MouseDown(1) And mouseheld = False And w\activated = True And RectsOverlap (w\x,w\y,w\xs,15,MouseX(),MouseY(),1,1) And w\held = False Then w\held=True If w\held = True w\x = w\x + mxs w\y = w\y + mys EndIf ; auto close warning event If readitem(ret,"but") = "x" And w\closewarning = True warningbox("Close Window " + readitem(ret,"win"),"Are you sure?",yesno,readitem(ret,"win")) EndIf Next ; close window auto events For w.win = Each win If w\popup = True If readitem(ret,"but")="No" Or readitem(ret,"but")="OK" Then DeleteWindow(w\name) If readitem(ret,"but")="Yes" deletewindow(w\extra) deletewindow(w\name) EndIf EndIf ;If readitem(ret,"win") = "Close Window "+w\name And readitem(ret,"but")="Yes" ; DeleteWindow("Close Window "+w\name):deletewindow(w\name) ;EndIf Next Return ret$ End Function Function fLine(x,y,x1,y1,r=255,g=255,b=255) ; fLine will only draw horizonal or vertical lines, no diagonals ; Defaults to a white line. argb=(b Or (g Shl 8) Or (r Shl 16) Or ($ff000000)) If x=x1 If y>y1 Then t=y1:y1=y:y=t For n=y To y1 If n>=0 And n<=GraphicsHeight() And x>=0 And x<=GraphicsWidth() Then WritePixelFast x,n,argb,BackBuffer() Next EndIf If y=y1 If x>x1 Then t=x1:x1=x:x=t For n=x To x1 If y>=0 And y<=GraphicsHeight() And n>=0 And n<=GraphicsWidth() Then WritePixelFast n,y,argb,BackBuffer() Next EndIf End Function Function Clip(x) If x>255 Then x=255 If x<0 Then x=0 Return x End Function Function frect(x,y,xs,ys,r=150,g=150,b=150,invert=False) ;For n=y+1 To y+ys-1 ;fline x+1,n,x+xs-1,n,r,g,b ;Next Color r,g,b Rect x+1,y+1,xs-2,ys-2,True If invert = False r1 = Clip(r+WindowContrast) g1 = Clip(g+WindowContrast) b1 = Clip(b+WindowContrast) r2 = Clip(r-WindowContrast) g2 = Clip(g-WindowContrast) b2 = Clip(b-WindowContrast) Else r1 = Clip(r-WindowContrast) g1 = Clip(g-WindowContrast) b1 = Clip(b-WindowContrast) r2 = Clip(r+WindowContrast) g2 = Clip(g+WindowContrast) b2 = Clip(b+WindowContrast) EndIf LockBuffer BackBuffer() fline x,y,x+xs-1,y,r1,g1,b1 fline x,y,x,y+ys-1,r1,g1,b1 fline x+xs-1,y,x+xs-1,y+ys-1,r2,g2,b2 fline x+xs-1,y+ys-1,x,y+ys-1,r2,g2,b2 UnlockBuffer BackBuffer() End Function Function warningbox(title$,message$,wType=1,extra$="") For w.win = Each win w\activated = False Next newwindow(title$,GraphicsWidth()/2 - 150,GraphicsHeight()/2 -50,300,100,False,True,True,True,extra) newwintext(title$,title$+":Message",message,150,20,True) If wType = yesno Then newbutton(title$,"Yes",50,50,90,20):newbutton(title$,"No",160,50,90,20) If wtype = ok Then newbutton(title$,"OK",105,50,90,20) End Function **** GUI_Demo.bb Graphics 1024,768,0,2 Include "gui.bb" font = LoadFont("arial.ttf",15) SetFont font ClsColor 98,114,138 newwindow("Gui Window",100,100,200,100,1) Newbutton("Gui Window","Up",20,20,40,20) Newbutton("Gui Window","Down",140,20,40,20) NewWinText("Gui Window","Counter","0",100,20,True) newbutton("Gui Window","Toggler!",40,60,120,20) newwindow("Another Window",300,100,200,200,1) Newbutton("Another Window","Up",20,20,40,20) Newbutton("Another Window","Down",140,20,40,20) NewWinText("Another Window","Counter","100",100,20,True) newbutton("Another Window","Toggler!",40,60,120,20) NewSlider("Another Window","Slider",20,110,160,0,True) NewWinText("Another Window","Slider Value",0,100,130,True) NewButton("Another Window","Pop!",40,150,120,20) SetBuffer BackBuffer() Repeat Cls time = MilliSecs() lastevent$ = event$ event$ = drawwindows() Text 0,20,"Render Time: "+Int(MilliSecs()-time)+" millisecs" Text 0,0,"Event: "+event If event = "<win>Gui Window</win><but>Toggler!</but>" And lastevent <> event Then togglebutton(event) If event = "<win>Gui Window</win><but>Up</but>" Then counter = gettext("<win>Gui Window</win><label>Counter</label>") + 1 : settext("<win>Gui Window</win><label>Counter</label>",counter) If event = "<win>Gui Window</win><but>Down</but>" Then counter = gettext("<win>Gui Window</win><label>Counter</label>") - 1 : settext("<win>Gui Window</win><label>Counter</label>",counter) If event = "<win>Another Window</win><but>Toggler!</but>" And lastevent <> event Then togglebutton(event) If event = "<win>Another Window</win><but>Up</but>" Then counter = gettext("<win>Another Window</win><label>Counter</label>") + 1 : settext("<win>Another Window</win><label>Counter</label>",counter) If event = "<win>Another Window</win><but>Down</but>" Then counter = gettext("<win>Another Window</win><label>Counter</label>") - 1 : settext("<win>Another Window</win><label>Counter</label>",counter) If event = "<win>Another Window</win><but>Pop!</but>" Then warningbox("Pop Up Message","Can be Yes/No or just OK",OK) settext("<win>Another Window</win><label>Slider Value</label>",Int(getvalue("<win>Another Window</win><label>Slider</label>")*100)) Flip Until KeyHit(1) |
Comments
None.
Code Archives Forum