 |
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 |
Mao
Anmeldungsdatum: 25.09.2005
Beiträge: 4409
Wohnort: /dev/hda1
|
 Verfasst am: 27.06.2008, 18:06 Titel: |
 |
|
Das @-Zeichen bei der Deklaration der SUB muss AFAIK weg. 
Ist der Adress-Operator und gibt einen Pointer auf eine Variable zurück.
_________________
Eine handvoll Glück reicht nie für zwei.
--
 |
|
| Nach oben |
|
 |
Lloyd
Anmeldungsdatum: 27.06.2008
Beiträge: 37
Wohnort: Nähe Frankfurt
|
| Verfasst am: 27.06.2008, 23:56 Titel: |
|
|
Ach, ich geb's auf. Hab den Code jetzt theoretisch fertig gesetellt, jedoch geht garnix, aber auch null! Ich konnte auch alle Fehlermeldungen beseitigen, aber ex passiert nunmal nix. 
Es öffnet sich nämlich nicht mal ein Fenster, weswegen ich FBIDETemp.exe per Taskmanager beenden muss.
Deswegen mach ich an meiner Vorherigen Version weiter, wo immerhin die Diffusion klappt. Mal schaun, ob ich die Bewegung noch irgendwie gebogen krieg. Ich poste spätestens morgen nochmal. Wenn ich weitergekommen bin, sag ich Bescheid, wenn nicht, frag ich nach Hilfe 
Nochmals Danke für all die Gedulgigen hier, die mich ertragen müssen!  |
|
| Nach oben |
|
|
Elektronix
Anmeldungsdatum: 29.06.2006
Beiträge: 742
|
| Verfasst am: 28.06.2008, 08:49 Titel: |
|
|
Nicht verzagen, das ist nämlich ein gutes Zeichen. Jetzt mußt Du beim Compilieren nur noch das richtige Zielsystem eingaben. Vermutlich kompilierst Du immer für Consolw, Du mußt aber für GUI (Option -s gui) kompilieren.
_________________
Und die Grundgebihr is aa scho drin- DOS is jo nett. |
|
| Nach oben |
|
|
Lloyd
Anmeldungsdatum: 27.06.2008
Beiträge: 37
Wohnort: Nähe Frankfurt
|
| Verfasst am: 28.06.2008, 12:30 Titel: |
|
|
Guten Morgen! 
Mein neuer Code is grad auf nem andern PC, den poste ich dann später.
Aber hier ist erstmal mein alter:
| Code: |
Screenres 800, 600, 32, 2
Dim As Byte Ptr rot, gruen, blau
Dim Shared As Integer Nx=600, Ny=600, H=5, Breite, Hoehe,_
MausX, MausY, Maustaste, MausXsave, MausYsave, Count, Spacepressed, Mausrad, Mausradsave
Windowtitle "Fluid-Simulation by Lloyd"
Screeninfo Nx, Ny
Dim Shared As Single Vx(Nx, Ny), Vy(Nx, Ny), Dichte(Nx, Ny), Dichte2(Nx, Ny),_
Dichte3(Nx, Ny), a, Vx2(Nx, Ny), Vy2(Nx, Ny), Vx3(Nx, Ny), Vy3(Nx, Ny), Pinselgroesse=2,Kappa=1, Visk=1, CLRrot=1,_
CLrgruen=1, Clrblau=1, Zeitschritt=0.1
Dim As Single x, y, s0, s1, t0, t1, dt0
Dim As Integer i0, j0, i1, j1
rot = Imagecreate(H, H, RGB(255, 0, 0))
gruen = Imagecreate(H, H, RGB(0, 255, 0))
blau = Imagecreate(H, H, RGB(0, 0, 255))
Do
Screenlock
Cls
? "Hilfe mit F1"
If Multikey(&h3B) Then
? "Leertaste: Vektorfeld an/ausschalten (inaktiv)"
? "Q/W: Rot verringern/erhoehen"
? "A/S: Gruen verringern/erhoehen"
? "Y/X: Blau verringern/erhoehen"
? "Mausrad: Pinselgroesse verringern/erhoehen"
? "Linke Maustaste: Dichte erhoehen"
Endif
If Multikey(&h39) And Spacepressed=0 Then
Spacepressed=1
Elseif Multikey(&h39) And Spacepressed=2 Then
Spacepressed=3
Elseif Multikey(&h39)=0 And Spacepressed=3 Then
Spacepressed=0
Elseif Multikey(&h39)=0 And Spacepressed=1 Then
Spacepressed=2
Endif
If Multikey(&h10) And Clrrot>0 Then Clrrot-=0.01
If Multikey(&h11) And Clrrot<1 Then Clrrot+=0.01
If Clrrot<0 Then Clrrot=0
If Clrrot>1 Then Clrrot=1
If Multikey(&h1E) And Clrgruen>0 Then Clrgruen-=0.01
If Multikey(&h1F) And Clrgruen<1 Then Clrgruen+=0.01
If Clrgruen<0 Then Clrgruen=0
If Clrgruen>1 Then Clrgruen=1
If Multikey(&h2C) And Clrblau>0 Then Clrblau-=0.01
If Multikey(&h2D) And Clrblau<1 Then Clrblau+=0.01
If Clrblau<0 Then Clrblau=0
If Clrblau>1 Then Clrblau=1
? "R: ";Clrrot
? "G: ";Clrgruen
? "B: ";Clrblau
If Count=0 Then
MausXSave=MausX
MausYSave=MausY
Count=0
Endif
Count+=0
Mausradsave=Mausrad
Getmouse (MausX, MausY, Mausrad, Maustaste)
If Mausradsave>Mausrad And Pinselgroesse>H/10 Then Pinselgroesse-=0.1
If Mausradsave<Mausrad Then Pinselgroesse+=0.1
dt0=Zeitschritt*(Nx*Ny)^0.5
a=20*Nx*Ny*Zeitschritt
For i = H to Nx-H Step H
For j = H to Ny-H Step H
If Maustaste<>0 And i-MausX<(H*Pinselgroesse) And i-MausX>-(H*Pinselgroesse)_
And j-MausY<(H*Pinselgroesse)And j-MausY>-(H*Pinselgroesse) Then 'And (MausX<>MausXsave Or MausY<>MausYsave) Then
If Maustaste=1 Then
Dichte(i, j)=1
Vx(i, j)=MausXSave-MausX
Vy(i, j)=MausYSave-MausY
Else
Dichte(i, j)=0
Vx(i, j)=0
Vy(i, j)=0
Endif
Endif
'Diffusion
'Dichte2(i, j)=Dichte(i, j)+Kappa*(Dichte(i-H, j)+Dichte(i+H, j)+_
'Dichte(i, j-H)+Dichte(i, j+H)-4*Dichte(i, j))/H^2
Dichte2(i, j)=(Dichte(i, j)+a*(Dichte(i-H, j)+Dichte(i+H, j)+_
Dichte(i, j-H)+Dichte(i, j+H)))/(1+4*a)
Vx2(i, j)=(Vx(i, j)+a*(Vx(i-H, j)+Vx(i+H, j)+_
Vx(i, j-H)+Vx(i, j+H)))/(1+4*a)
Vy2(i, j)=(Vy(i, j)+a*(Vy(i-H, j)+Vy(i+H, j)+_
Vy(i, j-H)+Vy(i, j+H)))/(1+4*a)
'If Vx2(i, j)>H/2 Then Vx2(i, j)=H/2
'If Vx2(i, j)<-(H/2) Then Vx2(i, j)=-(H/2)
'If Vy2(i, j)>H/2 Then Vy2(i, j)=H/2
'If Vy2(i, j)<-(H/2) Then Vy2(i, j)=-(H/2)
'Bewegen
x=i-dt0*Vx(i, j)
y=j-dt0*Vy(i, j)
If x<H/2 Then x=H/2
If x>Nx+H/2 Then x=Nx+H/2
If y<H/2 Then x=H/2
If y>Ny+H/3 Then y=Ny+H/2
i0=x
i1=i0+H
j0=y
j1=j0+H
s1=x-i0
s0=H-s1
t1=y-j0
t0=H-t1
'Dichte3(i, j)=s0*(t0*Dichte2(i0, j0)+t1*Dichte2(i0, j1))+_
' s1*(t0*Dichte2(i1, j0)+t1*Dichte2(i1, j1))
'Vx3(i, j)=s0*(t0*Vx2(i0, j0)+t1*Vx2(i0, j1))+_
' s1*(t0*Vx2(i1, j0)+t1*Vx2(i1, j1))
'Vy3(i, j)=s0*(t0*Vy2(i0, j0)+t1*Vy2(i0, j1))+_
' s1*(t0*Vy2(i1, j0)+t1*Vy2(i1, j1))
Next
Next
For i = H to Nx-H Step H
For j = H to Ny-H Step H
Dichte(i, j)=Dichte2(i, j)
Vx(i, j)=Vx2(i, j)
Vy(i, j)=Vy2(i, j)
If Spacepressed=1 Or Spacepressed=2 Then Line (i, j)-(i-Vx(i, j), j-Vy(i, j)), RGB(255, 0, 0)
If Dichte(i, j)<0 Then Dichte(i, j)*=-1
Put (i, j), rot, Add, Dichte(i, j)*Clrrot*255
Put (i, j), gruen, Add, Dichte(i, j)*Clrgruen*255
Put (i, j), blau, Add, Dichte(i, j)*Clrblau*255
Next
Next
? "Pinselgroesse: ";Pinselgroesse
Line (MausX-Pinselgroesse*4, MausY-Pinselgroesse*4)-(MausX+Pinselgroesse*4,_
MausY+Pinselgroesse*4), RGB(Clrrot*255, Clrgruen*255, Clrblau*255),bf
sleep 1
Flip
Screenunlock
Loop Until Inkey=Chr(255, 107) Or Multikey(&h01)
Imagedestroy rot
Imagedestroy gruen
Imagedestroy blau
|
Könnt mal ein paar ' 's wegmachen, und zugucken wie's abstürzt! ;D
Bin erstmal einkaufen! Bye! o/
Edit:
So, bin nun am andern PC. Als Compilerbefehl hab ich unter anderem "-s gui", geht trotzdem nicht. Naja, hier der Code:
| Code: |
Dim Shared As Integer N=100, size
size=(N+2)*(N+2)
Dim Shared As Single u(size), v(size), u_prev(size), v_prev(size), dens(size),_
dens_prev(size)
Dim Shared As Single H, dt, dt0, x, y, s0, t0, s1, t1, a, tmp, visc, diff
Dim Shared As Integer i0, j0, i1, j1
H = 1/N
Screenres size, size, 32, 2
#define IX(i, j) ((i)+(n+2)*(j))
Declare Sub add_source(N As Integer,x() As Single, s() As Single,dt As Single )
Sub add_source (N As Integer, x() As Single, s() As Single, dt As Single )
size = (N+2)*(N+2)
For i = 0 to size-1
x(i) += dt*s(i)
Next
End Sub
Declare Sub set_bnd ( N As Integer, b As Integer, x() As Single )
Sub set_bnd ( N As Integer, b As Integer, x() As Single )
Select Case b
Case 1
For i = 1 to N
x(IX(0, i)) = 0
x(IX(n+1, i)) = 0
Next
Case 2
For i = 1 to N
x(IX(i, 0)) = 0
x(IX(i, n+1)) = 0
Next
Case 3
For i = 1 to N
x(IX(0, i)) = 0
x(IX(n+1, i)) = 0
x(IX(i, 0)) = 0
x(IX(i, n+1)) = 0
Next
End Select
End Sub
Declare Sub diffuse (N As Integer, b As Integer , x() As Single, x0() As Single,_
Diff As Single, dt As Single )
Sub diffuse (N As Integer, b As Integer , x() As Single, x0() As Single,_
diff As Single, dt As Single )
a = dt*diff*N*N
For k = 0 to 19
For i = 1 to N
For j = 1 to N
x(IX(i, j)) = (x0(IX(i, j))+a*(x(IX(i-1, j))+x(IX(i+1, j))+_
x(IX(i, j-1))+x(IX(i, j+1))))/(1+4*a)
Next
Next
set_bnd ( N, b, x() )
Next
End Sub
Declare Sub advect ( N As Integer, b As Integer, d() As Single, d0() As Single,_
u() As Single, v() As Single, dt As Single )
Sub advect ( N As Integer, b As Integer, d() As Single, d0() As Single,_
u() As Single, v() As Single, dt As Single )
dt0=dt*N
For i = 1 to N
For j = 1 to N
x = i-dt0*u(IX(i, j))
y = j-dt0*v(IX(i, j))
If x<0.5 Then
x=0.5
Elseif x>N+0.5 Then
x=N+0.5
Endif
If y<0.5 Then
y=0.5
Elseif y>N+0.5 Then
y=N+0.5
Endif
i0 = Fix(x)
i1 = i0+1
j0 = Fix(y)
j1 = j0+1
s1 = x-i0
s0 = 1-s1
t1 = y-j0
t0 = 1-t1
d(IX(i, j)) = s0*(t0*d0(IX(i0, j0))+t1*d0(IX(i0, j1)))+_
s1*(t0*d0(IX(i1, j0))+t1*d0(IX(i1, j1)))
Next
Next
Set_bnd ( N, b, d() )
End Sub
#Macro Swap2 ( x0, x )
tmp = x0
x0 = x
x = tmp
#EndMacro
Declare Sub dens_step ( N As Integer, x() As Single, x0() As Single,_
u() As Single, v() As Single, diff As Single,_
dt As Single )
Sub dens_step ( N As Integer, x() As Single, x0() As Single,_
u() As Single, v() As Single, diff As Single,_
dt As Single )
add_source ( N, x(), x0(), dt )
For i = 0 to N
SWAP2 ( x0(i), x(i) )
Next
diffuse ( N, 0, x(), x0(), diff, dt )
For i = 0 to N
SWAP2 ( x0(i), x(i) )
Next
advect ( N, 0, x(), x0(), u(), v(), dt )
End Sub
Declare Sub project ( N As Integer, u() As Single, v() As Single, p() As Single,_
div() As Single )
Sub project ( N As Integer, u() As Single, v() As Single, p() As Single,_
div() As Single )
For i = 1 to N
For j = 1 to N
div(IX(i, j)) = -0.5*h*(u(IX(i+1, j))-u(IX(i-1, j))+_
v(IX(i, j+1))-v(IX(i, j-1)))
p(IX(i, j)) = 0
Next
Next
For k = 0 to 19
For i = 1 to N
For j = 1 to N
p(IX(i, j)) = (div(IX(i, j))+p(IX(i-1, j))+p(IX(i+1, j))+_
p(IX(i, j-1))+p(IX(i, j+1)))/4
Next
Next
Set_bnd ( N, 0, p())
Next
For i = 1 to N
For j = 1 to N
u(IX(i, j)) -= 0.5*(p(IX(i+1, j))-p(IX(i-1, j)))/h
v(IX(i, j)) -= 0.5*(p(IX(i, j+1))-p(IX(i-1, j-1)))/h
Next
Next
set_bnd ( N, 1, u())
set_bnd ( N, 2, v())
End Sub
Declare Sub vel_step ( N As Integer, u() As Single, v() As Single, u0() As Single,_
v0() As Single, visc As Single, dt As Single )
Sub vel_step ( N As Integer, u() As Single, v() As Single, u0() As Single,_
v0() As Single, visc As Single, dt As Single )
add_source ( N, u(), u0(), dt )
add_source ( N, v(), v0(), dt )
For i = 0 to N
SWAP2 ( u0(i), u(i) )
Next
diffuse ( N, 1, u(), u0(), visc, dt )
For i = 0 to N
SWAP2 ( v0(i), v(i) )
Next
diffuse ( N, 2, v(), v0(), visc, dt )
project ( N, u(), v(), u0(), v0() )
For i = 0 to N
SWAP2 ( u0(i), u(i) )
Next
For i = 0 to N
SWAP2 ( v0(i), v(i) )
Next
advect ( N, 1, u(), u0(), u0(), v0(), dt )
advect ( N, 2, v(), v0(), u0(), v0(), dt )
project (n, u(), v(), u0(), v0() )
End Sub
Declare Sub draw_dens ( N As Integer, den() As Single )
Sub draw_dens ( N As Integer, den() As Single )
For i = 1 to N
For j = 1 to N
Pset (i, j), RGBA(255, 255, 255, den(IX(i, j))*255)
Next
Next
End Sub
Do
Screenlock
Cls
vel_step ( N, u(), v(), u_prev(), v_prev(), visc, dt )
dens_step ( N, dens(), dens_prev(), u(), v(), diff, dt )
draw_dens ( N, dens() )
Sleep 1
Flip
Screenunlock
Loop Until Inkey=Chr(255, 107) Or Multikey(&h01)
|
Es wäre imo mal sehr praktisch, wenns ne Spoiler-Klapp Funktion geben würde, dann wär das übersichtlich und nicht son langer Post!  |
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4704
Wohnort: ~/
|
| Verfasst am: 29.06.2008, 18:12 Titel: |
|
|
| Zitat: | | Es wäre imo mal sehr praktisch, wenns ne Spoiler-Klapp Funktion geben würde |
http://www.freebasic-portal.de/index.php?s=fbporticula 
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| 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
