Sie sind der

Besucher

Letzte Aktualisierung: 15.04.2006

Ich bitte um die Beachtung des Copyrights bei einer Verbreitung des Programmes (Siehe auch Impressum).
Verbreitung/Änderung/Nutzung etc. nur für Nichtkommerzielle Zwecke erlaubt.
Bei Verbesserung(svorschläg)en können mir diese gerne geschickt werden - ich bin offen für alles!

Dafür kann das Objekt am Ring angefasst (Maus) werden, und in das Gefäß gehoben (gedrückt) werden. Die entstehenden Kräfte werden dabei in Echtzeit am Gewichtskraftanzeiger dargestellt. Wird ein Schwimmfähiger Körper weiter eingetaucht, so schwimmt dieser nach loslassen animiert auf, so wie er es in einem Physikversuch tun würde.

Der Programmcode:

(Code und .EXE-File Downloadbar unter Downloads)

declare zeit%, omillisec%, millisec%, n%, tim$, time$, millisec$, rx1%, ry1%, rx2%, ry2%, leer%, z%, ma%, omousey%
declare titel$, otitel$, mov%, sim%, sim$
declare Rg!, Rf!, Rm!, Fg!, Fm!, Ff!, Am!, hm!, g!, Fanz!, Fdif!, deep1!, deep2!, deep3!, vvol!, stat$, Ar!, hr!, Fauf!, B!, declare Fauf100!, Fae1!, Fae2!, Fauf1z!, minv!, minh!, dh!, ha!
declare posx1%,posy1%,posx2%,posy2%,dfh!,ahp!

proc sleep
 parameters zeit%
 let n% = zeit%
 while n%
  let tim$ = @time$(1)
  let millisec$ = @mid$(tim$,4,1)
  let millisec% = millisec$
  if @NEq(omillisec%,millisec%)
   dec n%
   let omillisec%=millisec%
  endif
 endwhile
endproc

proc mausanzeige
 NumWidth 3
 Decimals 0
 UseFont "COURIER",15,6,1,0,0
 TextColor @RGB(0,0,0),-2
 DrawText 610,370,%MousePressed
 DrawText 610,385,%MouseX
 DrawText 610,400,%MouseY
 NumWidth 7
 Decimals 2
endproc

proc rahmen
 parameters rx1%, ry1%, rx2%, ry2%
 UsePen 0,0,@RGB(63,63,63)
 UseBrush 1,@RGB(255,255,255)
 Rectangle @add(rx1%,1),@add(ry1%,1) - rx2%,ry2%
 UseBrush 0,@RGB(255,255,255)
 Rectangle rx1%,ry1% - @add(rx2%,1),@add(ry2%,1)
 UsePen 0,0,@RGB(191,191,191)
 Rectangle @sub(rx1%,1),@sub(ry1%,1) - rx2%,ry2%
 Rectangle @sub(rx1%,1),@sub(ry1%,1) - @sub(rx2%,1),@sub(ry2%,1)
 UsePen 0,0,@RGB(127,127,127)
 UseBrush 0,@RGB(127,127,127)
 Rectangle rx1%,ry1% - rx2%,ry2%
endproc

