Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0166: Schnellen Farbverlauf erstellen (Win 98)

VB 5/6-Tipp 0166: Schnellen Farbverlauf erstellen (Win 98)

 von ActiveVB

Schwierigkeitsgrad:

Verwendete API-Aufrufe: GradientFill (GradientFillRect)

Download: Download des Beispielprojektes [2,15 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------

Option Explicit

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 Type TRIVERTEX
  x As Long
  y As Long
  Red As Integer
  Green As Integer
  Blue As Integer
  Alpha As Integer
End Type

Private Type GRADIENT_RECT
  UpperLeft As Long
  LowerRight As Long
End Type

Const GRADIENT_FILL_RECT_H = &H0
Const GRADIENT_FILL_RECT_V = &H1
Const GRADIENT_FILL_TRIANGLE = &H2
Const GRADIENT_FILL_OP_FLAG = &HFF

Private Sub Form_Load()
  Me.ScaleMode = vbPixels
End Sub

Private Sub Form_Paint()
  Call PaintGradient
End Sub

Private Sub Form_Resize()
  Call PaintGradient
End Sub

Private Sub PaintGradient()
  Dim Vertex(0 To 1) As TRIVERTEX
  Dim Rect As GRADIENT_RECT

    With Vertex(0)
      .x = 0
      .y = 0
      .Red = CCol(255)
      .Green = 0
      .Blue = 0
      .Alpha = 0
    End With

    With Vertex(1)
      .x = Me.ScaleWidth
      .y = Me.ScaleHeight / 2
      .Red = 0
      .Green = 0
      .Blue = CCol(255)
      .Alpha = 0
    End With

    Rect.UpperLeft = 0
    Rect.LowerRight = 1
    GradientFillRect Me.hdc, Vertex(0), 2, Rect, 1, GRADIENT_FILL_RECT_H
    
    With Vertex(0)
      .x = 0
      .y = Me.ScaleHeight / 2
      .Red = CCol(255)
      .Green = 0
      .Blue = 0
      .Alpha = 0
    End With

    With Vertex(1)
      .x = Me.ScaleWidth
      .y = Me.ScaleHeight
      .Red = 0
      .Green = CCol(255)
      .Blue = 0
      .Alpha = 0
    End With

    Rect.UpperLeft = 0
    Rect.LowerRight = 1
    GradientFillRect Me.hdc, Vertex(0), 2, Rect, 1, GRADIENT_FILL_RECT_V
End Sub

Private Function CCol(ByVal Col As Byte) As Integer
If Col > &H7F Then
     CCol = (Col * &H100&) - &H10000
Else
     CCol = Col * &H100&
End If
End Function
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 2 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.