请教

解决方案 »

  1.   

    Option ExplicitPrivate Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    End TypePrivate Declare Function GetParent Lib "user32" _
    (ByVal hWnd As Long) As LongPrivate 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 Const GWL_WNDPROC = (-4)Private Declare Function GetProp Lib "user32" Alias "GetPropA" _
    (ByVal hWnd As Long, ByVal lpString As String) As Long
    Private Declare Function SetProp Lib "user32" Alias "SetPropA" _
    (ByVal hWnd As Long, ByVal lpString As String, _
    ByVal hData As Long) As Long
    Private Declare Function RemoveProp Lib "user32" Alias _
    "RemovePropA" (ByVal hWnd As Long, _
    ByVal lpString As String) As LongPrivate 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 LongPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, Source As Any, ByVal Length As Long)'Owner draw constants
    Private Const ODT_BUTTON = 4
    Private Const ODS_SELECTED = &H1
    'Window messages we're using
    Private Const WM_DESTROY = &H2
    Private Const WM_DRAWITEM = &H2BPrivate Type DRAWITEMSTRUCT
    CtlType As Long
    CtlID As Long
    itemID As Long
    itemAction As Long
    itemState As Long
    hwndItem As Long
    hDC As Long
    rcItem As RECT
    itemData As Long
    End TypePrivate Declare Function GetWindowText Lib "user32" Alias _
    "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, _
    ByVal cch As Long) As Long
    'Various GDI painting-related functions
    Private 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 Long
    Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, _
    ByVal crColor As Long) As Long
    Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, _
    ByVal nBkMode As Long) As Long
    Private Const TRANSPARENT = 1Private Const DT_CENTER = &H1
    Public Enum TextVAligns
    DT_VCENTER = &H4
    DT_BOTTOM = &H8
    End Enum
    Private Const DT_SINGLELINE = &H20
    Private Sub DrawButton(ByVal hWnd As Long, ByVal hDC As Long, _
    rct As RECT, ByVal nState As Long)Dim s As String
    Dim va As TextVAlignsva = GetProp(hWnd, "VBTVAlign")'Prepare DC for drawing
    SetBkMode hDC, TRANSPARENT
    SetTextColor hDC, GetProp(hWnd, "VBTForeColor")'Prepare a text buffer
    s = String$(255, 0)
    'What should we print on the button?
    GetWindowText hWnd, s, 255
    'Trim off nulls
    s = Left$(s, InStr(s, Chr$(0)) - 1)If va = DT_BOTTOM Then
    'Adjust specially for VB's CommandButton control
    rct.Bottom = rct.Bottom - 4
    End IfIf (nState And ODS_SELECTED) = ODS_SELECTED Then
    'Button is in down state - offset
    'the text
    rct.Left = rct.Left + 1
    rct.Right = rct.Right + 1
    rct.Bottom = rct.Bottom + 1
    rct.Top = rct.Top + 1
    End IfDrawText hDC, s, Len(s), rct, DT_CENTER Or DT_SINGLELINE _
    Or vaEnd SubPublic Function ExtButtonProc(ByVal hWnd As Long, _
    ByVal wMsg As Long, ByVal wParam As Long, _
    ByVal lParam As Long) As LongDim lOldProc As Long
    Dim di As DRAWITEMSTRUCTlOldProc = GetProp(hWnd, "ExtBtnProc")ExtButtonProc = CallWindowProc(lOldProc, hWnd, wMsg, wParam, lParam)If wMsg = WM_DRAWITEM Then
    CopyMemory di, ByVal lParam, Len(di)
    If di.CtlType = ODT_BUTTON Then
    If GetProp(di.hwndItem, "VBTCustom") = 1 Then
    DrawButton di.hwndItem, di.hDC, di.rcItem, _
    di.itemStateEnd IfEnd IfElseIf wMsg = WM_DESTROY Then
    ExtButtonUnSubclass hWndEnd IfEnd FunctionPublic Sub ExtButtonSubclass(hWndForm As Long)Dim l As Longl = GetProp(hWndForm, "ExtBtnProc")
    If l <> 0 Then
    'Already subclassed
    Exit Sub
    End IfSetProp hWndForm, "ExtBtnProc", _
    GetWindowLong(hWndForm, GWL_WNDPROC)
    SetWindowLong hWndForm, GWL_WNDPROC, AddressOf ExtButtonProcEnd SubPublic Sub ExtButtonUnSubclass(hWndForm As Long)Dim l As Longl = GetProp(hWndForm, "ExtBtnProc")
    If l = 0 Then
    'Isn't subclassed
    Exit Sub
    End IfSetWindowLong hWndForm, GWL_WNDPROC, l
    RemoveProp hWndForm, "ExtBtnProc"End SubPublic Sub SetButtonForecolor(ByVal hWnd As Long, _
    ByVal lForeColor As Long, _
    Optional ByVal VAlign As TextVAligns = DT_VCENTER)Dim hWndParent As LonghWndParent = GetParent(hWnd)
    If GetProp(hWndParent, "ExtBtnProc") = 0 Then
    ExtButtonSubclass hWndParent
    End IfSetProp hWnd, "VBTCustom", 1
    SetProp hWnd, "VBTForeColor", lForeColor
    SetProp hWnd, "VBTVAlign", VAlignEnd SubPublic Sub RemoveButton(ByVal hWnd As Long)RemoveProp hWnd, "VBTCustom"
    RemoveProp hWnd, "VBTForeColor"
    RemoveProp hWnd, "VBTVAlign"End Sub
    To use this, set the target command button's Style property to 1 - GraphicalEXAMPLES:To set command button forecolor(doesn't have to be in form_load)Private Sub Form_Load()
    SetButtonForecolor Command1.Hwnd, vbBlue
    End SubThat will set Command1's Forecolor to BlueTo remove the color(can be put anywhere)Private Sub Command2_Click()
    RemoveButton Command1.Hwnd
    Command1.Refresh
    End Sub
      

  2.   

    VB的CommandButton没有这项功能
    只有自己绘制
      

  3.   

    Microsoft Forms 2.0 Object Library控件组中的CommandButton提供了ForeColor属性,可以修改前景色,不过该控件组存在内存泄露的危险,用不用你自己决定吧:)
      

  4.   

    用CheckBox代替喽,呵呵放个CheckBox,把Style设为1,然后在其Click事件里象下面这样写上一句就很象了,哦哦哈哈Private Sub Check1_Click()
        Check1.Value = vbUnchecked
        
    End Sub
      

  5.   

    我也觉得用CheckBox代替最好
    而且我也经常这么做的!Private Sub cmdChkCopy_Click()
        If cmdChkCopy.Value = vbUnchecked Then Exit Sub
        cmdChkCopy.Value = vbUnchecked
        ……
    End Sub
      

  6.   

    to  supergreenbean(超级绿豆 - 良药苦口,不吃也得吃):高,实在是高~~~~
      

  7.   

    用IMAGE啊!上面再方一个LABEL控件一切就OK了
    没frm_mousemove
    image_mousemov
    image_mousedown
    image_mouseup
    图片你自己搞定