Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0399: Fenster-Properties setzen, lesen, löschen und aufzählen

VB 5/6-Tipp 0399: Fenster-Properties setzen, lesen, löschen und aufzählen

 von ActiveVB

Schwierigkeitsgrad:

Verwendete API-Aufrufe: EnumPropsExA (EnumPropsEx), GetPropA (GetProp), RemovePropA (RemoveProp), SetPropA (SetProp), lstrcpyA (lstrcpy), lstrlenA (lstrlen)

Download: Download des Beispielprojektes [3,27 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command3"
' Steuerelement: Schaltfläche "Command4"
' Steuerelement: Listen-Steuerelement "List1"
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"

Option Explicit

Private Declare Function SetProp Lib "user32.dll" Alias _
        "SetPropA" (ByVal hwnd As Long, ByVal lpString As _
        String, ByVal hData As Long) As Long
        
Private Declare Function GetProp Lib "user32.dll" Alias _
        "GetPropA" (ByVal hwnd As Long, ByVal lpString As _
        String) As Long
        
Private Declare Function RemoveProp Lib "user32.dll" Alias _
        "RemovePropA" (ByVal hwnd As Long, ByVal lpString _
        As String) As Long

Private Sub Command1_Click()
    Call SetProp(Me.hwnd, "Var1", 4711&)
    Call FillPropList
End Sub

Private Sub Command2_Click()
    Dim Result As Long
    
    Result = GetProp(Me.hwnd, "Var1")
    MsgBox (Result)
End Sub

Private Sub Command3_Click()
    Call FillPropList
End Sub

Private Sub Command4_Click()
    Dim x As Integer, y As Integer
    Dim aa As String
    
    If List1.ListIndex <> -1 Then
        aa = List1.List(List1.ListIndex)
        x = InStr(aa, "=")
        
        If x <> 0 Then
            aa = Left$(aa, x - 2)
            Call RemoveProp(Me.hwnd, aa)
            Call FillPropList
        End If
    End If
End Sub

Private Sub Form_Load()
    Call SetProp(Me.hwnd, "Var2", 4712&)
    Call SetProp(Me.hwnd, "Var3", 4713&)
    Call SetProp(Me.hwnd, "Var4", 4714&)
    Call SetProp(Me.hwnd, "Var5", 4715&)
    Call FillPropList
End Sub

Private Sub FillPropList()
    Dim Result As Long, x As Long
    Dim aa As String
    
    ReDim Props(0)
    List1.Clear
    Result = EnumPropsEx(Form1.hwnd, AddressOf PropEnumProcEx, 0)
    
    If Result > -1 Then
        For x = 0 To UBound(Props) - 1
            aa = Props(x) & " = " & GetProp(Me.hwnd, Props(x))
            List1.AddItem aa
        Next x
    Else
        Call MsgBox("Keine Properties vorhanden")
    End If
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------

Option Explicit

Public Declare Function EnumPropsEx Lib "user32.dll" Alias _
       "EnumPropsExA" (ByVal hwnd As Long, ByVal lpEnumFunc _
       As Long, ByVal lParam As Long) As Long

Private Declare Function lstrlen Lib "kernel32.dll" Alias _
        "lstrlenA" (ByVal lpString As Any) As Long

Private Declare Function lstrcpy Lib "kernel32.dll" Alias _
        "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 _
        As Any) As Long

Public Props() As String

Public Function PropEnumProcEx(ByVal hwnd As Long, ByVal _
    lpszString As Long, ByVal hData As Long, ByVal dwData As Long) As Long
    
    'Zeiger des übergebenen String ins Feld kopieren
    Props(UBound(Props)) = Space(lstrlen(lpszString))
    Call lstrcpy(Props(UBound(Props)), lpszString)
    
    'Feld um ein Element erhöhen
    ReDim Preserve Props(0 To UBound(Props) + 1)
    
    'Solange eins zurückgeben wird, läuft die Enummeration,
    'ansonsten wird die Callback nicht mehr erneut aufgerufen
    PropEnumProcEx = 1
End Function
'---------- Ende Modul "Module1" alias Module1.bas ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 2 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.