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

Re: Käyttöliittymän osia

Post by project coder » Fri Mar 07, 2008 9:55 pm

Tekstilaatikon päivitys. Lisäsin tekstin valinnan ja tein pieniä muutoksia.Toisessa versiossa on ohjelman ulkopuolinen leikepöytä. Lisäsin myös Windows perinteisen tekstilaatikon reunat. Funktio ei oletuksena palauta mitään, mutta _return arvoa muuttamalla se paluattaa joko kaiken tai valitun rivin.

Funktiot esimerkillä:
Versio 1:

Code: Select all

ClsColor 236,233,216:Cls

tbkpl=4
rivimaara=100

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

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

txb(1,1)="Testi teksti 1"+Chr(13)+"Testi teksti 2"+Chr(13)+"Testi teksti 3"+Chr(13)+"Testi teksti 4"+Chr(13)+"Testi teksti 5"

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

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

DrawScreen
Forever

Function textbox(x,y,x2,y2,num,mrm=100,pass$="",_return=0,vp=1)
_oldr=getRGB(1):_oldg=getRGB(2):_oldb=getRGB(3)
If num=0 Then num=1
tw=TextWidth("A"):th=TextHeight("A")
mx=MouseX():my=MouseY()
rm=Max(1,txbd(num,0))'Rivi määrä
If rm>y2 And vp Then
	vpl=tw*2
	x2=x2-2
	mz=MouseMoveZ()
EndIf

'Laatikko
'Tausta
Color 255,255,255:Box x,y,x2*tw+5+vpl,y2*15+2
'Reunat
'Windows perinteinen
Color 172,168,153:Box x-1,y-1,x2*tw+7+vpl,y2*15+4,0
Color 113,111,100:Box x,y,x2*tw+5+vpl,y2*15+2,0
Color 241,239,226:Box x,y+y2*15+1,x2*tw+5+vpl,1:Box x+x2*tw+4+vpl,y,1,y2*15+2
Color 255,255,255:Box x-1,y+y2*15+2,x2*tw+7+vpl,1:Box x+x2*tw+5+vpl,y-1,1,y2*15+4
'WinXP
'Color 127,157,185:Box x,y,x2*tw+5+vpl,y2*15+2,0

If (mx>=x And my>=y And mx<=x+x2*tw+5 And my<=y+y2*15+2) Or txbd(num,4)=1 Then
	If vpl Then
		If mz And _vtxb=num Then _vtxb=0:txbd(num,4)=0
		txbtk(num,1)=Max(Min(txbtk(num,1)+((mz<0)-(mz>0))*1,txbd(num,0)-y2),0)
	EndIf
	If MouseHit(1) Then
		_vtxb=num
		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),"")))
		txbkl(num,1)=txbka(num,1)
		txbkl(num,0)=txbka(num,0)
		ClearKeys():txbd(num,4)=1
	EndIf
	If MouseDown(1) And _vtxb=num And txbd(num,4)=1 Then
		txbkl(num,1)=Min(Max(1,(my-y+14)/15+(txbtk(num,1))),rm)
		txbkl(num,0)=Min(Max(0,(mx-x-1)/tw+(txbtk(num,0))),Len(Replace(txb(num,txbkl(num,1)),Chr(13),"")))
	EndIf
	If MouseUp(1) Then
		If _vtxb<>num Then
			_vtxb=num
			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),"")))
		EndIf
		txbkl(num,1)=Min(Max(1,(my-y+14)/15+(txbtk(num,1))),rm)
		txbkl(num,0)=Min(Max(0,(mx-x-1)/tw+(txbtk(num,0))),Len(Replace(txb(num,txbkl(num,1)),Chr(13),"")))
		ClearKeys():txbd(num,4)=0
	EndIf
ElseIf mx>x+x2*tw+5 And my>y And mx<x+x2*tw+5+vpl And my<y+y2*15+2 Then
	If MouseDown(1) And _vtxb=num Then _vtxb=0:txbd(num,4)=0
	If vpl Then
		If mz And _vtxb=num Then _vtxb=0:txbd(num,4)=0
		txbtk(num,1)=Max(Min(txbtk(num,1)+((mz<0)-(mz>0))*1,txbd(num,0)-y2),0)
	EndIf
Else
	If MouseUp(1) And _vtxb=num Then _vtxb=0:txbd(num,4)=0
EndIf

'Kerätään tiedot
vkk=txbka(num,0):vkkn=vkk-txbtk(num,0):pkk=txbka(num,1):pkkn=pkk-txbtk(num,1)
vkk2=txbkl(num,0):vkkn2=vkk2-txbtk(num,0):pkk2=txbkl(num,1):pkkn2=pkk2-txbtk(num,1)

