自制无焦点按钮

Question

以前见过一个例子，如何做无焦点的按钮，其实我有个更简单的送给和我一样菜的朋友。
在工程中添加一用户控件。在控件中添加一个Label控件更名为：lblNAME然后将下面代码拷贝到里面即可。'事件声明:
Event Click() 'MappingInfo=lblNAME,lblNAME,-1,ClickPrivate Sub lblNAME_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
UserControl.Cls
UserControl.Line (0, 0)-(UserControl.ScaleWidth, 0), &H80000010
UserControl.Line (0, 0)-(0, UserControl.ScaleHeight), &H80000010
UserControl.Line (UserControl.ScaleWidth - 20, 0)-(UserControl.ScaleWidth - 20, UserControl.ScaleHeight), &H80000014
UserControl.Line (0, UserControl.ScaleHeight - 20)-(UserControl.ScaleWidth, UserControl.ScaleHeight - 20), &H80000014
lblNAME.Font.Bold = True
End SubPrivate Sub lblNAME_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
UserControl.Cls
UserControl.Line (0, 0)-(UserControl.ScaleWidth, 0), &H80000014
UserControl.Line (0, 0)-(0, UserControl.ScaleHeight), &H80000014
UserControl.Line (UserControl.ScaleWidth - 20, 0)-(UserControl.ScaleWidth - 20, UserControl.ScaleHeight), &H80000010
UserControl.Line (0, UserControl.ScaleHeight - 20)-(UserControl.ScaleWidth, UserControl.ScaleHeight - 20), &H80000010
lblNAME.Font.Bold = False
End SubPrivate Sub UserControl_Click()
lblNAME_Click
End SubPrivate Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
UserControl.Cls
UserControl.Line (0, 0)-(UserControl.ScaleWidth, 0), &H80000010
UserControl.Line (0, 0)-(0, UserControl.ScaleHeight), &H80000010
UserControl.Line (UserControl.ScaleWidth - 20, 0)-(UserControl.ScaleWidth - 20, UserControl.ScaleHeight), &H80000014
UserControl.Line (0, UserControl.ScaleHeight - 20)-(UserControl.ScaleWidth, UserControl.ScaleHeight - 20), &H80000014
lblNAME.Font.Bold = True
End SubPrivate Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
UserControl.Cls
UserControl.Line (0, 0)-(UserControl.ScaleWidth, 0), &H80000014
UserControl.Line (0, 0)-(0, UserControl.ScaleHeight), &H80000014
UserControl.Line (UserControl.ScaleWidth - 20, 0)-(UserControl.ScaleWidth - 20, UserControl.ScaleHeight), &H80000010
UserControl.Line (0, UserControl.ScaleHeight - 20)-(UserControl.ScaleWidth, UserControl.ScaleHeight - 20), &H80000010
lblNAME.Font.Bold = False
End SubPrivate Sub UserControl_Resize()
UserControl.Cls
UserControl.Line (0, 0)-(UserControl.ScaleWidth, 0), &H80000014
UserControl.Line (0, 0)-(0, UserControl.ScaleHeight), &H80000014
UserControl.Line (UserControl.ScaleWidth - 20, 0)-(UserControl.ScaleWidth - 20, UserControl.ScaleHeight), &H80000010
UserControl.Line (0, UserControl.ScaleHeight - 20)-(UserControl.ScaleWidth, UserControl.ScaleHeight - 20), &H80000010lblNAME.Top = (UserControl.Height / 2 - lblNAME.Height / 2)
lblNAME.Left = (UserControl.Width / 2 - lblNAME.Width / 2)End Sub
Private Sub lblNAME_Click()
    RaiseEvent Click
End Sub'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
    BackColor = UserControl.BackColor
End PropertyPublic Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    UserControl.BackColor() = New_BackColor
    PropertyChanged "BackColor"
End Property'注意！不要删除或修改下列被注释的行！
'MappingInfo=lblNAME,lblNAME,-1,Caption
Public Property Get Caption() As String
    Caption = lblNAME.Caption
End PropertyPublic Property Let Caption(ByVal New_Caption As String)
    lblNAME.Caption() = New_Caption
    PropertyChanged "Caption"
End Property'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    lblNAME.Caption = PropBag.ReadProperty("Caption", "Button")
    lblNAME.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
End Sub'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
    Call PropBag.WriteProperty("Caption", lblNAME.Caption, "Button")
    Call PropBag.WriteProperty("ForeColor", lblNAME.ForeColor, &H80000012)
End Sub'注意！不要删除或修改下列被注释的行！
'MappingInfo=lblNAME,lblNAME,-1,ForeColor
Public Property Get ForeColor() As OLE_COLOR
    ForeColor = lblNAME.ForeColor
End PropertyPublic Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
    lblNAME.ForeColor() = New_ForeColor
    PropertyChanged "ForeColor"
End Property

Answer 1

用Subclassing才是正道，这样不支持XP Style

Answer 2

是阿，不过我不想使用VB了，而且在VB.NET中也是无法使用的。不过在VB6中也没有什么

Answer 3

楼主啊，送你一个更简单的：
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
'在窗体上放一个CommandButton
'==========|Form1|===============
Option Explicit
Private Sub Form_Load()
    HookNoFocus Command1.hWnd
End SubPrivate Sub Form_Unload(Cancel As Integer)
    UnHookNoFocus
End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
'==========|Module1|==================
Option Explicit
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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Const GWL_WNDPROC = (-4)
Private Const WM_SETFOCUS = &H7Private OldProc As Long
Private m_hWnd As LongPrivate 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 HookNoFocus(ByVal nhWnd As Long)    If OldProc <> 0 Then Exit Sub
    
    m_hWnd = nhWnd&
    
    OldProc = SetWindowLong(nhWnd&, GWL_WNDPROC, AddressOf WinProc)End Sub
Sub UnHookNoFocus()    If OldProc = 0 Then Exit Sub    SetWindowLong m_hWnd, GWL_WNDPROC, OldProc
    OldProc = 0
End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
去掉函数声明，比你那个要好吧