Узоры

@udov · Регистрация: 10.01.2013

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

Как сделать чтобы программа вызывалась по кнопке "шестиугольники"? И как залить шестиугольники разными цветами?

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
Option Explicit
Dim cW As Long, cH As Long
 
Private Sub Form_Load()
  ScaleMode = vbPixels
  'Задаём размер
  cW = 100
  cH = 99
End Sub
 
Private Sub Form_Click()
  Dim X As Long, Y As Long
  Cls
  For X = 0 To 512 + 512 * cW / cH Step cW
    For Y = 0 To 512 Step cH * 3 * 0.5
      Line (X, Y)-(X, Y + cH * 0.5)
      Line -(X + cW * 0.5, Y + cH * 0.75)
      Line -(X + cW * 0.5, Y + cH * 1.25)
      Line -(X, Y + cH * 1.5)
      Line (X + cW * 0.5, Y + cH * 0.75)-(X + cW, Y + cH * 0.5)
      Line (X + cW * 0.5, Y + cH * 1.25)-(X + cW, Y + cH * 1.5)
    Next Y
  Next X
End Sub

@Catstail · 13.06.2013, 15:13

И мой скромный вклад:

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
Sub Draw()
 
      Me.Picture1.Scale (-100, 100)-(100, -100)
      
      n! = Val(Me.Text1.Text)
      
      poly -100, -100, n!, -1
 
      Randomize
 
      Me.Timer1.Interval = 10
      
      Me.Timer1.Enabled = True
 
End Sub
 
Sub poly(X As Single, Y As Single, r As Single, flg As Single)
 
    If X > 100 And Y > 100 Then
       Exit Sub
    ElseIf X > 100 Then
       If flg < 0 Then
          poly -100 - Sqr(3) * 1.5 * r, Y + 1.5 * r, r, -flg  '!!! рек. вызов
       Else
          poly -100 + Sqr(3) * r, Y + 1.5 * r, r, -flg '!!! рек. вызов
       End If
       Exit Sub
    End If
 
    fi! = 3.1415926535 / 6
    
    X1 = X + r * Cos(fi!)
    Y1 = Y + r * Sin(fi!)
    
    For i% = 1 To 6
    
        fi! = fi! + 3.1415926535 / 3
    
        X2 = X + r * Cos(fi!)
        Y2 = Y + r * Sin(fi!)
     
        Me.Picture1.Line (X1, Y1)-(X2, Y2), QBColor(8)
    
        X1 = X2
        Y1 = Y2
        
    Next i%
 
    poly X + r * Sqr(3), Y, r, flg '!!! рек. вызов
 
End Sub

@udov · 15.06.2013, 23:18 **[ТС]**

Catstail, красота, жаль не могу саму программу открыть, чтобы у себя посмотреть!

@Swaer · 15.06.2013, 23:57

Юля тут очень сложная задача

@Catstail · 16.06.2013, 09:52

Вот полный код модуля формы... Ничего здесь нет особенного:

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
61
62
63
64
65
66
67
68
69
70
71
72
73
Private Declare Function FloodFill Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObj As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObj As Long) As Long
Private Declare Function SaveDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function RestoreDC Lib "gdi32" (ByVal hdc As Long, ByVal nSavedDC As Long) As Long
 
Sub Draw()
      Me.Picture1.Scale (-100, 100)-(100, -100)
      n! = Val(Me.Text1.Text)
      poly -100, -100, n!, -1
      Randomize
      Me.Timer1.Interval = 10
      Me.Timer1.Enabled = True
End Sub
 
Sub poly(X As Single, Y As Single, r As Single, flg As Single)
    If X > 100 And Y > 100 Then
       Exit Sub
    ElseIf X > 100 Then
       If flg < 0 Then
          poly -100 - Sqr(3) * 1.5 * r, Y + 1.5 * r, r, -flg
       Else
          poly -100 + Sqr(3) * r, Y + 1.5 * r, r, -flg
       End If
       Exit Sub
    End If
    fi! = 3.1415926535 / 6
    X1 = X + r * Cos(fi!)
    Y1 = Y + r * Sin(fi!)
    For i% = 1 To 6
        fi! = fi! + 3.1415926535 / 3
        X2 = X + r * Cos(fi!)
        Y2 = Y + r * Sin(fi!)
        Me.Picture1.Line (X1, Y1)-(X2, Y2), QBColor(8)
        X1 = X2
        Y1 = Y2
    Next i%
    poly X + r * Sqr(3), Y, r, flg
