Tipp 036: Ein Sinuskurve und ein regelmäßiges Vieleck zeichnen

Form                     frmSinus
Label                    lblInfo
OptionButton             optNEck
OptionButton             optSinuskurve
PictureBox               picBox
Slider                   Slider1

' VISUAL BASIC WORLD
' ===========================================
' Das große Portal zum Thema Visual Basic.
'
' Wenn Ihnen dieser Source Code gefallen hat,
' dann empfehlen Sie Visual Basic World bitte
' weiter und/oder setzen Sie einen Link auf:
'
' http://www.visualbasicworld.de/
'
' Vernetzen Sie sich mit uns:
'
' http://twitter.com/visualbasicwrld
'
' Autor: Benjamin Wilger


Option Explicit
 
Const Pi = 3.141592653
Const toRad = Pi / 180
Const toGrad = 180 / Pi
 
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 hObject As Long) As Long
 
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long

Private Sub Form_Resize()
 
    Dim c As Long
    Dim i As Long
    Dim x As Double, y As Double
    Dim n As Integer, r As Integer, hFFBrush As Long
    Dim alpha As Double, beta As Double, s As Double
 
    On Error Resume Next
    picBox.Width = Me.ScaleWidth
    picBox.Height = Me.ScaleHeight - 2 * Slider1.Height
    Slider1.Top = picBox.Height
    Slider1.Left = Me.ScaleWidth - Slider1.Width
    Slider2.Top = Slider1.Top + Slider1.Height
    Slider2.Left = Me.ScaleWidth - Slider2.Width
 
    optNEck.Top = picBox.Height + 4
    optSinuskurve.Top = optNEck.Top + optNEck.Height
    lblInfo.Top = picBox.Height + 4
    On Error GoTo 0
 
    If optSinuskurve.Value = True Then
        picBox.Cls
        n = Slider1.Value
        picBox.CurrentY = picBox.ScaleHeight \ 2
        picBox.Cls
        For i = 0 To picBox.ScaleWidth
            x = i
            y = Sin(i / picBox.ScaleWidth * 360 * n * Pi / 180) * _
               (picBox.ScaleHeight \ 2 - 6)
 
            If i = 0 Then
                picBox.Line (x, picBox.ScaleHeight \ 2)- _
                  (x, y + picBox.ScaleHeight / 2)
            Else
                picBox.Line -(x, y + picBox.ScaleHeight / 2)
            End If
        Next i
    Else
        picBox.Cls
        n = Slider1.Value
 
        If picBox.ScaleWidth < picBox.ScaleHeight Then
            r = picBox.ScaleWidth \ 2 - 10
        Else
            r = picBox.ScaleHeight \ 2 - 10
        End If 
 
        picBox.CurrentX = picBox.ScaleWidth \ 2
        picBox.CurrentY = picBox.ScaleHeight \ 2
 
        For i = 0 To 360 Step (360 / n)
            x = Cos((i + Slider2.Value) * toRad) * r
            y = Sin((i + Slider2.Value) * toRad) * r
            picBox.Line -(x + picBox.ScaleWidth \ 2, y + _
               picBox.ScaleHeight \ 2), c
 
            If c = 0 Then
                c = RGB(255, 255, 255)
            Else
                c = 0
            End If
 
        Next i
        x = Cos(Slider2.Value * toRad) * r
        y = Sin(Slider2.Value * toRad) * r
        picBox.Line -(x + picBox.ScaleWidth \ 2, y + _
         picBox.ScaleHeight \ 2), c
 
        alpha = (360 / n)
        beta = (180 - alpha) / 2
        alpha = alpha * toRad
        beta = beta * toRad
 
        r = 1
        s = (r * Sin(alpha)) / Sin(beta) / 2
        lblInfo.Caption = "r = " & r & "; " & _
            "s = " & Format(s, "#0.000") & vbCr & _
            "U = " & Format(s * n, "#0.000") & vbCr & _
            "alpha = " & Format(alpha * toGrad, "#0.000") & "; " & _
            "beta = " & Format(beta * toGrad, "#0.000")
 
    End If
 
End Sub 

Private Sub optNEck_Click()
 
   Slider1.Min = 3
   Slider2.Enabled = True
   Form_Resize
 
End Sub 

Private Sub optSinuskurve_Click()
 
   Slider1.Min = 1
   Slider2.Enabled = False
   Form_Resize
 
End Sub 

Private Sub Slider1_Change()
 
   Form_Resize
 
End Sub 

Private Sub Slider1_Scroll()
 
   Form_Resize
 
End Sub 

Private Sub Slider2_Change()
 
   Form_Resize
 
End Sub 

Private Sub Slider2_Scroll()
 
   Form_Resize
 
End Sub