vrm=Abs(pkk-pkk2)-1
If txbka(num,0)<>txbkl(num,0) Or txbka(num,1)<>txbkl(num,1) Then aluevalittuna=1
If _vtxb=num 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)
	vkk2=txbkl(num,0):vkkn2=txbkl(num,0)-txbtk(num,0)
	pkk2=txbkl(num,1):pkkn2=txbkl(num,1)-txbtk(num,1)
	
	If aluevalittuna=0 Then
		If txbd(num,1)<=0 Then txbd(num,1)=100'Välkytin
		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
	Else
		Color 0,100,255'Valitun alueen väri
		If pkk<pkk2 Then'alku ON ylempänä
			Box x+(vkkn*tw)+2,y+(pkkn-1)*15+2,(x2-vkkn)*tw,15
			For i=1 To Min(vrm,y2-pkkn)
				Box x+2,y+(pkkn-1+i)*15+2,x2*tw,15
			Next i
			If (pkkn2-1)<y2 Then Box x+2,y+(pkkn2-1)*15+2,(Min(vkkn2,x2)*tw)+2,14
		ElseIf pkk>pkk2 Then'alku ON alempana
			Box x+2,y+(pkkn-1)*15+2,(vkkn*tw)+2,14
			For i=1 To Min(vrm,pkkn-1)
				Box x+2,y+(pkkn-1-i)*15+2,x2*tw,15
			Next i
			If (pkkn2-1)=>0 Then Box x+Max(vkkn2*tw,0)+2,y+(pkkn2-1)*15+2,Min(x2-vkkn2,x2)*tw,15
		Else'alku ON samalla rivillä
			If vkk<vkk2 Then
				Box x+Max(vkkn*tw,0)+2,y+(pkkn-1)*15+2,(Min(Abs(vkkn-vkkn2),x2-vkkn)*tw)+2,14
			Else
				Box x+Max(vkkn2*tw,0)+2,y+(pkkn2-1)*15+2,(Min(Abs(vkkn-vkkn2),vkkn)*tw)+2,14
			EndIf
		EndIf
	EndIf
	
	If (KeyDown(200) Or KeyDown(203) Or KeyDown(205) Or KeyDown(208)) And txbd(num,2)=0 Then
		txbka(num,0)=Min(Max(txbka(num,0),0),pituus)
		txbka(num,0)=txbka(num,0)+(KeyDown(205)-KeyDown(203))
		txbka(num,1)=Min(Max(1,txbka(num,1)+(KeyDown(208)-KeyDown(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),"")))
		txbkl(num,0)=txbka(num,0):txbkl(num,1)=txbka(num,1)
		txbd(num,1)=100:txbd(num,2)=16*(txbd(num,3)<2)+2
		txbd(num,3)=txbd(num,3)+1
	EndIf
	
	lisattava$="":vahennet=0
	If KeyDown(29) Or KeyDown(157) Then
		If (KeyHit(45) Or KeyHit(46)) And aluevalittuna=1 Then'Leikkaa ja kopioi
			cliptext$=""
			If pkk<pkk2 Then
				cliptext=Right(t,Len(t)-vkk)
				For i=1 To vrm
					cliptext=cliptext+txb(num,pkk+i)
				Next i
				cliptext=cliptext+Left(txb(num,pkk2),vkk2)
			ElseIf pkk>pkk2 Then
				cliptext=Right(txb(num,pkk2),Len(txb(num,pkk2))-vkk2)
				For i=1 To vrm
					cliptext=cliptext+txb(num,pkk-i)
				Next i
				cliptext=cliptext+Left(t,vkk)
			Else
				cliptext=Mid(t,Int(Min(vkk,vkk2))+1,Int(Abs(vkk-vkk2)))
			EndIf
			If pass="" Then
				clipboard=cliptext
			Else
				clipboard=String(Left(pass,1),Len(cliptext))
			EndIf
			If KeyHit(45) Then vahennet=1
		ElseIf KeyHit(47) Then'Liitä
			lisattava=clipboard
		ElseIf KeyHit(30) Then'Valitse kaikki
			txbka(num,0)=0
			txbka(num,1)=1
			txbkl(num,0)=Len(txb(num,rm))
			txbkl(num,1)=rm
		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)
	ElseIf KeyHit(15) Then
		ClearKeys():lisattava=Chr(9)
	ElseIf KeyDown(14) And txbd(num,2)=0 Then'BackSpace
		vahennet=1
		txbd(num,2)=16*(txbd(num,3)<2)+2
		txbd(num,3)=txbd(num,3)+1
	ElseIf KeyDown(211) And txbd(num,2)=0 Then'Delete
		vahennet=-1
		txbd(num,2)=16*(txbd(num,3)<2)+2
		txbd(num,3)=txbd(num,3)+1
	Else
		If key=13 Then'Enter
			If mrm>1 Then lisattava=Chr(13) Else _vtxb=0
		ElseIf key=8 Then'BackSpace
			vahennet=1
		ElseIf key=4 Then'Delete
			vahennet=-1
		ElseIf key>31 Then
			lisattava=Chr(key)
		EndIf
	EndIf
	EndIf
	
	If lisattava<>"" Then'Lisätään teksti, jos ON lisättävää
		If aluevalittuna=1 Then
			If pkk<pkk2 Then'alku ON ylempänä
				t=Left(t,vkk)
				For i=1 To vrm
					txb(num,pkk+i)=""
				Next i
				txb(num,pkk2)=Right(txb(num,pkk2),Len(txb(num,pkk2))-vkk2)
			ElseIf pkk>pkk2 Then'alku ON alempana
				t=Right(t,Len(t)-vkk)
				For i=1 To vrm
					txb(num,pkk-i)=""
				Next i
				txb(num,pkk2)=Left(txb(num,pkk2),vkk2)
			Else'alku ON samalla rivillä
				t=StrRemove(t,Int(Min(vkk,vkk2))+1,Int(Abs(vkk-vkk2)))
			EndIf
			txbkl(num,1)=Min(txbkl(num,1),txbka(num,1)):txbka(num,1)=Min(txbkl(num,1),txbka(num,1))
			txbkl(num,0)=Min(txbkl(num,0),txbka(num,0)):txbka(num,0)=Min(txbkl(num,0),txbka(num,0))
			checkall=1
		EndIf
		t=StrInsert(t,vkk,lisattava)
		If lisattava=Chr(13) Then
			If txbka(num,1)<mrm Then
				txbka(num,1)=txbka(num,1)+1:txbkl(num,1)=txbkl(num,1)+1
				txbka(num,0)=0:txbkl(num,0)=0
			EndIf
		Else
			If InStr(lisattava,Chr(13))=0 Then
				txbka(num,0)=txbka(num,0)+Len(lisattava)
			EndIf
		EndIf
		txbkl(num,0)=txbka(num,0):txbd(num,1)=100
	EndIf
	
	If vahennet Then'Poistetaan tekstiä
		txbd(num,1)=100
		If aluevalittuna=0 Then
			If vahennet>0 Then'BackSpace
				If vkk>0 Then
					t=StrRemove(t,vkk,1)
					txbka(num,0)=txbka(num,0)-1:txbkl(num,0)=txbkl(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:txbkl(num,1)=txbkl(num,1)-1
					txbka(num,0)=Len(txb(num,vr-1)):txbkl(num,0)=txbka(num,0)
				EndIf
			Else'Delete
				If vkk<pituus2 Then
					t=StrRemove(t,vkk+1,1)
				EndIf
			EndIf	
		Else'Jos ON valinta päällä
			If pkk<pkk2 Then'alku ON ylempänä
				t=Left(t,vkk)
				For i=1 To vrm
					txb(num,pkk+i)=""
				Next i
				txb(num,pkk2)=Right(txb(num,pkk2),Len(txb(num,pkk2))-vkk2)
			ElseIf pkk>pkk2 Then'alku ON alempana
				t=Right(t,Len(t)-vkk)
				For i=1 To vrm
					txb(num,pkk-i)=""
				Next i
				txb(num,pkk2)=Left(txb(num,pkk2),vkk2)
			Else'alku ON samalla rivillä
				t=StrRemove(t,Int(Min(vkk,vkk2))+1,Int(Abs(vkk-vkk2)))
			EndIf
			txbkl(num,1)=Min(txbkl(num,1),txbka(num,1)):txbka(num,1)=Min(txbkl(num,1),txbka(num,1))
			txbkl(num,0)=Min(txbkl(num,0),txbka(num,0)):txbka(num,0)=Min(txbkl(num,0),txbka(num,0))
			checkall=1
		EndIf
		ClearKeys()
	EndIf
	txbd(num,2)=Max(0,(txbd(num,2)-1))
	If KeyUp(200) Or KeyUp(203) Or KeyUp(205) Or KeyUp(208) Or KeyUp(211) Or KeyUp(14) Then txbd(num,2)=0:txbd(num,3)=0
	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ä
		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)<>"" Or checkall=0 Then
			tt=tt+txb(num,i+1)
			For j=i+1 To mrm-1
				txb(num,j)=txb(num,j+1)
			Next j
			txb(num,mrm)="":mrm=mrm-1:vah=1
		Else
			ok=1
		EndIf
	EndIf
	txb(num,i)=tt
