Rubrik: Forms/Controls | VB-Versionen: VB5, VB6 | 15.07.03 |
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: | Views: 19.685 |
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.