Квадрат (Ковер) Серпинского

@ms_mrr · Регистрация: 17.11.2017

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

Подскажите,что и где нужно исправить чтоб получалась нормальная рекурсия, как достроить квадрат Серпинского?
На данный момент выходит вот так(см.фото)

VB.NET
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
Public Class Form1
Dim n As Integer 
    Dim g As Graphics
    Dim b As Bitmap
    Dim p = New Pen(Color.Black, 2)
 
    Private Sub Serp(ByVal p1 As PointF, ByVal p2 As PointF, ByVal p3 As PointF, ByVal p4 As PointF)
        g.DrawLine(p, p1, p2)
        g.DrawLine(p, p2, p4)
        g.DrawLine(p, p4, p3)
        g.DrawLine(p, p3, p1)
    End Sub
    Private Sub drawS(ByVal p1 As PointF, ByVal p2 As PointF, ByVal p3 As PointF, ByVal p4 As PointF, ByVal n As Integer)
        Dim p1n, p2n, p3n, p4n As PointF
        If n > 0 Then
            p1n = New PointF(p4.X / 3 + p2.X / 3, 2 * p4.Y / 3 + p2.Y / 3)
            p2n = New PointF(p2.X / 3 + p1.X / 3, p1.Y / 3 + 2 * p3.Y / 3)
            p3n = New PointF(p4.X / 3 + p2.X / 3, p4.Y / 3 + p2.Y / 3)
            p4n = New PointF(p2.X / 3 + p1.X / 3, p4.Y / 3 + p2.Y / 3)
            Serp(p1n, p2n, p3n, p4n)
            drawS(p1n, p1, p2, p4n, n - 1)
            drawS(p2n, p2, p1, p3n, n - 1)
            drawS(p4n, p3, p1n, p3n, n - 1)
            drawS(p3, p2n, p1n, p4n, n - 1)
            'drawS(p2n, p1n, p2, p1, n - 1)
            'drawS(p1n, p2n, p1, p2, n - 1)
            'drawS(p1n, p2n, p1, p2, n - 1)
            'drawS(p2n, p1n, p2, p1, n - 1)
        End If
    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        n = Convert.ToInt16(TextBox1.Text)
        Dim w As Integer = PictureBox1.Width
        Dim h As Integer = PictureBox1.Height
        Dim b As Bitmap = New Bitmap(w, h)
        g = Graphics.FromImage(b)
        Dim n1 As New PointF(0, 0)
        Dim n2 As New PointF(w, 0)
        Dim n3 As New PointF(0, h)
        Dim n4 As New PointF(w, h)
        Serp(n1, n2, n3, n4)
        drawS(n1, n2, n3, n4, n)
        PictureBox1.Image = b
    End Sub
End Class

@ovva · 18.11.2017, 12:00

Пример

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

VB.NET
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
74
75
76
77
78
79
80
81
82
83
84
85
86
Private p As Integer  'порядок кривой
Private lx, ly As Integer
Private X, Y As Integer
Private pp As New List(Of Point)
Private pn As Pen
Private Sub Form2_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
    p = 5
    lx = 4
    ly = 4
    X = 280
    Y = 30
    PictureBox1.BackColor = Color.AliceBlue
    pn = Pens.Green
    pp.Add(New Point(X, Y))
End Sub
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
    Dim g As Graphics = Graphics.FromHwnd(PictureBox1.Handle)
    a(p, g)
    DrawPart(g, 0, ly)
    b(p, g)
    DrawPart(g, -lx, 0)
    c(p, g)
    DrawPart(g, 0, -ly)
    d(p, g)
    DrawPart(g, lx, 0)
    g.FillClosedCurve(Brushes.LightGreen, pp.ToArray, Drawing2D.FillMode.Alternate, 0)
End Sub
Private Sub a(i As Integer, g As Graphics)
    If i > 0 Then
        a(i - 1, g)
        DrawPart(g, 0, ly)
        b(i - 1, g)
        DrawPart(g, +lx, 0)
        DrawPart(g, 0, ly)
        d(i - 1, g)
        DrawPart(g, +lx, 0)
        a(i - 1, g)
    End If
End Sub
Private Sub b(i As Integer, g As Graphics)
    If i > 0 Then
        b(i - 1, g)
        DrawPart(g, -lx, 0)
        c(i - 1, g)
        DrawPart(g, 0, ly)
        DrawPart(g, -lx, 0)
        a(i - 1, g)
        DrawPart(g, 0, ly)
        b(i - 1, g)
    End If
End Sub
Private Sub c(i As Integer, g As Graphics)
    If i > 0 Then
        c(i - 1, g)
        DrawPart(g, 0, -ly)
        d(i - 1, g)
        DrawPart(g, -lx, 0)
        DrawPart(g, 0, -ly)
        b(i - 1, g)
        DrawPart(g, -lx, 0)
        c(i - 1, g)
    End If
