 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
 Verfasst am: 19.10.2012, 00:09 Titel: Flüssigkeit/Partikel |
 |
|
Hi,
Ich versuche gerade eine relativ einfach gehaltene FluidParticle Struktur zu schreiben verbunden mit einer Zeichenroutine
Ich möchte versuchen ein Verhalten von zB einem in Tusche oder Tinte getränkten Pinsel auf einer Leinwand zu 'Simulieren' mit einer art von Frame basierten 'Line-Routine'
Passieren soll also bei aufruf das der imaginäre Pinsel in seine 'Farbe' getunkt? wird; also grundlegende Werte Initiation...
Aufgabe der Routine soll wie bei Line von-bis in n Frames, rückgabe soll dann das zuletzt berechnete Frame werden.
Der Pinsel soll also logischerweise Zeichnen, also muss er Partikel gewissermassen 'verlieren', wie bei einem Pinsel in Farbe getunkt üblich verliert er am anfang seines 'Pinselstrichs' mehr 'Farbe' soll in der Routine aber seinen vollständigen 'Strich' bis zu seinem Ziel 'Sichtbar' vollenden.. die Partikel (wie bei Flüssigkeiten üblich) soll aber auch verlaufen bzw nach unten laufen...
Und genau hier steh ich bissle auf den Schlauch wie ich das ganze am sinnvollsten umsetzen und berechnen kann...
EDIT:
Ein erster Versuch macht grob schon in etwa was ich mir vorstelle;
Probleme liegen noch an einer gewissen 'dynamik' aufgrund der vorberechneten Distantz der abständer wodurch das ganze etwas 'komisch' aussieht...
Wie ich das ganze Farblich noch etwas besser gestalten könnte fehlt mir leider auch noch ein Ansatz... in diesem Fall irgendwie eine art Gerinnungsfarbberechnungsformel oder so 
| Code: |
Randomize Timer
CONST Deg2Rad = ATN(1)/45 '=PI/180
Const BloodDrawQuantityCONST as Integer = 1000
Const BloodDrawRadiusCONST as Integer = 3
Const BloodDrawFluidState as Integer = 10
Namespace BloodDraw
Type FrameImage as any ptr
Type Particle_Struct
PositionX as Integer
PositionY as Integer
FluidState as Integer
LifeTime as Integer
End Type
''
Dim BloodParticle as Particle_Struct ptr
Dim ParticleRandomPositionCalc_R as Single 'Radius
Dim ParticleRandomPositionCalc_A as Single 'Angle (Winkel)
''
Function BloodLine (byval FromPositionX as Integer = 0, byval FromPositionY as Integer = 0, _
byval ToPositionX as Integer = 0, byval ToPositionY as Integer = 0, _
byval CDrawMoveFlag as Integer = 0, byval CDrawMoveFDC as Integer = 0) as FrameImage
Static FluidParticleCount as Integer
Static CurrentFrameDraw as Integer
Static FrameDrawCount as Integer
Static StartPositionX as Integer
Static StartPositionY as Integer
Static DirectionDistX as Single
Static DirectionDistY as Single
If (FromPositionX=0) and (FromPositionY=0) and (ToPositionX=0) and (ToPositionY=0) and (CDrawMoveFlag=0) and (CDrawMoveFDC=0) Then
CurrentFrameDraw += 1
If (CurrentFrameDraw = FrameDrawCount) Then
Delete[] BloodParticle
BloodParticle = 0
FrameDrawCount = 0
CurrentFrameDraw = 0
StartPositionX = 0
StartPositionY = 0
DirectionDistX = 0
DirectionDistY = 0
return 0
Else
For p as Integer = 0 to BloodDrawQuantityCONST-1
If (BloodParticle[p].LifeTime) Then
BloodParticle[p].PositionX += DirectionDistX
BloodParticle[p].PositionY += DirectionDistY
End If
Next p
End If
Else
If (BloodParticle) Then
Delete[] BloodParticle
BloodParticle = 0
End If
BloodParticle = NEW Particle_Struct[BloodDrawQuantityCONST]
CurrentFrameDraw = 0
FrameDrawCount = CDrawMoveFDC
StartPositionX = FromPositionX
StartPositionY = FromPositionY
DirectionDistX = (ToPositionX-FromPositionX)/FrameDrawCount
DirectionDistY = (ToPositionY-FromPositionY)/FrameDrawCount
If (CDrawMoveFlag) Then
FluidParticleCount = BloodDrawQuantityCONST
For p as Integer = 0 to BloodDrawQuantityCONST-1
ParticleRandomPositionCalc_R = ( RND * BloodDrawRadiusCONST )
ParticleRandomPositionCalc_A = ( RND * 360 ) * Deg2Rad
BloodParticle[p].PositionX = StartPositionX + ( COS(ParticleRandomPositionCalc_A) * ParticleRandomPositionCalc_R )
BloodParticle[p].PositionY = StartPositionY + ( SIN(ParticleRandomPositionCalc_A) * ParticleRandomPositionCalc_R )
BloodParticle[p].LifeTime = (RND * FrameDrawCount)
Next p
End If
End If
'Particle Draw Test Routine:
For p as Integer = 0 to BloodDrawQuantityCONST-1
If (CurrentFrameDraw) Then
If (BloodParticle[p].LifeTime) Then
line (BloodParticle[p].PositionX - DirectionDistX , BloodParticle[p].PositionY - DirectionDistY) - (BloodParticle[p].PositionX, BloodParticle[p].PositionY), &hFFFF0000
BloodParticle[p].LifeTime -= 1
Else
ParticleRandomPositionCalc_R = ( RND * BloodDrawRadiusCONST )
line (BloodParticle[p].PositionX , BloodParticle[p].PositionY) - (BloodParticle[p].PositionX, BloodParticle[p].PositionY + ParticleRandomPositionCalc_R), &hFFFF0000
BloodParticle[p].PositionY += ParticleRandomPositionCalc_R
End If
Else
pset (BloodParticle[p].PositionX, BloodParticle[p].PositionY),&hFFFF0000
End If
Next p
Return 1
End Function
End Namespace
Screen 19,32
BloodDraw.BloodLine (10,10,600,100,1,10)
Do
sleep 100
Loop while BloodDraw.BloodLine()
sleep
|
_________________
 |
|
| Nach oben |
|
 |
RockTheSchock
Anmeldungsdatum: 04.04.2007
Beiträge: 138
|
|
| Nach oben |
|
|
ThePuppetMaster
Anmeldungsdatum: 18.02.2007
Beiträge: 1839
Wohnort: [JN58JR]
|
| Verfasst am: 24.11.2012, 12:00 Titel: |
|
|
| Code: | Dim TWidth as UInteger = 800
Dim THeight as UInteger = 600
ScreenRes TWidth, THeight, 32
Dim TBackSurf as Any Ptr = ImageCreate(TWidth, THeight, 32)
Dim TFlowSurf as Any Ptr = ImageCreate(TWidth, THeight, 32)
Line TBackSurf, (0, 0)-(TWidth, THeight), &H00000000, BF
Line TFlowSurf, (0, 0)-(TWidth, THeight), &H00000000, BF
Dim TMR as Integer
Dim TMX as Integer
Dim TMY as Integer
Dim TMZ as Integer
Dim TMB as Integer
Dim TMXL as Integer
Dim TMYL as Integer
Do Until Inkey() = Chr(27)
TMR = GetMouse(TMX, TMY, TMZ, TMB)
If TMR = 0 Then
If TMB = 1 Then
Circle TBackSurf, (TMX, TMY), 3, &H00FF0000, , , , F
For Z as Integer = 3 - 1 to 0 Step -1
Circle TFlowSurf, (TMX, TMY), Z, Z + int((rnd * 30) + 1), , , , F
Next
'PSet TBackSurf, (TMX, TMY), &H00FF0000
'PSet TFlowSurf, (TMX, TMY), &H00000001 + int((rnd * 30) + 1)
End If
TMXL = TMX
TMYL = TMY
End If
For y as Integer = THeight - 2 to 0 Step -1
For X as Integer = 0 to TWidth - 1
If Cast(UInteger Ptr, TFlowSurf + 32)[Y * TWidth + X] > 0 Then
Cast(UInteger Ptr, TFlowSurf + 32)[(Y + 1) * TWidth + X] = Cast(UInteger Ptr, TFlowSurf + 32)[Y * TWidth + X] - 1
Cast(UInteger Ptr, TFlowSurf + 32)[Y * TWidth + X] = 0
PSet TBackSurf, (X, Y + 1), &H00FF0000
End If
Next
Next
ScreenLock()
Put (0, 0), TBackSurf, PSET
ScreenUnLock()
Sleep 1, 1
loop
screen 0
end 0
|
MfG
TPM
_________________
[ WebFBC ][ OPS ][ ToOFlo ][ Wiemann.TV ] |
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 25.11.2012, 18:11 Titel: |
|
|
Das ist absolut super TPM 
Noch ein bisschen modifizieren und es ist perfekt,
so wie ich es mir vorgestellt hatte...
Danke Dir
_________________
|
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
