CoolBasic Wiki
Don't have an account?
Register
Advertisement
Register
in: Mallineet, Tietopankit

Tietopankit/Koodipankki

< Tietopankit
Muokkaa

Täältä voit kopioida ja tänne voit ladata omia koodejasi, joiden uskot helpottavan jotakin ohjelmoijaa, tai ne ovat vain hauskoja. Sotkeminen johtaa estoon, ja oikeuksien poistoon!

Mikään pankeissa oleva ei saa olla:

  • Tekijänoikeuksien alainen
  • Rasistinen tai muuten halventava
  • K-18:ksi luokiteltua materiaalia.

Koodit viivan alle.


Säännöllinen kuusikulmio[]

(35px) Hex-grid

Hexaruudukon ruutu.

Tämä luo säännöllisen kuusikulmion, eli heksan. Ainoa mitä tarvitset on oikeastaan "drawhex"-subi, "drawhexfloat" on havainnollistamiseen. Sin ja Cos funktiot ovat käteviä, jos käsitellään kulmia, 

DrawToWorld ON

size = 32 : angle = 60
x# = 0+size/2 : y# = 0-Sin(angle)*size
//"+size/2" pistää koordinaatin "x#" heksan keskipisteeseen
//"-Sin(angle)*size" pistää koordinaatin "y#" heksan keskipisteeseen.

Gosub drawhex
	AddText "Paina mitä tahansa nappia jatkaaksesi."
	DrawScreen
WaitKey
ClearText

AddText "Paina mitä tahansa nappia poistuaksesi."
Gosub drawhexfloat
	DrawScreen
WaitKey
End

drawhex://tosi simppeli
	For i = 1 To 6
		Line x#, y#, x#+Cos(angle)*size, y#+Sin(angle)*size
		

		x# = x#+Cos(angle)*size
		y# = y#+Sin(angle)*size
		angle+60
	Next i
Return

drawhexfloat://havainnollistaminen
	Color cbYellow
	Line -100, 0, 100, 0 : Line 0, -100, 0, 100//akselit
	Circle x#-10, y#+10, 20, OFF//piirrä ympyrä viimeiseen koordinaattiin

	//piirretään heksa uudestaan
	For i = 1 To 6
		Color i*225/3 + 150, i*225/3 + 100, 225

		Line x#, y#, x#+Cos(angle)*size, y#+Sin(angle)*size

		AddText i + ".	x: " + x# + "	y: " + y#
		Circle x#-4, y#+4, 8
		
		x# = x#+Cos(angle)*size
		y# = y#+Sin(angle)*size
		angle+60
	Next i
Return

Lanka[]

tämä vaatii parantamista. esimerkiksi muuttamalla monet funkioiksi -- Poppula - Contact from

Tässä on se funktiona! (Paljon lyhyempi ja käytännöllisempi kuin edellinen (ks. muokkaushistoria) ) --MrZalli 17. heinäkuuta 2010 kello 16.50 (UTC) (Se pitäisi vielä saada toimimaan kulmilla X&Y:n sijaan. Teen jahka ehdin.) --MrZalli 9. elokuuta 2010 kello 08.03 (UTC) 

FrameLimit 40
Dim curve#(12,1)

Repeat
	Lanka(MouseX(),MouseY(), 12, 0.0)
DrawScreen
Forever

