Farbverlauf in Fenstern und Objekten Stört Sie das eintönige Grau von Windows? Möchten Sie Ihre Anwendungen optisch aufpeppen? Dann ist dieser Tipp genau richtig.
Autor:   Dieter Otter	Bewertung:     [ Jetzt bewerten ]	Views:  27.582
www.tools4vb.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 61 Bewertung insgesamt: gut Durchschnittliche Bewertung: 3.9 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Stört Sie das eintönige Grau von Windows? Möchten Sie Ihre Anwendungen optisch "aufpeppen"?
Dann probieren Sie mal folgende Routine:
Die nachfolgende Prozedur erzeugt einen Hintergrund-Farbverlauf für ein bestimmtes Formular. Setzen Sie zunächst die AutoRedraw-Eigenschaft auf True und rufen dann die Prozedur MakeGradient auf.

Anmerkung: Das Erzeugen des Farbverlaufs lässt sich ohne weiteres auch auf Picture-Objekte anwenden.

' zunächst die benötigten API-Funktionen
Private Declare Function DeleteObject Lib "gdi32" ( _
  ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" ( _
  ByVal crColor As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
  ByVal hDC As Long, _
  ByVal nIndex As Long) As Long
Private Declare Function FillRect Lib "user32" ( _
  ByVal hDC As Long, _
  lpRect As RECT, _
  ByVal hBrush As Long) As Long
 
Private Const PLANES = 14
Private Const BITSPIXEL = 12
 
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
 
' Parameterbeschreibung
' Obj:  Form oder Picture-Objekt
' FromColor: Farbwert Anfangsfarbe
' ToColor:   Farbwert Endfarbe
' Direction: 1 = von oben nach unten
'           2 = von links nach rechts
 
Sub MakeGradient(Obj As Object, ByVal FromColor As Long, _
  ByVal ToColor As Long, ByVal Direction As Integer)
 
  Static ColorBits As Long
  Static RgnCnt As Integer
 
  Dim NbrPlanes As Long
  Dim BitsPerPixel As Long
  Dim AreaHeight As Long
  Dim AreaWidth As Long
  Dim prevScaleMode As Integer
  Dim IntervalX As Long
  Dim IntervalY As Long
  Dim I As Integer
  Dim R As Long
  Dim R_ColorVal As Long
  Dim G_ColorVal As Long
  Dim B_ColorVal As Long
  Dim FillArea As RECT
  Dim hBrush As Long
  Dim ColRed As Integer
  Dim ColGreen As Integer
  Dim ColBlue As Integer
 
  With Obj
    If ColorBits = 0 Then
      BitsPerPixel = GetDeviceCaps(.hDC, BITSPIXEL)
      NbrPlanes = GetDeviceCaps(.hDC, PLANES)
      ColorBits = (BitsPerPixel * NbrPlanes)
 
      Select Case ColorBits
        Case 32:  RgnCnt = 256
        Case 24:  RgnCnt = 256
        Case 16:  RgnCnt = 256
        Case 15:  RgnCnt = 32
        Case 8:   RgnCnt = 64
        Case 4:   RgnCnt = 64
        Case Else
          ColorBits = 4
          RgnCnt = 64
      End Select
    End If
 
    prevScaleMode = .ScaleMode
    .ScaleMode = 3
    AreaHeight = .ScaleHeight
    AreaWidth = .ScaleWidth
    .ScaleMode = prevScaleMode
 
    R_ColorVal = Int((ColorRed(FromColor) - _
     ColorRed(ToColor) + 1) / RgnCnt * 100)
    G_ColorVal = Int((ColorGreen(FromColor) - _
     ColorGreen(ToColor) + 1) / RgnCnt * 100)
    B_ColorVal = Int((ColorBlue(FromColor) - _
     ColorBlue(ToColor) + 1) / RgnCnt * 100)
 
    ColRed = ColorRed(ToColor) * 100
    ColGreen = ColorGreen(ToColor) * 100
    ColBlue = ColorBlue(ToColor) * 100
 
    IntervalY = Int(AreaHeight / RgnCnt * 100)
    IntervalX = Int(AreaWidth / RgnCnt * 100)
 
    With FillArea
      .Left = 0
      .Top = 0
      .Right = AreaWidth
      .Bottom = AreaHeight
    End With
 
    For I = 0 To RgnCnt - 1
      hBrush = CreateSolidBrush(RGB(ColRed / 100, _
       ColGreen / 100, ColBlue / 100))
      If Direction = 1 Then
        FillArea.Top = AreaHeight - (I * IntervalY / 100)
        R = FillRect(.hDC, FillArea, hBrush)
        FillArea.Bottom = FillArea.Top
      Else
        FillArea.Left = AreaWidth - (I * IntervalX / 100)
        R = FillRect(.hDC, FillArea, hBrush)
        FillArea.Right = FillArea.Left
      End If
      R = DeleteObject(hBrush)
      If I < RgnCnt - 1 Then
        ColRed = ColRed + R_ColorVal
        ColGreen = ColGreen + G_ColorVal
        ColBlue = ColBlue + B_ColorVal
      End If
    Next I
 
    FillArea.Top = 0
    FillArea.Left = 0
    hBrush = CreateSolidBrush(RGB(Int(ColRed / 100), _
     Int(ColGreen / 100), Int(ColBlue / 100)))
    R = FillRect(.hDC, FillArea, hBrush)
    R = DeleteObject(hBrush)
  End With
End Sub
 
' Farbanteil BLAU
Private Function ColorBlue(ByVal Color As Long) As Integer
  ColorBlue = Color \ &H10000 And &HFF&
End Function
 
' Farbanteil ROT
Private Function ColorRed(ByVal Color As Long) As Integer
  ColorRed = Color And &HFF&
End Function
 
' Farbanteil GRÜN
Private Function ColorGreen(ByVal Color As Long) As Integer
  ColorGreen = Color \ &H100& And &HFF&
End Function

Hier ein kleines Beispiel:

Private Sub Form_Load()
  ' Farbverlauf von Schwarz nach Weiß
  ' und oben nach unten
  MakeGradient Me, vbBlack, vbWhite, 1
End Sub
 
Private Sub Form_Resize()
  ' Wenn die Größe der Form verändert wird,
  ' muß der Farbverlauf neu gezeichnet werden!
  MakeGradient Me, vbBlack, vbWhite, 1
End Sub