End Sub
Private Sub d(i As Integer, g As Graphics)
    If i > 0 Then
        d(i - 1, g)
        DrawPart(g, +lx, 0)
        a(i - 1, g)
        DrawPart(g, 0, -ly)
        DrawPart(g, lx, 0)
        c(i - 1, g)
        DrawPart(g, 0, -ly)
        d(i - 1, g)
    End If
End Sub
Private Sub DrawPart(g As Graphics, lx As Integer, ly As Integer, Optional ByVal bb As Integer = 10)
    g.DrawLine(pn, X, Y, X - lx * bb, Y - ly * bb)
    'g.DrawRectangle(pn, X + lx, Y + ly, bb, bb)
    'g.DrawBezier(pn2, X, Y, X + lx, Y + ly, X - bb, Y - bb, X - lx * bb, Y - ly * bb)
    'g.DrawArc(pn, X, Y, bb, bb, 0, -90)
    Dim ppt() As Point = {New Point(X, Y), New Point(X + lx, Y + ly), New Point(X - bb, Y - bb), New Point(X - lx * bb, Y - ly * bb)}
    g.DrawClosedCurve(pn, ppt)
    X = X + lx
    Y = Y + ly
    pp.Add(New Point(X, Y))
End Sub

@Yury Komar · 18.11.2017, 16:20

ovva, охничосе...

@Дядя Корней · 18.11.2017, 16:51

ovva, вот это поворот!

Мужик, а сшей мне красный ковёр

@ViterAlex · 18.11.2017, 18:39

ovva, прям настоящий ковёр. С бахромой

Предложу классическую реализацию:

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

Форма

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Public Class Form1
    Private Sub btnBuildUp_Click(sender As Object, e As EventArgs) Handles btnBuildUp.Click
        NewCarpet()
    End Sub
 
    Private Sub nudLevel_ValueChanged(sender As Object, e As EventArgs) Handles nudLevel.ValueChanged
        NewCarpet()
    End Sub
 
    Private Sub NewCarpet()
        Dim crp = New Carpet(PictureBox1.Width, PictureBox1.Height)
        PictureBox1.Image = crp.Create(nudLevel.Value)
    End Sub
End Class

Класс

VB.NET
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
Public Class Carpet
    Private _width As Integer
    Private _height As Integer
 
    Public Sub New(w As Integer, h As Integer)
        _width = w
        _height = h
    End Sub
 
    Public Function Create(level As Integer) As Bitmap
        Dim bmp = New Bitmap(_width, _height)
        Draw(level, New RectangleF(0, 0, bmp.Width, bmp.Height), Graphics.FromImage(bmp))
        Return bmp
    End Function
 
    Private Sub Draw(level As Integer, rect As RectangleF, g As Graphics)
        If level = 0 Then
            g.FillRectangle(Brushes.Blue, rect)
            Return
        End If
        Dim w = rect.Width / 3.0F
        Dim h = rect.Height / 3.0F
        Dim x = New Single() {rect.Left, rect.Left + w, rect.Left + 2 * w}
        Dim y = New Single() {rect.Top, rect.Top + h, rect.Top + 2 * h}
 
        Draw(level - 1, New RectangleF(x(0), y(0), w, h), g)
        Draw(level - 1, New RectangleF(x(1), y(0), w, h), g)
        Draw(level - 1, New RectangleF(x(2), y(0), w, h), g)
        Draw(level - 1, New RectangleF(x(0), y(1), w, h), g)
        Draw(level - 1, New RectangleF(x(2), y(1), w, h), g)
        Draw(level - 1, New RectangleF(x(0), y(2), w, h), g)
        Draw(level - 1, New RectangleF(x(1), y(2), w, h), g)
        Draw(level - 1, New RectangleF(x(2), y(2), w, h), g)
    End Sub
End Class

@XIST · 18.11.2017, 19:46

ViterAlex, Без обид, ovva, уделал)

@ms_mrr · 18.11.2017, 23:46 **[ТС]**

ViterAlex, спасибо огромное!

Новые блоги и статьи Все статьи Все блоги /
Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. 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 - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .

Квадрат (Ковер) Серпинского

Решение

Решение

@Yury Komar Модератор 4356 / 3426 / 512 Регистрация: 27.01.2014 Сообщений: 6,257
	18.11.2017, 16:20
	ovva, охничосе... 0

@Дядя Корней 399 / 318 / 53 Регистрация: 14.08.2014 Сообщений: 1,010
	18.11.2017, 16:51
	ovva, вот это поворот! Мужик, а сшей мне красный ковёр 0

@XIST 1960 / 1061 / 148 Регистрация: 01.10.2009 Сообщений: 3,589 Записей в блоге: 1
	18.11.2017, 19:46
	ViterAlex, Без обид, ovva, уделал) 1

@ms_mrr 0 / 0 / 0 Регистрация: 17.11.2017 Сообщений: 8
	18.11.2017, 23:46 [ТС]
	ViterAlex, спасибо огромное! 0