Until ok=1
If mrm=1 Then txb(num,1)=Replace(txb(num,1),Chr(13),"")
rm=i
'Piirretään 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(9)," "),txbtk(num,0)+1,x2)
	If i<mrm Then
		teksti$=Replace(teksti,Chr(13),"")
	EndIf
	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
If vpl Then
	Color 100,100,100'Vierityspalkin väri
	maximi#=rm-y2:pkoko=12:x=x+x2*tw+4:y=y+1:x2=vpl:y2=y2*15
	Box x,y,x2,y2,0
	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 MouseDown(1) Then'Lasketaan palkin sijainti
			txbtk(num,1)=Max(Min(((Float(my-ty)/ty2)*maximi),maximi),0)
		EndIf
	EndIf
	Box x+2,ty+(txbtk(num,1)/maximi)*ty2-pkoko/2,x2-4,pkoko'Palkki
EndIf
txbd(num,0)=Max(1,rm)'Tallennetaan rivien määrä
Color _oldr,_oldg,_oldb
If _return=1 Then'Palauttaa kaiken
	teksti=""
	For i=1 To rm
		If txb(num,i)="" Then Exit
		teksti=teksti+txb(num,i)
	Next i
	Return teksti
ElseIf _return=2 And _vtxb=num Then'Palauttaa valitun rivin
	Return txb(num,pkk)
