Deklaration: Declare Function DeleteObject Lib "gdi32.dll" ( _ ByVal hObject As Long) As Long Beschreibung: Parameter:
Rückgabewert: Beispiel: Private Declare Function CreateHatchBrush Lib "gdi32" ( _ ByVal nIndex As Long, _ ByVal crColor As Long) As Long Private Declare Function GetBrushOrgEx Lib "gdi32" ( _ ByVal hDC As Long, _ lpPoint As POINTAPI) As Long Private Declare Function SetBrushOrgEx Lib "gdi32" ( _ ByVal hDC As Long, _ ByVal nXOrg As Long, _ ByVal nYOrg As Long, _ lppt As POINTAPI) As Long Private Declare Function SelectObject Lib "gdi32" ( _ ByVal hDC As Long, _ ByVal hObject As Long) As Long Private Declare Function Rectangle Lib "gdi32" ( _ ByVal hDC As Long, _ ByVal X1 As Long, _ ByVal Y1 As Long, _ ByVal X2 As Long, _ ByVal Y2 As Long) As Long Private Declare Function DeleteObject Lib "gdi32" ( _ ByVal hObject As Long) As Long ' Diagonal von linksunten nach rechtsoben (/) Private Const HS_BDIAGONAL = 3 ' Kreuz (+) Private Const HS_CROSS = 4 ' Diagonales Kreuz (x) Private Const HS_DIAGCROSS = 5 ' Diagonal von rechtunten nach linksoben (\) Private Const HS_FDIAGONAL = 2 ' Horizontal (-) Private Const HS_HORIZONTAL = 0 ' Vertikal (|) Private Const HS_VERTICAL = 1 Private Type POINTAPI x As Long y As Long End Type Private RetVal As Long, hBrushNew As Long, hBrushOld As Long Private OldOrginPt As POINTAPI, NewOrginPt As POINTAPI ' Lädt die neuen Brush-Eigenschaften und speichert die alten ' in Variable. ' Die AutoReDraw-Eigenschaft muss False sein!!! Private Sub Form_Load() Me.ScaleMode = vbPixels ' Ersteinmal fragen wir den aktuellen "Orgin-Punkt" ab, ' den wir am Ende wiederherstellen müssen RetVal = GetBrushOrgEx(Me.hDC, OldOrginPt) ' Danach setzen wir den neuen "Orign-Punkt" With NewOrginPt .x = 4 .y = 4 RetVal = SetBrushOrgEx(Me.hDC, .x, .y, NewOrginPt) End With ' Dann erstellen wir uns einen neuen Brush in Blau hBrushNew = CreateHatchBrush(HS_DIAGCROSS, vbBlue) ' Nun weisen wir den neuen Brush dem Fernster zu ' und erhalten dabei den "Alten" hBrushOld = SelectObject(Me.hDC, hBrushNew) End Sub ' Zeichnet den neuen Brush innerhalb eines Rechteckes Private Sub Form_Paint() ' Forminhalt löschen Me.Cls ' Weil beim Maximieren und Minimieren die From den alten ' Brush immer wiederherstellt, müssen wir ihn jedesmal ' erneut zuweisen, um sicher zu stellen, dass der ' gewünschte Brush auch das Rechteck ausfüllt SelectObject Me.hDC, hBrushNew ' Nun zeichnen wir ein Rechteck in der Mitte der Form RetVal = Rectangle(Me.hDC, Me.ScaleWidth / 3, _ Me.ScaleHeight / 3, _ Me.ScaleWidth / 3 * 2, Me.ScaleHeight / 3 * 2) End Sub ' Erzwingt, dass beim Maximieren das Form_Paint Ereignis ' ausgelöst wird Private Sub Form_Resize() If Me.WindowState = vbMaximized Then Me.Refresh End If End Sub ' Stellt den Orginalbrush wieder her Private Sub Form_QueryUnload(Cancel As Integer, _ UnloadMode As Integer) ' Hier stellen wir den alten Brush und dessen ' "Orginpunkt" wieder her DeleteObject SelectObject(Me.hDC, hBrushOld) With OldOrginPt RetVal = SetBrushOrgEx(Me.hDC, .x, .y, OldOrginPt) End With End Sub Diese Seite wurde bereits 13.790 mal aufgerufen. |
Neu! sevEingabe 3.0 Einfach stark! Ein einziges Eingabe-Control für alle benötigten Eingabetypen und -formate, inkl. Kalender-, Taschenrechner und Floskelfunktion, mehrspaltige ComboBox mit DB-Anbindung, ImageComboBox u.v.m. Buchempfehlung Tipp des Monats November 2024 Dieter Otter WAVE-Dateien aufnehmen Ein Code-Ausschnitt, mit dem sich WAVE-Dateien in verschiedenen Aufnahmequalitäten aufnehmen lassen. TOP Entwickler-Paket TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||
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. |