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.566 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. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung 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 Neu! sevEingabe 3.0 Einfach stark! Ein einziges Eingabe-Control für alle benötigten Eingabetypen und -formate, inkl. Kalender-, Taschenrechner und Floskelfunktion, mehrspaltige ComboBox mit DB-Anbindung, ImageComboBox u.v.m. |
||||||||||||||||
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. |