EndIf
EndFunction
Versio 2:
Vaatii SDK:n cbAPI.cb ja cbAPI.dll tiedostot.

Code: Select all

ClsColor 236,233,216:Cls

Include "cbAPI.cb"

tbkpl=4
rivimaara=100

Global _txbm
_txbm=CreatePopupMenu()
AddPopupMenuItem(_txbm,1,"Leikkaa")
AddPopupMenuItem(_txbm,2,"Kopioi")
AddPopupMenuItem(_txbm,3,"Liitä")
AddPopupMenuSeparator(_txbm)
AddPopupMenuItem(_txbm,4,"Valitse kaikki")

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

txb(1,1)="Testi teksti 1"+Chr(13)+"Testi teksti 2"+Chr(13)+"Testi teksti 3"+Chr(13)+"Testi teksti 4"+Chr(13)+"Testi teksti 5"

Repeat

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

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

DrawScreen
Forever

Function textbox(x,y,x2,y2,num,mrm=100,pass$="",_return=0,vp=1)
_oldr=getRGB(1):_oldg=getRGB(2):_oldb=getRGB(3)
If num=0 Then num=1
tw=TextWidth("A"):th=TextHeight("A")
mx=MouseX():my=MouseY()
rm=Max(1,txbd(num,0))'Rivi määrä
If rm>y2 And vp Then
	vpl=tw*2
	x2=x2-2
	mz=MouseMoveZ()
EndIf

'Laatikko
'Tausta
Color 255,255,255:Box x,y,x2*tw+5+vpl,y2*15+2
'Reunat
'Windows perinteinen
Color 172,168,153:Box x-1,y-1,x2*tw+7+vpl,y2*15+4,0
Color 113,111,100:Box x,y,x2*tw+5+vpl,y2*15+2,0
Color 241,239,226:Box x,y+y2*15+1,x2*tw+5+vpl,1:Box x+x2*tw+4+vpl,y,1,y2*15+2
Color 255,255,255:Box x-1,y+y2*15+2,x2*tw+7+vpl,1:Box x+x2*tw+5+vpl,y-1,1,y2*15+4
'WinXP
'Color 127,157,185:Box x,y,x2*tw+5+vpl,y2*15+2,0

