|
Option Explicit
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, _
lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Dim Figure() As POINTAPI
Dim Pi As Double
Dim maxEdges As Integer
Private Sub Form_Load()
Pi = Atn(1) * 4
With Picture1
.ScaleMode = 3
End With
With HScroll1
.Min = 3
.Max = 30
.Value = .Max
Label1.Caption = "3 bis " & CStr(.Value)
End With
Check1.Value = vbChecked
End Sub
Private Sub Check2_Click()
If Check2.Value Then
Label1.Caption = CStr(maxEdges)
Else
Label1.Caption = "3 bis " & CStr(maxEdges)
End If
End Sub
Private Sub Command1_Click()
Static i As Integer
If Check2.Value = vbChecked Then
i = maxEdges
Else
i = i + 1
If i < 3 Then i = 3
If i > maxEdges Then i = 3
End If
Label2.Caption = "Ecken " & CStr(i)
Call RegelPolygonEcken(Picture1, i, Picture1.ScaleWidth / 2, _
Picture1.ScaleHeight / 2, Picture1.ScaleWidth / 3)
End Sub
Private Sub Command2_Click()
Dim i As Integer
If Check2.Value = vbChecked Then
i = maxEdges
Else
Randomize Timer
i = Int((maxEdges - 3 + 1) * Rnd + 3)
End If
Label2.Caption = "Ecken " & CStr(i)
Call UnregelPolygonEcken(Picture1, i, Picture1.ScaleWidth / 2, _
Picture1.ScaleHeight / 2, Picture1.ScaleWidth / 3)
End Sub
Private Sub HScroll1_Change()
maxEdges = HScroll1.Value
If Check2.Value = vbChecked Then
Label1.Caption = CStr(maxEdges)
Else
Label1.Caption = "3 bis " & CStr(maxEdges)
End If
End Sub
Private Sub RegelPolygonEcken(obj As Object, edges As Integer, _
x As Single, y As Single, d As Integer)
Dim i As Integer
With obj
If Check1.Value = vbChecked Then
.FillStyle = 0
Randomize Timer
.FillColor = RGB(256 * Rnd, 256 * Rnd, 256 * Rnd)
.ForeColor = 0
Else
.FillStyle = 1
End If
.Cls
End With
obj.PSet (x, y)
ReDim Figure(edges)
For i = 0 To edges - 1
Figure(i).x = x + d * Cos(i * 2 * Pi / edges)
Figure(i).y = y + d * Sin(i * 2 * Pi / edges)
Next i
Polygon obj.hdc, Figure(0), edges
End Sub
Private Sub UnregelPolygonEcken(obj As Object, edges As Integer, _
x As Single, y As Single, d As Integer)
Dim i As Integer
With obj
If Check1.Value = vbChecked Then
.FillStyle = 0
Randomize Timer
.FillColor = RGB(256 * Rnd, 256 * Rnd, 256 * Rnd)
.ForeColor = 0
Else
.FillStyle = 1
End If
.Cls
End With
obj.PSet (x, y)
ReDim Figure(edges)
For i = 0 To edges - 1
Figure(i).x = _
x + x * (0.5 + 0.5 * Rnd) * Sin(2 * Pi * i / edges)
Figure(i).y = _
y + y * (0.5 + 0.5 * Rnd) * Cos(2 * Pi * i / edges)
Next i
Polygon obj.hdc, Figure(0), edges
End Sub
|
|