CreatePatternBrush-Funktion Diese Funktion erstellt eine Bitmap-Brush und gibt das Handle zu diesem zurück.
Betriebssystem:  Win95, Win98, WinNT 3.1, Win2000, WinME	Views:  6.993

Deklaration:

 Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long

Beschreibung:
Diese Funktion erstellt eine Bitmap-Brush und gibt das Handle zu diesem zurück.

Parameter:

hBitmap

Erwartet das Handle eines bereits geladenen Bitmaps, das für den Brush verwendet werden soll.

Rückgabewert:
Ist die Funktion erfolgreich, so liefert sie das Handle des erstellten Brushs, andernfalls wird der Wert "-1" zurückgegeben. Unter Windows 95 werden lediglich 8x8 große Bitmaps unterstützt, alles was darüber hinausgeht wirdignoriert.

Beispiel:

Private Declare Function LoadImage Lib "user32" _
  Alias "LoadImageA" ( _
  ByVal hInst As Long, _
  ByVal lpsz As String, _
  ByVal dwImageType As Long, _
  ByVal dwDesiredWidth As Long, _
  ByVal dwDesiredHeight As Long, _
  ByVal dwFlags As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" ( _
  ByVal hBitmap As Long) As Long
Private Declare Function SelectObject Lib "gdi32" ( _
  ByVal hdc As Long, _
  ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" ( _
  ByVal hObject As Long)  As Long
Private Declare Function PatBlt Lib "gdi32" ( _
  ByVal hdc As Long, _
  ByVal x As Long, _
  ByVal y As Long, _
  ByVal nWidth As Long, _
  ByVal nHeight As Long, _
  ByVal dwRop As Long) As Long
 
' eine der LoadImage dwImageType-Konstanten
Const IMAGE_BITMAP = 0
 
' eine der LoadImage dwFlags-Konstanten
Const LR_LOADFROMFILE = &H10
 
' eine der PatBlt dwRop-Konstanten
Const PATCOPY = &HF00021 ' (DWORD) dest = pattern
 
Dim hBrush As Long, hOldBrush As Long

' Laden eines Bitmap-Brushs
Private Sub Form_Load()
  Dim Retval As Long, hBitmap As Long
 
  Me.AutoRedraw = True
  Me.ScaleMode = vbPixels
 
  ' Bitmap laden
  hBitmap = LoadImage(App.hInstance, App.Path & "\Test.bmp",  _
  IMAGE_BITMAP, 40, 40, LR_LOADFROMFILE)
  If hBitmap = 0 Then
    MsgBox "Fehler beim Laden des Bitmaps"
    Exit Sub
  End If
 
  ' Brush erstellen
  hBrush = CreatePatternBrush(hBitmap)
  If hBrush = 0 Then
    MsgBox "Fehler beim erstellen des Brushs"
    Exit Sub
  End If
 
  ' Brush der Form zuweisen und Ergebnis (alter Brush) zwischenspeichern
  hOldBrush = SelectObject(Me.hdc, hBrush)
End Sub

' Beim Zeichnen des Fensters neuen Brush erneut zuweisen
Private Sub Form_Paint()
  Call SelectObject(Me.hdc, hBrush)
  Retval = PatBlt(Me.hdc, 0, 0, Me.Width / Screen.TwipsPerPixelX,  _
  Me.Height / Screen.TwipsPerPixelY, PATCOPY)
End Sub

' Beim Ändern der Fenstergröße neuen Brush erneut zuweisen
Private Sub Form_Resize()
  Call SelectObject(Me.hdc, hBrush)
  Retval = PatBlt(Me.hdc, 0, 0, Me.Width / Screen.TwipsPerPixelX,  _
  Me.Height / Screen.TwipsPerPixelY, PATCOPY)
End Sub

' Beim Verlassen alten Brush wiederherstellen
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  ' Alten Brush wiederherstellen
  Call SelectObject(Me.hdc, hOldBrush)
 
  ' erstellten Brush zerstören
  Call DeleteObject(hBrush)
End Sub