If (mx>=x And my>=y And mx<=x+x2*tw+5 And my<=y+y2*15+2) Or txbd(num,4)=1 Then
	If vpl Then
		If mz And _vtxb=num Then _vtxb=0:txbd(num,4)=0
		txbtk(num,1)=Max(Min(txbtk(num,1)+((mz<0)-(mz>0))*1,txbd(num,0)-y2),0)
	EndIf
	If MouseHit(2) Then
		If _vtxb<>num Then
			_vtxb=num
			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),"")))
			txbkl(num,1)=txbka(num,1)
			txbkl(num,0)=txbka(num,0)
		EndIf
		toim=ShowPopupMenu(_txbm,MouseX(),MouseY())
		ClearMouse()
	EndIf
	If MouseHit(1) Then
		_vtxb=num
		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),"")))
		txbkl(num,1)=txbka(num,1)
		txbkl(num,0)=txbka(num,0)
		ClearKeys():txbd(num,4)=1
	EndIf
	If MouseDown(1) And _vtxb=num And txbd(num,4)=1 Then
		txbkl(num,1)=Min(Max(1,(my-y+14)/15+(txbtk(num,1))),rm)
		txbkl(num,0)=Min(Max(0,(mx-x-1)/tw+(txbtk(num,0))),Len(Replace(txb(num,txbkl(num,1)),Chr(13),"")))
	EndIf
	If MouseUp(1) Then
		If _vtxb<>num Then
			_vtxb=num
			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),"")))
		EndIf
		txbkl(num,1)=Min(Max(1,(my-y+14)/15+(txbtk(num,1))),rm)
		txbkl(num,0)=Min(Max(0,(mx-x-1)/tw+(txbtk(num,0))),Len(Replace(txb(num,txbkl(num,1)),Chr(13),"")))
		ClearKeys():txbd(num,4)=0
	EndIf
ElseIf mx>x+x2*tw+5 And my>y And mx<x+x2*tw+5+vpl And my<y+y2*15+2 Then
	If MouseDown(1) And _vtxb=num Then _vtxb=0:txbd(num,4)=0
	If vpl Then
		If mz And _vtxb=num Then _vtxb=0:txbd(num,4)=0
		txbtk(num,1)=Max(Min(txbtk(num,1)+((mz<0)-(mz>0))*1,txbd(num,0)-y2),0)
	EndIf
Else
	If MouseUp(1) And _vtxb=num Then _vtxb=0:txbd(num,4)=0
EndIf
'Kerätään tiedot
vkk=txbka(num,0):vkkn=vkk-txbtk(num,0):pkk=txbka(num,1):pkkn=pkk-txbtk(num,1)
vkk2=txbkl(num,0):vkkn2=vkk2-txbtk(num,0):pkk2=txbkl(num,1):pkkn2=pkk2-txbtk(num,1)

