Käyttöliittymän osia

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
User avatar
project coder
Newcomer
Posts: 27
Joined: Mon Aug 27, 2007 9:23 pm
Location: Kajaani

Käyttöliittymän osia

Post by project coder » Fri Dec 07, 2007 8:03 pm

Olin tehnyt muutamia käyttöliittymän osia ja kasasin ne nyt yhteen.
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
Nappi
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
Edit: Scrollbarin pieni bugi korjaus.
Last edited by project coder on Tue Aug 05, 2008 2:04 pm, edited 5 times in total.
Kotisivut: (Uusitaan)
Secret Unit War (Frozen)
Tilekarttaeditori (Frozen)
Käyttöliittymän osia

User avatar
valscion
Moderator
Moderator
Posts: 1587
Joined: Thu Dec 06, 2007 8:46 pm
Location: Espoo
Contact:

Re: Käyttöliittymän osia

Post by valscion » Sat Dec 08, 2007 12:00 am

Hieno koodi! Taisi tuon tekemiseen mennä hieman aikaakin?
Ainoa vaikea askel on se, että pitää opetella käyttämään näitä komentoja. Suosittelisin, että kommentoisit koodistasi, mitä teet esimerkkiohjelmassa. Samalla voisit kertoa, miten voit "leikkiä" näillä koodeilla (eli vaihdella arvoja ja katsoa mitä tapahtuu).

Niin, ja pieniä kielivirheitä, kuten "loc" funktioissa kun pitäisi olla "lock". Ei se minua silti haittaa ollenkaan :)

P.S.
Tekstilaatikko
inputbox(x,y,leveys,numero,teksti[,salasana merkki])

--Saatko tuohon sen "kirjoittamisviivan" vilkkumaan? Pientä pikkuhyvää kaiken päälle :)

User avatar
Koodiapina
Forum Veteran
Posts: 2396
Joined: Tue Aug 28, 2007 4:20 pm
Contact:

Re: Käyttöliittymän osia

Post by Koodiapina » Sat Dec 08, 2007 1:11 am

Hienoa työtä. Vielä kun teet tohon textarean niin sit toi on täydellinen. Keep up good work.
Olen liian älykäs ollakseni väärässä. Jos olet kanssani eri mieltä, suosittelen sinua pohtimaan omaa elämänkatsomustasi ja sen perusteita.

User avatar
elmo123
Active Member
Posts: 153
Joined: Sun Sep 09, 2007 4:19 pm

Re: Käyttöliittymän osia

Post by elmo123 » Sun Dec 09, 2007 6:05 pm

Vau, kerrankin tekstikentissä voi kirjoittaa merkkijonon keskelle :!: :D
Kiinnostuin pelien tekemisestä ennen 1. luokkaa.
Sitten 3. luokalla tuli CB. Ja siitä se alkoi.

Blender! TF2! CB! Game Maker! Nokia-mollaus! Kitaransoitto! Breakdance! MadTracker! Minecraft!

User avatar
project coder
Newcomer
Posts: 27
Joined: Mon Aug 27, 2007 9:23 pm
Location: Kajaani

Re: Käyttöliittymän osia

Post by project coder » Sun Dec 09, 2007 8:48 pm

OonSuomesta wrote:Hieno koodi! Taisi tuon tekemiseen mennä hieman aikaakin?
- Listaan meni n. 1 päivä
- Tekstilaatikkoon n. 3 päivää
- Numerolaatikon tein tekstilaatikon pohjalta ja siihen meni n. 2 päivää
- Napin ja valintaruudun tein 2 tunnissa.
- Vierityspalkki n. 2 päivää
Ja en koodannut 24 tuntia päivässä.
OonSuomesta wrote:Ainoa vaikea askel on se, että pitää opetella käyttämään näitä komentoja. Suosittelisin, että kommentoisit koodistasi, mitä teet esimerkkiohjelmassa. Samalla voisit kertoa, miten voit "leikkiä" näillä koodeilla (eli vaihdella arvoja ja katsoa mitä tapahtuu).
Pari kommenttia lisäsin tuonne esimerkki ohjelmaan, mutta ne eivät kerro kaikkea funktion käytöstä.
OonSuomesta wrote:Niin, ja pieniä kielivirheitä, kuten "loc" funktioissa kun pitäisi olla "lock". Ei se minua silti haittaa ollenkaan :)
lock on cb:ssä komento, joten sitä ei voinut käyttää muuttujana.
OonSuomesta wrote: P.S.
Tekstilaatikko
inputbox(x,y,leveys,numero,teksti[,salasana merkki])

--Saatko tuohon sen "kirjoittamisviivan" vilkkumaan? Pientä pikkuhyvää kaiken päälle :)
Tuossa on se vilkkuva versio:

Code: Select all

ClsColor 236,233,216:Cls

Dim txtv(2)
Dim txtk(2)
Dim txttk(2)
Dim txtkv(2)

Repeat

nimi$=inputbox(10,10,100,1,nimi)
salasana$=inputbox(10,30,100,2,salasana,"*")

DrawScreen
Forever

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
	If txtkv(num)=<0 Then txtkv(num)=100
	If txtkv(num)>50 Then Color 0,0,0:Line x+tx,y+2,x+tx,y+17-3
	txtkv(num)=txtkv(num)-1
	
	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
Grandi wrote:Hienoa työtä. Vielä kun teet tohon textarean niin sit toi on täydellinen. Keep up good work.
Textareaa olen tekemässä, mutta voi mennä aikaa ennen kuin saan se valmiiksi.
Kotisivut: (Uusitaan)
Secret Unit War (Frozen)
Tilekarttaeditori (Frozen)
Käyttöliittymän osia

User avatar
project coder
Newcomer
Posts: 27
Joined: Mon Aug 27, 2007 9:23 pm
Location: Kajaani

Re: Käyttöliittymän osia

Post by project coder » Sun Dec 16, 2007 8:45 pm

Nyt on tekstilaatikko melkein valmis. vielä puuttuu tekstin valinta ja pari muuta asiaa, mutta tämä versio on jo toimiva.

Code: Select all

ClsColor 236,233,216:Cls

rivimaara=100

Global clipboard As String'Leikepöytä
Dim txb(4,rivimaara) As String'Teksti
Dim txbd(4,2)'Muuta dataa (0=rivimäärä, 1=välke aika)
Dim txbv(4)'Valittuna
Dim txbka(4,1)'Kursorin alku kohta(rivin eka=1, sarakkeen eka=0)
Dim txbkl(4,1)'Kursorin loppu kohta
Dim txbtk(4,1)'Tekstin kohta (0=alku)

clipboard="Liitettävä"'Leikepöydän teksti

Repeat

