我想把command控件或者toolbar里的button当鼠标经过时凸出显示，如何完成？在线高分相候！

Question

请各位高手告知，在此谢过！

Answer 1

这种控件恐怕没有这项功能，我都是用PICTURE控件模拟，当鼠标移动过来时用RECT或LINE绘制轮廓

Answer 2

不知道LINE控件是否会被COMMAND按纽遮住，如果遮不住完全可以用4个LINE控件然后设置COMMAND数组移动时4个LINE控件的位置分别在按纽的四个边改变LINE控件的颜色，自然可以呈现凹凸感

Answer 3

yefanqiu 和 lshdic 能再具体一点吗？
我是指原来的按钮是平的。
鼠标过后会凸起，怎么用贴图？

Answer 4

用line控件好像没有效果。

Answer 5

Option ExplicitPrivate Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As LongPrivate Const BF_TOP = &H2
Private Const BF_LEFT = &H1
Private Const BF_RIGHT = &H4
Private Const BF_BOTTOM = &H8
Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)Private Const BDR_RAISEDINNER = &H4
Private Const BDR_SUNKENOUTER = &H2Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End TypePrivate rc As RECTPrivate Sub Form_Load()
    Picture1.AutoRedraw = True
    Picture1.BorderStyle = 0
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    GetClientRect Picture1.hWnd, rc
    If x > 0 And x < Picture1.ScaleWidth And y > 0 And y < Picture1.ScaleHeight Then
        DrawEdge Picture1.hdc, rc, BDR_RAISEDINNER, BF_RECT
        Picture1.Refresh
        SetCapture Picture1.hWnd
    Else
        Picture1.Cls
        ReleaseCapture
    End If
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    DrawEdge Picture1.hdc, rc, BDR_SUNKENOUTER, BF_RECT
    Picture1.Refresh
End SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    DrawEdge Picture1.hdc, rc, BDR_RAISEDINNER, BF_RECT
    Picture1.Refresh
End Sub

Answer 6

谢谢junwhj
你是不是指先要建一个picture.
然后把button放进去？
有没有toolbar+imagelist的方法呢？

Answer 7

对于command控件我想改变背景色就可以了吧?对于toolbar,因为我不使用非标准控件,所以也不太清楚.
当然您如果想完全控制显示或许得花一点时间了.给您一个小例子,刚写的,您再改一下.Option ExplicitPrivate Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As LongPrivate Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As LongPrivate Const DT_CENTER = &H1                       '文本垂直居中
Private Const DT_SINGLELINE = &H20                  '只画单行
Private Const DT_VCENTER = &H4                      '必须同时指定DT_SINGLE。指示文本对齐格式化矩形的中部Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Type RECT
      Left As Long
      Top As Long
      Right As Long
      Bottom As Long
End Type
Private drawRect As RECTPrivate Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
'填充指定区域
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
'用纯色创建一个刷子
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Dim hBrush As Long '笔刷
Dim dHdc As Long
Public Function MouseOver_Event(m_Obj As Object, X, Y) As Boolean
        Dim MouseOver As Boolean
        Dim mCaption As String
        mCaption = m_Obj.Caption
    
    Call GetWindowRect(m_Obj.hWnd, drawRect)
    dHdc = GetDC(m_Obj)
    MouseOver = (0 <= X) And (X <= m_Obj.Width) And (0 <= Y) And (Y <= m_Obj.Height)
    
    If MouseOver Then
        SetCapture m_Obj.hWnd
        hBrush = CreateSolidBrush(RGB(100, 30, 30))
        Call FillRect(dHdc, drawRect, hBrush)
        Call DrawText(dHdc, mCaption, -1, drawRect, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER)
        Call DrawFocusRect(dHdc, drawRect)
    Else
        ReleaseCapture
        hBrush = CreateSolidBrush(RGB(100, 120, 120))
        Call FillRect(dHdc, drawRect, hBrush)
        Call DrawText(dHdc, mCaption, -1, drawRect, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER)
    End If
End FunctionPrivate Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MouseOver_Event(Command1, X, Y)
End Sub

Answer 8

其实这样也可以的：
用两个image控件分别是平面按钮和特殊效果按钮的图象
再在其上加一个Label控件，其_MouseMove 事件中加上适当代码就可以了。
效果比其他方法简单又自由。

Answer 9

csdngoodnight
那凸起的感觉怎么画呢？？

Answer 10

我找到了方法
是在toolbar里改变一下style就可以啦
谢谢各位。
我还有一个问题。
如何引用toolbar里button的属性呢
比如commandbutton.enable这样的属性。

Answer 11

虽然你的问题已经解决了，我还是说一下image哪个方法是怎么用的
用image呈现凹凸干是这样的
设你的image名称是image1
加四个line控件，分别为line1,line2,line3,line4
事先四个line的visible是false
private sub form_load()
line1.x1=image1.left
line1.y1=image1.top
line1.x2=image1.left
line1.y2=image1.top+image1.height
line2.x1=line1.x1
line2.y1=line1.y1
line2.x2=image1.left+image1.width
line2.y2=image1.top
line3.x1=line2.x2
line3.y1=line2.y2
line3.x2=image1.left+image1.width
line3.y2=image1.top+image1,height
line4.x1=line1.x2
line4.y1=line1.y2
line4.x2=line3.x2
line4.y2=line3.y2
line1.visible=false
line2.visible=false
line3.visible=false
line4.visible=false
end sub
'就是说吧四个line围在image1的周围，并且都看不见private sub image1_mousemove()
line1.color=white
line2.color=white
line3.color=black
line4.color=black
line1.visible=true
line2.visible=true
line3.visible=true
line4.visible=true
end sub
'鼠标放上去时，line都变成可见，左边和上边的变成白色，右边和下边的变成黑色，鼠标按下去时相反，抬起来再变回来，line的颜色属性我记不清是怎么写了，用color代替，颜色也不知道怎么写，用white和black代替了。private sub image1_mousedown()
line1.color=black
line2.color=black
line3.color=white
line4.color=white
end subprivate sub image1_mouseup()
line1.color=white
line2.color=white
line3.color=black
line4.color=black
end subprivate sub form_mousemove()
form_load  '这是鼠标移出image1
end sub

Answer 12

如果是toolbar就不要这样了。
如果是command就要像上面说得这样了。哈哈，学习。