proc Neuaufbau
 LoadBmp "HG01.bmp", 0, 0; 0
 TextColor @RGB(31,0,0),-1
 CharSet 0
 Orientation 0 ' 30°-Winkel
 UseFont "ARIAL",20,8,1,0,1
 DrawText 370,30,"Aktuelle Größen:"
 UseFont "ARIAL",15,6,1,0,0
 DrawText 370,60,"Dichte Gas"
 DrawText 370,90,"Dichte Flüssigkeit"
 DrawText 370,120,"Dichte Körper"
 DrawText 370,140,"Grundfläche Körper"
 DrawText 370,160,"Höhe Körper"
 DrawText 370,180,"Gewichtskraft Körper"
 DrawText 370,210,"Körper in Fl. eingetaucht"
 DrawText 370,230,"= Körper in Fl. eingetaucht"
 DrawText 370,250,"= Verdrängtes Volumen"
 DrawText 370,270,"Anzeige Newtonmeter"
 DrawText 370,290,"Differenz Anzeige-Körper"
 DrawText 370,310,"= Auftriebskraft"
 DrawText 370,330,"= Status Körper"
 UseFont "ARIAL",20,8,1,0,1
 DrawText 370,360,"Grundsätzliche Infos:"
 UseFont "ARIAL",15,6,1,0,0
 DrawText 370,390,"Ortsfaktor: g = 9,81    ."
 DrawText 370,405,"Blaue Werte können verändert werden,"
 DrawText 370,420,"schwarze Werte sind anzeigende Werte."
 DrawText 370,435,"Gestrichelte Linien im Anzeigefeld bedeuten,"
 DrawText 370,450,"dass diese Angabe Inaktiv ist."
 UseFont "ARIAL",12,5,1,0,1
 DrawText 480,385," N "
 UseFont "ARIAL",12,5,1,0,0
 DrawText 480,395,"kg"
 UseFont "ARIAL",15,6,1,0,0
 DrawText 520,60,":"
 DrawText 520,90,":"
 DrawText 520,120,":"
 DrawText 520,140,":"
 DrawText 520,160,":"
 DrawText 520,180,":"
 DrawText 520,210,":"
 DrawText 520,230,":"
 DrawText 520,250,":"
 DrawText 520,270,":"
 DrawText 520,290,":"
 DrawText 520,310,":"
 DrawText 520,330,":"
 UseFont "ARIAL",12,5,1,0,1
 DrawText 610,55," g "
 DrawText 610,85," g "
 DrawText 610,115," g "
 UseFont "ARIAL",12,5,1,0,0
 DrawText 610,65,"cm³"
 DrawText 610,95,"cm³"
 DrawText 610,125,"cm³"
 UseFont "ARIAL",15,6,1,0,0
 DrawText 610,140,"cm²"
 DrawText 610,160,"cm"
 DrawText 610,180,"N"
 DrawText 610,210,"cm"
 DrawText 610,230,"%"
 DrawText 610,250,"cm³"
 DrawText 610,270,"N"
 DrawText 610,290,"N"
 DrawText 610,310,"N"
 UseFont "ARIAL",30,11,1,0,0
 DrawText 30,410,"Simulation:"
 UseFont "ARIAL",20,8,1,0,0
 DrawText 185,404,"Gas (Luftschiff)"
 DrawText 185,429,"Flüssigkeit"
 UseFont "ARIAL",11,5,1,0,0
 DrawText 434,469,"(C)2002 J. Walk, walktronics@gmx.de"
 rahmen 160,405,175,420
 rahmen 160,430,175,445
 rahmen 535,57,606,75
 rahmen 535,87,606,105
 rahmen 535,117,606,135
 rahmen 535,137,606,155
 rahmen 535,157,606,175
 rahmen 535,177,606,195
 rahmen 535,207,606,225
 rahmen 535,227,606,245
 rahmen 535,247,606,265
 rahmen 535,267,606,285
 rahmen 535,287,606,305
 rahmen 535,307,606,325
 rahmen 535,327,626,345
 rahmen 30,30,340,380
endproc

proc werte
 UseFont "COURIER",15,6,1,0,0
 NumWidth 7
 Decimals 2
 TextColor @RGB(0,0,255),-2
 Case @Mouse(530,140-610,155): TextColor @RGB(255,0,0),-2
 DrawText 540,140,Am!
 TextColor @RGB(0,0,255),-2
 Case @Mouse(530,160-610,175): TextColor @RGB(255,0,0),-2
 DrawText 540,160,hm!
 TextColor @RGB(0,0,0),-2
 UseFont "ARIAL",13,8,1,0,0
 Case sim%: DrawText 162,407,"X"
 Case sim%: rahmen 160,430,175,445
 Casenot sim%: DrawText 162,432,"X"
 Casenot sim%: rahmen 160,405,175,420
 Case @and(@Mouse(160,430-270,445),%mousepressed): let sim%=0
 Case @and(@Mouse(160,405-306,420),%mousepressed): let sim%=1
endproc

