如何去掉焦点按钮的虚线框。

Question

在模块中：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
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic Const GWL_WNDPROC = (-4)
Public Const WM_SETFOCUS = &H7Private OldProc&
Private mhWnd&'==================================================
'回调
Function WinProc&(ByVal hWnd&, ByVal wMsg&, _
                  ByVal wParam&, ByVal lParam&)
                  
    Select Case wMsg
        Case WM_SETFOCUS
            Exit Function
    End Select
    
    WinProc& = CallWindowProc(OldProc, hWnd, wMsg, wParam, lParam)
End Function
'==================================================
'==================================================
'挂钩
Sub Hook(ByVal nhWnd&)    If OldProc <> 0 Then Exit Sub
    
    mhWnd& = nhWnd&
    
    OldProc = SetWindowLong(nhWnd&, GWL_WNDPROC, AddressOf WinProc)End Sub
'==================================================
'==================================================
'脱钩
Sub UnHook()    If OldProc = 0 Then Exit Sub    SetWindowLong mhWnd, GWL_WNDPROC, OldProc
    OldProc = 0
End Sub
'==================================================
在窗口中：
Private Sub Form_Load()
    Hook cmdNoFocus.hWnd
End SubPrivate Sub Form_Unload(Cancel As Integer)
    UnHook
End Sub以上方法见http://community.csdn.net/Expert/topic/4239/4239721.xml?temp=.6970178
我参照了以上代码，在Form_Load中加入
Hook command1.hWnd
Hook command2.hWnd
Hook command3.hWnd
Hook command4.hWnd发现只能对一个按钮有效,如果将Sub Hook(ByVal nhWnd&)中的If OldProc = 0 Then Exit Sub去掉，则退去程序时死机，，不只为什么

Answer 1

要用superclass解决，我现在没时间，等明天吧
或者也可以考虑写四个回掉函数处理

Answer 2

If OldProc <> 0 Then Exit Sub 这一句会导致后面的Hook就此退出，因此后面的按钮未进行子类处理。所以只对第一个按钮有效了。

Answer 3

四个回调函数倒是不必，但 OldProc 和 mhWnd 需要数组吧
Private OldProc() as long 
Private mhWnd() as long 这样每个按钮的句柄和原处理过程入口可以在数组中保存，即使你窗口上有100个按钮也不怕了。另外，还有一个API叫SetClassLong，应该也是可以的。它可以对同类的所有控件做子类处理，但要求那些控件要在此函数组过程后创建，所以有点麻烦。

Answer 4

Function WinProc&(ByVal hWnd&, ByVal wMsg&, _
                  ByVal wParam&, ByVal lParam&)
                  
    Select Case wMsg
        Case WM_SETFOCUS
            Exit Function
    End Select
    
    WinProc& = CallWindowProc(OldProc, hWnd, wMsg, wParam, lParam)
End Function其中的OldProc怎么改成书组，小弟对回调不熟

Answer 5

模块代码：
Option Explicit 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
 Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
 Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Public Const GCL_WNDPROC = (-24)
 Public Const WM_SETFOCUS = &H7 Public preWinProc As Long Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, _
                         ByVal wParam As Long, ByVal lParam As Long) As Long
 
 If Msg = WM_SETFOCUS Then
    Debug.Print hwnd
    Exit Function
 End If
 wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
 End Function窗体：
Option Explicit
'去掉你程序中的4个按钮，然后添加一个按钮，命名为CmdHide
'用setclasslong之后，控件要重新加载才起作用，所以要先去掉你程序中的按钮，然后在程序中用Controls.Add添加控件
Private WithEvents Command1 As CommandButton
Private WithEvents Command2 As CommandButton
Private WithEvents Command3 As CommandButton
Private WithEvents Command4 As CommandButton'
 Sub Form_Load()
    CmdHide.Visible = False
    Dim ret As Long
    preWinProc = GetClassLong(CmdHide.hwnd, GCL_WNDPROC)
    ret = SetClassLong(CmdHide.hwnd, GCL_WNDPROC, AddressOf wndproc)
    Set Command1 = Controls.Add("vb.commandbutton", "Command1", Me)
    Set Command2 = Controls.Add("vb.commandbutton", "Command2", Me)
    Set Command3 = Controls.Add("vb.commandbutton", "Command3", Me)
    Set Command4 = Controls.Add("vb.commandbutton", "Command4", Me)
    '下面的代码设置按钮的位置等属性，你根据你的需要进行修改吧
    With Command1
    .Visible = True
    .Caption = "Command1"
    .Move 1000, 500
    End With
    With Command2
    .Visible = True
    .Caption = "Command2"
    .Move 1000, 1000
    End With
    With Command3
    .Visible = True
    .Caption = "Command3"
    .Move 1000, 1500
    End With
    With Command4
    .Visible = True
    .Caption = "Command4"
    .Move 1000, 2000
    End With
 End Sub Private Sub Form_Unload(Cancel As Integer)
 Dim ret As Long
 
 ret = SetClassLong(CmdHide.hwnd, GCL_WNDPROC, preWinProc)
 End Sub

