Форум программистов, компьютерный форум, киберфорум
Наши страницы
Basic
Войти
Регистрация
Восстановить пароль
Другие темы раздела
Basic Найти квадраты нечетных чисел в множестве http://www.cyberforum.ru/basic/thread682843.html
задано множество целых чисел, как в этом множестве найти удвоенные нечетные числа. например:дано мн-во {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,25,26.........}, где ...
Basic Перевод текстового значения в числовое в Small Basic
К сожалению не нашел раздела для Small Basic. Пользователь вводит какие-либо цифры, переменная отвечающая за текст считывает их, затем необходимо перевести их в числовое значение. Считывать сразу...
Макрос замены четных и нечетных слов местами Basic
помогите пожалуйста с таким заданием "сделать макрос для обмена четных и нечетных слов местами" заранее спасибо
Basic С помощью программы magnetism определите силовые линии магнитиого поля круговой петли с током Здравствуйте, помогите с решением одной программкой, есть у меня такая программка которая по задачке в ней "рассматривается круговая петля с током в плоскости x-z и рисуются силовые линии магнитного... http://www.cyberforum.ru/basic/thread677949.html
Basic Как определить ОС и имя пользователя http://www.cyberforum.ru/basic/thread676982.html
и имя пользователя. Так же хотелось бы узнать, где находится каталог с данными приложений.
Basic Создание раздела FreeBasic (голосование)
Приветствую всех форумчан!:) Многие из вас, наверное, заметили, что на форуме слишком мало подразделов языка Бейсик, особенно если сравнивать с Паскалем и си, в которых существуют свободные...
Самоуничтожения программы Basic
Здравствуйте, есть программа самоуничтожения программы при помощи bat файла на Дельфи кто-то делал на ВБ6? в чём там принцип? в ней четыре файла Unit1.dfm Unit1.pas Project1.dpr Project1.res...
Basic Mobile Basic: как найти длину строки Не нашел в списке такого ЯП, думаю, в этом разделе будет правильно задать вопрос. Вообщем, есть код, который позволяет выводить кириллицу в строках на экран: sub main a$ = "это моя контрольная... http://www.cyberforum.ru/basic/thread668460.html
Basic Открыть нужный html файл в IE и нажать кнопку в его MsgBox http://www.cyberforum.ru/basic/thread663085.html
Здравствуйте, пробую так Sub Открыть_нужный_html_файл() Dim IE As Object Set IE = CreateObject("InternetExplorer.Application") IE.Navigate "J:\Просмотровщик дисков, папок, файлов.html",...
Basic Определить название месяца выбранного дня Доброе время суток помогите решить задачки пожалуйста. 1. По названию введенной физической величины, характеризующей движение тела (координата, скорость, ускорение, время, сила) вывести ее... http://www.cyberforum.ru/basic/thread658545.html
stabud
122 / 49 / 1
Регистрация: 26.10.2012
Сообщений: 84
01.11.2012, 11:49 0

Графика FreeBasic

01.11.2012, 11:49. Просмотров 6212. Ответов 34
Метки (Все метки)

Ответ

Небольшой пример, мне лично понравился. Не боимся палочку поднимать мышкой, сгибать и пр.

Автор: h4tt3n

PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
''  Michael "h4tt3n" Nissen's spring simulation
''  this simulation shows how to simulate a spring and how to reduce its
''  movement with dampers and friction forces.
''  This example also includes angular springs, which makes it possible 
''  to simulate non-rigid objects like hair strains, straw, fishing rods ect...
 
Type Vector_2D
  As Double X, Y
End Type
 
Type Mass
  As Double Mass, radius
  As Vector_2D Pos, Vel, Acc
End Type 
 