proc simf
 NumWidth 7
 Decimals 2
 UseFont "COURIER",12,5,1,0,0
 TextColor @RGB(0,0,0),-2
 DrawText 35,35,"Auftrieb in einer Flüssigkeit:"
 DrawText 540,210,deep1!
 DrawText 540,230,deep2!
 NumWidth 7
 Decimals 0
 DrawText 540,250,vvol!
 NumWidth 7
 Decimals 2
 case @lt(9999,Fanz!):Decimals 0
 case @lt(Fanz!,-999):Decimals 0
 DrawText 540,270,Fanz!
 Decimals 2
 case @lt(9999,Fdif!):Decimals 0
 case @lt(Fdif!,-999):Decimals 0
 DrawText 540,290,Fdif!
 DrawText 540,310,Fdif!
 Decimals 2
 DrawText 540,330,stat$
 NumWidth 7
 Decimals 4
 TextColor @RGB(0,0,0),-2
 DrawText 540,60,Rg!
 NumWidth 7
 Decimals 2
 TextColor @RGB(0,0,255),-2
 Case @Mouse(530,90-610,105): TextColor @RGB(255,0,0),-2
 DrawText 540,90,Rf!
 TextColor @RGB(0,0,255),-2
 Case @Mouse(530,120-610,135): TextColor @RGB(255,0,0),-2
 DrawText 540,120,Rm!
 TextColor @RGB(0,0,0),-2
 DrawText 540,180,Fm!
 let Fdif!=@sub(Fm!,Fanz!)
 Case @and(@Mouse(530,90-610,105),%mousepressed):Let Rf!=@Input$("Flüssigkeitsdichte:","Eingabe Flüssigkeitsdichte",Rf!)
 case @lt(Rf!,0.01):let Rf!=0.01
 case @lt(150,Rf!):let Rf!=150
 Case @and(@Mouse(530,120-610,135),%mousepressed):Let Rm!=@Input$("Dichte Körper:","Eingabe Körperdichte",Rm!)
 case @lt(Rm!,0.01):let Rm!=0.01
 case @lt(9999,Rm!):let Rm!=9999
 let Fm!=@div(@mul(Am!,@mul(hm!,@mul(9.81,Rm!)))),1000)
 case @lt(9999,Fm!):let Rm!=@div(@mul(9999,1000),@mul(@mul(9.81,hm!),Am!))
 Case @and(@Mouse(530,140-610,155),%mousepressed):Let Am!=@Input$("Körper Grundfläche:","Eingabe Körpergrundfläche",Am!)
 case @lt(Am!,1):let Am!=1
 case @lt(9999,Am!):let Am!=9999
 let Fm!=@div(@mul(Am!,@mul(hm!,@mul(9.81,Rm!)))),1000)
 case @lt(9999,Fm!):let Am!=@div(@mul(9999,1000),@mul(@mul(9.81,hm!),Rm!))
 Case @and(@Mouse(530,160-610,175),%mousepressed):Let hm!=@Input$("Körper Höhe:","Eingabe Körperhöhe",hm!)
 case @lt(hm!,0.01):let hm!=0.01
 case @lt(50,hm!):let hm!=50
 let Fm!=@div(@mul(Am!,@mul(hm!,@mul(9.81,Rm!)))),1000)
 case @lt(9999,Fm!):let hm!=@div(@mul(9999,1000),@mul(@mul(9.81,Am!),Rm!))
endproc

proc simg
 NumWidth 7
 Decimals 2
 UseFont "COURIER",12,5,1,0,0
 TextColor @RGB(0,0,0),-2
 DrawText 35,35,"Auftrieb in einem Gas:        "
 DrawText 540,210,"-------"
 DrawText 540,230,"-------"
 DrawText 540,250,"-------"
 DrawText 540,270,"-------"
 DrawText 540,290,"-------"
 DrawText 540,310,fdif!
 DrawText 540,330,stat$
 NumWidth 7
 Decimals 4
 TextColor @RGB(0,0,255),-2
 Case @Mouse(530,60-610,75): TextColor @RGB(255,0,0),-2
 DrawText 540,60,Rg!
 TextColor @RGB(0,0,0),-2
 DrawText 540,120,Rm!
 NumWidth 7
 Decimals 2
 TextColor @RGB(0,0,0),-2
 DrawText 540,90,Rf!
 TextColor @RGB(0,0,255),-2
 Case @Mouse(530,180-610,195): TextColor @RGB(255,0,0),-2
 DrawText 540,180,Fm!
 NumWidth 7
 Decimals 4
 Case @and(@Mouse(530,60-610,75),%mousepressed):Let Rg!=@Input$("Gasdichte:","Eingabe Gasdichte",Rg!)
 case @lt(Rg!,0.0001):let Rg!=0.0001
 case @lt(99,Rg!):let Rg!=99
 NumWidth 7
 Decimals 2
 Case @and(@Mouse(530,140-610,155),%mousepressed):Let Am!=@Input$("Körper Grundfläche:","Eingabe Körpergrundfläche",Am!)
 case @lt(Am!,0.01):let Am!=0.01
 case @lt(9999,Am!):let Am!=9999
 let Rm!=@div(@mul(Fm!,1000),@mul(@mul(9.81,hm!),Am!))
 case @lt(99.99,Rm!):let Am!=@div(@mul(Fm!,1000),@mul(@mul(9.81,hm!),99.99))
 Case @and(@Mouse(530,160-610,175),%mousepressed):Let hm!=@Input$("Körper Höhe:","Eingabe Körperhöhe",hm!)
 case @lt(hm!,0.01):let hm!=0.01
 case @lt(9999,hm!):let hm!=9999
 let Rm!=@div(@mul(Fm!,1000),@mul(@mul(9.81,hm!),Am!))
 case @lt(99.99,Rm!):let hm!=@div(@mul(Fm!,1000),@mul(@mul(9.81,Am!),99.99))
 Case @and(@Mouse(530,180-610,195),%mousepressed):Let Fm!=@Input$("Gewichtskraft des Körpers:","Eingabe Gewichtskraft des Körpers",Fm!)
 case @lt(Fm!,0.01):let Fm!=0.01
 case @lt(9999,Fm!):let Fm!=9999
 let Rm!=@div(@mul(Fm!,1000),@mul(@mul(9.81,hm!),Am!))
 case @lt(99.99,Rm!):let Fm!=@div(@mul(Am!,@mul(hm!,@mul(9.81,99.99)))),1000)
 let Rm!=@div(@mul(Fm!,1000),@mul(@mul(9.81,hm!),Am!))
