Prozent-Wert in RGB-Übergang umrechnen Berechnet einen Farbwert aus einem Prozentwert. 0% entsprechen grün, 50% gelb und 100% rot.
Autor:   Sascha Wittling	Bewertung:     [ Jetzt bewerten ]	Views:  14.551
www.makrele.de.vu	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 12 Bewertung insgesamt: nützlich Durchschnittliche Bewertung: 2.8 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Nachfolgende Funktion berechnet einen Farbwert aus einem übergebenen Prozentwert.
0% entspricht hierbei grün, 50% gelb und 100% rot.

' Prozentwert in RGB-Farbwert umrechnen
Private Function PercentToRgb(ByVal nPercent As Integer) As Long
  Dim nInvert As Integer
 
  ' Überprüfen, ob nPercent zwischen 0 und 100 liegt
  If nPercent < 0 Then nPercent = 0
  If nPercent > 100 Then nPercent = 100
 
  ' nPercent "invertieren", so das 100% dem Wert 0%
  ' entspricht, 60% dem Wert 40%, usw..
  nInvert = 100 - nPercent
 
  ' Aus nInvert wird nun der Farbwert berechnet.
  ' Ist nInvert kleiner oder gleich 50, wird mehr
  ' grün in die Farbe gemischt. Ist nInvert größer oder
  ' gleich als 51, kommt mehr Rot in die Farbe.
  ' Die berechnete Farbe wird dann der "Funktionsvariable"
  ' PercentToRgb übergeben.
  If nInvert <= 50 Then
    PercentToRgb = RGB(255, nInvert * 5.1, 0)
  Else
    PercentToRgb = RGB((50 - (nInvert - 50)) * 5.1, 255, 0)
  End If
End Function

Erstellen Sie ein neues Projekt und platzieren auf die Form ein Label-Control, sowie einen CommandButton. Fügen Sie obige Funktion, sowie nachfolgenden Code in den Codeteil der Form ein und starten das Projekt.

Option Explicit
 
' benötigte API-Deklaration
Private Declare Sub Sleep Lib "kernel32" ( _
  ByVal dwMilliseconds As Long)

' Test der Funktion "PercentToRgb"
Private Sub Command1_Click()
  Dim i As Long
 
  For i = 1 To 100
    Label1.BackColor = PercentToRgb(i)
    Label1.Caption = CStr(i) & "%"
    DoEvents
    Sleep 15
  Next i
End Sub