Rubrik: Oberfläche · Fenster | VB-Versionen: VB4, VB5, VB6 | 25.02.01 |
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: | Views: 27.590 |
www.tools4vb.de | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
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