Code archives/Graphics/some win graphics
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
Here's an example:
graphics 640,640,0,2
setbuffer backbuffer()
include "win.bb"
win.Window=CreateWindow(100,100,300,300)
ok.Button=CreateButton("OK",250,380,100,30,true)
cbox.CheckBox=CreateCheckBox(110,130,0)
tbox.TextBox=CreateTextBox("",125,127,150)
obg.OptButGroup=CreateOptButGroup()
ob1.OptionButton=CreateOptionButton(obg,110,150)
ob2.OptionButton=CreateOptionButton(obg,110,170)
repeat
cls
if DrawWindow(win) then end
DrawButton(ok)
DrawCheckBox(cbox)
tbox\grey=not cbox\checked
DrawTextBox(tbox)
DrawOptButGroup(obg)
flip
until keyhit(1)
| |||||
;win.bb
Global FontMenu=LoadFont("Tahoma",13,False,False,False)
global check=loadimage("checked.bmp");7*7 pixels
global obimg=loadanimimage("optbutton.bmp",14,14,0,3)
maskimage obimg,255,0,255
maskimage check,255,0,255
global NumWindows,NumButtons,NumCBoxes,NumTBoxes
type Window
field x,y,w,h,capt$,xbut.Button
end type
type Button
field capt$,x,y,w=100,h=30,grey=0,down
end type
type CheckBox
field x,y,checked,grey,down
end type
type TextBox
field x,y,w,h,capt$,active,cursor,maxsize=0,tx,cflash,grey
end type
type OptButGroup
field firstbut.OptionButton,NumButs
end type
type OptionButton
field x,y,checked,grey,down,nextbut.OptionButton
end type
function DrawWinStuff()
;works with only one window
for w.Window=each Window
DrawWindow(w)
next
; for b.Button=each Button
; DrawButton(b)
; next
; for cb.CheckBox=each CheckBox
; DrawCheckBox(cb)
; next
; for tb.TextBox=each TextBox
; DrawTextBox(tb)
; next
end function
function CreateWindow.Window(wx,wy,ww,wh,wcapt$="_def",xbutton=1)
if wcapt$="_def" then wcapt$="Window "+(NumWindows+1)
w.Window=new Window
w\x=wx
w\y=wy
w\w=ww
w\h=wh
w\capt$=wcapt$
if xbutton then w\xbut.Button=CreateButton("X",w\x+w\h-4-15,w\y+4,15,15)
NumWindows=NumWindows+1
return w.Window
end function
function DeleteWindow(w.Window)
DeleteButton(w\xbut.Button)
delete w.Window
NumWindows=NumWindows-1
end function
function DrawWindow(w.window)
setfont FontMenu
color 0,0,0
rect w\x,w\y,w\w,w\h
color 192,192,192
rect w\x,w\y,w\w-1,w\h-1
color 128,128,128
rect w\x+1,w\y+1,w\w-2,w\h-2
color 255,255,255
rect w\x+1,w\y+1,w\w-3,w\h-3
color 192,192,192
rect w\x+2,w\y+2,w\w-4,w\h-4
if not w\capt$=""
color 128,128,128
line w\x+5,w\y+10,w\x+w\w-5,w\y+10
color 255,255,255
line w\x+5,w\y+11,w\x+w\w-5,w\y+11
color 192,192,192
rect w\x+(w\w/2-stringwidth(w\capt$)/2),w\y+10,stringwidth(w\capt$),2
color 0,0,0
text w\x+w\w/2,w\y+10.5,w\capt$,1,1
end if
if not w\xbut=null then return DrawButton(w\xbut)
end function
function CreateButton.Button(bcapt$,bx,by,bw=100,bh=30,center=0)
if center then bx=bx-bw/2:by=by-bh/2
if bcapt$="_def" then bcapt$="Button "+(NumButtons+1)
b.Button=new Button
b\x=bx
b\y=by
b\w=bw
b\h=bh
b\capt$=bcapt$
NumButtons=NumButtons+1
return b.Button
end function
function DeleteButton(b.Button)
delete b
NumButtons=NumButtons-1
end function
function DrawButton(b.Button)
;returns true if button is pressed
if mousedown(1) and mousex()>=b\x and mousex()<=b\x+b\w and mousey()>=b\y and mousey()<=b\y+b\h then b\down=1
color 0,0,0
rect b\x,b\y,b\w,b\h
color 255,255,255
if not b\down then rect b\x,b\y,b\w-1,b\h-1
color 128,128,128
rect b\x+1,b\y+1,b\w-2,b\h-2
color 192,192,192
if not b\down then rect b\x+1,b\y+1,b\w-3,b\h-3 else rect b\x+2,b\y+2,b\w-4,b\h-4
plot b\x+b\w,b\y
plot b\x,b\y+b\h
color 0,0,0
text b\x+(b\w/2),b\y+(b\h/2),b\capt$,1,1
if b\grey
color 255,255,255
text b\x+(b\w/2),b\y+(b\h/2),b\capt$,1,1
color 128,128,128
text b\x+(b\w/2)-1,b\y+(b\h/2)-1,b\capt$,1,1
end if
if b\grey=0 and b\down=1 and mousedown(1)=0 then ret=true
if mousedown(1)
if mousex()>=b\x and mousex<=b\x+b\w and mousey()>=b\y and mousey()<=b\y+b\h then b\down=1 else b\down = 0
else
b\down=0
end if
return ret
end function
function CreateCheckBox.CheckBox(cbx,cby,checked=0,center=0,greyed=0)
cb.CheckBox=new CheckBox
if center then cbx=cbx-7:cby=cby-7
cb\x=cbx
cb\y=cby
cb\checked=checked
cb\grey=greyed
NumCBoxes=NumCBoxes+1
return cb
end function
function DeleteCheckBox(cb.CheckBox)
delete cb
NumCBoxes=NumCBoxes-1
end function
function DrawCheckBox(cb.CheckBox)
color 255,255,255
rect cb\x,cb\y,13,13
color 128,128,128
rect cb\x,cb\y,13-1,13-1
color 192,192,192
rect cb\x+1,cb\y+1,13-2,13-2
color 0,0,0
rect cb\x+1,cb\y+1,13-3,13-3
color 255,255,255
rect cb\x+2,cb\y+2,13-4,13-4
if cb\down and mousedown(1)=0 then cb\checked=not cb\checked
cb\down=mousedown(1) and mousex()>=cb\x and mousex()<=cb\x+13 and mousey()>=cb\y and mousey()<=cb\y+13
if cb\grey or cb\down
color 192,192,192
rect cb\x+2,cb\y+2,13-4,13-4
end if
if cb\checked then drawimage check,cb\x+3,cb\y+3
end function
function CreateTextBox.TextBox(capt$,tbx,tby,tbw,tbh=0,center=0,greyed=0)
if tbh=0 then tbh=fontheight()+6
if center
tbx=tbx-tbw/2
tby=tby-tbh/2
end if
tb.TextBox=new TextBox
tb\capt$=capt$
tb\x=tbx
tb\y=tby
tb\w=tbw
tb\h=tbh
tb\grey=greyed
NumTBoxes=NumTBoxes+1
return tb
end function
function DeleteTextBox(tb.TextBox)
delete tb
NumTBoxes=NumTBoxes-1
end function
function DrawTextBox(tb.TextBox)
setfont FontMenu
color 255,255,255
rect tb\x,tb\y,tb\w,tb\h
color 128,128,128
rect tb\x,tb\y,tb\w-1,tb\h-1
color 192,192,192
rect tb\x+1,tb\y+1,tb\w-2,tb\h-2
color 0,0,0
rect tb\x+1,tb\y+1,tb\w-3,tb\h-3
color 255,255,255
if tb\grey then color 192,192,192
rect tb\x+2,tb\y+2,tb\w-4,tb\h-4
if mousedown(1) and mousex()>=tb\x and mousey()>=tb\y and mousex()<=tb\x+tb\w and mousey()<=tb\y+tb\h
tb\active=1
else if mousedown(1)
tb\active=0
end if
if tb\grey then tb\active=0
if tb\active
a=getkey()
if a<>0 and ((32<=a and a<=126)or a=145 or a=146 or(a>160))
tb\capt$=left(tb\capt$,tb\cursor)+chr(a)+right(tb\capt$,len(tb\capt$)-tb\cursor)
tb\cursor=tb\cursor+1
elseif a=8 and tb\cursor>0
tb\capt$=left(tb\capt$,tb\cursor-1)+right(tb\capt$,len(tb\capt$)-tb\cursor)
tb\cursor=tb\cursor-1
elseif a=30 and len(tb\capt$)>tb\cursor
tb\cursor=tb\cursor+1
elseif a=31 and tb\cursor>0
tb\cursor=tb\cursor-1
end if
if tb\maxsize
if len(tb\capt$)>tb\maxsize then tb\capt$=left$(tb\capt$,tb\maxsize)
end if
end if
if tb\active
color 0,0,0
tb\cflash=tb\cflash+1
if tb\cflash>10 then tb\cflash=-10
if tb\cflash>0 then line tb\x+3+stringwidth(left(tb\capt$,tb\cursor)),tb\y+tb\h/2-fontheight()/2,tb\x+3+stringwidth(left(tb\capt$,tb\cursor)),tb\y+tb\h/2+fontheight()/2
end if
color 0,0,0
text tb\x+3,tb\y+tb\h/2,tb\capt$,0,1
end function
function CreateOptButGroup.OptButGroup()
NomOBGroups=NomOBGroups+1
return new OptButGroup
end function
function DrawOptButGroup(obg.OptButGroup)
for i=1 to obg\NumButs
if i=1 then temp.OptionButton=obg\firstbut else temp=temp\nextbut
DrawOptionButton(temp,obg)
next
end function
function CreateOptionButton.OptionButton(OBgroup.OptButGroup,obx,oby,checked=0,center=0,greyed=0)
ob.OptionButton=new OptionButton
if center then obx=obx-7:oby=oby-7
ob\x=obx
ob\y=oby
ob\checked=checked
ob\grey=greyed
if OBgroup\NumButs=0
OBgroup\firstbut=ob
else
for i=1 to OBgroup\NumButs
if i=1 then temp.OptionButton=OBgroup\firstbut else temp=temp\nextbut
next
temp\nextbut=ob
end if
OBgroup\NumButs=OBgroup\NumButs+1
return ob
end function
function DrawOptionButton(ob.OptionButton,OBgroup.OptButGroup)
drawimage obimg,ob\x,ob\y,ob\grey or ob\down
if ob\down and mousedown(1)=0 and ob\grey=0
for i=1 to OBgroup\NumButs
if i=1 then temp.OptionButton=OBgroup\firstbut else temp=temp\nextbut
temp\checked=0
next
ob\checked=1
end if
if ob\checked then drawimage obimg,ob\x,ob\y,2
ob\down=mousedown(1) and imagerectcollide(obimg,ob\x,ob\y,0,mousex(),mousey(),1,1)
end function |
Comments
None.
Code Archives Forum