textbox(50,20,15,1,3,1)'Yhden rivin teksti laatikko
textbox(200,20,15,1,4,1,"*")'Sama salasanamerkillä

textbox(50,50,15,10,1,100)'Tekstilaatikko
textbox(200,50,15,10,2,100,"*")'Tekstilaatikko salasanamerkillä

DrawScreen
Forever

Function textbox(x,y,x2,y2,num,mrm=100,pass$="")
tw=TextWidth("A")
th=TextHeight("A")

Color 255,255,255
Box x,y,x2*tw+5,y2*15+2
Color 0,0,0
Box x,y,x2*tw+5,y2*15+2,0

mx=MouseX()
my=MouseY()
rm=Max(1,txbd(num,0))'Rivi määrä

If mx>=x And my>=y And mx<=x+x2*tw+5 And my<=y+y2*15+2 Then
	If MouseHit(1) Then
		txbv(num)=1
		txbka(num,1)=Min(Max(1,(my-y+14)/15+(txbtk(num,1))),rm)
		txbka(num,0)=Min(Max(0,(mx-x-1)/tw+(txbtk(num,0))),Len(Replace(txb(num,txbka(num,1)),Chr(13),"")))
		ClearKeys()
	EndIf
Else
	If MouseUp(1) Then txbv(num)=0
EndIf

vkk=txbka(num,0)'Rivi kursorin kohta
vkkn=txbka(num,0)-txbtk(num,0)'Rivi kursorin kohta näytöllä
pkk=txbka(num,1)'Sarake kursorin kohta näytöllä
pkkn=txbka(num,1)-txbtk(num,1)'Sarake kursorin kohta näytöllä

If txbv(num)=1 Then
	t$=txb(num,pkk)
	vr=txbka(num,1)
	pituus=Len(Replace(t,Chr(13),""))
	pituus2=Len(t)'Pituus enterien kanssa

	If vkk<txbtk(num,0) Then txbtk(num,0)=vkk
	If vkk>txbtk(num,0)+x2 Then txbtk(num,0)=vkk-x2
	If pkk-1<txbtk(num,1) Then txbtk(num,1)=pkk-1
	If pkk>txbtk(num,1)+y2 Then txbtk(num,1)=pkk-y2
		
	'Päivitetään tiedot
	vkk=txbka(num,0):vkkn=txbka(num,0)-txbtk(num,0)
	pkk=txbka(num,1):pkkn=txbka(num,1)-txbtk(num,1)
	
	If txbd(num,1)<=0 Then txbd(num,1)=100
	If txbd(num,1)>50 Then
		Color 0,0,0'Viivan väri
		Line x+(vkkn*tw)+2,y+(pkkn-1)*15+2,x+(vkkn*tw)+2,y+(pkkn-1)*15+14
	EndIf
	txbd(num,1)=txbd(num,1)-1
	
	txbka(num,0)=Min(Max(txbka(num,0),0),pituus)
	txbka(num,0)=txbka(num,0)+(KeyHit(205)-KeyHit(203))
	txbka(num,1)=Min(Max(1,txbka(num,1)+(KeyHit(208)-KeyHit(200))),rm)
	
	If txbka(num,0)<0 And vr>1 Then
		txbka(num,1)=txbka(num,1)-1
		txbka(num,0)=Len(txb(num,txbka(num,1)))
	ElseIf txbka(num,0)>pituus And vr<rm Then
		txbka(num,1)=txbka(num,1)+1
		txbka(num,0)=0
	EndIf
	txbka(num,0)=Min(Max(txbka(num,0),0),Len(Replace(txb(num,txbka(num,1)),Chr(13),"")))
	
	lisattava$=""
	If KeyDown(29) Or KeyDown(157) Then
		If KeyHit(45) Then'Leikkaa(valittu rivi)
			clipboard=t:t=""
		ElseIf KeyHit(46) Then'Kopioi(valittu rivi)
			clipboard=t
		ElseIf KeyHit(47) Then'Liitä
			lisattava=clipboard
		EndIf
	ElseIf KeyUp(29) Or KeyUp(157) Then
		ClearKeys()
	Else'Jos ei ctrl painettuna, niin kirjoittaminen alkaa
	key=GetKey()
	If KeyHit(199) Then'Home
		txbka(num,0)=0:txbkl(num,0)=0
	ElseIf KeyHit(207) Then'End
		txbka(num,0)=pituus:txbkl(num,0)=pituus
	ElseIf KeyDown(181) And key=45 Then'Num jako (korjaus)
		ClearKeys():lisattava=Chr(47)
	ElseIf KeyHit(82) Then'Num näppäimet
		ClearKeys():lisattava=Chr(48)
	ElseIf KeyHit(79) Then
		ClearKeys():lisattava=Chr(49)
	ElseIf KeyHit(80) Then
		ClearKeys():lisattava=Chr(50)
	ElseIf KeyHit(81) Then
		ClearKeys():lisattava=Chr(51)
	ElseIf KeyHit(75) Then
		ClearKeys():lisattava=Chr(52)
	ElseIf KeyHit(76) Then
		ClearKeys():lisattava=Chr(53)
	ElseIf KeyHit(77) Then
		ClearKeys():lisattava=Chr(54)
	ElseIf KeyHit(71) Then
		ClearKeys():lisattava=Chr(55)
	ElseIf KeyHit(72) Then
		ClearKeys():lisattava=Chr(56)
	ElseIf KeyHit(73) Then
		ClearKeys():lisattava=Chr(57)
	Else
		If key=13 Then'Enter
			t=StrInsert(t,vkk,Chr(13))
			If txbka(num,1)<mrm Then
				txbka(num,1)=txbka(num,1)+1
				txbka(num,0)=0
			EndIf
		ElseIf key=8 Then'BackSpace
			If vkk>0 Then
				t=StrRemove(t,vkk,1)
				txbka(num,0)=txbka(num,0)-1
			ElseIf vkk=0 And vr>1 Then
				txb(num,vr-1)=Left(txb(num,vr-1),Len(txb(num,vr-1))-1)
				txbka(num,1)=txbka(num,1)-1
				txbka(num,0)=Len(txb(num,vr-1))
			EndIf
		ElseIf key=4 Then'Delete
			If vkk<pituus2 Then
				t=StrRemove(t,vkk+1,1)
			EndIf
		ElseIf key>31 Then
			t=StrInsert(t,vkk,Chr(key))
			txbka(num,0)=txbka(num,0)+1
		EndIf
	EndIf
	EndIf
	
	If lisattava<>"" Then'Lisätään teksti, jos ON lisättävää
		t=StrInsert(t,vkk,lisattava)
		txbka(num,0)=txbka(num,0)+Len(lisattava)
	EndIf

	txb(num,pkk)=t
