Rechteck mit vermischten Farben zeichnen Mit Hilfe des folgenden Codes kann ein Bereich mit zwei Farben gemischt ausgefüllt werden (Dithering).
Autor:   Torsten Kerz	Bewertung:     [ Jetzt bewerten ]	Views:  13.891
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 4 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.0 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Mit Hilfe des folgenden Codes kann ein Bereich mit zwei Farben gemischt ausgefüllt werden (Dithering).

Den folgenden Code zu einem Formular hinzufügen und einfach testen:

Option Explicit
 
' zunächst die benötigten API-Deklarationen
Private Type Rect
  Left   As Long
  Top    As Long
  Right  As Long
  Bottom As Long
End Type
 
Private Declare Function FillRect Lib "user32" ( _
  ByVal hdc As Long, _
  lpRect As Rect, _
  ByVal hBrush As Long) As Long
 
Private Declare Function CreateBitmap Lib "gdi32" ( _
  ByVal nWidth As Long, _
  ByVal nHeight As Long, _
  ByVal nPlanes As Long, _
  ByVal nBitCount As Long, _
  lpBits As Any) As Long
 
Private Declare Function DeleteObject Lib "gdi32" ( _
  ByVal hObject As Long) As Long
 
Private Declare Function CreatePatternBrush Lib "gdi32" ( _
  ByVal hBitmap As Long) As Long
 
Private Sub Form_Paint()
   ' ----------------------------------------   
   RectangleDithered Me, 0, 0, ScaleWidth, _
     ScaleHeight, vbBlue
   ' ----------------------------------------
End Sub
 
Sub RectangleDithered(Target As Object, X1 As Long, _
  Y1 As Long, X2 As Long, Y2 As Long, Color As OLE_COLOR)
 
  Dim Rect As Rect ' zu befüllendes Rechteck
  Dim hBrush As Long ' Handle auf das Brush
  Dim hBitmap As Long ' Handle auf die Bitmap
  Dim lBitmap(0 To 3) As Long ' Daten der Bitmap
  Dim lForecolor As OLE_COLOR ' Vorherige Farbe
 
  ' Ziel muß hDC, Back- und Forecolor unterstützen
  With Target
    ' [Dither-Bitmap im Speicher erstellen]
    ' Das Muster kann durch Änderung dieser
    ' Schleife geändert werden:
 
    For hBrush = 0 To 3
      lBitmap(hBrush) = &H5555AAAA
    Next
 
    hBitmap = CreateBitmap(16, 8, 1, 1, lBitmap(0))
 
    ' [Brush aus Bitmap erstellen]
    hBrush = CreatePatternBrush(hBitmap)
    DeleteObject hBitmap
 
    ' [Farbe sichern und neu einstellen]
    lForecolor = .ForeColor
    .ForeColor = Color
 
    ' [Rechteck befüllen]
    Rect.Top = Y1
    Rect.Left = X1
    Rect.Bottom = Y2
    Rect.Right = X2
    FillRect .hdc, Rect, hBrush
 
    ' [Aufräumen]
    .ForeColor = lForecolor
    DeleteObject hBrush
  End With
End Sub

Wenn Sie das obige Beispiel einmal testen, werden Sie feststellen, dass das gesamte Formular mit einem blauen Hintergrund dargestellt wird. Obwohl im Beispiel im Form_Paint-Ereignis eine kräftige Farbe "blau" angegeben wurde, wird der Hintergrund eher sanft dargestellt.

Probieren Sie ruhig auch einmal eine andere Farbe aus...