FreeBASIC マニュアルのトップに戻る

FreeBASIC terminal velocity sim

目次→フォーラム→FreeBASIC→補足terminal velocity : fireworks ←オリジナル・サイト

花火? 左にメニュー・フレームが表示されていない場合は、ここをクリックして下さい

←リンク元に戻る プログラム開発関連に戻る

花火  dodicat さんの 花火? プログラムです。
 重力を考慮した物理現象です。

注:FreeBASIC 1.08〜 で、SetEnviron を追加しなくても、日本語環境で描画画面が表示されるように改善されました。
'terminal velocity sim
'by dodicat ≫ Feb 07, 2012 21:13
'https://www.freebasic.net/forum/viewtopic.php?f=7&t=19341#p170576

' Sets the graphics method GDI
' 描画方法を GDI に設定
SetEnviron("fbgfx=GDI")
 
Dim As Integer xres,yres
Screen 20
ScreenInfo xres,yres

Const k=1   
Const g=9.81  '重力 gravity
Const m=5     '質量 mass
Const v=200   '初速 initial velocity
Const w=0     '風速 windspeed

Dim As Any Pointer im=ImageCreate(xres,yres,0)
Type v2
    As Single x,y
End Type
#define r(f,l) Rnd * ((l) - (f)) + (f)
Dim As Integer n=100
Dim As v2 startpos,position,lastposition
ReDim Shared As v2 b()
ReDim Shared As Single ang(),vel(),rad()

#Macro setup(n)
ReDim b(1 To n)
ReDim rad(1 To n)
ReDim vel(1 To n)
ReDim ang(1 To n)
For z As Integer=1 To n
    rad(z)=(8-3)*(z-1)/(n-1)+3
    ang(z)=r(0,360)
    ang(z)=ang(z)*(4*Atn(1))/180
    vel(z)=r(10,50)
  Next z
  #EndMacro
 
  setup(n)
startpos=Type(100,0)

Dim As Single theta=60  '発射角 initial angle
theta=theta*(4*Atn(1))/180 'ラジアン degrees to radians
Dim As Single t,y,zz
Do
Do
  t=t+.03 
    position.x=startpos.x+(m/k)*(1-Exp(-(k/m)*t))*(V*Cos(theta)-w)+w*t
    position.y=startpos.y+(m/k)*(1-Exp(-(k/m)*t))*(V*Sin(theta)+g*m/k)-(g*m/k)*t
    ScreenLock
    Cls
    Put(0,0),im
    PSet im,(position.x,yres-position.y),2
    Circle (position.x,yres-position.y),5,4,,,,f
        If position.y<lastposition.y Then
        ScreenUnlock
        startpos=Type(position.x,position.y)
        t=0
        Do
            t=t+.03
            ScreenLock
            Cls
            Put(0,0),im
            For z As Integer=1 To n
b(z)=Type(startpos.x+(m/k)*(1-Exp(-(k/m)*t))*(vel(z)*Cos(ang(z))-w)+w*t,_
       startpos.y+(m/k)*(1-Exp(-(k/m)*t))*(vel(z)*Sin(ang(z))+g*m/k)-(g*m/k)*t)
       Circle(b(z).x,yres-b(z).y),rad(z),z,,,,f
       PSet im,(b(z).x,yres-b(z).y),z
       If y<b(z).y Then y=b(z).y:zz=z
   Next z
   ScreenUnlock
   Sleep 1,1
   If InKey=Chr(27) Then Exit Do,Do,Do
   If b(zz).y<0 Then Exit Do,Do
   Loop
        End If
    lastposition=position
    ScreenUnlock
    Sleep 1,1
Loop

Randomize
startpos=Type(r(.4*xres,.6*xres))
theta=r(70,110)
theta=theta*(4*Atn(1))/180 'degrees to radians
n=r(250,450)
y=0
setup(n)
lastposition=startpos
ImageDestroy(im)
im=ImageCreate(xres,yres,0)
t=0
Loop Until InKey=Chr(27)
ImageDestroy(im)
 
補足 に戻る
←リンク元に戻る プログラム開発関連に戻る
ページ歴史:2012-02-07
日本語翻訳:WATANABE Makoto、原文著作者:dodicat

ホームページのトップに戻る

表示-非営利-継承