End Sub
 
Sub Repaint()
    xx# = 200 * Rnd
    yy# = -200 * Rnd
    ax& = Me.Picture1.ScaleX((xx#), vbUser, vbPixels)
    ay& = Me.Picture1.ScaleY((yy#), vbUser, vbPixels)
    If Me.Picture1.Point(xx#, yy#) <> QBColor(8) Then
       c& = RGB(255 * Rnd, 255 * Rnd, 255 * Rnd)
       svHdc& = SaveDC(Me.Picture1.hdc)
       pbrush& = CreateSolidBrush(c&)
       ar1& = SelectObject(Me.Picture1.hdc, pbrush&)
       ar4& = FloodFill(Me.Picture1.hdc, ax&, ay&, QBColor(8))
       Me.Picture1.Refresh
       ar3& = RestoreDC(Me.Picture1.hdc, svHdc&)
       ar2& = DeleteObject(pbrush&)
    End If
End Sub
 
Private Sub Command1_Click()
    Me.Picture1.Cls
    Draw
    Me.Command1.Enabled = False
End Sub
 
Private Sub Command2_Click()
    Me.Command1.Enabled = True
    Me.Timer1.Enabled = False
End Sub
 
Private Sub Timer1_Timer()
    Repaint
End Sub

Новые блоги и статьи Все статьи Все блоги /
Про "Windows must die!" kumehtar 04.11.2026 Знаете, чет накатило. . . . Когда-то это было почти боевым кличем: мол, нормальный человек сидит на DOS, OS/ 2 или Linux, а вот это вот - Must Die. А теперь человек произносит «мастдай» с усмешкой - и. . .	Красочные поля с номером страницы svg+background-image russiannick 04.11.2026 Красочные поля с номером страницы не менее важны чем в эпоху бумажных книг. Посему спешу представить почтеннейшей публике этот важный инструмент который эти поля и формирует. В процессе разработки. . .	Вступаем в новую фазу генерации favicons, векторную. russiannick 02.11.2026 Теперь нет нужды скрывать что используется простой svg. Исходный код изображения помещаем в поле и жмем кнопку. Исходник преобразуется в вид корректный для помещения в favicon или в url(). Нажатие. . .	Генератор паролей (вариант №4) Maks 01.11.2026 После публикации 3-го варианта генератора паролей, разослал его своим коллегам (с целью оценки), в итоге были получены следующие рекомендации: 1. Вернуть возможность использования знаков \| 1 l I;. . .
Генератор паролей (вариант №3) Maks 30.10.2026 Финальная версия генератора паролей 1С. Доработка решения в этот раз коснулась только визуальной части, а именно, добавлен реквизит ДопПараметры (тип Булево), который скрывает/ отображает реквизиты:. . .	Магическое мышление и магия, современная наука не отличима от магии (говорит ИИ Джемени) zorxor 30.10.2026 Джемени, расскажи, пожалуйста, что такое магическое мышление, что такое магия, почему современная наука чем-то напоминает магию? Фраза «Любая достаточно развитая технология неотличима от магии». . .	За какое время ИИ может подобрать пароль по хешу (рассказывает Джемени ИИ) zorxor 30.10.2026 Расскажи, Джемени, если известен хэш МД5, например, за сколько ИИ сможет подобрать соответствующий пароль? Искусственный интеллект (ИИ) может подобрать простой или средний по сложности пароль по. . .	Кто убил Suno? Почему наше солнышко погасло? (диалог с ИИ Джемени) zorxor 30.10.2026 Как убивали Suno. Хронология. «Убийство» музыкальной нейросети Suno — это затяжной процесс, в котором технологический хайп стартапа разбился о жесткую реальность судебных исков от гигантов. . .

Узоры

Решение

Решение

@udov 7 / 7 / 0 Регистрация: 10.01.2013 Сообщений: 59
	15.06.2013, 23:18 [ТС]
	Catstail, красота, жаль не могу саму программу открыть, чтобы у себя посмотреть! 1

@Swaer 1 / 1 / 0 Регистрация: 13.06.2013 Сообщений: 163
	15.06.2013, 23:57
	Юля тут очень сложная задача 0

Опции темы