Erhält eine normale Windows-Schaltfläche den Fokus, wird dies durch das sogenannte Fokus-Rechteck deutlich gemacht. Je nach "Verwendungszweck" der Schaltfläche stört das Fokus-Rechteck aber manchmal. Wie man das Fokus-Rechteck deaktiviert, zeigt unser heutiger Extra-Tipp. Um das Fokus-Rechteck zu deaktivieren, müssen die Fensternachrichten der Schaltfläche "abgehorcht" werden (auch Subclassing genannt). Wird die Nachricht "WM_SETFOCUS" an die Schaltfläche geschickt, wird autom. das Fokusrechteck gezeichnet. Was liegt also näher, diese Nachricht einfach zu umgehen? Fügen Sie Ihrem Projekt hierzu ein Modul mit folgendem Code hinzu: Option Explicit ' Benötigte API-Deklarationen Private Declare Function GetWindowLong Lib "user32" _ Alias "GetWindowLongA" ( _ ByVal hWnd As Long, _ ByVal nIndex As Long) As Long 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 Const GWL_WNDPROC As Long = -4 Private Const WM_SETFOCUS As Long = &H7 ' Collection-Objekt, in dem wir die Fensterhandle der ' Schaltflächen zwischenspeichern Private oColButtons As New Collection ' Fokus-Rechteck einer Schaltfläche deaktivieren Public Sub NoFocus_AddButton(ByVal oButton As Object) ' Prüfen, ob das Objekt (Schaltfläche) bereits ' vorhanden... If Not IsInCollection(oColButtons, oButton) Then ' jetzt hinzufügen und ursprüngliche Fensterprozedur merken With oButton oColButtons.Add GetWindowLong(.hWnd, GWL_WNDPROC), "k" & CStr(.hWnd) ' Fensternachrichten des Buttons an unsere eigene ' Fensterprozedur umleiten SetWindowLong .hWnd, GWL_WNDPROC, AddressOf ButtonWndProc End With End If End Sub Private Function IsInCollection(oCol As Collection, ByVal sKey As String) As Boolean ' Prüft, ob es im Collection-Objekt ein ' Element mit dem angegebenen Keywert existiert On Error Resume Next IsInCollection = Not IsEmpty(oCol(sKey)) On Error GoTo 0 End Function ' Hier trudeln alle Fensternachrichten unserer Schaltflächen ein... Private Function ButtonWndProc(ByVal hWnd As Long, ByVal uMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Dim NewWnd As Long Dim OldHWnd As Long If IsInCollection(oColButtons, "k" & CStr(hWnd)) Then Select Case uMsg Case WM_SETFOCUS ' keine Aktion, was wiederum bewirkt, dass ' das Fokusrechteck NICHT angezeigt wird! Case Else ' Nachricht an die ursprüngliche ' Fensterprozedur weiterleiten OldHWnd = oColButtons.Item("k" & CStr(hWnd)) ButtonWndProc = CallWindowProc(OldHWnd, hWnd, uMsg, wParam, lParam) End Select End If End Function ' Buttons aus dem Collection-Objekt entfernen, so dass ' das Fokus-Rechteck wieder wie gewohnt angezeigt wird Public Sub NoFocus_RemoveButton(oButton As Object) Dim OldHWnd As Long With oButton If IsInCollection(oColButtons, "k" & CStr(.hWnd)) Then ' ursprüngliche Fensterprozedur ermitteln... OldHWnd = oColButtons.Item("k" & CStr(.hWnd)) ' ... und wiederherstellen SetWindowLong .hWnd, GWL_WNDPROC, OldHWnd ' Element aus Collection löschen oColButtons.Remove "k" & CStr(.hWnd) End If End With End Sub Wenn Sie den Quellcode ein wenig aufmerksam "mitgelesen" haben, haben Sie bemerkt, dass wir das Fensterhandle der Schaltfläche in einem Collection-Objekt speichern, so dass wir auf diese Weise das Fokus-Rechteck von nicht nur einer Schaltfläche, sondern beliebig vieler Schaltflächen deaktivieren können. Aufruf: Private Sub Form_Load() ' Fokus-Rechteck deaktivieren NoFocus_AddButton Command1 NoFocus_AddButton Command2 ... End Sub Damit die Anwendung beim Beenden nicht abstürzt, sollte im Form_QueryUnload das Ganze dann wieder rückgängig gemacht werden: Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) ' Subclassing der Buttons ausschalten NoFocus_RemoveButton Command1 NoFocus_RemoveButton Command2 ... End Sub Tipp: Private Sub Form_Load() Dim oControl As Control For Each oControl In Me.Controls If TypeOf oControl Is CommandButton Then NoFocus_AddButton oControl End If Next End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Dim oControl As Control For Each oControl In Me.Controls If TypeOf oControl Is CommandButton Then NoFocus_RemoveButton oControl End If Next End Sub |