Deklaration: Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long Beschreibung: Parameter:
Rückgabewert: 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 Diese Seite wurde bereits 7.022 mal aufgerufen. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Buchempfehlung Tipp des Monats Mai 2024 Hermann Röttger Wochentage eines Datumsbereichs ermitteln Wochentage eines Datumsbereichs ermitteln, optional mit Feiertagsberechnung Neu! sevCommand 4.0 Professionelle Schaltflächen im modernen Design! Mit nur wenigen Mausklicks statten auch Sie Ihre Anwendungen ab sofort mit grafischen Schaltflächen im modernen Look & Feel aus (WinXP, Office, Vista oder auch Windows 8), inkl. große Symbolbibliothek. |
||||||||||||
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. |