Väritys on mustaa ja valkoista, mutta se on helposti muutettavissa.
Nappi
Valintapainike
Lista (valinnalla ja ilman)
Tekstilaatikko
Numerolaatikko
vierityspalkki (päivitys: nimi muuttui scrollbar:iin)
Tekstilaatikkon vanha versio on alemmissa viesteissä ja uusi versio on seuraavalla sivulla.
Alasvetovalikko on alemmissa viesteissä.
Koodia ei ole kommentoitu.
Funktiot esimerkillä:
Code: Select all
ClsColor 236,233,216:Cls
Dim txtv(2)
Dim txtk(2)
Dim txttk(2)
Dim ltb2(1,20) as string
Dim ltbk2(1)
Dim ltbv2(1,20)
Dim nbx(5) As String
Dim nbxtk(5)
Dim nbxk(5)
Dim nbxv(5)
For i=1 To 20
ltb2(1,i)=i
Next i
Repeat
nimi$=inputbox(10,10,100,1,nimi)
salasana$=inputbox(10,30,100,2,salasana,"*")
listavalinta=listbox2(10,50,100,5,1,listavalinta,20,valinta) 'Lista
Color 255,255,255
valinta=button(10,130,100,25,"Päälle","Pois",4,valinta,1,lukko) 'Valintanappi, jossa vaihtoehdot päälle/pois
Color 255,255,255
If button(10,160,100,25,"Lopeta","Loppu",1,0,1,lukko) Then End 'Lopeta nappi
Color 255,255,255
lukko=checkedbox(10,190,"Lukitse",lukko) 'Valintaruutu joka laittaa lukon päälle
Color 255,255,255
c=checkedbox(10,210,"Valitse",c,1,14,14,1,lukko) 'Radionapin ekan valinta
Color 255,255,255
c=checkedbox(10,230,"Valitse",c,2,14,14,1,lukko) 'Radionapin toinen valinta
numero=numberbox(170,100,50,1,numero,-50,50,0,0) 'Numerolaatikko ilman lisäosia
numero2=numberbox(170,125,50,2,numero2,-50,50,1,0) 'Numerolaatikko updown painikkeilla
numero3=numberbox(170,150,50,3,numero3,-50,50,1,1) 'Numerolaatikko updown painikkeilla ja liukuvalitsimissella
v=numberbox(170,180,100,4,v,0,100,0,1) 'Numerolaatikko liukuvalinnalla
Color 0,0,0
DrawScreen
Forever
Function numberbox(x,y,x2,num,luku,min1=0,max1=100,updown=1,scroll=0)
Color 255,255,255
Box x,y,x2,17
Color 0,0,0
Box x,y,x2,17,0
If nbxv(num)=1 Then t$=nbx(num) Else t$=Str(luku)
nbxtk(num)=Max(1,nbxtk(num))
pituus=Len(t)
mahtuu=x2/8
nakyva$=Mid(t,nbxtk(num),mahtuu)
kk=nbxk(num)
kk2=nbxk(num)-(nbxtk(num)-1)
mx=MouseX():my=MouseY()
If mx>x And mx<x+x2 And my>y And my<y+17 Then
If MouseHit(1) And nbxv(num) Then nbxk(num)=Max(0,(mx-x)/TextWidth("A"))+(nbxtk(num)-1):nbxv(num)=1
If MouseHit(1) And nbxv(num)=0 Then nbxv(num)=1:nbxk(num)=pituus:ClearKeys()
If MouseHit(2) And nbxv(num)=1 Then nbxv(num)=2:nbxk(num)=pituus:ClearKeys()
Else
If MouseUp(1) Then nbxv(num)=0
If MouseUp(2) Then nbxv(num)=0
EndIf
If nbxv(num)=1 Then
nbxk(num)=Min(Max(0,nbxk(num)+(KeyHit(205)-KeyHit(203))),pituus)
tx=TextWidth(Left(nakyva,Int(Max(kk2,0))))+2
Color 0,0,0:Line x+tx,y+2,x+tx,y+17-3
key=GetKey()
If key And nbxv(num)=2 Then t="":nbxv(num)=1
If KeyHit(199) Then
nbxtk(num)=0
nbxk(num)=0
ElseIf KeyHit(207) Then
nbxk(num)=pituus
ElseIf KeyHit(82) Then
ClearKeys():t=StrInsert(t,kk,Chr(48)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(79) Then
ClearKeys():t=StrInsert(t,kk,Chr(49)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(80) Then
ClearKeys():t=StrInsert(t,kk,Chr(50)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(81) Then
ClearKeys():t=StrInsert(t,kk,Chr(51)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(75) Then
ClearKeys():t=StrInsert(t,kk,Chr(52)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(76) Then
ClearKeys():t=StrInsert(t,kk,Chr(53)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(77) Then
ClearKeys():t=StrInsert(t,kk,Chr(54)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(71) Then
ClearKeys():t=StrInsert(t,kk,Chr(55)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(72) Then
ClearKeys():t=StrInsert(t,kk,Chr(56)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(73) Then
ClearKeys():t=StrInsert(t,kk,Chr(57)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(11) Then
ClearKeys():t=StrInsert(t,kk,Chr(48)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(2) Then
ClearKeys():t=StrInsert(t,kk,Chr(49)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(3) Then
ClearKeys():t=StrInsert(t,kk,Chr(50)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(4) Then
ClearKeys():t=StrInsert(t,kk,Chr(51)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(5) Then
ClearKeys():t=StrInsert(t,kk,Chr(52)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(6) Then
ClearKeys():t=StrInsert(t,kk,Chr(53)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(7) Then
ClearKeys():t=StrInsert(t,kk,Chr(54)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(8) Then
ClearKeys():t=StrInsert(t,kk,Chr(55)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(9) Then
ClearKeys():t=StrInsert(t,kk,Chr(56)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(10) Then
ClearKeys():t=StrInsert(t,kk,Chr(57)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(53) And nbxk(num)=0 And Left(t,1)<>Chr(45) Then
ClearKeys():t=StrInsert(t,kk,Chr(45)):nbxk(num)=nbxk(num)+1
ElseIf KeyHit(74) And nbxk(num)=0 And Left(t,1)<>Chr(45) Then
ClearKeys():t=StrInsert(t,kk,Chr(45)):nbxk(num)=nbxk(num)+1
Else
If key=13 Then
nbxv(num)=0
ElseIf key=8 Then
If kk>0 Then t=StrRemove(t,kk,1):nbxk(num)=nbxk(num)-1
ElseIf key=4 Then
If kk<pituus Then t=StrRemove(t,kk+1,1)
ElseIf key<32 Then
EndIf
EndIf
EndIf
Color 0,0,0
If nbxv(num)=2 Then
Color 20,20,200:Box x+2,y+2,x2-4,13
Color 255,255,255
EndIf
Text x+2,y+1,nakyva
If updown Then
Color 255,255,255:Box x+x2,y,17,17
Color 0,0,0:Box x+x2-1,y,18,9,0:Box x+x2-1,y+8,18,9,0
seu=17
EndIf
If scroll Then
Color 255,255,255:Box x+x2+seu-1,y,7,17
Color 0,0,0:Box x+x2+seu-1,y,7,17,0
EndIf
If (Len(t)>11 And Left(t,1)="-") Or (Len(t)>10 And Left(t,1)<>"-") Then
t=Left(t,Len(t)-1)
EndIf
If Len(t)>10 And Left(t,1)="-" Then
If Int(Left(t,10))<-214748364 Or (Left(t,10)="-214748364" And Int(Right(t,1))>7) Then
t=Left(t,10)
EndIf
EndIf
If Len(t)>9 And Left(t,1)<>"-" Then
If Int(Left(t,9))>214748364 Or (Left(t,9)="214748364" And Int(Right(t,1))>7) Then
t=Left(t,9)
EndIf
EndIf
If nbxv(num)=1 Then
If t="" Or t="-" Or Left(t,1)="0" Or Left(t,2)="-0" Then nbx(num)=t Else nbx(num)=Int(t)
Else
luku=Max(Min(Int(t),max1),min1)
EndIf
If MouseHit(1) Then
If updown Then
If mx>x+x2 And mx<x+x2+17 And my>y And my<y+8 Then
luku=Max(Min(luku+1,max1),min1)
EndIf
If mx>x+x2 And mx<x+x2+17 And my>y+9 And my<y+17 Then
luku=Max(Min(luku-1,max1),min1)
EndIf
EndIf
If scroll Then
If mx>x+x2+seu And mx<x+x2+seu+7 And my>y And my<y+17 Then
nbxv(num)=3
EndIf
EndIf
EndIf
If nbxv(num)=3 And scroll=1 Then
Color 255,255,255:Box x,y+16,x2+seu+6,8
Color 0,0,0:Box x,y+16,x2+seu+6,8,0
luku=luku-min1
max1=max1-min1
If MouseDown(1) Then
If mx=>x And mx=<x+x2+seu+6 And my=>y+15 And my=<y+17+10 Then
luku=Min(Max((MouseX()-x)*max1/(x2+seu+6),0),max1)
EndIf
EndIf
Color 0,0,255:Box x+1,y+17,(x2+seu+4)*luku/max1,6
luku=luku+min1
EndIf
Return luku
EndFunction
Function checkedbox(x,y,t$,luku,pitaa=1,x2=14,y2=14,pain=1,loc=0)
Box x,y,x2,y2
If loc Then Color 160,160,160 Else Color 0,0,0
Box x,y,x2,y2,0
mx=MouseX():my=MouseY()
If mx=>x And my=>y And mx=<x+x2 And my=<y+y2 And loc=0 Then
If (MouseHit(1) And pain=0) Or (MouseUp(1) And pain=1) Then
If luku=pitaa Then luku=0 Else luku=pitaa
EndIf
If loc Then Color 160,160,160 Else Color 0,0,0
Box x+2,y+2,x2-4,y2-4,0
EndIf
If luku=pitaa Then
Box x+2,y+2,x2-4,y2-4
EndIf
Text x+x2+2,y+y2/2-TextHeight(t)/2,t
Return luku
EndFunction
Function button(x,y,x2,y2,t$="",t2$="",pain=1,luku=0,pitaa=1,loc=0)
Box x,y,x2,y2
If loc Then Color 160,160,160 Else Color 0,0,0
Box x,y,x2,y2,0
mx=MouseX():my=MouseY()
If mx=>x And my=>y And mx=<x+x2 And my=<y+y2 And loc=0 Then
If MouseHit(1) And pain=0 Then
luku=pitaa
ElseIf MouseUp(1) And pain=1 Then
luku=pitaa
ElseIf MouseDown(1) And pain=2 Then
luku=pitaa
EndIf
If (MouseHit(1) And pain=3) Or (MouseUp(1) And pain=4) Then
If luku=pitaa Then luku=0 Else luku=pitaa
EndIf
If MouseDown(1) And (pain=1 Or pain=0 Or pain=3 Or pain=4) Then pohj=1
'paal=1
EndIf
If luku=pitaa Then
Box x+1,y+1,x2-1,y2-1,0
ElseIf pohj Then
Box x+1,y+1,x2-1,y2-1,0
ElseIf paal=0 Then
Line x+1,y+y2,x+x2,y+y2
Line x+x2,y+1,x+x2,y+y2
EndIf
If luku=pitaa and t2<>"" then
CenterText x+x2/2,y+y2/2-TextHeight(t2)/2,t2
Else
CenterText x+x2/2,y+y2/2-TextHeight(t)/2,t
EndIf
Return luku
EndFunction
Function inputbox(x,y,x2,num,t$,pass$="")
Color 255,255,255
Box x,y,x2,17
Color 0,0,0
Box x,y,x2,17,0
txttk(num)=Max(1,txttk(num))
pituus=Len(t)
mahtuu=x2/8
nakyva$=Mid(t,txttk(num),mahtuu)
kk=txtk(num)
kk2=txtk(num)-(txttk(num)-1)
If MouseX()>x And MouseX()<x+x2 And MouseY()>y And MouseY()<y+17 Then
If MouseHit(1) And txtv(num) Then txtk(num)=Max(0,(MouseX()-x)/TextWidth("A"))+(txttk(num)-1):txtv(num)=1
If MouseHit(1) And txtv(num)=0 Then txtv(num)=1:txtk(num)=pituus:ClearKeys()
If MouseHit(2) And txtv(num)=1 Then txtv(num)=2:txtk(num)=pituus:ClearKeys()
Else
If MouseUp(1) Then txtv(num)=0
If MouseUp(2) Then txtv(num)=0
EndIf
If txtv(num) Then
txtk(num)=Min(Max(0,txtk(num)+(KeyHit(205)-KeyHit(203))),pituus)
tx=TextWidth(Left(nakyva,Int(Max(kk2,0))))+2
Color 0,0,0:Line x+tx,y+2,x+tx,y+17-3
key=GetKey()
If key And txtv(num)=2 Then t="":txtv(num)=1
If KeyHit(199) Then
txttk(num)=0
txtk(num)=0
ElseIf KeyDown(181) And key=45 Then
t=StrInsert(t,kk,Chr(47))
txtk(num)=txtk(num)+1
ElseIf KeyHit(207) Then
txtk(num)=pituus
ElseIf KeyHit(82) Then
ClearKeys():t=StrInsert(t,kk,Chr(48)):txtk(num)=txtk(num)+1
ElseIf KeyHit(79) Then
ClearKeys():t=StrInsert(t,kk,Chr(49)):txtk(num)=txtk(num)+1
ElseIf KeyHit(80) Then
ClearKeys():t=StrInsert(t,kk,Chr(50)):txtk(num)=txtk(num)+1
ElseIf KeyHit(81) Then
ClearKeys():t=StrInsert(t,kk,Chr(51)):txtk(num)=txtk(num)+1
ElseIf KeyHit(75) Then
ClearKeys():t=StrInsert(t,kk,Chr(52)):txtk(num)=txtk(num)+1
ElseIf KeyHit(76) Then
ClearKeys():t=StrInsert(t,kk,Chr(53)):txtk(num)=txtk(num)+1
ElseIf KeyHit(77) Then
ClearKeys():t=StrInsert(t,kk,Chr(54)):txtk(num)=txtk(num)+1
ElseIf KeyHit(71) Then
ClearKeys():t=StrInsert(t,kk,Chr(55)):txtk(num)=txtk(num)+1
ElseIf KeyHit(72) Then
ClearKeys():t=StrInsert(t,kk,Chr(56)):txtk(num)=txtk(num)+1
ElseIf KeyHit(73) Then
ClearKeys():t=StrInsert(t,kk,Chr(57)):txtk(num)=txtk(num)+1
Else
If key=13 Then
txtv(num)=0
ElseIf key=8 Then
If kk>0 Then t=StrRemove(t,kk,1):txtk(num)=txtk(num)-1
ElseIf key=4 Then
If kk<pituus Then t=StrRemove(t,kk+1,1)
ElseIf key<32 Then
ElseIf key>0 Then
t=StrInsert(t,kk,Chr(key)):txtk(num)=txtk(num)+1
EndIf
If mahtuu<kk2 Then txttk(num)=kk-Len(nakyva)+1
If 1>kk2 Then txttk(num)=kk
If Len(nakyva)<mahtuu Then
txttk(num)=Max(1,pituus-mahtuu)
EndIf
EndIf
EndIf
Color 0,0,0
If txtv(num)=2 Then
Color 20,20,200
Box x+2,y+2,x2-4,13
Color 255,255,255
EndIf
If pass="" Then
Text x+2,y+1,nakyva
Else
Text x+2,y+1,String(Left(pass,1),Int(Min(mahtuu,pituus)))
EndIf
Return t
EndFunction
Function listbox2(x,y,x2,y2,num,valittuna,maara,tyyli=0,merkkim=0)
Color 255,255,255
Box x,y,x2,y2*15
For i=1 To Min(y2,maara)
If tyyli=1 Then
Color 0,0,0
Box x+3,y+(i-1)*15+2,12,12,0
If ltbv2(num,i+ltbk2(num))=1 Then
Box x+6,y+(i-1)*15+5,6,6
EndIf
lisa=18
Else
lisa=0
EndIf
If maara>y2 Then pois=15
If MouseX()>x And MouseX()<x+x2-18 And MouseY()>y+(i-1)*15 And MouseY()<y+i*15 Then
Color 50,50,255
Box x+lisa,y+(i-1)*15,x2-lisa-pois,15
Color 255,255,255
If MouseUp(1) And tyyli=1 And valittuna=i+ltbk2(num) Then ltbv2(num,i+ltbk2(num))=Not ltbv2(num,i+ltbk2(num))
If MouseUp(1) Then valittuna=i+ltbk2(num)
Else
Color 0,0,0
EndIf
If valittuna=i+ltbk2(num) Then
Color 100,100,255
Box x+lisa,y+(i-1)*15,x2-lisa-pois,15
Color 255,255,255
EndIf
If merkkim=0 Then
Text x+lisa+2,y+(i-1)*15,ltb2(num,i+ltbk2(num))
Else
Text x+lisa+2,y+(i-1)*15,Left(Str(ltb2(num,i+ltbk2(num))),merkkim)
EndIf
Next i
Color 0,0,0
Box x-1,y-1,x2+2,y2*15+2,0
If maara>y2 Then
ma=maara-y2
y2=y2*15
Color 0,0,0
Box x+x2-15,y-1,16,y2+2,0
y=y+6:y2=y2-12
If MouseDown(1) Then
If MouseX()>=x+x2-15 And MouseX()<=x+x2+1 And MouseY()>=y And MouseY()<=y+y2 Then
ltbk2(num)=Min(Max((MouseY()-y)*(ma)/(y2-5),0),(ma))
EndIf
EndIf
Box x+x2-13,y+(y2)*ltbk2(num)/(ma)-5,12,10
EndIf
Return valittuna
EndFunction
button(x,y,leveys,korkeus[,teksti,teksti kun valittu,klikkaus tyyppi,luku,luku pitää olla jotta valittu,lukko])
Voi käyttää valinta painikkeena (esimerkissä)
Käyttää nykyistä piirtoväriä taustavärinä.
Valintapainike
checkedbox(x,y,teksti,luku[,luku pitää olla jotta valittu,leveys,korkeus,klikkaus tyyppi,lukko])
Voi käyttää sekä radio- että valintanappina (esimerkissä).
Käyttää nykyistä piirtoväriä taustavärinä.
Lista
listbox2(x,y,leveys,korkeus näkyvien osien määränä,numero,valittu osa,osien määrä[,tyyli,merkkien määrä joka mahtuu yhteen osaan])
Vaatii taulukot:
Dim ltb2(1,20) as String
Dim ltbk2(1)
Dim ltbv2(1,20)
Tyylit
1 = valintapainikkeilla
0 = ilman valintapainikkeita
palauttaa valitun osan numeron.
Tekstilaatikko
inputbox(x,y,leveys,numero,teksti[,salasana merkki])
vaatii taulukot:
Dim txtv(2)
Dim txtk(2)
Dim txttk(2)
palauttaa tekstin
voi kirjoittaa väliin (paikan voi valita hiirellä).
Hiiren oikea näppäin valitsee kaikki ja kirjoittaminen pyyhkii silloin edellisen pois.
Numeronäppäimet toimivat.
Numerolaatikko
numberbox(x,y,leveys,numero,luku[,pienin arvo,suurin arvo,pienennä suurenna painikkeet,liuku valinta])
vaatii taulukot:
Dim nbx(5) As String
Dim nbxtk(5)
Dim nbxk(5)
Dim nbxv(5)
palauttaa luvun.
Voi syöttää negatiivisiä lukuja ja vain numeroita (myös numeronäppäimet ja miinus merkki).
Syöttöraja on kokonaisluvun minimi ja maksimi luvut.
Lisätoimintoina painikkeet ja liukuvalinta.
Vierityspalkki(Päivitys)
scrollbar(x,y,leveys,korkeus,luku[,Pienin arvo,suurin arvo,palkin koko,käännä,tyyli,rulla])
Käännä:
Känntää arvon
Tyylit:
0 = laatikossa
1 = viivalla
Rulla:
1 = käytä hiiren rullaa
0 = älä käytä
Tunnistaa suunnan leveydestä ja korkeudesta.
Käyttää nykyistä piirtoväriä viivojen värinä.
Esimerkki:
Code: Select all
ClsColor 236,233,216:Cls
Repeat
Color 0,0,0
'Vaaka esimerkit
v1=scrollbar(100,10,100,15,v1,0,100,12,0,1,5)
v2=scrollbar(100,30,100,15,v2,8,10,12,0,1,1)
v3=scrollbar(100,50,100,15,v3,0,100,12,0,2,10)
v4=scrollbar(100,70,100,15,v4,8,10,12,0,2,1)
'Pysty esimerkit
p1=scrollbar(10,10,15,100,p1,0,100,12,0,1,5)
p2=scrollbar(30,10,15,100,p2,8,10,12,0,1,1)
p3=scrollbar(50,10,15,100,p3,0,100,12,0,2,10)
p4=scrollbar(70,10,15,100,p4,8,10,12,0,2,1)
DrawScreen
Forever
Function scrollbar(x,y,x2,y2,arvo,minimi=0,maximi#=100,pkoko=12,invert=0,tyyli=1,scroll=1)
arvo=arvo-minimi'Muutetaan niin, että pienin arvo on nolla
maximi=maximi-minimi'Muutetaan myös suurin arvo
arvo=Max(Min(arvo,maximi),0)'Rajataan arvo
If invert Then arvo=maximi-arvo'Kääntää arvon
If tyyli=1 Then Box x,y,x2,y2,0'Laatikko ympärille
mx=MouseX():my=MouseY()
If x2>y2 Then'Vaaka
pkoko=Max(Min(pkoko,x2*0.8),1)'Rajataan palkin koko
tx=x+2+pkoko/2:tx2=x2-4-pkoko'Lasketaan laskuja
If mx>=x And my>=y And mx<=x+x2 And my<=y+y2 Then
If scroll Then
mz=MouseMoveZ()'Rulla vieritys
arvo=Max(Min(arvo+((mz<0)-(mz>0))*scroll,maximi),0)
EndIf
If MouseDown(1) Then'Lasketaan palkin sijainti
arvo=Max(Min(((Float(mx-tx)/tx2)*maximi),maximi),0)
EndIf
EndIf
If tyyli=2 Then Line x+pkoko/2,y+y2/2,x+x2-pkoko/2,y+y2/2
Box tx+(arvo/maximi)*tx2-pkoko/2,y+2,pkoko,y2-4'Palkki
Else'Pysty
pkoko=Max(Min(pkoko,y2*0.8),1)'Rajataan palkin koko
ty=y+2+pkoko/2:ty2=y2-4-pkoko'Lasketaan laskuja
If mx>=x And my>=y And mx<=x+x2 And my<=y+y2 Then
If scroll Then
mz=MouseMoveZ()'Rulla vieritys
arvo=Max(Min(arvo+((mz<0)-(mz>0))*scroll,maximi),0)
EndIf
If MouseDown(1) Then'Lasketaan palkin sijainti
arvo=Max(Min(((Float(my-ty)/ty2)*maximi),maximi),0)
EndIf
EndIf
If tyyli=2 Then Line x+x2/2,y+pkoko/2,x+x2/2,y+y2-pkoko/2
Box x+2,ty+(arvo/maximi)*ty2-pkoko/2,x2-4,pkoko'Palkki
EndIf
If invert Then arvo=maximi-arvo'Kääntää arvon
Return arvo+minimi
End Function