vb@rchiv · Extra-Tipps · Eigenes Kontextmenü für das WebBrowser-Control

Rubrik: | VB-Versionen: VB5, VB6

02.01.03

Eigenes Kontextmenü für das WebBrowser-Control Dieser Tipp zeigt, wie sich das Standard Kontextmenü des WebBrowser-Controls durch ein eigenes individuelles Menü ersetzen lässt.
Autor: Dieter Otter	Bewertung:	Views: 1.506
http://www.tools4vb.de/	System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt

Das WebBrowser-Control eignet sich hervorragend für das Anzeigen von lokalen HTML-Dateien oder auch um seinen eigenen Browser zu programmieren. Nur leider lässt sich das Standard-Kontextmenü nicht so ohne weiteres durch ein eigenes individuelles Kontextmenü ersetzen. Hiermit ist ab sofort Schluß!

Da uns das WebBrowser-Control bei einem Rechtsklick mit der Maus leider kein entsprechendes Ereignis liefert, um das Standard-Kontextmenü durch unser eigenes Menü zu ersetzen, müssen wir den "Umweg" des Subclassings in Kauf nehmen.

Hierzu "horchen" wir die Fensternachrichten ab. Das geht in VB aber nur in einem Modul. Zunächst aber müssen wir das Handle des Fensters ermitteln, das die Mausereignisse des WebBrowser-Controls empfängt.

Bevor wir jetzt mit dem "coden" loslegen, ziehen wir erst einmal ein WebBrowser-Control auf die Form1 unseres VB-Projekts. Und da wir unser eigenes Kontextmenü anzeigen möchten, müssen wir dieses natürlich zunächst über den VB-Menüeditor erstellen. Das Menü selbst benennen wir MenuPopUp (Name-Eigenschaft), setzen Visible = False und fügen dann testweise erst einmal nur einen (beliebigen) Untereintrag hinzu.

Danach fügen wir über das Menü Projekt ein neues Modul hinzu mit folgendem Code:

Option Explicit
' Benötigte API-Deklarationen
Private Declare Function GetClassName Lib "user32" _
  Alias "GetClassNameA" ( _
  ByVal hWnd As Long, _
  ByVal lpClassName As String, _
  ByVal nMaxCount As Long) As Long
 
Private Declare Function GetWindow Lib "user32" ( _
  ByVal hWnd As Long, _
  ByVal wCmd As Long) As Long
 
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5

' Ermittelt das Fensterhandle des WebBrowser-Controls,
' welches wir subclassen müssen
' 
' Erwartet wird zunächst das Handle der Form, auf dem
' sich das WebBrowser-Control befindet
Public Function GetWebBrowserHWnd( _
  ByVal hWndMain As Long) As Long
 
  Dim hWnd As Long
  Dim sClassName As String
  Dim nResult As Long
 
  ' Alle Child-Windows der MainForm durchlaufen und
  ' nach dem Klassennamen "Shell Embedding" suchen
  ' Wenn wir einen solchen Klassennamen finden,
  ' haben wir das gesuchte Fensterhandle.
  hWnd = GetWindow(hWndMain, GW_CHILD)
  Do While hWnd <> 0
    ' Klassennamen ermitteln...
    sClassName = Space$(256)
    nResult = GetClassName(hWnd, sClassName, Len(sClassName))
 
    ' ... und prüfen...
    sClassName = Left$(sClassName, nResult)
    If sClassName = "Shell Embedding" Then
      ' ... und gefunden
      GetWebBrowserHWnd = hWnd
      Exit Do
    End If
 
    ' Nächstes Child-Window ermitteln
    hWnd = GetWindow(hWnd, GW_HWNDNEXT)
  Loop
End Function

Wenn wir ein Window subclassen muss dies immer in einem Modul erfolgen:

' Benötigte API-Deklarationen
Public 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
 
Public Declare Function SetWindowLong Lib "user32" _
  Alias "SetWindowLongA" ( _
  ByVal hWnd As Long, _
  ByVal nIndex As Long, _
  ByVal dwNewLong As Long) As Long
 
Private Declare Sub CopyMemory Lib "kernel32" _
  Alias "RtlMoveMemory" ( _
  Destination As Any, _
  Source As Any, _
  ByVal Length As Long)
 
Private Const GWL_WNDPROC = (-4)
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5
Private Const WM_MOUSEACTIVATE = &H21
Private Const WM_RBUTTONDOWN = &H204
 
' Merkvariable für unsere ursprüngliche Window-Prozedur
Private oldWndProc As Long

' Subclassing beginnen
Public Sub StartSubClass(ByVal hWnd As Long)
  oldWndProc = SetWindowLong(hWnd, GWL_WNDPROC, _
    AddressOf WndProc)
End Sub

Public Sub EndSubClass(ByVal hWnd As Long)
  ' Fensternachrichten wieder an die ursprüngliche
  ' WindowProcedur leiten
  Call SetWindowLong(hWnd, GWL_WNDPROC, oldWndProc)
End Sub

Und hier unsere Fensternachrichten-Abhorchfunktion:

' Fensternachrichten auswerten und nach
' der WM_MOUSEACTIVATE "Ausschau halten"
Public Function WndProc(ByVal hWnd As Long, _
  ByVal uMsg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As Long) As Long
 
  Dim nValue As Long
  Dim bForward As Boolean
 
  bForward = True
  Select Case uMsg
    Case WM_MOUSEACTIVATE
      ' Aha! Mausaktivität
      ' Prüfen, ob Rechtsklick
      nValue = HiWord(lParam)
      If nValue = WM_RBUTTONDOWN Then
        ' Eigenes Kontextmenü anzeigen
        Form1.PopupMenu Form1.MenuPopUp
        bForward = False
      End If
  End Select
 
  ' Nachricht an die ursprüngliche WindowProzedur
  ' weiterleiten
  If bForward Then
    WndProc = CallWindowProc(oldWndProc, hWnd, uMsg, _
      wParam, lParam)
  End If
End Function

Tritt das WM_MOUSEACTIVATE Ereignis ein müssen wir prüfen, ob es sich bei der Mausaktion um einen Rechtsklick handelt. Hierzu benötigen wir das höherwertige "Wort" des lParam-Parameters. Da uns VB hierbei aber mal wieder im Regen stehen lässt, bedienen wir uns der CopyMemory-Funktion aus dem Windows-API:

' Hilfsfunktion
Private Function HiWord(ByRef uParam As Long) As Long
  Dim n As Long
 
  n = 0
  CopyMemory ByVal VarPtr(n), ByVal VarPtr(uParam) + 2, 2
  HiWord = n
End Function

Fehlt jetzt nur noch der Formcode, in dem wir das Subclassing starten und auch wieder beenden:

In Form1:

Option Explicit
 
' WindowHandle
Private nWnd As Long

Private Sub Form_Load()
  ' Window-Handle unseres Browserfensters ermitteln,
  ' so dass wir das Window subclassen können
  nWnd = GetWebBrowserHWnd(Me.hWnd)
 
  ' Subclassing starten
  If nWnd <> 0 Then
    StartSubClass nWnd
  End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  ' Wichtig! Subclassing beenden
  If nWnd <> 0 Then
    EndSubClass nWnd
  End If
End Sub

Und nun starten wir das Projekt und klicken einfach einmal mit der rechten Maustaste in das WebBrowser-Fenster.