Subclassing mit Klasse Haben Sie sich nicht auch schon darüber geärgert, Sie wollten Subclassing in Ihrem Projekt verwenden und als Sie Ihr Projekt testen wollten stürzt Ihre Anwendung ab und direkt danach die IDE. Und das speichern hatten Sie vergessen .... Damit Ihnen genau dies nicht wieder passiert möchten wir Ihnen nun eine sichere Methode für das Subclassing zeigen.
Autor:  Wolfgang Christ	Bewertung:     [ Jetzt bewerten ]	Views:  19.804

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 2 Bewertung insgesamt: sehr gut Durchschnittliche Bewertung: 5.0 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Haben Sie sich nicht auch schon darüber geärgert, Sie wollten Subclassing in Ihrem Projekt verwenden und als Sie Ihr Projekt testen wollten stürzt Ihre Anwendung ab und direkt danach die IDE. Und das speichern hatten Sie vergessen .... Damit Ihnen genau dies nicht wieder passiert möchten wir Ihnen nun eine sichere Methode für das Subclassing zeigen.

Zunächst müssen wir erst mal wissen, warum die IDE abstürzt, wenn Ihre Anwendung unerwartet beendet wird!

Wie starten Sie das Subclassing?
Nun Sie werden es sicherlich innerhalb Ihres Programms eingeleitet haben und auch daran gedacht haben im Form_Unload Event Ihr Subclassing zu beenden. Soweit so gut, aber was passiert genau: Nun Ihre Anwendung startet das Subclassing indem es die Adresse für die Empfangsfunktion aller Messages in eine Funktion in Ihrem Programm umbiegt. Das klappt auch hervorragend; aber wenn Sie Ihre Anwendung beenden, oder beendet wird weil ein Fehler auftritt, versucht Windows trotzdem, Ihrem Control noch eine Mitteilung zu senden. Diese Message wird abgeschickt und in Ihre Anwendung umgeleitet. Aber nach dem Stopp-Befehl oder der Debug-Schaltfläche wird kein Code Ihrer Anwendung von der IDE mehr ausgeführt, genauer gesagt: Ihre Anwendung (die Adresse Ihrer Empfangsfunktion) existiert nicht mehr... Damit wird ein ungültiger Speicherzugriff ausgelöst und Ihre IDE stürzt ab.

Wie können wir uns da helfen?
Nun wir müssen das Subclassing so kapseln, dass in jedem Fall beim Auftreten eines Fehlers oder Debug-klicken das Subclassing beendet wird. Damit würde die Speicheradresse wieder zurückgebogen und die Message läuft in eine gültige Speicheradresse. Da denken Sie nun sicherlich an das Gleiche wie ich: eine Klasse mit ihren Events Initialize und Terminate. Das Terminate-Ereignis wird auch beim Auftreffen auf eine Stopp-Anweisung ausgeführt .....
Und eine Klasse hat Events die wir definieren können ...

Wie wäre das: wir instanzieren ein Objekt, übergeben diesem die hWnd des Objektes, das wir subclassen wollen und starten es. Wenn eine Nachricht eintrifft, dann lösen wir ein Event aus und übergeben die Daten an unsere Anwendung. In das Terminate Ereignis fügen wir zusätzlich noch den Code ein, der das Subclassing wieder beendet.

Sie fangen nun also wie wild an zu programmieren und dann .... - Halt, Stopp - der AdressOf Operator kann nicht innerhalb von Klassen eingesetzt werden ??

Wie können wir uns da behelfen ? Nun wir können innerhalb der AktiveX-DLL Module verwenden und den AdressOf-Operator auf eine solche Funktion verweisen lassen. Nun müssen wir nur noch einen Weg finden die abgefangene Nachricht wieder zurück ins Objekt zu bekommen, damit wir ein Event auslösen können.

Kommen wir zum Grundgerüst unserer Klasse clsSubclass:

Option Explicit
 
' zu subclassendes Fenster
Private mvar_hWnd As Long
 
' SubClassen wir bereits ?
Private mvar_bSubClass As Boolean
 
' Alte WindowProc Prozedur
Private mvar_OldWindowProc As Long
 
Public Event MessageCatched( _
  ByVal hWnd As Long, _
  ByRef uMsg As Long, _
  ByRef wParam As Long, _
  ByRef lParam As Long, _
  ByRef Cancel As Boolean)
 
' Die benötigten API - Funktionen
Private Declare Function SetWindowLong Lib "user32" _
  Alias "SetWindowLongA" ( _
  ByVal hWnd As Long, _
  ByVal nIndex As Long, _
  ByVal dwNewLong As Long) As Long
 
Private Declare Function CallWindowProc Lib "user32" _
  Alias "CallWindowProcA" ( _
  ByVal lpPrevWndFunc As Long, _
  ByVal hWnd As Long, _
  ByVal Msg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As Long) As Long
 
