Узоры

@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

Новые блоги и статьи Все статьи Все блоги /
Особенности gif сгенерированных в Си russiannick 21.10.2026 Рассмотрим генерацию gif файлов, которые в Си имеют свои особенности. Gif представляет собой графический формат популярный в интернете. Посмотрим на палитру. Gif файл сгенерированный в си отличается. . .	FPS контроллер с анимированными Y-Bot и 3D-звуком miniaudio (Box3D, Recast, BehaviorTree.CPP, ozz-animation, ImGui, OpenGL и SDL3) 8Observer8 18.10.2026 Содержание блога \| English Version Полное мультиплатформенное руководство по стартовому проекту с FPS-контроллером игрока, анимированными роботами Y-Bot с 4-слойным блендингом, 3D-физикой Box3D,. . .	Локальный http сервер Argus19 17.10.2026 Локальный http сервер На работе, на двух локальных компьютерах круглосуточно работают программы опроса приборов с записью в книги Excel,которые раз в сутки записываются на сервер компании. Т. к. . . .	Копировать Windows на новый диск на UEFI damix 17.10.2026 https:/ / uriesk. wordpress. com/ 2016/ 11/ 01/ move-window-10-to-ssd-on-a-uefi-dualboot-system-with-basic-linux-tools/ TL DR Вставляем диск, а старый подключаем через переходник, грузимся с лайва. . .
ИИ не может найти нужный язык в списке Supersumestria 05.10.2026 Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .	Новая последняя моя музыка в SUNO zorxor 05.10.2026 Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .	Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .	Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .

Узоры

Решение

Решение

@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