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 6.995 mal aufgerufen. |
sevWizard für VB5/6 Professionelle Assistenten im Handumdrehen Erstellen Sie eigene Assistenten (Wizards) im Look & Feel von Windows 2000/XP - mit allem Komfort und zwar in Windeseile :-) Buchempfehlung Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 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. |