const pi = 4*Atn(1)
const degtorad = pi/180
Const Num_Masses = 10         ''  number of point masses in rope
Const Rope_Length = 600       ''  rope length in pixels
Const Spring_Stiffnes = 6e3   ''  spring stiffnes. Higher = harder spring
const Angular_Stiffnes = 15e5 ''  spring angular stiffnes ie "bendability"
Const Time_Scale = 0.01       ''  timestep. Smaller = more accurate but slower
Const G_Acc = 600             ''  gravity
const Air_Friction = 0.01     ''  air friction / drag
const wall_friction = 0.75    ''  wall friction
const Int_Friction = 0.2      ''  internal friction
const Spring_Damping = 4      ''  damping
const pick_mindist = 32       ''  minimum mouse pick up distance
 
Dim As Vector_2D Dist, Dist_1, Dist_2, vel
Dim As Mass Mass(1 to Num_Masses)
Dim As Double Force, Force_1, Force_2, Distance, Distance_1, Distance_2, _
velocity, Cos_Angle, Sin_Angle, spring_angle, cos_spring_angle, sin_spring_angle, _
temp_dist, Spring_Length
Dim As Integer i, i2, i3, scrn_wid, scrn_hgt, Mouse_x, Mouse_y, Mouse_Btn, _
pick_state, picked
 
ScreenInfo Scrn_wid, scrn_hgt
ScreenRes scrn_wid, scrn_hgt, 16,, 1
 
''  initialize springs
spring_angle = 0
Cos_Spring_Angle = Cos(Spring_Angle*degtorad)
Sin_Spring_Angle = Sin(Spring_Angle*degtorad)
Spring_Length = Rope_Length/Num_Masses
 
For i = Lbound(Mass) To Ubound(Mass)
  With Mass(i)
    .Mass = 1
    .radius = 3
    .Pos.x = (Scrn_wid\3) + (i*Spring_Length)
    .pos.y = (Scrn_hgt\3)
  End With
Next
 