vrm=Abs(pkk-pkk2)-1
If txbka(num,0)<>txbkl(num,0) Or txbka(num,1)<>txbkl(num,1) Then aluevalittuna=1
t$="":lisattava$="":vahennet=0
If _vtxb=num 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)
	vkk2=txbkl(num,0):vkkn2=txbkl(num,0)-txbtk(num,0)
	pkk2=txbkl(num,1):pkkn2=txbkl(num,1)-txbtk(num,1)
	
	If aluevalittuna=0 Then
		If txbd(num,1)<=0 Then txbd(num,1)=100'Välkytin
		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
	Else
		Color 0,100,255'Valitun alueen väri
		If pkk<pkk2 Then'alku ON ylempänä
			Box x+(vkkn*tw)+2,y+(pkkn-1)*15+2,(x2-vkkn)*tw,15
			For i=1 To Min(vrm,y2-pkkn)
				Box x+2,y+(pkkn-1+i)*15+2,x2*tw,15
			Next i
			If (pkkn2-1)<y2 Then Box x+2,y+(pkkn2-1)*15+2,(Min(vkkn2,x2)*tw)+2,14
		ElseIf pkk>pkk2 Then'alku ON alempana
			Box x+2,y+(pkkn-1)*15+2,(vkkn*tw)+2,14
			For i=1 To Min(vrm,pkkn-1)
				Box x+2,y+(pkkn-1-i)*15+2,x2*tw,15
			Next i
			If (pkkn2-1)=>0 Then Box x+Max(vkkn2*tw,0)+2,y+(pkkn2-1)*15+2,Min(x2-vkkn2,x2)*tw,15
		Else'alku ON samalla rivillä
			If vkk<vkk2 Then
				Box x+Max(vkkn*tw,0)+2,y+(pkkn-1)*15+2,(Min(Abs(vkkn-vkkn2),x2-vkkn)*tw)+2,14
			Else
				Box x+Max(vkkn2*tw,0)+2,y+(pkkn2-1)*15+2,(Min(Abs(vkkn-vkkn2),vkkn)*tw)+2,14
			EndIf
		EndIf
	EndIf
	
	If (KeyDown(200) Or KeyDown(203) Or KeyDown(205) Or KeyDown(208)) And txbd(num,2)=0 Then
		txbka(num,0)=Min(Max(txbka(num,0),0),pituus)
		txbka(num,0)=txbka(num,0)+(KeyDown(205)-KeyDown(203))
		txbka(num,1)=Min(Max(1,txbka(num,1)+(KeyDown(208)-KeyDown(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),"")))
		txbkl(num,0)=txbka(num,0):txbkl(num,1)=txbka(num,1)
		txbd(num,1)=100:txbd(num,2)=16*(txbd(num,3)<2)+2
		txbd(num,3)=txbd(num,3)+1
	EndIf
	
	If KeyDown(29) Or KeyDown(157) Or toim Then
		If (KeyHit(45) Or KeyHit(46) Or toim=1 Or toim=2) And aluevalittuna=1 Then'Leikkaa ja kopioi
			cliptext$=""
			If pkk<pkk2 Then
				cliptext=Right(t,Len(t)-vkk)
				For i=1 To vrm
					cliptext=cliptext+txb(num,pkk+i)
				Next i
				cliptext=cliptext+Left(txb(num,pkk2),vkk2)
			ElseIf pkk>pkk2 Then
				cliptext=Right(txb(num,pkk2),Len(txb(num,pkk2))-vkk2)
				For i=1 To vrm
					cliptext=cliptext+txb(num,pkk-i)
				Next i
				cliptext=cliptext+Left(t,vkk)
			Else
				cliptext=Mid(t,Int(Min(vkk,vkk2))+1,Int(Abs(vkk-vkk2)))
			EndIf
			If pass="" Then
				clipboard=cliptext
			Else
				clipboard=String(Left(pass,1),Len(cliptext))
			EndIf
			SetClipboardText(clipboard)
			If (KeyHit(45) Or toim=1) And aluevalittuna=1 Then vahennet=1
		ElseIf KeyHit(47) Or toim=3 Then'Liitä
			lisattava=GetClipboardText()
		ElseIf KeyHit(30) Or toim=4 Then'Valitse kaikki
			txbka(num,0)=0:txbka(num,1)=1
			txbkl(num,0)=Len(txb(num,rm)):txbkl(num,1)=rm
		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)
	ElseIf KeyHit(15) Then
		ClearKeys():lisattava=Chr(9)
	ElseIf KeyDown(14) And txbd(num,2)=0 Then'BackSpace
		vahennet=1
		txbd(num,2)=16*(txbd(num,3)<2)+2
		txbd(num,3)=txbd(num,3)+1
	ElseIf KeyDown(211) And txbd(num,2)=0 Then'Delete
		vahennet=-1
		txbd(num,2)=16*(txbd(num,3)<2)+2
		txbd(num,3)=txbd(num,3)+1
	Else
		If key=13 Then'Enter
			If mrm>1 Then lisattava=Chr(13) Else _vtxb=0
		ElseIf key=8 Then'BackSpace
			vahennet=1
		ElseIf key=4 Then'Delete
			vahennet=-1
		ElseIf key>31 Then
			lisattava=Chr(key)
		EndIf
	EndIf
	EndIf
	
	If lisattava<>"" Then'Lisätään teksti, jos ON lisättävää
		If aluevalittuna=1 Then
			If pkk<pkk2 Then'alku ON ylempänä
				t=Left(t,vkk)
				For i=1 To vrm
					txb(num,pkk+i)=""
				Next i
				txb(num,pkk2)=Right(txb(num,pkk2),Len(txb(num,pkk2))-vkk2)
			ElseIf pkk>pkk2 Then'alku ON alempana
				t=Right(t,Len(t)-vkk)
				For i=1 To vrm
					txb(num,pkk-i)=""
				Next i
				txb(num,pkk2)=Left(txb(num,pkk2),vkk2)
			Else'alku ON samalla rivillä
				t=StrRemove(t,Int(Min(vkk,vkk2))+1,Int(Abs(vkk-vkk2)))
			EndIf
			txbkl(num,1)=Min(txbkl(num,1),txbka(num,1)):txbka(num,1)=Min(txbkl(num,1),txbka(num,1))
			txbkl(num,0)=Min(txbkl(num,0),txbka(num,0)):txbka(num,0)=Min(txbkl(num,0),txbka(num,0))
			checkall=1
		EndIf
		t=StrInsert(t,vkk,lisattava)
		If lisattava=Chr(13) Then
			If txbka(num,1)<mrm Then
				txbka(num,1)=txbka(num,1)+1:txbkl(num,1)=txbkl(num,1)+1
				txbka(num,0)=0:txbkl(num,0)=0
			EndIf
		Else
			If InStr(lisattava,Chr(13))=0 Then
				txbka(num,0)=txbka(num,0)+Len(lisattava)
			EndIf
		EndIf
		txbkl(num,0)=txbka(num,0):txbd(num,1)=100
	EndIf
	If vahennet Then'Poistetaan tekstiä
		txbd(num,1)=100
		If aluevalittuna=0 Then
			If vahennet>0 Then'BackSpace
				If vkk>0 Then
					t=StrRemove(t,vkk,1)
					txbka(num,0)=txbka(num,0)-1:txbkl(num,0)=txbkl(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:txbkl(num,1)=txbkl(num,1)-1
					txbka(num,0)=Len(txb(num,vr-1)):txbkl(num,0)=txbka(num,0)
				EndIf
			Else'Delete
				If vkk<pituus2 Then
					t=StrRemove(t,vkk+1,1)
				EndIf
			EndIf	
		Else'Jos ON valinta päällä
			If pkk<pkk2 Then'alku ON ylempänä
				t=Left(t,vkk)
				For i=1 To vrm
					txb(num,pkk+i)=""
				Next i
				txb(num,pkk2)=Right(txb(num,pkk2),Len(txb(num,pkk2))-vkk2)
			ElseIf pkk>pkk2 Then'alku ON alempana
				t=Right(t,Len(t)-vkk)
				For i=1 To vrm
					txb(num,pkk-i)=""
				Next i
				txb(num,pkk2)=Left(txb(num,pkk2),vkk2)
			Else'alku ON samalla rivillä
				t=StrRemove(t,Int(Min(vkk,vkk2))+1,Int(Abs(vkk-vkk2)))
			EndIf
			txbkl(num,1)=Min(txbkl(num,1),txbka(num,1)):txbka(num,1)=Min(txbkl(num,1),txbka(num,1))
			txbkl(num,0)=Min(txbkl(num,0),txbka(num,0)):txbka(num,0)=Min(txbkl(num,0),txbka(num,0))
			checkall=1
		EndIf
		ClearKeys()
	EndIf
	txbd(num,2)=Max(0,(txbd(num,2)-1))
	If KeyUp(200) Or KeyUp(203) Or KeyUp(205) Or KeyUp(208) Or KeyUp(211) Or KeyUp(14) Then txbd(num,2)=0:txbd(num,3)=0
	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ä
		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)<>"" Or checkall=0 Then
			tt=tt+txb(num,i+1)
			For j=i+1 To mrm-1
				txb(num,j)=txb(num,j+1)
			Next j
			txb(num,mrm)="":mrm=mrm-1:vah=1
		Else
			ok=1
		EndIf
	EndIf
	txb(num,i)=tt
