VB按钮的Caption颜色问题！（在线等）

Question

  请教怎样更改VB按钮中Caption字体的颜色？解决了今天就结贴！！！

Answer 1

本身没有这个属性
要用api 
gz

Answer 2

换一个按钮的控件呀。我现在用一的像xp那样呢。还可以加图的呢。
www.dapha.net 有

Answer 3

使用api 
我有现成的模块 你留下你的信箱吧

Answer 4

To use this, set the target command button's Style property to 1 - Graphical''EXAMPLES:Add Three CommandBox On The Form,Add a Module On The project ''    To set command button forecolor(doesn't have to be in form_load)         Private Sub Form_Load()     'Set Command1's Forecolor to Blue     SetButtonForecolor Command1.hWnd, vbBlue    End Sub     '    That will set Command1's Forecolor to Green    Private Sub Command2_Click()     SetButtonForecolor Command1.hWnd, vbGreen     Command1.Refresh    End Sub'    To remove the color(can be put anywhere)         Private Sub Command3_Click()     RemoveButton Command1.hWnd     Command1.Refresh    End Sub'Module1 Option Explicit         Private Type RECT     Left As Long     Top As Long     Right As Long     Bottom As Long    End Type         Private Declare Function GetParent Lib "user32" _     (ByVal hWnd As Long) As Long         Private 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 Long         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 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 = &H2B         Private 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 Type         Private 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 = 1         Private 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 TextVAligns          va = 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 If          If (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 If          DrawText hdc, s, Len(s), rct, DT_CENTER Or DT_SINGLELINE _     Or va         End Sub         Public Function ExtButtonProc(ByVal hWnd As Long, _    ByVal wMsg As Long, ByVal wParam As Long, _    ByVal lParam As Long) As Long         Dim lOldProc As Long    Dim di As DRAWITEMSTRUCT         lOldProc = 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.itemState          End If          End If         ElseIf wMsg = WM_DESTROY Then     ExtButtonUnSubclass hWnd         End If         End Function         Public Sub ExtButtonSubclass(hWndForm As Long)         Dim l As Long         l = GetProp(hWndForm, "ExtBtnProc")    If l <> 0 Then     'Already subclassed     Exit Sub    End If         SetProp hWndForm, "ExtBtnProc", _     GetWindowLong(hWndForm, GWL_WNDPROC)    SetWindowLong hWndForm, GWL_WNDPROC, AddressOf ExtButtonProc         End Sub         Public Sub ExtButtonUnSubclass(hWndForm As Long)         Dim l As Long         l = GetProp(hWndForm, "ExtBtnProc")    If l = 0 Then     'Isn't subclassed     Exit Sub    End If         SetWindowLong hWndForm, GWL_WNDPROC, l    RemoveProp hWndForm, "ExtBtnProc"         End Sub         Public Sub SetButtonForecolor(ByVal hWnd As Long, _     ByVal lForeColor As Long, _     Optional ByVal VAlign As TextVAligns = DT_VCENTER)         Dim hWndParent As Long         hWndParent = GetParent(hWnd)    If GetProp(hWndParent, "ExtBtnProc") = 0 Then     ExtButtonSubclass hWndParent    End If         SetProp hWnd, "VBTCustom", 1    SetProp hWnd, "VBTForeColor", lForeColor    SetProp hWnd, "VBTVAlign", VAlign         End Sub         Public Sub RemoveButton(ByVal hWnd As Long)          RemoveProp hWnd, "VBTCustom"     RemoveProp hWnd, "VBTForeColor"     RemoveProp hWnd, "VBTVAlign"         End Sub
不值的花这代码

Answer 5

其实自己用一个caption做个按钮就成了。

Answer 6

楼上的那段代码不好，大家看我的Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Public Const DT_CENTER = &H1
Public Const DT_VCENTER = &H4
Public Const DT_SINGLELINE = &H20Public 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
Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As LongPublic Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As LongPublic Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As LongPublic Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As LongPublic Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long
Public Type LOGBRUSH
        lbStyle As Long
        lbColor As Long
        lbHatch As Long
End Type
Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As LongPublic Const LF_FACESIZE = 32
Public Const DEFAULT_CHARSET = 1
Public Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Public Type LOGFONT
        lfHeight As Long
        lfWidth As Long
        lfEscapement As Long
        lfOrientation As Long
        lfWeight As Long
        lfItalic As Byte
        lfUnderline As Byte
        lfStrikeOut As Byte
        lfCharSet As Byte
        lfOutPrecision As Byte
        lfClipPrecision As Byte
        lfQuality As Byte
        lfPitchAndFamily As Byte
        lfFaceName  As String * LF_FACESIZE
End TypePublic Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Public Const TRANSPARENT = 1Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPublic Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Public Const CF_BITMAP = 2&
Public Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As LongPublic Sub SetCommandCaption(dstCommand As CommandButton, ByVal szCaption As String)
    Dim dDC As Long
    Dim dRect As RECT
    
    Dim dPic As Long
    Dim dOldPic As Long
    Dim dDCMem As Long
    
    Dim dBrush As Long
    Dim dLogBrush As LOGBRUSH
    
    Dim hFont As Long
    Dim dLogFont As LOGFONT
    Dim hOldfont As Long
    
    dstCommand.Caption = vbNullString
    '获得按钮大小
    GetClientRect dstCommand.hwnd, dRect
    '获得按钮的DC
    dDC = GetDC(dstCommand.hwnd)
    
    '建立兼容的内存DC
    dDCMem = CreateCompatibleDC(dDC)
    '建立兼容的位图
    dPic = CreateCompatibleBitmap(dDC, dRect.Right - dRect.Left, dRect.Bottom - dRect.Top)
    
    '把位图选入内存
    dOldPic = SelectObject(dDCMem, dPic)
    
    '******画图********
    '画背景
    
    With dLogBrush
        .lbStyle = 0
        .lbColor = dstCommand.BackColor
        .lbHatch = 0
    End With
    dBrush = CreateBrushIndirect(dLogBrush)
    FillRect dDCMem, dRect, dBrush
    
    '***********写字************
    '选择字体
    With dLogFont
        .lfHeight = dstCommand.FontSize * -20 / Screen.TwipsPerPixelY
        .lfWeight = 0
        .lfEscapement = 0
        .lfOrientation = 0
        .lfWeight = 400
        .lfItalic = dstCommand.FontItalic
        .lfUnderline = dstCommand.FontUnderline
        .lfStrikeOut = dstCommand.FontStrikethru
        .lfCharSet = DEFAULT_CHARSET
        .lfOutPrecision = 0
        .lfClipPrecision = 0
        .lfQuality = 0
        .lfPitchAndFamily = 0
        .lfFaceName = dstCommand.FontName
    End With
    hFont = CreateFontIndirect(dLogFont)
    hOldfont = SelectObject(dDCMem, hFont)
    '选择文字背景模式为透明
    SetBkMode dDCMem, TRANSPARENT
    '设置文字颜色
    SetTextColor dDCMem, dstCommand.MaskColor
    '写字
    DrawText dDCMem, szCaption, -1, dRect, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
    
    '恢复内存DC 获得图片 并删除DC
    dPic = SelectObject(dDCMem, dOldPic)
    SelectObject dDCMem, hOldfont
    ReleaseDC dstCommand.hwnd, dDC
    DeleteDC dDCMem
    
    '把图片寄存到剪贴板
    OpenClipboard 0
    EmptyClipboard
    SetClipboardData CF_BITMAP, dPic
    CloseClipboard
    
    '清理对象
    DeleteObject hFont
    DeleteObject dPic
    
    '从剪贴板获得数据并清理剪贴板
    dstCommand.Picture = Clipboard.GetData(vbCFBitmap)
    Clipboard.Clear
End Sub

Answer 7

对！就是楼上的方法——Owner Draw

Answer 8

借用了按钮的maskcolor属性
只要阁下把按钮的属性style改为图形就可以发挥作用了

Answer 9

如果谁有时间写Owner Draw技术的说明（我没时间，正在写一个图像处理软件），这个帖子可以放入精华区

Answer 10

就是你那种方法啊
你不知道？
Windows的内部控件（Button、List Box、Combo Box、Menu）都允许用户（程序员）自定义控件的界面，这种方法叫做Owner Draw（对于通用控件（TreeView、ListView……）是另一种方法——Custom Draw）
主要是通过处理WM_DrawItem消息自己绘制界面

Answer 11

 首先多谢各位的热心！小弟在此有礼了！^=^
 不过我想知道具体是哪一个API函数，另我时间有限，可能没时间看太多的东东！
 希望各位最好能一语中的！谢谢！~~~~` 另还多谢 Greaitm(夜草)，，能否请早点发给我！谢谢~~~

Answer 12

    TO：Greaitm(夜草)，你发给我的好像是加图片，我要的是仅改变Button.caption的字体颜色！不是给按钮加图片或背景色！
    能否请您教教俺？谢谢！

Answer 13

确实是这样，你了解windows底层原理的话你就明白，其实即使你不用图片模式，它也是通过GDI把文字画出来而已，而且画的方法是一样的。因为你不可能获得它画的那幅图的句柄，所以你也不可能动动手指头就改变颜色。而且用这种方法只是增加了代码的大小，但其性能却没有丝毫减弱，你放心使用吧。比起你专程换个控件来说，这种方法更合适。

Answer 14

  好的，俺有信心了！Thanks~

Answer 15

轻松搞掂按钮众多效果！
看看效果：
http://www.oklong.net/sdbutton.htm
下载吧：http://www.oklong.net/download/sdflatbtn.ocx