مرکز انجمنهای تخصصی

رسم مثلث سرپینسکی به روش فراخوانی تابع از درون خود .

کد زیر را در محیط کد نویسی کپی کنید

 ‘ In the name of GOD
‘Project : Serpineski
‘Author : Ehsan Zare
‘

Private Type POINTAPI
X As Single ' long
Y As Single ' long
End Type

Dim a As POINTAPI, b As POINTAPI, c As POINTAPI

Private Sub Serpineski(pic As PictureBox, a As POINTAPI, b As POINTAPI, c As POINTAPI, n)
If n = 1 Then
pic.Line (a.X, a.Y)-(b.X, b.Y)
pic.Line (a.X, a.Y)-(c.X, c.Y)
pic.Line (c.X, c.Y)-(b.X, b.Y)
Else
Dim Mab As POINTAPI, Mac As POINTAPI, Mbc As POINTAPI
Mab.X = (a.X + b.X) / 2: Mab.Y = (a.Y + b.Y) / 2
Mac.X = (a.X + c.X) / 2: Mac.Y = (a.Y + c.Y) / 2
Mbc.X = (c.X + b.X) / 2: Mbc.Y = (c.Y + b.Y) / 2
Dim Newa(1 To 3) As POINTAPI
Dim Newb(1 To 3) As POINTAPI
Dim Newc(1 To 3) As POINTAPI
Newa(1) = a: Newb(1) = Mab: Newc(1) = Mac
Newa(2) = Mab: Newb(2) = b: Newc(2) = Mbc
Newa(3) = Mac: Newb(3) = Mbc: Newc(3) = c
For i = 1 To 3
Serpineski pic, Newa(i), Newb(i), Newc(i), n - 1
Next i
End If
End Sub


Private Sub Form_Load()
a.X = Picture1.ScaleWidth / 2: a.Y = 0
b.X = 0: b.Y = Picture1.ScaleHeight - 1
c.X = Picture1.ScaleWidth: c.Y = Picture1.ScaleHeight - 1
End Sub

Private Sub Picture1_Click()
Picture1.Cls
Serpineski Picture1, a, b, c, 10

End