Until ok=1
If mrm=1 Then txb(num,1)=Replace(txb(num,1),Chr(13),"")
rm=i
'Piirretään 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(9)," "),txbtk(num,0)+1,x2)
	If i<mrm Then
		teksti$=Replace(teksti,Chr(13),"")
	EndIf
	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
If vpl Then
	Color 100,100,100'Vierityspalkin väri
	maximi#=rm-y2:pkoko=12:x=x+x2*tw+4:y=y+1:x2=vpl:y2=y2*15
	Box x,y,x2,y2,0
	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 MouseDown(1) Then'Lasketaan palkin sijainti
			txbtk(num,1)=Max(Min(((Float(my-ty)/ty2)*maximi),maximi),0)
		EndIf
	EndIf
	Box x+2,ty+(txbtk(num,1)/maximi)*ty2-pkoko/2,x2-4,pkoko'Palkki
EndIf
txbd(num,0)=Max(1,rm)'Tallennetaan rivien määrä
Color _oldr,_oldg,_oldb
If _return=1 Then'Palauttaa kaiken
	teksti=""
	For i=1 To rm
		If txb(num,i)="" Then Exit
		teksti=teksti+txb(num,i)
	Next i
	Return teksti
ElseIf _return=2 And _vtxb=num Then'Palauttaa valitun rivin
	Return txb(num,pkk)
EndIf
EndFunction
Käyttö:
textbox(x,y,leveys,korkeus,numero[,max rivimäärä,salasanamerkki,palautettava,vierityspalkki])

Leveys annetaan kirjaimina ja korkeus riveinä.
Numero on tekstilaatikon numero.

Palautettava:
0 = Ei palauta mitään
1 = Palauttaa kaiken
2 = Palauttaa valitun rivin

