Private Sub ProzentualerFarbverlauf(picZiel As PictureBox, ByVal intWert As _
  Integer, ByVal lngFarbe1 As Long, ByVal lngFarbe2 As Long)
 
Dim intFV_Start As Integer
Dim intFV_Breite As Integer 'Breite des Farbverlauf-Teils
Dim intFarbe1R As Integer, intFarbe1G As Integer, intFarbe1B As Integer
Dim intDiffR As Integer, intDiffG As Integer, intDiffB As Integer
Dim i As Integer
Dim sngGrad As Single
 
'Farb-Anteile aufspalten
intFarbe1R = lngFarbe1 And &HFF&
intFarbe1G = (lngFarbe1 And &HFF00&) / &H100&
intFarbe1B = (lngFarbe1 And &HFF0000) / &H10000
intDiffR = (lngFarbe2 And &HFF&) - intFarbe1R
intDiffG = (lngFarbe2 And &HFF00&) / &H100& - intFarbe1G
intDiffB = (lngFarbe2 And &HFF0000) / &H10000 - intFarbe1B
 
'Farbverlauf-Position bestimmen
picZiel.ScaleMode = vbPixels
intFV_Breite = picZiel.ScaleWidth / 20
intFV_Start = intWert * picZiel.ScaleWidth / 100 - intFV_Breite / 2
 
'Linken Teil zeichnen
If intFV_Breite > 0 Then
    picZiel.Line (0, 0)-(intFV_Start, picZiel.ScaleHeight), lngFarbe1, BF
End If
 
'Farbverlauf zeichnen
For i = 0 To intFV_Breite
    sngGrad = i / intFV_Breite
    picZiel.Line (intFV_Start + i, 0)-Step(0, picZiel.ScaleHeight), RGB( _
      intFarbe1R + sngGrad * intDiffR, intFarbe1G + sngGrad * intDiffG, _
      intFarbe1B + sngGrad * intDiffB)
Next
 
'Rechten Teil zeichnen
If intFV_Start + intFV_Breite < picZiel.ScaleWidth Then
    picZiel.Line (intFV_Start + intFV_Breite, 0)-(picZiel.ScaleWidth, _
      picZiel.ScaleHeight), lngFarbe2, BF
End If
End Sub