EndIf

i=0
ok=0
Repeat'Rivin vaihdot
	i=i+(vah=0):vah=0
	If i=mrm Then Exit
	tt$=txb(num,i)
	entk=InStr(tt,Chr(13))
	If entk Then
		If entk=Len(tt) Then'Jos enter viimeisenä
			'Hyvä rivi
		ElseIf entk=1 Then'Jos enter ekana
			txb(num,i+1)=Right(tt,Len(tt)-1)+txb(num,i+1)
			tt=Chr(13)
		Else'Jos enter välissä
			txb(num,i+1)=Right(tt,Len(tt)-(entk))+txb(num,i+1)
			tt=Left(tt,entk)
		EndIf
	Else
		If txb(num,i+1)<>"" Then
			tt=tt+txb(num,i+1)
			txb(num,i+1)=""
			vah=1
		Else
			ok=1
		EndIf
	EndIf
	txb(num,i)=tt
Until ok=1
rm=i
'Kirjoitetaan teksti
Color 0,0,0'Tekstin väri
For i=1+txbtk(num,1) To Min(rm,y2+txbtk(num,1))
teksti$=Mid(Replace(txb(num,i),Chr(13),""),txbtk(num,0)+1,x2)
If pass="" Then
Text x+2,y+2+(i-1-txbtk(num,1))*15,teksti
Else
Text x+2,y+2+(i-1-txbtk(num,1))*15,String(Left(pass,1),Len(teksti))
EndIf
Next i
txbd(num,0)=Max(1,rm)'Tallennetaan rivien määrä
EndFunction
Tekstilaatikko:
textbox(x,y,leveys,korkeus,numero[,max rivimäärä,salasanamerkki])

leveys annetaan kirjaimina ja korkeus riveinä

tarvitsee taulukot:
Dim txb(4,rivimaara) As String
Dim txbd(4,2)
Dim txbv(4)
Dim txbka(4,1)
Dim txbkl(4,1)
Dim txbtk(4,1)

ja globaalin leikepöydän voi laittaa, mutta se ei ole pakollinen:
Global clipboard As String

Leikkaa: Ctrl + X
Kopioi: Ctrl + C
Liittää: Ctrl + V

koko tekstin voi laittaa ensimmäiselle riville, tekstilaatikko osaa rivittää sen. Viimeistä mahdollista riviä ei rivitetä.

korvaa tekstikentän kun laittaa korkeudeksi 1 ja max rivimääräksi 1
Kotisivut: (Uusitaan)
Secret Unit War (Frozen)
Tilekarttaeditori (Frozen)
Käyttöliittymän osia

User avatar
valscion
Moderator
Moderator
Posts: 1587
Joined: Thu Dec 06, 2007 8:46 pm
Location: Espoo
Contact:

Re: Käyttöliittymän osia

Post by valscion » Sun Dec 16, 2007 9:16 pm

Leikepöytä on hieno uudistus ja salasanasuojattua tekstiareaa tulee ehkä joskus tarvitsemaan. Siinä on vain sellainen turvallisuusaukko. Pystyt kopioimaan salasanamerkittyä tekstiä salasanamerkitsemättömään tekstilaatikkoon. (Vaikka eihän näitä kahta tarvitse pitää samassa koodissa.)
cbEnchanted, uudelleenkirjoitettu runtime. Uusin versio: 0.4.1 — Nyt myös sorsat GitHubissa!
NetMatch - se kunnon nettimättö-deathmatch! Avoimella lähdekoodilla varustettu
vesalaakso.com

User avatar
tuhoojabotti
Advanced Member
Posts: 485
Joined: Tue Aug 28, 2007 3:53 pm
Location: Suomi, Finland
Contact:

Re: Käyttöliittymän osia

Post by tuhoojabotti » Sun Dec 16, 2007 10:23 pm

text areaa vois laittaa sillee jos loppuu rivi niin vaihtuu rivi ;) tai semmonen parametri että vaihtuuko automaattisesti vai ei ;)
Imagedev.tuhoojabotti.com — “Programmer (noun): An organism that turns caffeine into code.”

User avatar
project coder
Newcomer
Posts: 27
Joined: Mon Aug 27, 2007 9:23 pm
Location: Kajaani

Re: Käyttöliittymän osia

Post by project coder » Sun Jan 06, 2008 6:31 pm

Taas tuli tehtyä uutta ja päivitettyä vanhaa. Uutena on alasvetovalikko ja päivitin vierityspalkin. Nyt on myös enemmän kommentointia.
Alasvetovalikkoja on kaksi versiota: Toisen osat on taulukossa ja toisen yhdessä merkkijonossa

Alasvetovalikot:
Versio 1:
dropdownlist(x, y, leveys, numero, osien määrä[, max osia näkyvillä, palautus, käytä pisteitä])

Tarvitsee taulukot:
Dim ddl(lista määrä,osien max määrä) As String
Dim ddld(lista määrä,8)

ja globaalin
Global ddlopen

ddl(num,0) taulukon osa 0 toimii ohje tekstinä, joka ei näy listassa

Palautus:
0 = Palauta osan numero
1 = Palauta osa

Käytä pisteitä:
1 = Lisää kolme pistettä ylipitkiin lauseisiin

Lsäksi on drawopenlist() funktio, joka pitää piirtää viimeisenä. Se piirtää avoimen listan kaikkien muiden asioiden päälle.

Listan alle jäävät painikkeet eivät painallu, kun listan osa valitaan(paitsi vierityspalkin kohdalla), mutta mousedown reakoi listan alla.

Ja sitten koodi:

Code: Select all

ClsColor 255,255,255

Dim ddl(10,20) As String'Tekstit
Dim ddld(10,8)'Tärkeää dataa
Global ddlopen'Avoimen listan numero

ddl(1,0)="Valitse"'Oletus teksti(ei näy listassa)
'Lisätään tietoa
For i=1 To 10
	ddl(1,i)=i
	ddl(2,i)=10-i
Next i

Repeat

a=dropdownlist(10,10,100,1,10,12,0,1)'Palauttaa luvun
b$=dropdownlist(10,50,100,2,10,5,1,0)'Palauttaa tekstin

If button(10,80,100,30,"Sulje") Then End'Testaa läpi painalluksen

drawopenlist()'Piirtää listan kaikkien muiden päälle
DrawScreen
Forever