Function Lanka(x#,y#, length, smooth#)	'tarvitsee vielä aikaisemmin
	For i= 0 To length					'luodun taulukon nimeltä: "curve"
		curve(i,OFF)=CurveValue(x#,curve(i,0), smooth#+i)	'maksimit:(length, 1)
		'X'
		curve(i,ON)=CurveValue(y#,curve(i,ON), smooth#+i)
		'Y'
	Next i
	For i= 0 To length-1
		Line curve(i,OFF),curve(i,ON), curve(i+1,OFF),curve(i+1,ON)
	Next i
EndFunction

Lähde[]

tämä sopii näytönsäästäjäksikin. Hyvin yksinkertainen toteustus (ainakin minulle).-- Poppula - Contact from 


SCREEN 1024,768,0,0 
'kokeile resoluutioita:
'320*240,40*300(2 ekaa ei ehkä toimi jokaisella kokonäytöllä)
'640*480,800*600 (jos on venynyt niin 800*500)
'1024*768 tai 1280*1024 (jos venyy niin 1280*800)

FrameLimit 40

img=MakeImage (5,5)
DrawToImage img
	Color 60,100,255
	Circle 0,0,5,1
DrawToScreen

par=MakeEmitter(img,100) 'lifetime for 3 seconds

'speed 5, gravity 0.1 
ParticleMovement par,5,0.1

'frequency 5, amount 4, chaos [-60 -> 60] 
ParticleEmission par,5,10,6

'rotate the emitter to face upwards 
RotateObject par,90

Repeat
	
	Color 20,50,210
	Box 0,0,ScreenWidth (),ScreenHeight ()
	
	Color 0,150,0
	Box 0,(ScreenHeight ()/2)-50,ScreenWidth (),(ScreenHeight ()/2)+50
	
	Color 170,170,170
	Box (ScreenWidth ()/2)-120,ScreenHeight ()/2,240,80,1	
	Ellipse (ScreenWidth ()/2)-120,(ScreenHeight ()/2)+25,240,100,1	
	Color cbsilver
	Ellipse (ScreenWidth ()/2)-120,(ScreenHeight ()/2)-50,240,100,1	
	
	Color 50,80,240
	Ellipse (ScreenWidth ()/2)-100,(ScreenHeight ()/2)-40,200,80,1
	
    DrawScreen 

Until EscapeKey()

3D-laatikkko[]

Vaatii parantelua. -- Poppula - Contact from 


SCREEN 800,600,0,1

DrawToWorld ON,ON,ON

ClsColor 0,255,0

Repeat

	Line MouseWX ()/2+z-700,MouseWY ()/2+z,MouseWX ()/2+z-(-700),MouseWY ()/2+z

	Box (MouseWX ()/2+z)-100,(MouseWY ()/2+z)+100,100,100,OFF
	Line MouseWX ()/1.5+z,MouseWY ()/1.5+z,MouseWX ()/2+z,MouseWY ()/2+z
	Line (MouseWX ()/1.5+z)-100,MouseWY ()/1.5+z,(MouseWX ()/2+z)-100,MouseWY ()/2+z
	Line MouseWX ()/1.5+z,(MouseWY ()/1.5+z)+100,MouseWX ()/2+z,(MouseWY ()/2+z)+100
	Line (MouseWX ()/1.5+z)-100,(MouseWY ()/1.5+z)+100,(MouseWX ()/2+z)-100,(MouseWY ()/2+z)+100
	Color 255,255,255
	Box (MouseWX ()/1.5+z)-100,(MouseWY ()/1.5+z)+100,100,100,ON
	Color 0,0,0
	Box (MouseWX ()/1.5+z)-100,(MouseWY ()/1.5+z)+100,100,100,OFF

	Box (MouseWX ()/2+z)-300,(MouseWY ()/2+z)+100,100,100,OFF
	Line MouseWX ()/1.5+z-200,MouseWY ()/1.5+z,MouseWX ()/2+z-200,MouseWY ()/2+z
	Line (MouseWX ()/1.5+z)-300,MouseWY ()/1.5+z,(MouseWX ()/2+z)-300,MouseWY ()/2+z
	Line MouseWX ()/1.5+z-200,(MouseWY ()/1.5+z)+100,MouseWX ()/2+z-200,(MouseWY ()/2+z)+100
	Line (MouseWX ()/1.5+z)-300,(MouseWY ()/1.5+z)+100,(MouseWX ()/2+z)-300,(MouseWY ()/2+z)+100
	Color 255,255,255
	Box (MouseWX ()/1.5+z)-300,(MouseWY ()/1.5+z)+100,100,100,ON
	Color 0,0,0
	Box (MouseWX ()/1.5+z)-300,(MouseWY ()/1.5+z)+100,100,100,OFF

	Line (MouseWX ()/1.5+z)-600,MouseWY ()/1.5+z,(MouseWX ()/2+z)-600,MouseWY ()/2+z

	Line MouseWX ()/1.5+z-600,MouseWY ()/1.5+z,MouseWX ()/1.5+z-(-600),MouseWY ()/1.5+z

DrawScreen
Forever

Yksinkertainen musiikkisoitin[]

Musiikkisoitin

Koska CB tukee niin monia eri musiikkitiedostomuotoja, ninpä loin simppelin musiikkisoittimen. Kunhan vain avaat haluamasi tiedoston tällä ohjelmalla, vaikka raahaamalla sen ohjelman päälle. Ohjelmassa on äänen voimakkuuden säätely ja mahdollisuus toistoon. Ikävä kyllä sitä ei voi laittaa paussille, koska CB:ssä ei ole moista tomintoa. Ikävä kyllä, koodia ei ole kommentoitu kovinkaan paljoa, joten jos haluat muokata sitä, niin pitäisi osata perusteet CB:stä. 

SCREEN 700,200
FrameLimit 25

'Before start
Prepare:
volume=100
playing=ON
loop=False
Gosub LOAD
Gosub Texts

SetWindow "Music Player        Playing: "+GetLastWord(sound$, Chr(92))

current = PlaySound(sound$, volume)


Repeat
    If KeyHit(cbkeyspace) Then
        playing=Not playing
        If playing Then
            current=PlaySound(sound$, volume)
        Else
            StopSound current
        EndIf
    EndIf

	If KeyHit(cbkeyL) Then loop=Not loop
	If loop And SoundPlaying(current)=OFF And playing Then current=PlaySound(sound$)
	
	If SoundPlaying(current)=0 Then playing=0
	
	If UpKey() And volume<100 Then volume+1 : SetSound current, 0, volume
	If DownKey() And volume>0 Then volume-1 : SetSound current, 0, volume
	voluumipalkki$=String("|", volume/2)
	
	If AnyVitalDone() Then Gosub Texts
        
    DrawScreen
Forever
End

LOAD:
	sound$ = Mid(CommandLine(), 5, Len(CommandLine() )-5)
	ChDir Mid(CommandLine(), 2, 3)
Return

Texts:
	ClearText

	Locate 10,10
	AddText "Supports: raw, Mod, s3m, xm, it, mid, rmi, wav, mp2, mp3, ogg, wma, asf and mo3."
	AddText ""
	AddText CurrentDir()+sound$
	
	Locate 100,75
	AddText "Volume:	"+volume+"%"
	Locate 10,100
	AddText voluumipalkki$

	Locate 10,150
	If SoundPlaying(current) Then AddText "Press space t"+"o stop file." Else AddText "Press space to play file."
	AddText "Press up and down keys to adjust the volume."
	If loop=False Then AddText "Press 'L' to start looping." Else AddText "Press 'L' to stop looping."
Return

Function AnyVitalDone()//Ettei tarvitse tekstiä kirjoittaa aina (nopeuttaa)
	If KeyHit(57) Or KeyHit(38) Or UpKey() Or DownKey() Or SoundPlaying(current)=0 Then Return 1 Else Return 0 
EndFunction

Function GetLastWord$(strng$, separator$)
	now=CountWords(strng$, separator$)
	Return GetWord(strng$, now, separator$)
EndFunction
Community content is available under CC-BY-SA unless otherwise noted.
Advertisement

Fan Feed