Source/ Codesnippets | | | | | 
Nico
Madysa | Simulation eines Sternensystems. Ist qui Masse einer soleil juste zéro, so wird un Planeten-Sonnensystem betrachtet, andernfalls un Doppelstern avec Planet. qui Sonnenradius darf pas zéro son. Programmiert avec XPSE et nativen Funktionen.
KompilierenMarqueSéparation {$cleq}
{Gravi
nproc Gravi
parameters gamma!,x1!,y1!,m1!,x2!,y2!,m2!
var r2! = sqr(x1! - x2!) + sqr(y1! - y2!)
case nnull(r2!) : return 0
return gamma! * m1! * m2! / r2! 0.0000000000667428 * m1! * m2! / r2!
endproc
{nnull
nproc nnull
parameters x!
case (fabs(x!) < 0.000001) : return 1
return 0
endproc
{nnnull
nproc nnnul
parameters x!
case (fabs(x!) < 0.000001) : return 0
return 1
endproc
{fabs
nproc fabs
parameters x!
case (x! < 0.0) : return (-1.0) * x!
return x!
endproc
{fif
nproc fif
parameters bed&, fthen!, felse!
case bed& : return fthen!
return felse!
endproc
{arctan
nproc arctan
parameters atan!
return (atan! + 0.43157974 * atan!*sqr(atan!)) / (1.0 + 0.76443945 * sqr(atan!) + 0.05831938 * sqr(sqr(atan!)))
}endproc
{arccos
nproc arccos
parameters acos!
case acos! = 1 : return 0
case acos! = -1 : return Pi()
return (Pi() / 2) - arctan(acos! / Sqrt(1 - Sqr(acos!)))
}endproc
{GetAngle
nproc GetAngle
parameters dx!,dy!
case (dx! * dy!) < 0.0000001 : return 0
case dy! <= 0 : return arccos(dx! / Sqrt(Sqr(dx!) + Sqr(dy!)))
return 2 * Pi() - arccos(dx! / Sqrt(Sqr(dx!) + Sqr(dy!)))
}endproc
{UseBrush
nproc useBrush
parameters t&,c&
if t&=0
SelectObject(memDC,GetStockObject(NULL_BRUSH))
elseif t&=1
SetDCBrushColor(memDC,c&)
SelectObject(memDC,GetStockObject(DC_BRUSH))
endif
endproc
{usePen
nproc usePen
parameters t&,w&,c&
if t&=5
SelectObject(memDC,GetStockObject(NULL_PEN))
elseif t&=0
SetDCPenColor(memDC,c&)
SelectObject(memDC,GetStockObject(DC_PEN))
endif
endproc
{Mal_es
nproc Mal_Es
parameters x1!,y1!,x2!,y2!,x3!,y3!
Luusch
UseBrush(1,$FFFFFF)
UsePen(5,0,0)
Rectangle(&memDC,0,0,640,480)
Körper
UseBrush(1,$FF)
Ellipse(&memDC,int(x1!)-10,int(y1!)-10,int(x1!)+10,int(y1!)+10)
Ellipse(&memDC,int(x2!)-10,int(y2!)-10,int(x2!)+10,int(y2!)+10)
UseBrush(1,0)
Ellipse(&memDC,int(x3!)- 5,int(y3!)- 5,int(x3!)+ 5,int(y3!)+ 5)
BitBlt(%hDC,0,0,640,480,&memDC,0,0,SRCCOPY)
endproc
{main
nproc main
parameters mx!,my!,gamma!,r1!,r2!,m1!,m2!,m3!,v1!,v3!
declare F12!,F13!,F23!,r12!,r13!,r23!
var s1_x! = mx! + r1!
var s1_y! = my!
var s1_m! = m1!
var s1_vx! = 0.0
var s1_vy! = 0.0 - v1!
var s2_x! = mx! - r1!
var s2_y! = my!
var s2_m! = m2!
var s2_vx! = 0.0
var s2_vy! = v1!
var s3_x! = mx! + r2!
var s3_y! = my!
var s3_m! = m3!
var s3_vx! = 0.0
var s3_vy! = 0.0 - v3!
Mal_es(s1_x!,s1_y!,s2_x!,s2_y!,s3_x!,s3_y!)
Sleep(1000)
while 1
F12! = Gravi(gamma!,s1_x!,s1_y!,s1_m!,s2_x!,s2_y!,s2_m!)
F13! = Gravi(gamma!,s1_x!,s1_y!,s1_m!,s3_x!,s3_y!,s3_m!)
F23! = Gravi(gamma!,s2_x!,s2_y!,s2_m!,s3_x!,s3_y!,s3_m!)
r12! = sqrt(sqr(s2_x! - s1_x!) + sqr(s2_y! - s1_y!))
r13! = sqrt(sqr(s3_x! - s1_x!) + sqr(s3_y! - s1_y!))
r23! = sqrt(sqr(s3_x! - s2_x!) + sqr(s3_y! - s2_y!))
if nnnul(s1_m!)
s1_vx! = s1_vx! + F12! / s1_m! * (s2_x! - s1_x!) / r12! + F13! / s1_m! * (s3_x! - s1_x!) / r13!
s1_vy! = s1_vy! + F12! / s1_m! * (s2_y! - s1_y!) / r12! + F13! / s1_m! * (s3_y! - s1_y!) / r13!
endif
if nnnul(s2_m!)
s2_vx! = s2_vx! + F12! / s2_m! * (s1_x! - s2_x!) / r12! + F23! / s2_m! * (s3_x! - s2_x!) / r23!
s2_vy! = s2_vy! + F12! / s2_m! * (s1_y! - s2_y!) / r12! + F23! / s2_m! * (s3_y! - s2_y!) / r23!
endif
if nnnul(s3_m!)
s3_vx! = s3_vx! + F13! / s3_m! * (s1_x! - s3_x!) / r13! + F23! / s3_m! * (s2_x! - s3_x!) / r23!
s3_vy! = s3_vy! + F13! / s3_m! * (s1_y! - s3_y!) / r13! + F23! / s3_m! * (s2_y! - s3_y!) / r23!
endif
s1_x! = s1_x! + s1_vx!
s1_y! = s1_y! + s1_vy!
s2_x! = s2_x! + s2_vx!
s2_y! = s2_y! + s2_vy!
s3_x! = s3_x! + s3_vx!
s3_y! = s3_y! + s3_vy!
Mal_es(s1_x!,s1_y!,s2_x!,s2_y!,s3_x!,s3_y!)
Sleep(100)
case GetASyncKeyState(13) : break
wend
endproc
declare e%
WindowTitle "Animation mit OK starten"
cls
MCls 640,480,$FFFFFF
var h& = Create("Dialog",%hWnd,"Parameter",5,5,210,240)
Create("Text",h&,"Gravitationskonstante:",5, 5,100,20)
Create("Text",h&,"Radius der Sonnen:" ,5, 25,100,20)
Create("Text",h&,"Masse Sonne 1:" ,5, 45,100,20)
Create("Text",h&,"Masse Sonne 2:" ,5, 65,100,20)
Create("Text",h&,"Sonnen-Geschw.:" ,5, 85,100,20)
Create("Text",h&,"Radius des Planeten:" ,5,105,100,20)
Create("Text",h&,"Masse des Planeten:" ,5,125,100,20)
Create("Text",h&,"Geschw. des Planeten:" ,5,145,100,20)
var h1& = Create("Edit",h&,"0.667428",105, 5,100,20)
var h2& = Create("Edit",h&,"33" ,105, 25,100,20)
var h3& = Create("Edit",h&,"10000" ,105, 45,100,20)
var h4& = Create("Edit",h&,"0" ,105, 65,100,20)
var h5& = Create("Edit",h&,"0" ,105, 85,100,20)
var h6& = Create("Edit",h&,"100" ,105,105,100,20)
var h7& = Create("Edit",h&,"50" ,105,125,100,20)
var h8& = Create("Edit",h&,"11" ,105,145,100,20)
var b& = Create("Button",h&,"OK",5,170,100,20)
var a& = Create("Button",h&,"Abbruch",105,170,200,20)
repeat
WindowTitle "Animation mit OK starten"
e% = 0
repeat
waitinput
case Clicked(b&) : e% = 1
case Clicked(a&) : e% = -1
until e%
case e% < 0 : break
SetFocus(%hWnd)
WindowTitle "Animation mit ENTER abbrechen"
main(320,240,val(GetText$(h1&)) , val(GetText$(h2&)),val(GetText$(h6&)) , val(GetText$(h3&)),val(GetText$(h4&)),val(GetText$(h7&)) , val(GetText$(h5&)),val(GetText$(h8&)))
until e% < 0
end
|
 | | | | | | |
| | 
Thomas
Zielinski | Pour einem Klick sur OK avec den Voreinstellungen hat sich cela Programme gnadenlos aufgehangen. un Stück qui Animation était oui encore trop sehn. mais pour einer halben drehung qui Kugel et un Klick dans cela Einstellungsfenster wars vorbei.
Salut Thomas |
| | | | XProfan X4; Win10 x64
Der Kuchen ist eine lüge! | 30.11.2009 ▲ |
| | |
| |
Nico
Madysa | la hâte du Enter gedrückt? cela pourrait wohl à den NProcs liegen. si je ins la fenêtre klicke, venez zwar aussi "Keine Rückmeldung", mais chez Druck sur Enter reagierts meist doch wieder.
Es sei car, dein PC rechnet avec ner anderen Physik comme meiner.  |
| | | | | | |
| |
Thomas
Zielinski | | Ah Okay. avec Enter gehts ensuite wieder. quand même ist encore un winziges Anzeigeproblem |
| | | | XProfan X4; Win10 x64
Der Kuchen ist eine lüge! | 30.11.2009 ▲ |
| | |
| |
Nico
Madysa | c'est beabsichtigt. cela Programme soll pas schick son, mais un Doppelsternsystem simulieren. Daher ist aussi qui Dialog so hingeklatscht.  |
| | | | | | |
| |  | "Keine Rückmeldung" wird angezeigt, z.B. si un Prozess voll sous charge ist et qui WProc aussi aucun Zeit zum répondre hat. Eigentlich ist toujours "Keine Rückmeldung" ausserhalb de Waitinput - grob gesehen. un Sleep ändert rien à "Keine Rückmeldung" - ici bliebe z.B. un eigener Fil ou bien encore plutôt une TimerProc, sodass qui XProfan-WProc aussi la fois Zeit zum "antworten" hat.
qui annonce "Keine Rückmeldung" heisst alors absolu pas, dass quelque chose abgestürzt ou non funktioniert - eigentlich seulement cela grad dur am travailler ist. 
cls avec sleep 100000 gibt aussi "keine Rückmeldung" si on qui wProc versucht trop befragen z.B. avec lauter Klicks aufs hWnd. ^ ^ |
| | | | | | |
| |
Nico
Madysa | | bien, ensuite vois je la fois, si je une Fil daraus faire peux. |
| | | | | | |
| | | Ginge maintenant très simple sogar per Fil.Start [...]  . ^ ^ |
| | | | | | |
|
Zum QuelltextOptions du sujet | 11.726 Views |
Themeninformationencet Thema hat 3 participant: |
(1.117)
Deutsch
English
Français
Español
Italia