Option Explicit

Dim Rot(1), Gruen(1), Blau(1)
Dim Richtung As Integer

Private Sub Form_Load()
  StartFarbe 0, 0, 255
  EndFarbe 0, 0, 0
  Richtung = 3
  check_Auswahl 0
  check_Auswahl 1
  MnuStartFarbe(4).Checked = True
  MnuEndFarbe(6).Checked = True
End Sub

Public Sub Farbverlauf()
  Dim FrmDraw As Boolean
  Dim Beginn As Integer
  Dim B As Integer, H As Integer
  Dim x As Double, XX As Double
  Dim AktuelleFarbe As Long

  FrmDraw = Me.AutoRedraw
  Me.AutoRedraw = True
  B = Me.ScaleWidth
  H = Me.ScaleHeight
  Me.Cls

  Select Case Richtung
    Case 1, 2   ' Horizontal
      Beginn = 0
      For x# = Beginn To 1 Step 0.01
        XX# = x#
        If Richtung = 1 Then
          XX# = (1 - x#)
        End If
        AktuelleFarbe = RGB(Rot(0) - (Rot(0) - Rot(1)) * XX#, _
                Gruen(0) - (Gruen(0) - Gruen(1)) * XX#, _
                Blau(0) - (Blau(0) - Blau(1)) * XX#)
        Me.Line (x# * B, 0)-((x# + 0.01) * B, H), _
                AktuelleFarbe&, BF
      Next

    Case 3, 4    ' Vertikal
      For x# = 0 To 1 Step 0.01
        XX# = x#
        If Richtung = 3 Then
          XX# = (1 - x#)
          AktuelleFarbe = RGB(Rot(0) - (Rot(0) - Rot(1)) * _
                  XX#, Gruen(0) - (Gruen(0) - Gruen(1)) * _
                  XX#, Blau(0) - (Blau(0) - Blau(1)) * XX#)
          Me.Line (0, x# * H)-(B, (x# + 0.01) * H), _
                  AktuelleFarbe&, BF
      Next
  End Select

  Me.AutoRedraw = FrmDraw
End Sub

Private Sub MnuEndFarbe_Click(index As Integer)
  check_Auswahl 0
  MnuEndFarbe(index).Checked = True

  Select Case index
    Case 1
      EndFarbe 255, 0, 0
    Case 2
      EndFarbe 255, 255, 0
    Case 3
      EndFarbe 0, 255, 0
    Case 4
      EndFarbe 0, 0, 255
    Case 5
      EndFarbe 255, 255, 255
    Case 6
      EndFarbe 0, 0, 0
  End Select
  Farbverlauf
End Sub

Private Sub mnuRichtung_Click(index As Integer)
  Richtung = index
  Farbverlauf
End Sub

Public Sub EndFarbe(R0 As Integer, G0 As Integer, B0 As Integer)
  Rot(0) = R0: Gruen(0) = G0: Blau(0) = B0
End Sub

Public Sub StartFarbe(R1 As Integer, G1 As Integer, B1 As Integer)
  Rot(1) = R1: Gruen(1) = G1: Blau(1) = B1
End Sub

Private Sub MnuStartFarbe_Click(index As Integer)
  check_Auswahl 0
  MnuStartFarbe(index).Checked = True

  Select Case index
    Case 1
      StartFarbe 255, 0, 0
    Case 2
      StartFarbe 255, 255, 0
    Case 3
      StartFarbe 0, 255, 0
    Case 4
      StartFarbe 0, 0, 255
    Case 5
      StartFarbe 255, 255, 255
    Case 6
      StartFarbe 0, 0, 0
  End Select
  Farbverlauf
End Sub

Public Sub check_Auswahl(index As Integer)
  Dim x As Integer

  For x = 1 To 6
    If index = 1 Then
      MnuStartFarbe(x).Checked = False
    Else
      MnuEndFarbe(x).Checked = False
    End If
  Next
End Sub