Function dropdownlist(x,y,x2,num,items,maxitems=10,returnstr=0,usedots=1)
Color 255,255,255
Box x,y,x2,15
Color 0,0,0
Box x,y,x2,15,0
Box x+x2-15,y,15,15,0
Line x+x2-15+3,y+5,x+x2-4,y+5
Line x+x2-15+3,y+5,x+x2-8,y+15-6
Line x+x2-4,y+5,x+x2-8,y+15-6
'Näyttää valitun arvon tai oletus arvon
If ddld(num,5)=>0 Then
	mahtuu=(x2-15)/TextWidth("A")
	t$=ddl(num,ddld(num,5))
	If Len(t)>mahtuu Then
		If usedots Then t=Left(t,mahtuu-3)+"..." Else t=Left(t,mahtuu)
	EndIf
	Text x+2,y+1,t
EndIf
mx=MouseX():my=MouseY():mu=MouseUp(1)
If mx>x And my>y And mx<x+x2 And my<y+15 Then
	If mu Then
		If ddlopen<>num Then ddlopen=num Else ddlopen=0
		z=MouseMoveZ()'Tyhjennetään hiiren rullan liike
		ClearMouse:mu=0
	EndIf
Else
	If mu Then
		If ddlopen=num Then
			If mx<x And my<y And mx>x+x2 And my>y+15+Min(maxitems,items)*15 
				ddlopen=0:mu=0
			EndIf
		EndIf
	EndIf
EndIf

If ddlopen=num Then
	If mx>x And my=>y And mx<x+x2 And my<y+15+Min(maxitems,items)*15 
		If MouseHit(1) Then ClearMouse'Estetään läpi painallus
		'Laitetaan tiedot taulukkoon
		ddld(num,0)=x
		ddld(num,1)=y+15
		ddld(num,2)=x2
		ddld(num,3)=items
		ddld(num,4)=maxitems
		ddld(num,6)=(my-y)/15
		ddld(num,8)=usedots
		If items>maxitems Then'Jos tarvitaan vierityspalkkia
			x=x+x2-15:y=y+15
			marvo=items-maxitems
			kor=Min(maxitems,items)*15
			ty=y+7:ty2=kor-14
			mz=MouseMoveZ()'Rulla vieritys
			ddld(num,7)=Max(Min(ddld(num,7)+(mz<0)-(mz>0),marvo),0)
			If mx>=x And mx<=x+15 And my>y And my<y+x+kor Then
				If MouseDown(1) Then
					ddld(num,7)=Max(Min(((Float(my-ty)/ty2)*marvo),marvo),0)
				EndIf
				mu=0
			EndIf
		EndIf
		
		If mu Then'Kun valinta tehdään
			ddlopen=0
			ddld(num,5)=ddld(num,6)+ddld(num,7)
			ClearMouse:mu=0
		EndIf
	EndIf
EndIf

If ddld(num,5)=0 Then Return 0
If returnstr=0 Then'Palauttaa joko osan numeron tai osan
	Return ddld(num,5)
Else
	Return ddl(num,ddld(num,5))
EndIf

EndFunction

'---------------------------------------------------------

Function drawopenlist()'Kutsutaan juuri ennen drawscreeniä
If ddlopen Then
	'Luetaan tiedot taulukosta
	x=ddld(ddlopen,0)
	y=ddld(ddlopen,1)-1
	x2=ddld(ddlopen,2)
	items=ddld(ddlopen,3)
	mitems=ddld(ddlopen,4)
	k=ddld(ddlopen,6)
	k2=ddld(ddlopen,7)
	usedots=ddld(ddlopen,8)
	If items>mitems Then vp=1 Else vp=0
	
	'Piirretään laatikko
	Color 255,255,255
	Box x,y,x2,15*Min(items,mitems)
	Color 0,0,0
	Box x,y,x2,15*Min(items,mitems),0
	
	mahtuu=(x2-15*(vp=1))/TextWidth("A")
	For i=1 To Min(items,mitems)'Piirretään vaihtoehdot
		If i=k Then
			Color 0,0,255
			Box x+1,y+(i-1)*15,x2-2-((vp=1)*15-1),15
			Color 255,255,255
		Else
			Color 0,0,0
		EndIf
		t$=ddl(ddlopen,i+k2)
		If Len(t)>mahtuu Then
			If usedots Then t=Left(t,mahtuu-3)+"..." Else t=Left(t,mahtuu)
		EndIf
		Text x+2,y+(i-1)*15+1,t
	Next i
	If vp Then'Piirretään vierityspalkki, jos tarvitaan
		x=x+x2-15
		marvo=items-mitems
		kor=Min(mitems,items)*15
		Color 0,0,0
		Box x,y,15,kor,0
		Box x+2,y+(kor-15)*k2/marvo+2,15-4,11
	EndIf
EndIf
EndFunction

Function button(x,y,x2,y2,t$)'Testiä varten
Color 255,255,255
Box x,y,x2,y2
Color 0,0,0
Box x,y,x2,y2,0
If MouseX()>x And MouseY()>y And MouseX()<x+x2 And MouseY()<y+y2 Then
If MouseHit(1) Or MouseUp(1) Then arvo=1
Color 100,100,100
EndIf
Box x,y,x2,y2,0
CenterText x+x2/2,y+y2/2,t,2
Return arvo
EndFunction
Versio 2:
dropdownlist(x, y, leveys, numero[, max osia näkyvillä, ohjeteksti, palautus, käytä pisteitä])

Tarvitsee taulukot:
Dim ddl(lista) As String
Dim ddld(lista määrä,8)

ja globaalin
Global ddlopen

Infoteksti:
Teksti joka näkyy jos ei ole valittu mitään. Esim "Valitse"

Palautus:
0 = Palauta osan numero
1 = Palauta osa

Käytä pisteitä:
1 = Lisää kolme pistettä ylipitkiin lauseisiin

Myös tämä käyttää drawopenlist() funktiota

Ominaisuudet ovat samat, paitsi tässä on paremmat hallinta funktiot. Ongelma on vain ä ja ö kirjaimissa jotka jäävät pois, jos ovat listan viimeisiä

Ja sitten koodi:

Code: Select all

ClsColor 255,255,255

Dim ddl(10) As String'Tekstit
Dim ddld(10,8)'Tärkeää dataa
Global ddlopen'Avoimen listan numero

'Lisätään tietoa
ddl(1)="Eka|Toka|Tämä lause on liian pitkä|Neljäs||edellinen tyhjä|Viimeinen"
ddl(2)="Eka|Toka|Tämä lause on liian pitkä|Neljäs||edellinen tyhjä|Viimeinen"

'Lisätään funktiolla
dropdownlistadd(1,"Lisätty")
'Korvataan ekaa
dropdownlistadd(1,"Eka(edit)",1,2)
'Lisätään neljännen jälkeen viides
dropdownlistadd(1,"Viides",4,1)

'Poistaa kakkos listan kolmannen
dropdownlistremove(2,3)

Repeat

