Die nachfolgende Routine erzeugt einen Hintergrund-Farbverlauf für ein bestimmtes Formular. Der Aufruf der MakeGradient-Prozedur sollte hierbei im Form_Paint-Ereignis erfolgen! Anmerkung: Der Farbverlauf lässt sich ohne weiteres auch auf Picture-Objekte anwenden bzw. für alle Objekte, mit hWnd- und hDC-Eigenschaft. Option Explicit ' benötigte API-Deklarationen Private Declare Function GradientFillRect Lib "msimg32" _ Alias "GradientFill" ( _ ByVal hdc As Long, _ pVertex As TRIVERTEX, _ ByVal dwNumVertex As Long, _ pMesh As GRADIENT_RECT, _ ByVal dwNumMesh As Long, _ ByVal dwMode As Long) As Long Private Declare Function GetSysColor Lib "user32" ( _ ByVal nIndex As Long) As Long Private Declare Function GetClientRect Lib "user32" ( _ ByVal hwnd As Long, _ lpRect As RECT) As Long Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Type GRADIENT_RECT UpperLeft As Long LowerRight As Long End Type Private Type TRIVERTEX x As Long y As Long Red As Integer Green As Integer Blue As Integer Alpha As Integer End Type Public Enum eGradientDirection GRADIENT_FILL_RECT_H = &H0 GRADIENT_FILL_RECT_V = &H1 End Enum Public Sub MakeGradient(obj As Object, _ ByVal ColorFrom As Long, _ ByVal ColorTo As Long, _ Optional ByVal nDirection As eGradientDirection) ' Farbverlauf erzeugen Dim oRect As RECT Dim gRect As GRADIENT_RECT Dim oVertex(0 To 1) As TRIVERTEX ' Prüfen auf Systemfarb-Konstanten und ggf. umwandeln If (ColorFrom And &HFF000000) = &H80000000 Then ColorFrom = GetSysColor(ColorFrom And &HFFFFFF) If (ColorTo And &HFF000000) = &H80000000 Then ColorTo = GetSysColor(ColorTo And &HFFFFFF) ' Größe des Objekt-Innenbereichs ermittlen GetClientRect obj.hwnd, oRect ' Linke obere Ecke des Rechtecks With oVertex(0) .x = 0 .y = 0 .Red = sShort((ColorFrom And &HFF&) * 256) .Green = sShort((ColorFrom \ &H100& And &HFF&) * 256) .Blue = sShort((ColorFrom \ &H10000 And &HFF&) * 256) .Alpha = 0 End With ' rechte untere Ecke des Rechtecks With oVertex(1) .x = oRect.Right .y = oRect.Bottom .Red = sShort((ColorTo And &HFF&) * 256) .Green = sShort((ColorTo \ &H100& And &HFF&) * 256) .Blue = sShort((ColorTo \ &H10000 And &HFF&) * 256) .Alpha = 0 End With ' Farbverlauf erstellen gRect.UpperLeft = 0 gRect.LowerRight = 1 Call GradientFillRect(obj.hdc, oVertex(0), 2, gRect, 1, nDirection) End Sub Private Function sShort(ByVal nValue As Long) As Integer ' Hilfsfunktion: Umwandeln eines Long-Wertes nach SignedShort If nValue < 32768 Then sShort = CInt(nValue) Else sShort = CInt(nValue - &H10000) End If End Function Anwendungsbeispiel Private Sub Form_Paint() ' vertikaler Farbverlauf von blau nach weiß MakeGradient Me, vbBlue, vbWhite, GRADIENT_FILL_RECT_V End Sub Dieser Tipp wurde bereits 11.574 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 TOP! Unser Nr. 1 Neu! sevDataGrid 3.0 Mehrspaltige Listen, mit oder ohne DB-Anbindung. Autom. Sortierung, Editieren von Spalteninhalten oder das interaktive Hinzufügen von Datenzeilen sind ebenso möglich wie das Erstellen eines Web-Reports. |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |