vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevDataGrid - Gönnen Sie Ihrem SQL-Kommando diesen krönenden Abschluß!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2019
 
zurück
Rubrik: Oberfläche · Effekte   |   VB-Versionen: VB4, VB5, VB625.06.07
Farbverlauf für beliebige Objekte mit Hilfe des Windows-API

Mit Hilfe der GradientFill-Funktion einen Farbverlauf für Fenster und Objekte mit hWnd-Eigenschaft erzeugen und anzeigen

Autor:   Dieter OtterBewertung:     [ Jetzt bewerten ]Views:  9.857 
www.tools4vb.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

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
Farbverlauf von Blau nach Weiß im aktuellen Fenster anzeigen:

Private Sub Form_Paint()
  ' vertikaler Farbverlauf von blau nach weiß
  MakeGradient Me, vbBlue, vbWhite, GRADIENT_FILL_RECT_V
End Sub

Dieser Tipp wurde bereits 9.857 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!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.
 
   

Druckansicht Druckansicht Copyright ©2000-2019 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel