Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0310: Farbverläufe erstellen

VB 5/6-Tipp 0310: Farbverläufe erstellen

 von Detlev Schubert

Schwierigkeitsgrad:

Verwendete API-Aufrufe: keine

Download: Download des Beispielprojektes [2,75 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Menü "MnuTitle" (Index von 0 bis 40)
' Steuerelement: Menü "mnuRichtung" (Index von 1 bis 4) auf MnuTitle
' Steuerelement: Menü "MnuFarben" (Index von 20 bis 30) auf MnuTitle
' Steuerelement: Menü "MnuStartFarbe" (Index von 1 bis 6) auf MnuFarben
' Steuerelement: Menü "MnuEndFarbe" (Index von 1 bis 6) auf MnuFarben
' Steuerelement: Menü "MnuEnde" (Index von 41 bis 41) auf MnuTitle

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        'Breite
    H = Me.ScaleHeight       'Höhe
    Me.Cls
     
    ' Farbübergang
    Select Case Richtung
    
      ' Horizontal; 0 Farbe1 -> Farbe2, ' 1 Farbe1 <- Farbe2
      Case 1, 2
        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
       
      ' Vertikal; ' 2 Farbe1 -> Farbe2, 3 Farbe1 <- Farbe2
      Case 3, 4
        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     ' Zurücksetzen
End Sub

Private Sub MnuEnde_Click(index As Integer)
  Unload Me
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 1
  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
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------