用API函数来实现,findwindowex和sendmessage

解决方案 »

  1.   

    用image做成command好了,
    用两个image,话成一个是边框显出来的样子,
    一个是平常样子,把他们放在一起写。
    然后写
    Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Image2.Visible = False
    Image1.Visible = True
    End SubPrivate Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Image1.Visible = False
    Image2.Visible = True
    End Sub
      

  2.   

    可以用label 和 line 控件进行模拟。
    Label 的left和Top边用白色线,right和bottom用黑色线。
    在mouse move 时,让这四条线show ,mouse 过去后让它们hide.
      

  3.   

    '这是微软提供的一个仿XP的Command控件。可以到微软的网站下载全套的。
    VERSION 5.00
    Object = "{27395F88-0C0C-101B-A3C9-08002B2F49FB}#1.1#0"; "PICCLP32.OCX"
    Begin VB.UserControl xpcmdbutton 
       Appearance      =   0  'Flat
       AutoRedraw      =   -1  'True
       BackColor       =   &H80000005&
       ClientHeight    =   1155
       ClientLeft      =   0
       ClientTop       =   0
       ClientWidth     =   1695
       DefaultCancel   =   -1  'True
       FillStyle       =   0  'Solid
       ScaleHeight     =   77
       ScaleMode       =   3  'Pixel
       ScaleWidth      =   113
       ToolboxBitmap   =   "xpcmdbutton.ctx":0000
       Begin VB.Timer Timer1 
          Enabled         =   0   'False
          Interval        =   50
          Left            =   1200
          Top             =   480
       End
       Begin PicClip.PictureClip pc 
          Left            =   105
          Top             =   555
          _ExtentX        =   2381
          _ExtentY        =   556
          _Version        =   393216
          Cols            =   5
          Picture         =   "xpcmdbutton.ctx":0312
       End
       Begin VB.Label lbl 
          Alignment       =   2  'Center
          Appearance      =   0  'Flat
          AutoSize        =   -1  'True
          BackColor       =   &H80000005&
          BackStyle       =   0  'Transparent
          Caption         =   "xpcmdbutton"
          ForeColor       =   &H80000008&
          Height          =   180
          Left            =   435
          TabIndex        =   0
          Top             =   240
          Width           =   1005
       End
    End
    Attribute VB_Name = "xpcmdbutton"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = True
    Attribute VB_PredeclaredId = False
    Attribute VB_Exposed = False
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINT_API) As Long
    Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINT_API) As LongPublic Enum State_b
        Normal_ = 0
        Default_ = 1
    End EnumDim m_State As State_b
    Dim m_Font As FontConst m_Def_State = State_b.Normal_Private Type POINT_API
        X As Long
        Y As Long
    End TypeDim s As Integer
    Event Click()
    Attribute Click.VB_UserMemId = -600
    Event KeyDown(KeyCode As Integer, Shift As Integer)
    Attribute KeyDown.VB_UserMemId = -602
    Event KeyPress(KeyAscii As Integer)
    Attribute KeyPress.VB_UserMemId = -603
    Event KeyUp(KeyCode As Integer, Shift As Integer)
    Attribute KeyUp.VB_UserMemId = -604
    Event MouseOut()
    Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Attribute MouseDown.VB_UserMemId = -605
    Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Attribute MouseMove.VB_UserMemId = -606
    Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Attribute MouseUp.VB_UserMemId = -607Private Sub lbl_Change()
        UserControl_Resize
    End SubPrivate Sub lbl_Click()
        UserControl_Click
    End SubPrivate Sub lbl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
        Call UserControl_MouseDown(Button, Shift, X, Y)
    End SubPrivate Sub lbl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        Call UserControl_MouseMove(Button, Shift, lbl.Left, lbl.Top)
    End SubPrivate Sub lbl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
        Call UserControl_MouseUp(Button, Shift, X, Y)
    End SubPrivate Sub Timer1_Timer()
        Dim pnt As POINT_API
        GetCursorPos pnt
        ScreenToClient UserControl.hWnd, pnt    If pnt.X < UserControl.ScaleLeft Or _
           pnt.Y < UserControl.ScaleTop Or _
           pnt.X > (UserControl.ScaleLeft + UserControl.ScaleWidth) Or _
           pnt.Y > (UserControl.ScaleTop + UserControl.ScaleHeight) Then
           
            Timer1.Enabled = False
            RaiseEvent MouseOut
            statevalue_pic
        End If
    End SubPrivate Sub UserControl_AccessKeyPress(KeyAscii As Integer)
        RaiseEvent Click
    End SubPrivate Sub UserControl_Click()
        RaiseEvent Click
    End Sub
      

  4.   

    Private Sub UserControl_Initialize()
        statevalue_pic
    End SubPrivate Sub UserControl_InitProperties()
        state_value = m_Def_State
        Enabled = True
        Caption = Ambient.DisplayName
        Set Font = UserControl.Ambient.Font
    End SubPrivate Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
        RaiseEvent KeyDown(KeyCode, Shift)
    End SubPrivate Sub UserControl_KeyPress(KeyAscii As Integer)
        RaiseEvent KeyPress(KeyAscii)
    End SubPrivate Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
        RaiseEvent KeyUp(KeyCode, Shift)
    End SubPrivate Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
        RaiseEvent MouseDown(Button, Shift, X, Y)
        make_xpbutton 1
    End SubPrivate Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        Timer1.Enabled = True
        If X >= 0 And Y >= 0 And _
           X <= UserControl.ScaleWidth And Y <= UserControl.ScaleHeight Then
            RaiseEvent MouseMove(Button, Shift, X, Y)
            If Button = vbLeftButton Then
                make_xpbutton 1
            Else: make_xpbutton 3
            End If
        End If
    End SubPrivate Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
        RaiseEvent MouseUp(Button, Shift, X, Y)
        statevalue_pic
    End SubPrivate Sub UserControl_ReadProperties(PropBag As PropertyBag)
        state_value = PropBag.ReadProperty("State", m_Def_State)
        Enabled = PropBag.ReadProperty("Enabled", True)
        Caption = PropBag.ReadProperty("Caption", Ambient.DisplayName)
        Set Font = PropBag.ReadProperty("Font", UserControl.Ambient.Font)
    End SubPublic Property Get Enabled() As Boolean
    Attribute Enabled.VB_ProcData.VB_Invoke_Property = ";Behavior"
    Attribute Enabled.VB_UserMemId = -514
        Enabled = UserControl.Enabled
    End PropertyPublic Property Let Enabled(ByVal New_Enabled As Boolean)
        UserControl.Enabled() = New_Enabled
        PropertyChanged "Enabled"
        statevalue_pic
        If Enabled = True Then lbl.ForeColor = vbBlack Else lbl.ForeColor = RGB(161, 161, 146)
    End PropertyPrivate Sub UserControl_Resize()
        statevalue_pic
        lbl.Top = (UserControl.ScaleHeight - lbl.Height) / 2
        lbl.Left = (UserControl.ScaleWidth - lbl.Width) / 2
    End SubPrivate Sub UserControl_Show()
        statevalue_pic
    End SubPrivate Sub UserControl_Terminate()
        statevalue_pic
    End SubPrivate Sub UserControl_WriteProperties(PropBag As PropertyBag)
        Call PropBag.WriteProperty("State", m_State, m_Def_State)
        Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
        Call PropBag.WriteProperty("Caption", lbl.Caption, Ambient.DisplayName)
        Call PropBag.WriteProperty("Font", m_Font, UserControl.Ambient.Font)
    End SubPublic Property Get State() As State_b
    Attribute State.VB_Description = "Returns/sets the state of the command button when mouse_out."
    Attribute State.VB_ProcData.VB_Invoke_Property = ";Misc"
        State = m_State
    End PropertyPublic Property Let State(ByVal vNewValue As State_b)
        m_State = vNewValue
        PropertyChanged "State"
        statevalue_pic
    End PropertyPrivate Sub statevalue_pic()
        If State = Default_ Then
            s = 4
        ElseIf State = Normal_ Then
            s = 0
        End If
        
        If UserControl.Enabled = True Then
            make_xpbutton s
        Else: make_xpbutton 2
        End If
    End SubPrivate Sub make_xpbutton(z As Integer)
        UserControl.ScaleMode = 3
        Dim brx, bry, bw, bh As Integer    brx = UserControl.ScaleWidth - 3
        bry = UserControl.ScaleHeight - 3
        bw = UserControl.ScaleWidth - 6
        bh = UserControl.ScaleHeight - 6
        
        UserControl.PaintPicture pc.GraphicCell(z), 0, 0, 3, 3, 0, 0, 3, 3
        UserControl.PaintPicture pc.GraphicCell(z), brx, 0, 3, 3, 15, 0, 3, 3
        UserControl.PaintPicture pc.GraphicCell(z), brx, bry, 3, 3, 15, 18, 3, 3
        UserControl.PaintPicture pc.GraphicCell(z), 0, bry, 3, 3, 0, 18, 3, 3
        UserControl.PaintPicture pc.GraphicCell(z), 3, 0, bw, 3, 3, 0, 12, 3
        UserControl.PaintPicture pc.GraphicCell(z), brx, 3, 3, bh, 15, 3, 3, 15
        UserControl.PaintPicture pc.GraphicCell(z), 0, 3, 3, bh, 0, 3, 3, 15
        UserControl.PaintPicture pc.GraphicCell(z), 3, bry, bw, 3, 3, 18, 12, 3
        UserControl.PaintPicture pc.GraphicCell(z), 3, 3, bw, bh, 3, 3, 12, 15End SubPublic Property Get Caption() As String
    Attribute Caption.VB_ProcData.VB_Invoke_Property = ";Appearance"
    Attribute Caption.VB_UserMemId = -518
        Caption = lbl.Caption
    End PropertyPublic Property Let Caption(ByVal vNewCaption As String)
        lbl.Caption() = vNewCaption
        PropertyChanged "Caption"
    End PropertyPublic Property Get Font() As Font
    Attribute Font.VB_UserMemId = -512
        Set Font = m_Font
    End PropertyPublic Property Set Font(ByVal vNewFont As Font)
        Set m_Font = vNewFont
        Set UserControl.Font = vNewFont
        Set lbl.Font = m_Font
        Call UserControl_Resize
        PropertyChanged "Font"
    End Property