Тело. :-)

Ranger11 · 27.05.2010

Здравствуйте.Пробую программировать.И вот такая проблемка тело двигается вдоль прямо x,нажимаю например на кнопку и оно должно самостоятельно двигаться.А у меня получается что я нажимаю на кнопку и она делает шаг и всё.

Подскажите как исправить ошибку.Заранее большое спасибо.

Tanya · 28.05.2010

На форме располагаем следующие элементы управления:
CommandButton с именем cmd (Top = 360, Height=375)
Timer с именем Timer1
PictureBox с именем Picture1

Код:

Option Explicit


Private S As Double
Private R As Double
Private d As Double
Private da As Double
Private bR As Boolean

Private Sub cmd_Click()
If Me.Timer1.Interval > 0 Then
Me.Timer1.Interval = 0
Else
Me.Timer1.Interval = 10
End If
End Sub

Private Sub Form_Load()
R = 200
d = 20
End Sub

Private Sub Form_Resize()
If Me.WindowState <> vbMinimized Then
Me.Picture1.Move 60, 1200, Me.Width - 220, Me.Height - 2000
bR = True
End If
End Sub

Private Sub Picture1_Paint()
Dim y As Double
Dim w As Double
Dim b As Long
Dim x1 As Double, x2 As Double
Dim r1 As Double
Dim c As Double

y = Me.Picture1.Height * 0.5
w = 100

Me.Picture1.ForeColor = Me.ForeColor
b = Me.Picture1.ForeColor
Me.Picture1.FillStyle = vbFSSolid

x1 = 0
x2 = Me.Picture1.Width

If bR Then

bR = False

Else

Me.Picture1.Line (S - d - R, y + R)-(S - d + R, y - R), Me.Picture1.BackColor, BF 

End If


Me.Picture1.ForeColor = vbWhite

Me.Picture1.DrawWidth = 1
Me.Picture1.Line (x1, y - w)-(x2, y + w), , BF
Me.Picture1.ForeColor = b

Me.Picture1.DrawWidth = 2
Me.Picture1.Line (x1, y - w)-(x2, y - w)
Me.Picture1.Line (x1, y + w)-(x2, y + w)

Me.Picture1.DrawWidth = 1
Me.Picture1.DrawStyle = vbDash
Me.Picture1.Line (x1, y)-(x2, y)

Me.Picture1.DrawStyle = vbSolid
Me.Picture1.FillColor = RGB(255, 200, 200)
Me.Picture1.Circle (S + R, y), R, RGB(255, 180, 180)

c = 10
r1 = 0.3 * R
Me.Picture1.FillColor = RGB(255, 220, 220)
Me.Picture1.ForeColor = Me.Picture1.FillColor
Me.Picture1.Circle (S + R + (R - r1 - c) * Sin(da), y + (R - r1 - c) * Cos(da)), r1 ', RGB(255, 0, 0)

c = c + 0.7 * r1
r1 = 0.3 * r1
Me.Picture1.FillColor = RGB(255, 240, 240)
Me.Picture1.ForeColor = Me.Picture1.FillColor
Me.Picture1.Circle (S + R + (R - r1 - c) * Sin(da), y + (R - r1 - c) * Cos(da)), r1 ', RGB(255, 0, 0)


End Sub

Private Sub Timer1_Timer()
If S + d + R <= Me.Picture1.Width Then
S = S + d
Else
S = R
End If

da = da - 0.1

Me.Picture1.Refresh
End Sub

Ranger11 · 29.05.2010

Tanya сказал(а):
Option Explicit

Private S As Double
Private R As Double
Private d As Double
Private da As Double
Private bR As Boolean

Private Sub cmd_Click()
If Me.Timer1.Interval > 0 Then
Me.Timer1.Interval = 0
Else
Me.Timer1.Interval = 10
End If
End Sub

Private Sub Form_Load()
R = 200
d = 20
End Sub

Private Sub Form_Resize()
If Me.WindowState <> vbMinimized Then
Me.Picture1.Move 60, 1200, Me.Width - 220, Me.Height - 2000
bR = True
End If
End Sub

Private Sub Picture1_Paint()
Dim y As Double
Dim w As Double
Dim b As Long
Dim x1 As Double, x2 As Double
Dim r1 As Double
Dim c As Double

y = Me.Picture1.Height * 0.5
w = 100

Me.Picture1.ForeColor = Me.ForeColor
b = Me.Picture1.ForeColor
Me.Picture1.FillStyle = vbFSSolid

x1 = 0
x2 = Me.Picture1.Width

If bR Then

bR = False

Else

Me.Picture1.Line (S - d - R, y + R)-(S - d + R, y - R), Me.Picture1.BackColor, BF

End If

Me.Picture1.ForeColor = vbWhite

Me.Picture1.DrawWidth = 1
Me.Picture1.Line (x1, y - w)-(x2, y + w), , BF
Me.Picture1.ForeColor = b

Me.Picture1.DrawWidth = 2
Me.Picture1.Line (x1, y - w)-(x2, y - w)
Me.Picture1.Line (x1, y + w)-(x2, y + w)

Me.Picture1.DrawWidth = 1
Me.Picture1.DrawStyle = vbDash
Me.Picture1.Line (x1, y)-(x2, y)

Me.Picture1.DrawStyle = vbSolid
Me.Picture1.FillColor = RGB(255, 200, 200)
Me.Picture1.Circle (S + R, y), R, RGB(255, 180, 180)

c = 10
r1 = 0.3 * R
Me.Picture1.FillColor = RGB(255, 220, 220)
Me.Picture1.ForeColor = Me.Picture1.FillColor
Me.Picture1.Circle (S + R + (R - r1 - c) * Sin(da), y + (R - r1 - c) * Cos(da)), r1 ', RGB(255, 0, 0)

c = c + 0.7 * r1
r1 = 0.3 * r1
Me.Picture1.FillColor = RGB(255, 240, 240)
Me.Picture1.ForeColor = Me.Picture1.FillColor
Me.Picture1.Circle (S + R + (R - r1 - c) * Sin(da), y + (R - r1 - c) * Cos(da)), r1 ', RGB(255, 0, 0)

End Sub

Private Sub Timer1_Timer()
If S + d + R <= Me.Picture1.Width Then
S = S + d
Else
S = R
End If

da = da - 0.1

Me.Picture1.Refresh
End Sub

Дорогая Таня.А если тело движется равномерно.И через определённое время с тела как бы капает капля и падая на прямую фиксирует его координату.Например dt=1 c.Тем самым на PictureBox надо разместить координатную прямую или опустить ту,по которой движется тело?

Tanya · 02.06.2010

Ranger11 сказал(а):
Дорогая Таня.А если тело движется равномерно.И через определённое время с тела как бы капает капля и падая на прямую фиксирует его координату.Например dt=1 c.Тем самым на PictureBox надо разместить координатную прямую или опустить ту,по которой движется тело?

В примере тело движется равномерно. Если что, меняйте скорость в таймере.
"Как бы падает капля и падая на прямую ..." - очень поэтично )))
Размещать координатную прямую или опускать существующую - дело ваше )))
Я думаю, что пример достаточно развернут, чтобы из него сделать все что вам нужно.

<offtop>To Saxol: работа, работа и еще раз работа :ya_lamo: </offtop>

Все сервисы Codeby

Поиск

Поиск

Тело. :-)

Ranger11

Tanya

Ranger11

Tanya