a=dropdownlist(10,10,100,1,10,"Valitse",0,1)'Palauttaa luvun
b$=dropdownlist(10,50,150,2,5,"Valitse",1,0)'Palauttaa tekstin

Text 0,100,a'Ykkös listan valittun osan numero
Text 0,115,b'Kakkos listan valittu osa
Text 0,130,dropdownlistget(1,3)'Haetaan 1 lista kolmas osa
Text 0,145,dropdownlistcount(1)'Laskee 1 listan osien määrän
Text 0,160,dropdownlistfind(1,"Viimeinen")'Etsitään monesko on "Viimeinen"
Text 0,175,dropdownlistfind(1,"on",0)'Etsitään monesko sisältää sanan "on"

drawopenlist()'Piirtää listan kaikkien muiden päälle
DrawScreen
Forever

Function dropdownlist(x,y,x2,num,maxitems=10,infotext$="",returnstr=0,usedots=1)
Color 255,255,255
Box x,y,x2,15
Color 0,0,0
Box x,y,x2,15,0
Box x+x2-15,y,15,15,0
Line x+x2-15+3,y+5,x+x2-4,y+5
Line x+x2-15+3,y+5,x+x2-8,y+15-6
Line x+x2-4,y+5,x+x2-8,y+15-6
items=CountWords(ddl(num),"|")
If ddld(num,5)>0 Then
	mahtuu=(x2-15)/TextWidth("A")
	t$=GetWord(ddl(num),ddld(num,5),"|")
	If Len(t)>mahtuu Then
		If usedots Then t=Left(t,mahtuu-3)+"..." Else t=Left(t,mahtuu)
	EndIf
	Text x+2,y+1,t
ElseIf ddld(num,5)=0 Then
	Text x+2,y+1,infotext'Jos ei ole valittua näytetään ohje teksti
EndIf
mx=MouseX():my=MouseY():mu=MouseUp(1)
If mx>x And my>y And mx<x+x2 And my<y+15 Then
	If mu Then
		If ddlopen<>num Then ddlopen=num Else ddlopen=0
		z=MouseMoveZ()'Tyhjennetään hiiren rullan liike
		ClearMouse:mu=0
	EndIf
Else
	If mu Then
		If ddlopen=num Then
			If mx<x And my<y And mx>x+x2 And my>y+15+Min(maxitems,items)*15 
				ddlopen=0:mu=0
			EndIf
		EndIf
	EndIf
EndIf
If ddlopen=num Then
	If mx>x And my=>y And mx<x+x2 And my<y+15+Min(maxitems,items)*15 
		If MouseHit(1) Then ClearMouse
		ddld(num,0)=x
		ddld(num,1)=y+15
		ddld(num,2)=x2
		ddld(num,3)=items
		ddld(num,4)=maxitems
		ddld(num,6)=(my-y)/15
		ddld(num,8)=usedots
		If items>maxitems Then
			x=x+x2-15:y=y+15
			marvo=items-maxitems
			kor=Min(maxitems,items)*15
			ty=y+7:ty2=kor-14
			mz=MouseMoveZ()'Rulla vieritys
			ddld(num,7)=Max(Min(ddld(num,7)+(mz<0)-(mz>0),marvo),0)
			If mx>=x And mx<=x+15 And my>y And my<y+x+kor Then
				If MouseDown(1) Then
					ddld(num,7)=Max(Min(((Float(my-ty)/ty2)*marvo),marvo),0)
				EndIf
				mu=0
			EndIf
		EndIf
		If mu Then
			ddlopen=0
			ddld(num,5)=ddld(num,6)+ddld(num,7)
			ClearMouse:mu=0
		EndIf
	EndIf
EndIf
If ddld(num,5)=0 Then Return 0
If returnstr=0 Then'Palauttaa joko osan numeron tai osan
	Return ddld(num,5)
Else
	Return GetWord(ddl(num),ddld(num,5),"|")
EndIf
EndFunction

'---------------------------------------------------------

Function drawopenlist()'Kutsutaan juuri ennen drawscreeniä
If ddlopen Then
	'Luetaan tiedot taulukosta
	x=ddld(ddlopen,0)
	y=ddld(ddlopen,1)-1
	x2=ddld(ddlopen,2)
	items=ddld(ddlopen,3)
	mitems=ddld(ddlopen,4)
	k=ddld(ddlopen,6)
	k2=ddld(ddlopen,7)
	usedots=ddld(ddlopen,8)
	If items>mitems Then vp=1 Else vp=0
	Color 255,255,255
	Box x,y,x2,15*Min(items,mitems)
	Color 0,0,0
	Box x,y,x2,15*Min(items,mitems),0
	mahtuu=(x2-15*(vp=1))/TextWidth("A")
	For i=1 To Min(items,mitems)
		If i=k Then
			Color 0,0,255
			Box x+1,y+(i-1)*15,x2-2-((vp=1)*15-1),15
			Color 255,255,255
		Else
			Color 0,0,0
		EndIf
		t$=GetWord(ddl(ddlopen),i+k2,"|")
		If Len(t)>mahtuu Then
			If usedots Then t=Left(t,mahtuu-3)+"..." Else t=Left(t,mahtuu)
		EndIf
		Text x+2,y+(i-1)*15+1,t
	Next i
	If vp Then'Piirretään vierityspalkki, jos tarvitaan
		x=x+x2-15
		marvo=items-mitems
		kor=Min(mitems,items)*15
		Color 0,0,0
		Box x,y,15,kor,0
		Box x+2,y+(kor-15)*k2/marvo+2,15-4,11
	EndIf	
EndIf
EndFunction

Function dropdownlistadd(num,item$,index=0,mihin=0)'mihin: 0=eteen 1=taakse 2=korvaa
item=Replace(item,"|",":")
words=CountWords(ddl(num),"|")
If index=0 Or index>words Then
	ddl(num)=ddl(num)+"|"+item
Else
	word$=GetWord(ddl(num),index,"|")
	t$=ddl(num)
	If index=1 Then
		If mihin=0 Then
			ddl(num)=item+"|"+t
		ElseIf mihin=1 Then
			ddl(num)=Left(t,Len(word))+"|"+item+Right(t,Len(t)-Len(word))
		Else
			ddl(num)=item+Right(t,Len(t)-Len(word))
		EndIf
	ElseIf index=words Then
		If mihin=0 Then
			ddl(num)=Left(t,Len(t)-Len(word))+item+"|"+Right(t,Len(word))
		ElseIf mihin=1 Then
			ddl(num)=t+"|"+item
		Else
			ddl(num)=Left(t,Len(t)-Len(word))+item
		EndIf
	Else
		tempint=InStr(t,word)
		If mihin=0 Then
			ddl(num)=Left(t,tempint-1)+item+"|"+Right(t,Len(t)-tempint+1)
		ElseIf mihin=1 Then
			ddl(num)=Left(t,tempint+Len(word))+item+"|"+Right(t,Len(t)-(tempint+Len(word)))
		Else
			ddl(num)=Left(t,tempint-1)+item+"|"+Right(t,Len(t)-(tempint+Len(word)))
		EndIf
	EndIf
