Движение точки на PIcture

@didimozg · Регистрация: 22.04.2014

Студворк — интернет-сервис помощи студентам

День добрый.

Задача:
на Picture сгенерировать 10000 точек.
затем по траектории, выраженной функцией, провести новую точку. и в радиусе 20 точек от этой новой закрашивать ранее сгенерированные точки.
Код:

Кликните здесь для просмотра всего текста

Visual Basic
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
Dim x(1 To 10000) As Integer, y(1 To 10000) As Integer
Dim i As Long, j As Long
 
Private Sub Command1_Click()
 
For i = 1 To 10000
    x(i) = Rnd * Picture1.ScaleWidth
    y(i) = Rnd * Picture1.ScaleHeight
    Picture1.PSet (x(i), y(i)), vbWhite
Next i
i = 0
Timer1.Enabled = True
 
End Sub
 
Private Sub Timer1_Timer()
    Dim polet(0 To 10000) As Single
 
    If i <= Picture1.ScaleWidth Then
        polet(i) = 2 * Sin(i / 2) + (1 / 2) * Cos(2 * i)
        Picture1.Circle (i, polet(i) + 150), 1, vbWhite
        If i > 1 Then Picture1.Circle (i - 1, polet(i - 1)), 1, vbBlack
        For j = 0 To 20
            Picture1.PSet (i, polet(i) + 150), vbBlack
            Picture1.PSet (i, polet(i) + j + 150), vbBlack
            Picture1.PSet (i, polet(i) - j + 150), vbBlack
        Next j
 
        i = i + 1
    Else
        Timer1.Enabled = False
    End If
End Sub

ScaleWidth=300
ScaleHeight=300

Но у меня возникло две проблемы:
1. Как закрасить предыдущую позицию точки?
2. Как удалить точки перед движением новой? т.е. удалять перед самым носом получается, но как сделать, что б на указанные 20 точек вперед тоже очищалось?

И еще вопросик: как сделать закрашенный круг? но это пока так, влом лезть в справку. на него можно и не отвечть

SoftIce · 28.04.2014, 14:06

Сообщение от didimozg

по траектории, выраженной функцией

какая функция?

@didimozg · 28.04.2014, 14:10 **[ТС]**

y=2 * Sin(x / 2) + (1 / 2) * Cos(2 * x)
x от 0 до конца picture

@Казанский · 28.04.2014, 14:32

Пробуйте - полет по фигуре Лиссажу

Visual Basic
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
Option Explicit
 
Dim i As Long, j As Long, x#(0 To 10000), y#(0 To 10000), xx#, yy#
 
Private Sub Command1_Click()
Picture1.Scale (-1.1, -1.1)-(1.1, 1.1)
For i = 1 To 10000
    x(i) = Rnd * 2.2! - 1.1!
    y(i) = Rnd * 2.2! - 1.1!
    Picture1.PSet (x(i), y(i)), vbWhite
Next i
i = 0
Timer1.Interval = 50
Timer1.Enabled = True
 
End Sub
 
Private Sub Timer1_Timer()
    xx = Sin(Timer)
    yy = Cos(Timer * 2.5)
    For i = 1 To 10000
      If (x(i) - xx) ^ 2 + (y(i) - yy) ^ 2 < 0.01 Then
        Picture1.PSet (x(i), y(i)), vbRed
      Else
        Picture1.PSet (x(i), y(i)), vbWhite
      End If
    Next
End Sub

@didimozg · 28.04.2014, 14:57 **[ТС]**

Казанский, офигенно.
но немножко не то.

давай так.
Есть точки. туева куча. в размере 10000.
есть круг. радиусом 20 точек.
И вот этот круг должен пройти по всей длине Picture. При этом должен отрисовываться центр круга. А все что находиться внутри круга - удаляться. Позиция центра круга определяетяся по координатам X и Y. X от 0, Y по формуле

Ссылка удалена, читайте п 4.12. и это

у меня остается след движения этого круга. а должно отображаться только текущее местоположение центра круга.
Надеюсь, немного понятней объяснил задачу

Добавлено через 12 минут

Visual Basic
1
2
3
y(x) = 2 * Sin(x / 2) + (1 / 2) * Cos(2 * x)
        Picture1.Circle (x, y(x) + 150), 1, vbWhite
        If x > 1 Then Picture1.Circle (x - 1, y(x - 1) + 150), 1, vbBlack

Вот же я ему говорю: нарисуй белый круг на шаге 0.
начиная со следующего шага рисуй новый круг, а старый зарисуй черным

@didimozg · 28.04.2014, 15:12 **[ТС]**

вот тут показано как оно рисуется у меня сейчас.

ВО первых перед кругом нет зазора в 20 точек по Х.
хм. стал зарисовывать за собой.
но вот пропускает кое какие точки в радиусе 20. где все должно быть черно.

Кликните здесь для просмотра всего текста

Visual Basic
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
Dim x(1 To 10000) As Integer, y(1 To 10000) As Integer
Dim i As Long, j As Long
Dim polet(0 To 10000) As Single
 
Private Sub Command1_Click()
 
For i = 1 To 10000
    x(i) = Rnd * Picture1.ScaleWidth
    y(i) = Rnd * Picture1.ScaleHeight
    Picture1.PSet (x(i), y(i)), vbWhite
Next i
i = 0
Timer1.Enabled = True
 
End Sub
 
Private Sub Timer1_Timer()
    
    If i <= Picture1.ScaleWidth Then
        polet(i) = 2 * Sin(i / 2) + (1 / 2) * Cos(2 * i)
        Picture1.Circle (i, polet(i) + 150), 1, vbWhite
        If i > 1 Then Picture1.Circle (i - 1, polet(i - 1) + 150), 1, vbBlack
        For j = 0 To 20
            Picture1.PSet (i, polet(i) + 150), vbBlack
            Picture1.PSet (i, polet(i) + j + 150), vbBlack
            Picture1.PSet (i, polet(i) - j + 150), vbBlack
 
        Next j
 
        i = i + 1
    Else
        Timer1.Enabled = False
        Form1.Caption = "Óñ¸"
    End If
End Sub

@The trick · 28.04.2014, 15:17

didimozg, можешь рисовать посредством vbXorPen, тогда просто рисуешь еще раз и фон восстановится, либо отрисовывывай в отдельный битмап и каждый раз перерисовывай все, либо сохраняй кусочек изображения, а потом восстанавливай.

SoftIce · 28.04.2014, 16:01

Сообщение от didimozg

закрашивать ранее сгенерированные точки

Обращаю Ваше внимание, что точки нужно закрашивать, а не стирать их .

@didimozg · 28.04.2014, 16:20 **[ТС]**

SoftIce, Спасибо.
Как раз почти такой же код написал. Не так изящно, но все же
Но есть одна маленькая загвоздка: нужен круг радиусом 2, который движется от Х=0.
У Вас сделана точка. Это, к сожалению не канает

Visual Basic
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
Dim x(1 To 10000) As Integer, y(1 To 10000) As Integer
Dim i As Long, j As Long
Dim polet(0 To 10000) As Single
 
Private Sub Command1_Click()
 
For i = 1 To 10000
    x(i) = Rnd * Picture1.ScaleWidth
    y(i) = Rnd * Picture1.ScaleHeight
    Picture1.PSet (x(i), y(i)), vbWhite
Next i
i = 0
    Timer1.Enabled = True
End Sub
 
Private Sub Timer1_Timer()
    Picture1.FillStyle = 0
    If i <= Picture1.ScaleWidth + 30 Then
        polet(i) = 2 * Sin(i / 2) + (1 / 2) * Cos(2 * i)
        
        For j = 0 To 20
            Picture1.FillColor = vbBlack
            Picture1.Circle (i, polet(i) + 150), 20, vbBlack
            Picture1.FillColor = vbWhite
            Picture1.Circle (i - 19, polet(i - 19) + 150), 2, vbWhite
        Next j
 
        i = i + 1
    Else
        Timer1.Enabled = False
    End If
End Sub

хм. больше на птичку похоже. но уже что то.
Как сделать, что б это было похоже именно на круг?

SoftIce · 28.04.2014, 16:30

Сообщение от didimozg

затем по траектории, выраженной функцией, провести новую точку

Сообщение от didimozg

нужен круг радиусом 2, который движется от Х=0

Ты уж определись, что тебе нужно....
С кругом еще легче

@The trick · 28.04.2014, 16:42

Сообщение от The trick

либо сохраняй кусочек изображения, а потом восстанавливай.

Если я правильно тебя понял тебе нужно это.

Visual Basic
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
Dim x(1 To 10000) As Integer, y(1 To 10000) As Integer
Dim i As Long, j As Long
Dim polet(0 To 10000) As Single
 
Private Sub Command1_Click()
    
    Picture1.AutoRedraw = True
    For i = 1 To 10000
        x(i) = Rnd * Picture1.ScaleWidth
        y(i) = Rnd * Picture1.ScaleHeight
        Picture1.PSet (x(i), y(i)), vbWhite
    Next i
    
    i = 0
    Timer1.Enabled = True
 
End Sub
 
Private Sub Form_Load()
    Dim buf As PictureBox
    
    Set buf = Me.Controls.Add("VB.PictureBox", "img")
    buf.AutoRedraw = True
    buf.ScaleMode = vbPixels
    buf.BorderStyle = 0
    buf.Move 0, 0, ScaleX(40, vbPixels, ScaleMode), ScaleX(40, vbPixels, ScaleMode)
End Sub
 
