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.009 mal aufgerufen. |
sevZIP40 Pro DLL Zippen und Unzippen wie die Profis! Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. Buchempfehlung Tipp des Monats Mai 2024 Hermann Röttger Wochentage eines Datumsbereichs ermitteln Wochentage eines Datumsbereichs ermitteln, optional mit Feiertagsberechnung Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||
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. |