EndIf
EndFunction

Function dropdownlistget(num,index)
If index<0 Then Return 0
If index=0 Then Return GetWord(ddl(num),Int(CountWords(ddl(num),"|")),"|")
Return GetWord(ddl(num),index,"|")
EndFunction

Function dropdownlistcount(num)
Return CountWords(ddl(num),"|")
EndFunction

Function dropdownlistremove(num,index,all=0)
If all Then ddl(num)="":Return 1
word$=GetWord(ddl(num),index,"|")
t$=ddl(num)
If index=1 Then
	ddl(num)=Right(t,Len(t)-Len(word)-1)
ElseIf index=CountWords(t,"|") Or index=0 Then
	word=GetWord(t,Int(CountWords(t,"|")),"|")
	ddl(num)=Left(t,Len(t)-Len(word)-1)
Else
	tempint=InStr(t,word)
	ddl(num)=Left(t,tempint-1)+Right(t,Len(t)-(tempint+Len(word)))
EndIf
Return 0
EndFunction

Function dropdownlistfind(num,find$,fullitem=1)
If InStr(ddl(num),find) Then
	For i=1 To CountWords(ddl(num),"|")
		If fullitem=0 And InStr(GetWord(ddl(num),i,"|"),find) Then Return i
		If fullitem=1 And GetWord(ddl(num),i,"|")=find Then Return i
	Next i
EndIf
Return 0
EndFunction
Hallinta funktiot:
Nämä eivät toimi ekassa versiossa. Saman nimisten osien kassa voi tulla ongelmia.
indexin arvona 0 on useimmissa listan viimeinen ja 1 ensimmäinen osa.

drropdownlistadd(numero, lisättävä[, kohta, mihin])
Lisää uuden osan listaan
Mihin:
0 = Taakse
1 = Eteen
2 = Korvaa

dropdownlistget(numero,kohta)
Hakee listan osan. 0 on viimeinen ja 1 on eka

dropdownlistcount(numero)
Laskee listan osien määrän

dropdownlistremove(numero, kohta[, kaikki])
Poistaa listan osan tai kaikki osat

dropdownlistfind(numero, etsittävä[, koko osa])
Etsii ja palauttaa etsittävän osan kohdan

koko osa:
1 = etsii vain koko osia
0 = etsii osien sisältä


Vierityspalkin päivitin ensimmäiseen viestiin.
Last edited by project coder on Tue Jan 08, 2008 5:15 pm, edited 1 time in total.
Kotisivut: (Uusitaan)
Secret Unit War (Frozen)
Tilekarttaeditori (Frozen)
Käyttöliittymän osia

User avatar
Eräs cb koodaaja
Active Member
Posts: 126
Joined: Wed Aug 29, 2007 3:55 pm

Re: Käyttöliittymän osia

Post by Eräs cb koodaaja » Sun Jan 06, 2008 10:29 pm

Voisit laittaa nuolet niihin pienempiin laatikoihin niin kuin Wintoosassa. Nämä ovat kyllä käteviä. Kauanko näiden pudotusvalikoiden tekeminen kesti ?(itse värkkäsin joskus viikon verran, mutta jätin kesken, kun ei toiminut)
ps. Tarvitseeko nimeäsi mainita, jos näitä käyttää.
Tiimit ja tuotokset:
RE:Ydintuho
Drahtlose:Infernalisch, Pienet pelit

User avatar
project coder
Newcomer
Posts: 27
Joined: Mon Aug 27, 2007 9:23 pm
Location: Kajaani

Re: Käyttöliittymän osia

Post by project coder » Sun Jan 06, 2008 11:19 pm

Eräs cb koodaaja wrote:Voisit laittaa nuolet niihin pienempiin laatikoihin niin kuin Wintoosassa. Nämä ovat kyllä käteviä. Kauanko näiden pudotusvalikoiden tekeminen kesti ?(itse värkkäsin joskus viikon verran, mutta jätin kesken, kun ei toiminut)
ps. Tarvitseeko nimeäsi mainita, jos näitä käyttää.
Oho. piti laittaa ne nuolet, mutta unohdin. Lisään kun kerkeän.
Ekan version tein yhtenä iltana n.5 tunnissa ja seuraavana päivänä tein kakkos version.
Nimeä ei tarvitse mainita.
Kotisivut: (Uusitaan)
Secret Unit War (Frozen)
Tilekarttaeditori (Frozen)
Käyttöliittymän osia

User avatar
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Käyttöliittymän osia

Post by MaGetzUb » Mon Jan 07, 2008 6:41 pm

Miksi inputit toteutetaan aina noin hankalasti?!? Miksei sitä palautettavaa muuttujaa pistetä funktion sisälle, periaatteessa sen pitäisi pelata.
esim:

Code: Select all

Function Inputbox(x,y,w,h,key,s$)
s$=newS$
koodia....

if keydown(cbkeyA) then news$=strinsert(s$,lens$,"a")

koodia...

endfunction 
return news$
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

User avatar
koodaaja
Moderator
Moderator
Posts: 1583
Joined: Mon Aug 27, 2007 11:24 pm
Location: Otaniemi - Mikkeli -pendelöinti

Re: Käyttöliittymän osia

Post by koodaaja » Tue Jan 08, 2008 4:47 pm

programmer of DSG wrote:Miksi inputit toteutetaan aina noin hankalasti?!? Miksei sitä palautettavaa muuttujaa pistetä funktion sisälle, periaatteessa sen pitäisi pelata.
esim:

Code: Select all

Function Inputbox(x,y,w,h,key,s$)
s$=newS$
koodia....

if keydown(cbkeyA) then news$=strinsert(s$,lens$,"a")

koodia...

endfunction 
return news$
No ajattelepa hetki. Jos tuolla tavalla teet inputin, mitä muuta näytöllä näkyy inputin aikana? Aivan, ei mitään. Kaikki muutkin näytöllä olevat asiat pitää piirtää, ei vain sitä inputtia. Joten hankalampi olisi tehdä input noin.

User avatar
Raspful
Member
Posts: 83
Joined: Tue Aug 28, 2007 2:40 pm
Location: Raisio
Contact:

Re: Käyttöliittymän osia

Post by Raspful » Tue Jan 08, 2008 8:01 pm