Private Sub Timer1_Timer()
    Static ox As Single, oy As Single
    Dim x As Single, y As Single, dx As Single, _
        dy As Single, px As Single, py As Single, _
        sx As Single, sy As Single, buf As PictureBox
    
    sx = Picture1.ScaleX(1, vbPixels, vbUser)
    sy = Picture1.ScaleY(1, vbPixels, vbUser)
    Set buf = Me.Controls("img")
    
    If i <= Picture1.ScaleWidth Then
        
        x = i
        y = 20 * Sin(i / 2) + 0.5 * Cos(2 * i) + 150
        
        px = Picture1.ScaleX(x, vbUser, vbPixels): py = Picture1.ScaleY(y, vbUser, vbPixels)
        
        If i Then Picture1.PaintPicture buf.Image, ox - sx * 20, oy - sy * 20, sx * 40, sy * 40, 0, 0, sx * 40, sy * 40
        buf.PaintPicture Picture1.Image, 0, 0, 40, 40, px - 20, py - 20, 40, 40
 
        Picture1.FillStyle = vbSolid
        Picture1.Circle (x, y), sx * 18, vbBlack
        Picture1.FillStyle = vbTransparent
        Picture1.Circle (x, y), 2, vbWhite
        
        oy = y: ox = x
        i = i + 1
    Else
        Timer1.Enabled = False
        Form1.Caption = "Óñ¸"
    End If
End Sub

@didimozg · 28.04.2014, 16:54 **[ТС]**

SoftIce, Спасибо. То что надо. А вообще я ж во втором сообщении уточнился.

итоговое, что я хотел. осталось только с масштабом разобраться

ВложениеНовая папка.rar

SoftIce · 28.04.2014, 16:59

x это от 0 до 300
а от -150 до 150 это у.
ScreenHeight все равно получается 300, но зато точка движется посередине , а не где-то вверху.

@didimozg · 28.04.2014, 17:00 **[ТС]**

SoftIce, как раз допер сам))).
Большое спасибо за помощь

Новые блоги и статьи Все статьи Все блоги /
Модульный подход на примере F# DevAlt 06.03.2026 В блоге дяди Боба наткнулся на такое определение: В этой книге («Подход, основанный на вариантах использования») Ивар утверждает, что архитектура программного обеспечения — это структуры,. . .	Управление камерой с помощью скрипта OrbitControls.js на Three.js: Вращение, зум и панорамирование 8Observer8 05.03.2026 Содержание блога Финальная демка в браузере работает на Desktop и мобильных браузерах. Итоговый код: orbit-controls-threejs-js. zip. Сканируйте QR-код на мобильном. Вращайте камеру одним пальцем,. . .	SDL3 для Web (WebAssembly): Синхронизация спрайтов SDL3 и тел Box2D 8Observer8 04.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-sync-physics-sprites-sdl3-c. zip На первой гифке отладочные линии отключены, а на второй включены:. . .	SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий 8Observer8 02.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip Сканируйте QR-код на мобильном и вы увидите, что появится джойстик для управления главным героем. . . .
Реалии Hrethgir 01.03.2026 Нет, я не закончил до сих пор симулятор. Эта задача сложнее. Не получилось уйти в плавсостав, но оно и к лучшему, возможно. Точнее получалось - но сварщиком в палубную команду, а это значит, в моём. . .	Ритм жизни kumehtar 27.02.2026 Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .	SDL3 для Web (WebAssembly): Сборка библиотек: SDL3, Box2D, FreeType, SDL3_ttf, SDL3_mixer и SDL3_image из исходников с помощью CMake и Emscripten 8Observer8 27.02.2026 Недавно вышла версия 3. 4. 2 библиотеки SDL3. На странице официальной релиза доступны исходники, готовые DLL (для x86, x64, arm64), а также библиотеки для разработки под Android, MinGW и Visual Studio. . . .	SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .

Движение точки на PIcture

Решение

Решение

@didimozg 1 / 1 / 0 Регистрация: 22.04.2014 Сообщений: 70
	28.04.2014, 14:10 [ТС]
	y=2 * Sin(x / 2) + (1 / 2) * Cos(2 * x) x от 0 до конца picture 0

@The trick Модератор 10057 / 3902 / 884 Регистрация: 22.02.2013 Сообщений: 5,853 Записей в блоге: 79
	28.04.2014, 15:17
	didimozg, можешь рисовать посредством vbXorPen, тогда просто рисуешь еще раз и фон восстановится, либо отрисовывывай в отдельный битмап и каждый раз перерисовывай все, либо сохраняй кусочек изображения, а потом восстанавливай. 0

SoftIce es geht mir gut 11274 / 4760 / 1183 Регистрация: 27.07.2011 Сообщений: 11,439
	28.04.2014, 16:59
	x это от 0 до 300 а от -150 до 150 это у. ScreenHeight все равно получается 300, но зато точка движется посередине , а не где-то вверху. 1

@didimozg 1 / 1 / 0 Регистрация: 22.04.2014 Сообщений: 70
	28.04.2014, 17:00 [ТС]
	SoftIce, как раз допер сам))). Большое спасибо за помощь 0