Option Explicit
Dim y1, y2, y3, y4, y5, y6, y7, y8 As Double
 
Private Sub cmd_zeichnen_Click()
Dim x1, x2, x3, x4, x5, x6, x7, x8 As Double
'Dim a, n, abstand, winkel, anzschichten As Single
 
    'anzschichten = 150
    'a = 0.01
    'winkel = 45
 
    pic.Cls
 
    y2 = 3000: y4 = y2: y6 = y2: y8 = y2
    x1 = 400
    x2 = 900
 
    'For n = 1 To anzschichten
 
        'abstand = (a * n) / Sin(winkel)
        'y2 = y2 + abstand: y4 = y4 + abstand
        'y6 = y6 + abstand: y8 = y8 + abstand
        'x1 = x1 - abstand
        'x2 = x2 - abstand
 
        wertberechnung txt_1.Text, txt_2.Text, txt_3.Text, txt_4.Text
 
        pic.FillStyle = vbSolid
        pic.FillColor = vbBlue
        pic.Line (x1, y1)-(x2, y2), , B
 
        x3 = 2 * x1 + x2
        x4 = x3 + (x2 - x1)
 
        pic.FillColor = vbYellow
        pic.Line (x3, y3)-(x4, y4), , B
 
        x5 = x4 + (x3 - x2)
        x6 = x5 + (x2 - x1)
 
        pic.FillColor = vbGreen
        pic.Line (x5, y5)-(x6, y6), , B
 
        x7 = x6 + (x3 - x2)
        x8 = x7 + (x2 - x1)
 
        pic.FillColor = vbRed
        pic.Line (x7, y7)-(x8, y8), , B
 
    'Next
 
End Sub
 
Sub wertberechnung(w As Double, t As Double, u As Double, s As Double)
 
    If w > t And w > u And w > s Then
 
        mfaktor w, t, u, s, w
 
    ElseIf t > w And t > u And t > s Then
 
        mfaktor w, t, u, s, t
 
    ElseIf u > s And u > w And u > t Then
 
        mfaktor w, t, u, s, u
 
    Else
 
        mfaktor w, t, u, s, s
 
    End If
 
End Sub
 
Sub mfaktor(w As Double, t As Double, u As Double, s As Double, main As Double)
Dim maxbalkh As Single, mfaktor As Double
 
    maxbalkh = 2500
 
    If y2 < maxbalkh Then
        MsgBox "Maximale Balkenhöhe überschritten!" & vbCrLf & " Bitte Werte im" & _
          "Surcecode ändern!", vbCritical, "Warnung"
        End
    End If
 
    mfaktor = maxbalkh / main
    w = w * mfaktor
    t = t * mfaktor
    u = u * mfaktor
    s = s * mfaktor
 
    y1 = y2 - w
    y3 = y4 - t
    y5 = y6 - u
    y7 = y8 - s
 
End Sub