Upeaa työtä! Näille tulee varmasti käyttöä(ainakin pudotusvalikolle ), kunhan koodaus taito hieman karttuu. 8-)
Tiimin kotisivut

Ydintuhon edistyminen:

Koodi=[70%]
Grafiikka=[60%]
Kentät=[40%]
Musiikki=[50%]

User avatar
nevssons
Devoted Member
Posts: 503
Joined: Sun Jan 13, 2008 6:02 pm

Re: Käyttöliittymän osia

Post by nevssons » Tue Mar 04, 2008 9:18 pm

mikä palauttaa ton tekstilaatikon tekstin?
Koodarina kohtalainen, henkilönä vittumainen
Image

User avatar
Harakka
Advanced Member
Posts: 430
Joined: Mon Aug 27, 2007 9:08 pm
Location: Salo
Contact:

Re: Käyttöliittymän osia

Post by Harakka » Tue Mar 04, 2008 10:25 pm

Itsekin saa miettiä...

Code: Select all

nimi$=inputbox(10,10,100,1,nimi)
Noin on esimerkkikoodissa. Eiköhän ole aika selvää että InputBox() palauttaa siinä olevan tekstin ja esimerkissä se tallennetaan nimi-muuttujaan.
Peli piirtokomennoilla - voittaja, Virtuaalilemmikkipeli - voittaja,
Sukellusvenepeli - voittaja, Paras tileset - voittaja
Vaihtuva päähenkilö - voittaja, Autopeli - voittaja sekä
Hiirellä ohjattava peli - voittaja B)

User avatar
nevssons
Devoted Member
Posts: 503
Joined: Sun Jan 13, 2008 6:02 pm

Re: Käyttöliittymän osia

Post by nevssons » Tue Mar 04, 2008 10:37 pm

Harakka wrote:Itsekin saa miettiä...

Code: Select all

nimi$=inputbox(10,10,100,1,nimi)
Noin on esimerkkikoodissa. Eiköhän ole aika selvää että InputBox() palauttaa siinä olevan tekstin ja esimerkissä se tallennetaan nimi-muuttujaan.
tarkoitin tota textbox komentoa.
Koodarina kohtalainen, henkilönä vittumainen
Image

User avatar
project coder
Newcomer
Posts: 27
Joined: Mon Aug 27, 2007 9:23 pm
Location: Kajaani

Re: Käyttöliittymän osia

Post by project coder » Tue Mar 04, 2008 10:55 pm

Funktio ei palauta mitään vaan teksti tallennetaan txb(num,rivinumero) taulukkoon, josta jokainen rivi pitää lukea erikseen.
Kaiken tekstin saa yhteen muuttujaan esimerkiksi näin:

Code: Select all

Teksti$=""
For i=1 to rivimaara
    If txb(1,i)="" Then Exit
    Teksti=Teksti+txb(1,i)
Next i
Kotisivut: (Uusitaan)
Secret Unit War (Frozen)
Tilekarttaeditori (Frozen)
Käyttöliittymän osia

User avatar
nevssons
Devoted Member
Posts: 503
Joined: Sun Jan 13, 2008 6:02 pm

Re: Käyttöliittymän osia

Post by nevssons » Wed Mar 05, 2008 7:19 pm

Tos on versio jos on paremmat reunat

Code: Select all

ClsColor 236,233,216:Cls

rivimaara=100

Global clipboard As String'Leikepöytä
Dim txb(4,rivimaara) As String'Teksti
Dim txbd(4,2)'Muuta dataa (0=rivimäärä, 1=välke aika)
Dim txbv(4)'Valittuna
Dim txbka(4,1)'Kursorin alku kohta(rivin eka=1, sarakkeen eka=0)
Dim txbkl(4,1)'Kursorin loppu kohta
Dim txbtk(4,1)'Tekstin kohta (0=alku)

clipboard="Liitettävä"'Leikepöydän teksti

Repeat

textbox(50,20,15,1,3,1)'Yhden rivin teksti laatikko
textbox(200,20,15,1,4,1,"*")'Sama salasanamerkillä

textbox(50,50,15,10,1,100)'Tekstilaatikko
textbox(200,50,15,10,2,100,"*")'Tekstilaatikko salasanamerkillä

DrawScreen
Forever

Function textbox(x,y,x2,y2,num,mrm=100,pass$="")
r=getRGB(RED)
g=getRGB(GREEN)
b=getRGB(BLUE)
tw=TextWidth("A")
th=TextHeight("A")

    w=x2*8 
    h=y2*10

	Color 64,64,64
	Line x-1,y-1,x+w-1,y-1
	Line x-1,y,x-1,y+h-1
	Color 212,208,200
	Line x-1,y+h,x+w,y+h
	Line x+w,y-1,x+w,y+h-1
	Color 128,128,128
	Line x-2,y-2,x+w,y-2
	Line x-2,y-1,x-2,y+h
	Color 255,255,255
	Line x-2,y+h+1,x+w+1,y+h+1
	Line x+w+1,y-2,x+w+1,y+h
	Box x,y,w,h

mx=MouseX()
my=MouseY()
rm=Max(1,txbd(num,0))'Rivi määrä

If mx>=x And my>=y And mx<=x+x2*tw+5 And my<=y+y2*15+2 Then
   If MouseHit(1) Then
      txbv(num)=1
      txbka(num,1)=Min(Max(1,(my-y+14)/15+(txbtk(num,1))),rm)
      txbka(num,0)=Min(Max(0,(mx-x-1)/tw+(txbtk(num,0))),Len(Replace(txb(num,txbka(num,1)),Chr(13),"")))
      ClearKeys()
   EndIf
Else
   If MouseUp(1) Then txbv(num)=0
EndIf

vkk=txbka(num,0)'Rivi kursorin kohta
vkkn=txbka(num,0)-txbtk(num,0)'Rivi kursorin kohta näytöllä
pkk=txbka(num,1)'Sarake kursorin kohta näytöllä
pkkn=txbka(num,1)-txbtk(num,1)'Sarake kursorin kohta näytöllä

