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

longki 2003-08-14 11:17:20

请教怎样更改VB按钮中Caption字体的颜色？解决了今天就结贴！！！
...全文
498 21 打赏 收藏 转发到动态 举报
写回复
用AI写文章
21 条回复
切换为时间正序
请发表友善的回复…
发表回复
kakon 2003-11-09
  • 打赏
  • 举报
 回复
轻松搞掂按钮众多效果！
看看效果：
http://www.oklong.net/sdbutton.htm
下载吧：http://www.oklong.net/download/sdflatbtn.ocx
lisong770818 2003-08-20
  • 打赏
  • 举报
 回复
up
Greaitm 2003-08-20
  • 打赏
  • 举报
 回复
确实是这样，你了解windows底层原理的话你就明白，其实即使你不用图片模式，它也是通过GDI把文字画出来而已，而且画的方法是一样的。因为你不可能获得它画的那幅图的句柄，所以你也不可能动动手指头就改变颜色。而且用这种方法只是增加了代码的大小，但其性能却没有丝毫减弱，你放心使用吧。比起你专程换个控件来说，这种方法更合适。
longki 2003-08-20
  • 打赏
  • 举报
 回复

好的，俺有信心了！Thanks~
longki 2003-08-19
  • 打赏
  • 举报
 回复

TO：Greaitm(夜草)，你发给我的好像是加图片，我要的是仅改变Button.caption的字体颜色！不是给按钮加图片或背景色！
能否请您教教俺？谢谢！
Greaitm 2003-08-14
  • 打赏
  • 举报
 回复
什么叫Owner Draw？
zyl910 2003-08-14
  • 打赏
  • 举报
 回复
如果谁有时间写Owner Draw技术的说明（我没时间，正在写一个图像处理软件），这个帖子可以放入精华区
Greaitm 2003-08-14
  • 打赏
  • 举报
 回复
借用了按钮的maskcolor属性
只要阁下把按钮的属性style改为图形就可以发挥作用了
zyl910 2003-08-14
  • 打赏
  • 举报
 回复
对！就是楼上的方法——Owner Draw
Greaitm 2003-08-14
  • 打赏
  • 举报
 回复
楼上的那段代码不好，大家看我的

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 = &H20

Public 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 Long

Public 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 Long

Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Public 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 Long

Public 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 Type

Public Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Public Const TRANSPARENT = 1

Public 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 Long

Public 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 Long

Public 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

danielinbiti 2003-08-14
  • 打赏
  • 举报
 回复
其实自己用一个caption做个按钮就成了。
danielinbiti 2003-08-14
  • 打赏
  • 举报
 回复
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




不值的花这代码
Greaitm 2003-08-14
  • 打赏
  • 举报
 回复
使用api
我有现成的模块 你留下你的信箱吧
friendwei 2003-08-14
  • 打赏
  • 举报
 回复
换一个按钮的控件呀。我现在用一的像xp那样呢。还可以加图的呢。
www.dapha.net 有
didishu0807 2003-08-14
  • 打赏
  • 举报
 回复
API函数
strongfisher 2003-08-14
  • 打赏
  • 举报
 回复
本身没有这个属性
要用api
gz
chenkangli 2003-08-14
  • 打赏
  • 举报
 回复
学习！！
longki 2003-08-14
  • 打赏
  • 举报
 回复

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

另还多谢 Greaitm(夜草)，我的邮箱是：longki@vip.sina.com，能否请早点发给我！谢谢~~~
Greaitm 2003-08-14
  • 打赏
  • 举报
 回复
真的还不知道有这个名词呃
看来还得让你出马，你那个图像处理软件也不知道什么时候才写完。你都写了这么久了
hxy2003 2003-08-14
  • 打赏
  • 举报
 回复
我在外国的一个网站上看过，不过现在忘啦在哪里，好像有点难啊
加载更多回复（1）
VB按钮控件大全，多个漂亮的VB按钮
VB按钮控件大全，多个漂亮的VB按钮。The-VB-button-controls，使用方便。
漂亮的vb 按钮超炫
vb 做的漂亮按钮 带源码，大家放心下载
vb 各式各样的按钮
visual basic 里各式各样的按钮 控件
非常漂亮的VB按钮,可以制作出XP风格的效果
这是一个控件，用来帮助你制作出具有XP风格的按钮出来，如果你嫌VB自带的太丑了，就用这个
VB制作鼠标悬停颜色渐变的按钮.rar
VB制作鼠标悬停颜色渐变的按钮，制作成了一个QQ登录窗口，登录按钮就是渐变风格的，当鼠标放在上面时，按钮的渐变色会变化，比较漂亮的按钮，而且在windows7下也可以运行，代码写于2009年。
VB基础类

7,789

社区成员

197,583

社区内容

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章