Answer 6

或者你这样,假设你已经有100多个按钮的窗体名为form1,先添加一个窗体,命名为frmHide(在窗体上有一个按钮cmdHide),将工程的启动对象设为frmHide模块代码不变,frmHide代码如下:
Sub Form_Load()
    Me.Visible = False
    Dim ret As Long
    preWinProc = GetClassLong(CmdHide.hwnd, GCL_WNDPROC)
    ret = SetClassLong(CmdHide.hwnd, GCL_WNDPROC, AddressOf wndproc)
    Form1.Show
 End Sub Private Sub Form_Unload(Cancel As Integer)
 Dim ret As Long
 
 ret = SetClassLong(CmdHide.hwnd, GCL_WNDPROC, preWinProc)
 End Sub

Answer 7

在我前次回答你时，给了你两个方案，其的一个使用SetClassLong的方案“暴风雨”已给出了，另一个使用数组的代码如下：这来方案我是受MSDN中一个定时器示例的启发，曾在工程中使用过：
Option ExplicitDeclare 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
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic Const GWL_WNDPROC = (-4)
Public Const WM_SETFOCUS = &H7Private OldProc() As Long
Private mhWnd() As Long
Private lngCount As Long
Private lngIndex As Long
'==================================================
'回调
Function WinProc&(ByVal hwnd&, ByVal wMsg&, _
                  ByVal wParam&, ByVal lParam&)
    Dim idx As Long
    
    Select Case wMsg
        Case WM_SETFOCUS
            Exit Function
    End Select
    
    idx = GetProcIndex(hwnd)
    WinProc& = CallWindowProc(OldProc(idx), hwnd, wMsg, wParam, lParam)
End Function
'==================================================
'==================================================
'挂钩
Sub Hook(ByVal nhWnd&)
    Dim idx As Long
    
    idx = GetProcIndex(nhWnd)
    If idx >= 0 Then Exit Sub
    
    ReDim Preserve OldProc(lngCount)
    ReDim Preserve mhWnd(lngCount)
    mhWnd(lngCount) = nhWnd&
    
    OldProc(lngCount) = SetWindowLong(nhWnd&, GWL_WNDPROC, AddressOf WinProc)
    
    lngCount = lngCount + 1
End Sub
'==================================================
'==================================================
'脱钩
Sub UnHook(Optional hwnd As Long)
    Dim idx As Long
    Dim i As Long
    
    If hwnd > 0 Then
    '' 如果指定hwnd，则删除指定的子类
        idx = GetProcIndex(hwnd)
        SetWindowLong hwnd, GWL_WNDPROC, OldProc(idx)
        
        OldProc(idx) = OldProc(lngCount - 1)
        mhWnd(i) = mhWnd(lngCount - 1)
        
        lngCount = lngCount - 1
        If lngCount > 0 Then
            ReDim Preserve OldProc(lngCount)
            ReDim Preserve mhWnd(lngCount)
        End If
    Else
    '' 否则全部删除
        For i = 0 To lngCount - 1
            SetWindowLong mhWnd(i), GWL_WNDPROC, OldProc(i)
        Next
        Erase mhWnd()
        Erase OldProc()
    End If
End Sub
'==================================================
Private Function GetProcIndex(hwnd As Long) As Long
    Dim i As Long
    
    GetProcIndex = -1
    
    For i = 0 To lngCount - 1
        If mhWnd(i) = hwnd Then
            GetProcIndex = i
            Exit For
        End If
    Next
End Function
我要说明一下，上面的代码是专为你的问题写的，只进行了简单的调试。不过我还是要建议你一下，如果你的窗口中按钮确实很多，而且又不是控件数组，那么应该考虑使用SetClassLong的方案，因为这样代码量少。你要看懂他的代码，第一种不行，虽然可以运行，但个人认为不适用，如果你的按钮中有图片你就更惨了，你要写很多烦死人的代码；但第二次给你的方案可行。

Answer 8

如果你的窗体中按钮很多，那么在使用时应该这样:
Private Sub Form_Load()
    Dim o As Object
    
    For Each o In Me.Controls
        If TypeName(o) = "CommandButton" Then
            Hook o.hwnd
        End If
    Next
End SubPrivate Sub Form_Unload(Cancel As Integer)
    UnHook
End Sub

Answer 9

to  songyaowu
你的代码可行，可靠性有待验证

Answer 10

上面的代码如果有问题也只是一些细节上的问题，如数组增减变化时的问题，但整体思路绝对可靠，这个思路来源于MSDN，且这个方法我在其他工程中已用过。