Private Declare Function IsWindow Lib "user32" ( _
  ByVal hWnd As Long) As Long
 
' Konstanten
Private Const GWL_WNDPROC = (-4)

Public Function StartSubclass(ByVal hWnd As Long) As Boolean
End Function

Public Function StopSubClass() as Boolean
End Function

Private Function NewWindowProc( _
    ByVal hWnd As Long, _
    ByVal uMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
End Function

Private Sub Class_Terminate()
End Sub

Fensternachrichten abfangen

Hier möchten wir als erstes unser Ereignis auslösen und diese Nachricht ggf. weiterleiten falls gewünscht:

Friend Function NewWindowProc( _
  ByVal hWnd As Long, _
  ByVal uMsg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As Long) As Long
 
  Dim bCancel As Boolean
 
  ' Standard Message weiterleiten
  bCancel = False
 
  NewWindowProc = 0
 
  ' Ereignis auslösen
  RaiseEvent MessageCatched(hWnd, uMsg, wParam, lParam, bCancel)
 
  ' Wenn die Nachricht nicht unterbunden wurde,
  ' dann weiterleiten
  If Not bCancel Then
    ' Senden der Nachricht an die originale WindowProc
    NewWindowProc = CallWindowProc(mvar_OldWindowProc, _
      hWnd, uMsg, wParam, lParam)
  End If
End Function

Diese Funktion definieren wir als Friend, da wir sie von unserem Modul heraus aufrufen wollen.

Nun kommen wir zum Einleiten des Subclassings...

Public Function StartSubclass(ByVal hWnd As Long) As Boolean
  Dim lRet As Long
 
  If mvar_bSubClass Then
    ' nene, gleich mehere Fenster SubClassen
    ' wollen tztztz ....
    StartSubclass = False
    Exit Function
  End If
 
  ' Als erstes der Klasse mitteilen, daß wir nun
  ' "subclassen"
  mvar_bSubClass = True
 
  ' Windowhandle speichern
  mvar_hWnd = hWnd
 
 If IsWindow(hWnd) Then
   ' Ist das Handle ein Fenster ?
 
   ' Der AdressOf Operator läßt sich nicht für
   ' Klassenprozeduren einsetzen .....
   ' wir schicken den Aufruf ins Modul ...
   lRet = SetWindowLong(hWnd, GWL_WNDPROC, _
     AddressOf modWindowProc)
 
   ' Erfolgreich ?
   If lRet <> 0 Then
     StartSubclass = True
     ' Alte WindowProc merken ....
     mvar_OldWindowProc = lRet
     lClassAdress = ObjPtr(Me)
   Else
     StartSubclass = False
   End If
  Else
    StartSubclass = False
  End If
End Function

Damit hätten wir den ersten Teil abgeschlossen. Nun fehlt nur noch die Funktion zum Wiederherstellen:

Public Function StopSubClass() As Boolean
  Dim lRet As Long
 
  StopSubClass = True
 
  ' Subclassen wir überhaupt ...
  If mvar_bSubClass Then
    lRet = SetWindowLong(mvar_hWnd, GWL_WNDPROC, _
      mvar_OldWindowProc)
    If lRet <> 0 Then
      ' Erfolgreich ?
      mvar_bSubClass = False
    Else
      StopSubClass = False
    End If
  End If
End Function

Und nicht vergessen, damit die IDE Ihnen nie wieder Probleme bereitet:

Private Sub Class_Terminate()
  Dim bResult As Boolean
  bResult = StopSubClass
End Sub

Und hierzu später mehr:

Private Sub Class_Initialize()
  mvar_bSubClass = False
 
  ' Adresse der Klasse dem Modul mitteilen
  lClassAdress = ObjPtr(Me)
End Sub

Vom Modul zurück zur Klasse

Damit haben wir nun den ersten Streich fertig: die Klasse. Wie vorhin bereits angekündigt müssen wir nun noch ein Modul erstellen, das als Empfänger der Messages dient. Das Grundgerüst davon dürfte relativ schnell fertig sein:

Option Explicit
 
' Hierin übergibt die Klasse die Adresse der
' Klasse '*fett_grins*
Public lClassAdress As Long

' diese Funktion übergibt der entsprechenden 
' Klasseninstanz die Message
Public Function modWindowProc( _
  ByVal hWnd As Long, _
  ByVal uMsg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As Long) As Long
End Function

Soweit so gut, aber nun müssen wir noch einen Weg finden die Message in die Klasse zu bringen, damit diese dann das Event auslösen kann.

Hierzu müssen wir erst mal wissen, was stellt eigentlich ein Objektname dar?
Nun wir schreiben

Dim Bezeichner As Objekt

Was steht im Speicher ? ... Nichts warum ? - Naja - das Objekt ist noch nicht angelegt. dies machen wir erst mit

Set Bezeichner = New Objekt

Was passiert intern? Es wird ein entsprechend großer Speicherbereich für dieses Objekt belegt und an der Adresse von Bezeichner wird die Adresse des Objektes abgelegt. Nun damit können wir doch etwas anfangen.

Innerhalb der Klasse können wir ganz einfach die Objektadresse der Klasse abfragen

ObjPtr(Me)

Wenn wir nun hingehen, innerhalb des Modules ein Objekt vom Typ der Klasse definieren und es nicht initialisieren (wir wollen ja kein neues sondern das alte Objekt) und in den Speicherbereich des Bezeichners die Adresse des bestehenden Objektes schreiben, dann können wir eine Funktion der Klasse aufrufen, die dann das Ereignis in unsere Anwendung bringt.

Dazu brauchen wir eine kleine Hilfsfunktion:

Private Declare Sub CopyMemory Lib "kernel32" _
  Alias "RtlMoveMemory" ( _
  Destination As Any, _
  Source As Any, _
  ByVal Length As Long)

Die Funktion "modWindowProc"

Die eigentliche Funktion modWindowProc ist dann nur noch ganz einfach:

*trommelwirbel* und *Vorhang auf*

' Diese Funktion übergibt der entsprechenden
' Klasseninstanz die Message
Public Function modWindowProc( _
  ByVal hWnd As Long, _
  ByVal uMsg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As Long) As Long
 
  ' Ein Objekt der Klasse clsSubClass erzeugen!!
  ' nicht initialisieren
  Dim oSubClass As clsSubClass
 
  ' man beachte diesen "Dirty Trick"
  ' Speicheradresse des Originalen Objektes an
  ' Adresse des neuen Objektes kopieren
  CopyMemory oSubClass, lClassAdress, 4
 
  ' Aufrufen - ohne Initialisierung
  modWindowProc = oSubClass.NewWindowProc(hWnd, _
    uMsg, wParam, lParam)
 
  ' In die Speicheradresse des neuen Objektes
  ' Nullzeiger kopieren
  ' entspricht Set oSubClass = nothing, können wir
  ' aber nicht, da sonst das Spass vorbei ist ;-)
  CopyMemory oSubClass, 0&, 4
End Function

Als kleinen Hinweis, damit es auch funktioniert und es keinen Absturz innerhalb der IDE mehr gibt:
Dieses Konstrukt funktioniert nur fertig als AktiveX-DLL, da nur dann auch das Terminate-Ereignis noch bearbeitet wird. Wird diese Klasse innerhalb des Projektes hinzugefügt, dann funktioniert es nicht, da dann das Terminate-Ereignis nicht mehr bearbeitet wird.

Sollten Sie Fragen zu dieser Klasse haben, so zögern Sie nicht diese ins Forum zu stellen.

Verwenden der Subclass-ActiveX-DLL in einem VB-Projekt

Nachdem Sie nun die Subclass-Klasse als ActiveX-DLL kompiliert haben, wird diese über "Projekt - Verweise" in ein normales VB-Projekt eingebunden. In der Form, in der Sie ein Window subclassen möchten, gehen Sie dann wie folgt vor:

Option Explicit
' Subclass-Klasse instanzieren
Dim WithEvents oSubClass As clsSubClass

Das Subclassing wird durch Aufruf der StartSubclass-Methode gestartet, wobei Sie als Parameter das Handle des Window angeben, dessen Fensternachrichten Sie "abhören" wollen:

Private Sub Form_Load()
  ' Subclass-Objekt erstellen
  Set oSubClass = New clsSubClass
 
  ' Form subclassen
  oSubClass.StartSubclass Me.hWnd  
End Sub

Private Sub Form_Unload(Cancel As Integer)
  ' Subclassing beenden: Sicher ist sicher :-)
  oSubClass.StopSubClass
  DoEvents
End Sub

Über das MessageCatched-Ereignis werden Sie über alle Fensternachrichten benachrichtigt:

Private Sub oSubClass_MessageCatched(ByVal hWnd As Long, _
  uMsg As Long, wParam As Long, lParam As Long, _
  Cancel As Boolean)
 
  Debug.Print "uMsg: " & CSTR(uMsg) & _
    ", wParam: " & CStr(wParam) & ", lParam: " & CStr(lParam)  
End Sub

uMsg bezeichnet die Fensternachricht, die sogenannten WM_-Konstanten. Das Beispielprojekt, das Sie sich über nachfolgenden Link downloaden können, beinhaltet all diese Nachrichten-Konstanten, sowie eine Funktion, die die Fensternachricht als lesbaren STRING zurückgibt.