Движение точки на 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, как раз допер сам))).
Большое спасибо за помощь

Новые блоги и статьи Все статьи Все блоги /
Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. Programma_Boinc 26.12.2025 Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. Нашел на реддите интересную статью под названием «Кто-нибудь знает, где получить бесплатный компьютер или. . .	Thinkpad X220 Tablet — это лучший бюджетный ноутбук для учёбы, точка. Programma_Boinc 23.12.2025 Рецензия / Мнение/ Перевод Нашел на реддите интересную статью под названием The Thinkpad X220 Tablet is the best budget school laptop period . Ниже её машинный перевод. Thinkpad X220 Tablet —. . .	PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Как объединить две одинаковые БД Access с разными данными VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro
Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .	Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .	Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .

Движение точки на 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 Модератор 10046 / 3892 / 883 Регистрация: 22.02.2013 Сообщений: 5,846 Записей в блоге: 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