Die Community zu .NET und Classic VB.
Menü

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

 von 

Beschreibung 

Dieser Tip zeigt wie recht komfortabel schnelle Farbverläufe leicht selbst erstellt werden können.

Schwierigkeitsgrad:

Schwierigkeitsgrad 1

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 --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.