Do
  
  ''  bend spring left / right with leftarrow / rightarrow
  If Multikey(&h4b) Then 
    Spring_angle += 1
    Cos_Spring_Angle = Cos(Spring_Angle*degtorad)
    Sin_Spring_Angle = Sin(Spring_Angle*degtorad)
  End If
 
  If Multikey(&h4d) Then 
    Spring_angle -= 1
    Cos_Spring_Angle = Cos(Spring_Angle*degtorad)
    Sin_Spring_Angle = Sin(Spring_Angle*degtorad)
  End If
  
  ''  Increase / decrease spring length with uparrow / downarrow
  If Multikey(&h48) Then Spring_Length += 1
  
  If Multikey(&h50) Then 
    Spring_Length -= 1
    If Spring_Length < 32 Then Spring_length = 32
  End If
  
  ''  apply forces to every mass
  For i = Lbound(Mass) To Ubound(Mass)
    With Mass(i)
      
      ''  gravity
      .Acc.Y += G_acc
      
      ''  air friction
      .Acc.X -= Air_Friction*.Vel.X
      .Acc.Y -= Air_Friction*.Vel.Y
      
    End With
  Next
  
  ''  axial spring force
  For i = Lbound(Mass) To Ubound(Mass)-1
    
    i2 = i+1
    
    ''  find distance between mass i and i2, ie. the spring length (Pythagoras)
    Dist.X = Mass(i2).Pos.X-Mass(i).Pos.X
    Dist.Y = Mass(i2).Pos.Y-Mass(i).Pos.Y
    Distance = Sqr(Dist.X*Dist.X+Dist.Y*Dist.Y)
    
    ''  find relative velocity of mass compared to its neigbour
    Vel.X = Mass(i2).Vel.X-Mass(i).Vel.X
    Vel.Y = Mass(i2).Vel.Y-Mass(i).Vel.Y
    
    ''  find spring force (Hooke's law)
    Force = -Spring_Stiffnes*(Distance-Spring_Length)
    
    ''  spring damping (scalar projection of velocity vector onto spring)
    Force -= Spring_Damping*((vel.x*dist.x+vel.y*dist.y)/Distance)
    
    ''  accelerate masses (acceleration = force / mass)
    Mass(i).Acc.X -= (Force/Mass(i).mass)*(Dist.X/Distance)
    Mass(i).Acc.Y -= (Force/Mass(i).mass)*(Dist.Y/Distance)
    Mass(i2).Acc.X += (Force/Mass(i2).mass)*(Dist.X/Distance)
    Mass(i2).Acc.Y += (Force/Mass(i2).mass)*(Dist.Y/Distance)
    
    ''  internal friction
    Mass(i).Acc.X += Int_Friction*Vel.X
    Mass(i).Acc.Y += Int_Friction*Vel.Y
    Mass(i2).Acc.X -= Int_Friction*Vel.X
    Mass(i2).Acc.Y -= Int_Friction*Vel.Y
    
  Next
  
  ''  angular spring force
  For i = Lbound(Mass) to Ubound(Mass)-2
    i2 = i+1
    i3 = i+2
    
    Dist_1.X = Mass(i2).Pos.X-Mass(i).Pos.X
    Dist_1.Y = Mass(i2).Pos.Y-Mass(i).Pos.Y
    Distance_1 = Sqr(Dist_1.X*Dist_1.X+Dist_1.y*Dist_1.Y)
    
    Dist_2.X = Mass(i2).Pos.X-Mass(i3).Pos.X
    Dist_2.Y = Mass(i2).Pos.Y-Mass(i3).Pos.Y
    Distance_2 = Sqr(Dist_2.X*Dist_2.X+Dist_2.Y*Dist_2.Y)
    
    ''  cosine of the angle between springs.
    ''  keeps springs at a 90 / 270 deg angle (perpendicular).
    Cos_angle = (Dist_1.x*Dist_2.x+Dist_1.y*Dist_2.Y)/(Distance_1*Distance_2)
    
    ''  sine of the angle between springs.
    ''  keeps springs at a 0 / 180 deg angle (parallel).
    Sin_angle = (Dist_1.x*Dist_2.y-Dist_1.y*Dist_2.x)/(Distance_1*Distance_2)
    
    ''  angular spring force
    Force = Angular_Stiffnes*(Cos_Spring_Angle*Sin_Angle+Sin_Spring_Angle*Cos_angle)
    
    ''  angular accelleration. Apply force perpendicular to spring axis.
    Force_1 = Force/Distance_1
    Mass(i).Acc.X -= (Force_1/Mass(i).Mass)*(Dist_1.y/Distance_1)
    Mass(i).Acc.y -= (Force_1/Mass(i).Mass)*(-Dist_1.x/Distance_1)
    Mass(i2).Acc.X += (Force_1/Mass(i2).Mass)*(Dist_1.y/Distance_1)
    Mass(i2).Acc.y += (Force_1/Mass(i2).Mass)*(-Dist_1.x/Distance_1)
    
    Force_2 = Force/Distance_2
    Mass(i2).Acc.X -= (Force_2/Mass(i2).Mass)*(Dist_2.y/Distance_2)
    Mass(i2).Acc.y -= (Force_2/Mass(i2).Mass)*(-Dist_2.x/Distance_2)
    Mass(i3).Acc.X += (Force_2/Mass(i3).Mass)*(Dist_2.y/Distance_2)
    Mass(i3).Acc.y += (Force_2/Mass(i3).Mass)*(-Dist_2.x/Distance_2)
    
  Next
  
  ''  gravity and friction
  ''  update movement (Euler 1st order integration algorithm)
  For i = Lbound(Mass) To Ubound(Mass)
    With Mass(i)
      
      ''  update velocity (velocity = acceleration * delta time)
      .Vel.X += .Acc.X*Time_Scale
      .Vel.Y += .Acc.Y*Time_Scale
      
      ''  update position (position = velocity * delta time)
      .Pos.X += .Vel.X*Time_Scale
      .Pos.Y += .Vel.Y*Time_Scale
      
      ''  reset acceleration
      .acc.x = 0
      .acc.y = 0
      
    End With
  Next
  
  ''  on leftmouse, pick up closest mass within reach
  Getmouse Mouse_X, Mouse_Y,, Mouse_Btn
  If Mouse_Btn = 1 Then 
    If Pick_State = 0 Then
      Temp_Dist = Pick_MinDist
      For i = Lbound(mass) To Ubound(mass) 
        Dist.X = mass(i).Pos.X-Mouse_X
        Dist.Y = mass(i).Pos.Y-Mouse_Y
        Distance = Sqr(Dist.X*Dist.X+Dist.Y*Dist.Y)
        If Distance < Temp_Dist Then 
          Temp_Dist = Distance
          Picked = i
        End If
      Next
      If Picked <> -1 Then
        Pick_State = 1
      End If
    Else
      mass(Picked).Vel.X = 0
      mass(Picked).Vel.Y = 0
      mass(Picked).Pos.X = Mouse_X
      mass(Picked).Pos.Y = Mouse_Y
    End If
  Else
    Pick_State = 0
    Picked = -1
  End If
  
  ''  keep masses within screen
  ''  wall friction
  For i = Lbound(Mass) To Ubound(mass)
    
    With mass(i)
      
      If .Pos.x >= Scrn_wid-.Radius-1 Then
        .Vel.X *= Wall_Friction
        .Vel.Y *= Wall_Friction
        .Pos.x = Scrn_wid-.Radius-1
        .Vel.X = -.Vel.X
      Elseif .Pos.x <= .Radius Then
        .Vel.X *= Wall_Friction
        .Vel.Y *= Wall_Friction
        .Pos.x = .Radius
        .Vel.X = -.Vel.X
      End If
      If .Pos.y >= Scrn_hgt-.Radius-1 Then
        .Vel.X *= Wall_Friction
        .Vel.Y *= Wall_Friction
        .Pos.y = Scrn_hgt-mass(i).Radius-1
        .Vel.Y = -.Vel.Y
      Elseif .Pos.y <= .Radius Then
        .Vel.X *= Wall_Friction
        .Vel.Y *= Wall_Friction
        .Pos.y = .Radius
        .Vel.Y = -.Vel.Y
      End If
      
    End With
    
  Next
  
  ''  clear screen and draw new image
  ScreenLock
    
    Cls
    
    ''  draw springs
    For i = Lbound(Mass) To Ubound(Mass)-1
      
      i2 = i+1
      
      Line (Mass(i).Pos.X, Mass(i).Pos.Y)-(Mass(i2).Pos.X, Mass(i2).Pos.Y), Rgb(32, 255, 32)
      
    Next i
    
    ''  draw masses
    For i = Lbound(Mass) To Ubound(Mass)
      
      Circle (Mass(i).Pos.X, Mass(i).Pos.Y), Mass(i).Radius, RGB(255, 32, 32),,, 1, F
      
    Next i
    
    Locate 2, 2: Print "use left- / rightarrow to change spring angle"
    Locate 4, 2: Print "use up- / downarrow to change spring length"
    Locate 6, 2: Print "Use mouse to pick up and interact with masses"
    Locate 8, 2: Print Using "Spring angle:  #####"; Spring_Angle
    Locate 10, 2: Print Using "Spring length: #####"; Spring_length
    
  ScreenUnlock
  
  Sleep 1, 1
  
Loop Until Multikey(1)
 
End


Вернуться к обсуждению:
Графика FreeBasic
2
Миниатюры
Графика FreeBasic  
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
01.11.2012, 11:49

FreeBasic круги на воде
Очень интересный код имитирующий распространение кругов на воде. Описание алгоритма тут Что меня...

Задача на графику в FreeBASIC
Помогите с задача по графике в FreeBASIC Построить совокупность n равных отрезков, центры которых...

FreeBasic. MyFbFramework + VisualFBEditor
Начал новый фреймворк для FreeBasic: MyFbFramework И редактор для него: VisualFBEditor Файлы...

0
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.
Рейтинг@Mail.ru