Fuente/ Codesnippets | | | | | 
Nico
Madysa | Simulation uno Sternensystems. Ist el Masse uno Sonne igual Null, así una Planeten-Sonnensystem betrachtet, de otra manera una Doppelstern con Planet. Der Sonnenradius darf no Null ser. Programmiert con XPSE y nativen Características.
KompilierenMarcaSeparación {$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 | Nach una Clic en OK con el Voreinstellungen ha se el Programa gnadenlos aufgehangen. Ein Stück el Animation war sí todavía a sehn. aber después de uno halben drehung el Kugel y una Clic en el Einstellungsfenster wars vorbei.
Saludo Thomas |
| | | | XProfan X4; Win10 x64
Der Kuchen ist eine lüge! | 30.11.2009 ▲ |
| | |
| |
Nico
Madysa | Hast du Enter gedrückt? Das dürfte wohl a el NProcs mentira. Wenn Yo la ventana klicke, kommt zwar auch "Keine Rückmeldung", pero en Druck en Enter reagierts meist doch otra vez.
Lo sei porque, dein PC rechnet con ner otro Physik como meiner.  |
| | | | | | |
| |
Thomas
Zielinski | | Ah Okay. Mit Enter gehts entonces otra vez. Trotzdem es todavía una winziges Anzeigeproblem |
| | | | XProfan X4; Win10 x64
Der Kuchen ist eine lüge! | 30.11.2009 ▲ |
| | |
| |
Nico
Madysa | Es beabsichtigt. Das Programa se no schick ser, pero una Doppelsternsystem simulieren. Daher es auch el Diálogo así hingeklatscht.  |
| | | | | | |
| |  | "Keine Rückmeldung" se adecuado, z.B. si una Prozess voll bajo Last es y el WProc auch no Tiempo para Respuesta ha. Eigentlich es siempre "Keine Rückmeldung" ausserhalb de Waitinput - grob gesehen. Ein Sleep ändert nichts a "Keine Rückmeldung" - hier bliebe z.B. una eigener Hilo oder todavía más una TimerProc, sodass el XProfan-WProc auch veces Tiempo para "antworten" ha.
El Meldung "Keine Rückmeldung" heisst also absolut no, dass algo abgestürzt o no funktioniert - eigentlich sólo el grad hart al Arbeiten es. 
cls con sleep 100000 son auch "keine Rückmeldung" si uno el wProc intenta a befragen z.B. con lauter Klicks aufs hWnd. ^ ^ |
| | | | | | |
| |
Nico
Madysa | | Gut, entonces sehe Yo veces, si Soy un Hilo lo hacer kann. |
| | | | | | |
| | | Ginge ahora muy simplemente incluso por Hilo.Start [...]  . ^ ^ |
| | | | | | |
|
Zum QuelltextTema opciones | 11.339 Views |
ThemeninformationenDieses Thema ha 3 subscriber: |
(843)
Deutsch
English
Français
Español
Italia