If txbv(num)=1 Then
   t$=txb(num,pkk)
   vr=txbka(num,1)
   pituus=Len(Replace(t,Chr(13),""))
   pituus2=Len(t)'Pituus enterien kanssa

   If vkk<txbtk(num,0) Then txbtk(num,0)=vkk
   If vkk>txbtk(num,0)+x2 Then txbtk(num,0)=vkk-x2
   If pkk-1<txbtk(num,1) Then txbtk(num,1)=pkk-1
   If pkk>txbtk(num,1)+y2 Then txbtk(num,1)=pkk-y2
      
   'Päivitetään tiedot
   vkk=txbka(num,0):vkkn=txbka(num,0)-txbtk(num,0)
   pkk=txbka(num,1):pkkn=txbka(num,1)-txbtk(num,1)
   
   If txbd(num,1)<=0 Then txbd(num,1)=100
   If txbd(num,1)>50 Then
      Color 0,0,0'Viivan väri
      Line x+(vkkn*tw)+2,y+(pkkn-1)*15+2,x+(vkkn*tw)+2,y+(pkkn-1)*15+14
   EndIf
   txbd(num,1)=txbd(num,1)-1
   
   txbka(num,0)=Min(Max(txbka(num,0),0),pituus)
   txbka(num,0)=txbka(num,0)+(KeyHit(205)-KeyHit(203))
   txbka(num,1)=Min(Max(1,txbka(num,1)+(KeyHit(208)-KeyHit(200))),rm)
   
   If txbka(num,0)<0 And vr>1 Then
      txbka(num,1)=txbka(num,1)-1
      txbka(num,0)=Len(txb(num,txbka(num,1)))
   ElseIf txbka(num,0)>pituus And vr<rm Then
      txbka(num,1)=txbka(num,1)+1
      txbka(num,0)=0
   EndIf
   txbka(num,0)=Min(Max(txbka(num,0),0),Len(Replace(txb(num,txbka(num,1)),Chr(13),"")))
   
   lisattava$=""
   If KeyDown(29) Or KeyDown(157) Then
      If KeyHit(45) Then'Leikkaa(valittu rivi)
         clipboard=t:t=""
      ElseIf KeyHit(46) Then'Kopioi(valittu rivi)
         clipboard=t
      ElseIf KeyHit(47) Then'Liitä
         lisattava=clipboard
      EndIf
   ElseIf KeyUp(29) Or KeyUp(157) Then
      ClearKeys()
   Else'Jos ei ctrl painettuna, niin kirjoittaminen alkaa
   key=GetKey()
   If KeyHit(199) Then'Home
      txbka(num,0)=0:txbkl(num,0)=0
   ElseIf KeyHit(207) Then'End
      txbka(num,0)=pituus:txbkl(num,0)=pituus
   ElseIf KeyDown(181) And key=45 Then'Num jako (korjaus)
      ClearKeys():lisattava=Chr(47)
   ElseIf KeyHit(82) Then'Num näppäimet
      ClearKeys():lisattava=Chr(48)
   ElseIf KeyHit(79) Then
      ClearKeys():lisattava=Chr(49)
   ElseIf KeyHit(80) Then
      ClearKeys():lisattava=Chr(50)
   ElseIf KeyHit(81) Then
      ClearKeys():lisattava=Chr(51)
   ElseIf KeyHit(75) Then
      ClearKeys():lisattava=Chr(52)
   ElseIf KeyHit(76) Then
      ClearKeys():lisattava=Chr(53)
   ElseIf KeyHit(77) Then
      ClearKeys():lisattava=Chr(54)
   ElseIf KeyHit(71) Then
      ClearKeys():lisattava=Chr(55)
   ElseIf KeyHit(72) Then
      ClearKeys():lisattava=Chr(56)
   ElseIf KeyHit(73) Then
      ClearKeys():lisattava=Chr(57)
   Else
      If key=13 Then'Enter
         t=StrInsert(t,vkk,Chr(13))
         If txbka(num,1)<mrm Then
            txbka(num,1)=txbka(num,1)+1
            txbka(num,0)=0
         EndIf
      ElseIf key=8 Then'BackSpace
         If vkk>0 Then
            t=StrRemove(t,vkk,1)
            txbka(num,0)=txbka(num,0)-1
         ElseIf vkk=0 And vr>1 Then
            txb(num,vr-1)=Left(txb(num,vr-1),Len(txb(num,vr-1))-1)
            txbka(num,1)=txbka(num,1)-1
            txbka(num,0)=Len(txb(num,vr-1))
         EndIf
      ElseIf key=4 Then'Delete
         If vkk<pituus2 Then
            t=StrRemove(t,vkk+1,1)
         EndIf
      ElseIf key>31 Then
         t=StrInsert(t,vkk,Chr(key))
         txbka(num,0)=txbka(num,0)+1
      EndIf
   EndIf
   EndIf
   
   If lisattava<>"" Then'Lisätään teksti, jos ON lisättävää
      t=StrInsert(t,vkk,lisattava)
      txbka(num,0)=txbka(num,0)+Len(lisattava)
   EndIf

   txb(num,pkk)=t
EndIf

i=0
ok=0
Repeat'Rivin vaihdot
   i=i+(vah=0):vah=0
   If i=mrm Then Exit
   tt$=txb(num,i)
   entk=InStr(tt,Chr(13))
   If entk Then
      If entk=Len(tt) Then'Jos enter viimeisenä
         'Hyvä rivi
      ElseIf entk=1 Then'Jos enter ekana
         txb(num,i+1)=Right(tt,Len(tt)-1)+txb(num,i+1)
         tt=Chr(13)
      Else'Jos enter välissä
         txb(num,i+1)=Right(tt,Len(tt)-(entk))+txb(num,i+1)
         tt=Left(tt,entk)
      EndIf
   Else
      If txb(num,i+1)<>"" Then
         tt=tt+txb(num,i+1)
         txb(num,i+1)=""
         vah=1
      Else
         ok=1
      EndIf
   EndIf
   txb(num,i)=tt
Until ok=1
rm=i
'Kirjoitetaan teksti
Color 0,0,0'Tekstin väri
For i=1+txbtk(num,1) To Min(rm,y2+txbtk(num,1))
teksti$=Mid(Replace(txb(num,i),Chr(13),""),txbtk(num,0)+1,x2)
If pass="" Then
Text x+2,y+2+(i-1-txbtk(num,1))*15,teksti
Else
Text x+2,y+2+(i-1-txbtk(num,1))*15,String(Left(pass,1),Len(teksti))
EndIf
Next i
txbd(num,0)=Max(1,rm)'Tallennetaan rivien määrä
Color r,g,b
EndFunction
Koodarina kohtalainen, henkilönä vittumainen
Image

User avatar
Koodiapina
Forum Veteran
Posts: 2396
Joined: Tue Aug 28, 2007 4:20 pm
Contact:

Re: Käyttöliittymän osia

Post by Koodiapina » Thu Mar 06, 2008 4:33 pm

Muuten hyvä, mutta tuo rämpyttäminen on ärsyttävää. Tossa Nevsonin versiossa tekstit menee yli reunojen. Mutta toiseksi paras tekstilaatikko mitä olen Coolbasicilla nähnyt :)
Olen liian älykäs ollakseni väärässä. Jos olet kanssani eri mieltä, suosittelen sinua pohtimaan omaa elämänkatsomustasi ja sen perusteita.

Post Reply