Source / code snippets | | | | | 
Nico
Madysa | Simulation one Sternensystems. is The volume of/ one sun same zero, so becomes one planets-Sonnensystem viewing, otherwise one Doppelstern with planet's. The Sonnenradius must not zero his. program with XPSE and nativen functions.
CompileMarkSeparation {$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 | After one Click on OK with the Voreinstellungen has the program gnadenlos aufgehangen. One Piece the Animation was Yes yet To sehn. but after a half-way turn the bullet and a Click into Einstellungsfenster wars past.
Greeting Thomas |
| | | | XProfan X4; Win10 x64
Der Kuchen ist eine lüge! | 11/30/09 ▲ |
| | |
| |
Nico
Madysa | have you got Enter pressed? the might well on whom NProcs lying. If I in that Window click, comes of course too "Keine Rückmeldung", but with pressure on Enter reagierts mostly still again.
it be because, your PC rechnet with Ner others Physics as of my.  |
| | | | | | |
| |
Thomas
Zielinski | | Ah Okay. with Enter GEHTS then again. nevertheless is another winziges Anzeigeproblem |
| | | | XProfan X4; Win10 x64
Der Kuchen ist eine lüge! | 11/30/09 ▲ |
| | |
| |
Nico
Madysa | this is beabsichtigt. the Program should not schick his, separate one Doppelsternsystem simulate. therefore is too the dialog so hingeklatscht.  |
| | | | | | |
| |  | "Keine Rückmeldung" becomes displayed, z.B. if one Process fully under Last and that the WProc too no Time to that Answer has. really is always "Keine Rückmeldung" ausserhalb of Waitinput - roughly seen. One Sleep changes nothing on "Keine Rückmeldung" - here bliebe z.B. one eigener Thread or yet sooner a TimerProc, so The XProfan-WProc too time Time to that "antworten" has.
The Message "Keine Rückmeldung" means means utterly not, that something abgestürzt or not functions - really only the degree hard on the works is. 
cls with sleep 100000 gives too "keine Rückmeldung" if one The wProc attempts To question z.B. with lauter Klicks aufs hWnd. ^^ |
| | | | | | |
| |
Nico
Madysa | | well, then see I time, whether I a Thread from it can make. |
| | | | | | |
| | | went now very simply even by Thread.Start [...]  . ^^ |
| | | | | | |
|
Zum QuelltextTopic-Options | 11.367 Views |
Themeninformationenthis Topic has 3 subscriber: |
(840)
Deutsch
English
Français
Español
Italia