endproc

proc ssimf
 UsePen 0,0,@RGB(255,255,255)
 UseBrush 1,@RGB(255,255,255)
 Rectangle 80,50-290,310
 UsePen 0,0,@RGB(63,63,63)
 UseBrush 1,@RGB(63,63,63)
 Rectangle 80,320-290,330
 UsePen 0,0,@RGB(127,127,127)
 UseBrush 1,@RGB(127,127,127)
 Rectangle 120,330-140,378
 Rectangle 230,330-250,378
 UsePen 0,0,@RGB(60,60,200)
 UseBrush 1,@RGB(60,60,200)
 Rectangle 130,313-240,320
 Rectangle 134,190-128,318
 Rectangle 236,190-242,318
 UsePen 0,0,@RGB(127,127,255)
 UseBrush 1,@RGB(160,160,255)
 Rectangle 236,@sub(240,dfh!)-134,313
 UsePen 0,0,@RGB(255,60,60)
 UseBrush 1,@RGB(255,60,60)
 Rectangle @sub(185,@div(@sqrt(Am!),2),ahp!-@add(185,@div(@sqrt(Am!),2),@add(ahp!,hm!)
 UsePen 0,0,@RGB(0,0,0)
 line 185,ahp!-185,@sub(ahp!,20)
 rahmen 135,@sub(ahp!,20),235,@sub(ahp!,37)
 UseFont "COURIER",12,5,1,0,0
 TextColor @RGB(0,0,0),-2
 Decimals 2
 case @lt(9999,Fanz!):Decimals 0
 case @lt(Fanz!,-999):Decimals 0
 DrawText 150,@sub(ahp!,35),Fanz!
 Decimals 2
 DrawText 220,@sub(ahp!,35),"N"
 UsePen 0,0,@RGB(0,0,0)
 line 185,@sub(ahp!,39)-185,@sub(ahp!,60)
 UsePen 0,20,@RGB(0,0,0)
 line 185,@sub(ahp!,60)-185,@sub(ahp!,60)
 UsePen 0,18,@RGB(127,127,127)
 line 185,@sub(ahp!,60)-185,@sub(ahp!,60)
 UsePen 0,16,@RGB(255,255,255)
 line 185,@sub(ahp!,60)-185,@sub(ahp!,60)
 let ma%=0
 case @and(@Mouse(130,40-240,360),%mousepressed):let ma%=1
 case ma%:let z%=0
 case ma%:let ahp!=@add(%MouseY,60)
 case @lt(260,ahp!):let ahp!=260
 case @lt(ahp!,130):let ahp!=130
 let Fm!=@div(@mul(Am!,@mul(hm!,@mul(9.81,Rm!)))),1000)
 let Fanz!=@sub(Fm!,Fauf!)
 case @lt(240,@add(ahp!,hm!)): Let Ar!=@mul(@sub(@add(ahp!,hm!),240),@sqrt(Am!))
 casenot @lt(240,@add(ahp!,hm!)): Let Ar!=0
 case @lt(@mul(@sqrt(Am!),hm!),Ar!): Let Ar!=@mul(@sqrt(Am!),hm!)
 casenot @lt(@sub(240,hr!),ahp!): let hr!=@div(Ar!,@sub(104,@sqrt(Am!)))
 case @lt(@sub(240,hr!),ahp!): let hr!=@div(@mul(@sqrt(Am!),hm!),104)
 let dfh!=hr!
 casenot @lt(240,@add(ahp!,hm!)):let dfh!=0
 let vvol!=@mul(@sub(@add(ahp!,hm!),@sub(240,hr!)),Am!)
 case @lt(@mul(Am!,hm!),vvol!): Let vvol!=@mul(Am!,hm!)
 casenot @lt(240,@add(ahp!,hm!)): Let vvol!=0
 let Fauf!=@mul(@mul(Rf!,vvol!),0.00981)
 let deep1!=@sub(@add(ahp!,hm!),@sub(240,hr!)
 case @lt(hm!,deep1!): let deep1!=hm!
 case @lt(deep1!,0): let deep1!=0
 let deep2!=@mul(@div(100,hm!),deep1!)
 let Fauf100!=@mul(@mul(Rf!,@mul(Am!,hm!)),0.00981)
 let minv!=@div(Fm!,@mul(Rf!,0.00981))
 let minh!=@div(minv!,Am!)
 let dh!=@sub(@add(ahp!,hm!),@sub(240,dfh!))
 let ha!=@sub(minh!,dh!)
 case @and(@not(%mousepressed),@lt(Fanz!,0)):let ahp!=@add(ahp!,@div(ha!,@sqrt(Am!)))
 case @and(@not(%mousepressed),@and(@lt(Fanz!,0),@lt(@sub(241,dfh!),ahp!))): let ahp!=@sub(ahp!,1)
 let stat$="---------"
 case @lt(0,Fanz!):let stat$="---------"
 case @equ(0,Fanz!):let stat$="schwebt "
 casenot @lt(0,Fanz!):let stat$="schwimmt "
endproc

proc ssimg
 UsePen 0,0,@RGB(255,255,255)
 UseBrush 1,@RGB(255,255,255)
 Rectangle 80,50-290,378
 let Fauf!=@mul(@mul(Rg!,@mul(Am!,hm!)),0.00981)
 let Fdif!=Fauf!
 case @lt(Fauf!,Fm!):let stat$=" sinkend"
 case @lt(Fm!,Fauf!):let stat$=" steigend"
 case @equ(@round(Fauf!,2),@round(Fm!,2)):let stat$="schwebend"
 TextColor @RGB(255,0,0),-1
 CharSet 0
 Orientation 500 ' 30°-Winkel
 UseFont "ARIAL",40,17,1,0,1
 DrawText 85,280,"Nicht Verfügbar"
 TextColor @RGB(31,0,0),-1
 CharSet 0
 Orientation 0 ' 30°-Winkel
 UseFont "ARIAL",20,8,1,0,1
endproc


windowstyle 56
windowtitle ""
settruecolor 1
window 20,20-641,500
cls @rgb(0,0,0)
LoadBmp "HG01.bmp", 0, 0; 0
windowtitle "Simulation für stat. Auftrieb in Flüssigkeiten und Gasen"
' STARTWERTE:
let z%=0
let Rg!=0.01
let Rf!=1.00
let Rm!=3.00
let Am!=100.00
let hm!=5.00
let Fanz!=0.00
let stat$="---------"
let dfh!=0
let ahp!=150
let Fauf!=0
Neuaufbau
NumWidth 7
Decimals 2
Hauptprog:
'mausanzeige
case sim%:simg
case sim%:ssimg
casenot sim%:simf
casenot sim%:ssimf
werte
case @equ(z%,1):let leer%=%mousekey
case @equ(z%,1):let z%=0
case @equ(%mousepressed,1):let z%=1
case @equ(%mousepressed,2):let z%=1
sleep 1
goto "hauptprog"
waitkey
end
 

Ich bitte um die Beachtung des Copyrights bei einer Verbreitung des Programmes (Siehe auch Impressum).
Verbreitung/Änderung/Nutzung etc. nur für Nichtkommerzielle Zwecke erlaubt.
Bei Verbesserung(svorschläg)en können mir diese gerne geschickt werden - ich bin offen für alles!

(Code und .EXE-File Downloadbar unter Downloads)

Copyright by Johannes Walk (C) 2002-2006
www.walktronics.com

-