Vierityspalkki:
0 = Ei vierityspalkkia
1 = Vierityspalkki jos rivimäärä on suurempi kuin korkeus

Funktio tarvitsee taulukot:
Dim txb(tekstilaatikoiden määrä,rivimäärä) As String
Dim txbd(tekstilaatikoiden määrä,4)
Dim txbka(tekstilaatikoiden määrä,1)
Dim txbkl(tekstilaatikoiden määrä,1)
Dim txbtk(tekstilaatikoiden määrä,1)
ja globaalin:
Global _vtxb

Versio 1 leikepöytä tarvitsee globaalin:
Global clipboard As String
Versio 2 valikko tarvitsee globaalin:
Global _txbm

Ominaisuudet:
Tekstin valinta ja valitun alueen leikkaaminen kopioiminen ja poistaminen.
Poisto ja nuoli näppäinten pohjassa pitäminen mahdollista.
Vierityspalkki kun rivimäärä on suurempi kuin korkeus.
Versio 2 on yleinen leikepöytä, mutta se vaatii SDK:n cbAPI.cb ja cbAPI.dll tiedostot.
Säilyttää nykyisen piirtovärin.
Salasanamerkki tekstiä ei voi enää kopioida.

Pikanäppäimet:
Ctrl + A = Valitse kaikki
Ctrl + X = Leikkaa
Ctrl + C = Kopioi
Ctrl + V = Liitä
EDIT:

Toisessa versiossa hiiren oikeasta painikkeesta tulee valikko, jossa on leikkaa, kopioi, liitä ja valitse kaikki toiminnot.

Last edited by project coder on Sat Mar 08, 2008 9:02 pm, edited 1 time in total.
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 » Fri Mar 07, 2008 11:47 pm

Mikä sitten palauttaa rivien määrän?
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 » Sat Mar 08, 2008 11:10 am

Rivien määrä tallennetaan taulukkoon txbd(laatikon numero,0).
Kotisivut: (Uusitaan)
Secret Unit War (Frozen)
Tilekarttaeditori (Frozen)
Käyttöliittymän osia

M.R
Active Member
Posts: 102
Joined: Sat Dec 22, 2007 4:05 pm

Re: Käyttöliittymän osia

Post by M.R » Sat Mar 08, 2008 11:15 am

Erittäin hyvä.Panee vielä popup valikon(cbApilla)(siis liitä,kopioi,leikkaa ja valitse kaikki) niin on lähes täydellinen.

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

Re: Käyttöliittymän osia

Post by nevssons » Sat Mar 08, 2008 1:32 pm

project coder wrote:Rivien määrä tallennetaan taulukkoon txbd(laatikon numero,0).
täytyyks nollan tilalle laittaa jotain?
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 » Sat Mar 08, 2008 2:32 pm

nevssons wrote:
project coder wrote:Rivien määrä tallennetaan taulukkoon txbd(laatikon numero,0).
täytyyks nollan tilalle laittaa jotain?
Ei. txbd() taulukon eka ulottuvuus kertoo tekstilaatikon numeron ja toinen ulottuvuus haetun tiedon solun:
0 = rivimäärä
1 = Kursorin välke
2,3 = Painallus ajat

Seuraava koodi palauttaa ensimmäisen textboxin rivimäärän

Code: Select all

rivimäärä = txbd(1,0)
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 » Sat Mar 08, 2008 4:38 pm

Joo... okei! Onks tässä jotain vikaa? se ei tunnu toimivan!

Code: Select all

For tbrm=1 To txbd(1,0)
WriteLine OT,txb(1,tbrm)
Next tbrm
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 » Sat Mar 08, 2008 5:05 pm

nevssons wrote:Joo... okei! Onks tässä jotain vikaa? se ei tunnu toimivan!

Code: Select all

For tbrm=1 To txbd(1,0)
WriteLine OT,txb(1,tbrm)
Next tbrm
Onko tekstilaatikon numerona 1? Ja jättääkö se kirjoittamatta vai jotain muita ongelmia?

Toimii ihan hyvin liitettynä esimerkkiin:

Code: Select all

If KeyHit(28) Then
OT=OpenToWrite("testi.txt")
For tbrm=1 To txbd(1,0)
WriteLine OT,txb(1,tbrm)
Next tbrm
CloseFile(OT)
EndIf
EDIT:

Hiiri valikko lisätty tekstilaatikon kakkos versioon.

Kotisivut: (Uusitaan)
Secret Unit War (Frozen)
Tilekarttaeditori (Frozen)
Käyttöliittymän osia

Post Reply