VB中按钮的背景色和文字的字体颜色怎么弄？

[Edison621]

好像不能设置？我想设置一下按钮的背景色和字体颜色等等。

要是用到一些别人做好的，那是不是直接生成的exe程序copy到别的机器就不能用了？我是菜鸟，请帮忙，谢谢！

[Edison621]

请问怎样设置窗体运行时最大化显示？

[wzzwwz]

Option Explicit

Private Sub Form_Load()
Me.WindowState = vbMaximized
End Sub

[wzzwwz]

字体颜色不能改

[wzzwwz]

背景颜色:
把 Style 属性改成 1
然后更改 BackColor 属性

[mndsoft]

这里有个“改变CommandButton字体颜色 "

http://www.mndsoft.com

个代码演示的是改变CommandButton字体颜色，但程序中的控件不是一个真正的CommandButton，但示例却能达到这样的效果

[唐古拉山]

给你一个设置 CommandButton 字体颜色的模块：mSetCommandButtonFontColor

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
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 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 Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
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 As Long = 1
Private Const GWL_WNDPROC As Long = -4
Private Const ODT_BUTTON As Long = 4
Private Const ODS_SELECTED As Long = &H1
Private Const WM_DESTROY As Long = &H2
Private Const WM_DRAWITEM As Long = &H2B
Private Const DT_HCENTER As Long = &H1
Private Const DT_TOP As Long = &H0
Private Const DT_VCENTER As Long = &H4
Private Const DT_BOTTOM As Long = &H8
Private Const DT_SINGLELINE As Long = &H20

Private Const DT_WORDBREAK As Long = &H10
Public Const DT_CHARSTREAM = 4 ' Character-stream, PLP
Public Const DT_EXPANDTABS = &H40
Public Const DT_EXTERNALLEADING = &H200
Public Const DT_LEFT = &H0
Public Const DT_NOCLIP = &H100
Public Const DT_CENTER As Long = &H1
Public Const DT_CALCRECT = &H400
Public Const DT_INTERNAL = &H1000

Public Const TA_CENTER = 6
Public Const TA_UPDATECP = 1
Public Const TA_BASELINE = 24
Public Const DT_METAFILE = 5 ' Metafile, VDM
Public Const DT_PLOTTER = 0 ' Vector plotter
Public Const DUPLICATE = &H6

Public Const WM_GETTEXT = &HD
Public Const WM_GETMINMAXINFO = &H24
Public Const WM_GETFONT = &H31
Public Const WM_COPY = &H301
Public Const WM_GETTEXTLENGTH = &HE
Public Const WM_COPYDATA = &H4A
Public Const WM_PASTE = &H302

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

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

Public Enum AlignText
AlignTop = DT_TOP
AlignCenter = DT_VCENTER
AlignBottom = DT_BOTTOM
ThreeD = DT_VCENTER Or DT_BOTTOM
End Enum

Private Const PropCustom = "UMGCustom"
Private Const PropForeColor = "UMGForeColor"
Private Const PropAlign = "UMGVAlign"
Private Const PropSubclass = "UMGDrawProc"

Public Sub SetForeColor(Button As CommandButton, ByVal ForeColor As OLE_COLOR, Optional ByVal Alignment As AlignText = AlignCenter)
Dim hWndPnt As Long
With Button
hWndPnt = GetParent(.hWnd)
If GetProp(hWndPnt, PropSubclass) = 0 Then
SetProp hWndPnt, PropSubclass, GetWindowLong(hWndPnt, GWL_WNDPROC)
SetWindowLong hWndPnt, GWL_WNDPROC, AddressOf DrawButtonProc
End If
SetProp .hWnd, PropCustom, True
SetProp .hWnd, PropForeColor, ForeColor
SetProp .hWnd, PropAlign, Alignment
.Refresh
End With
End Sub

Public Sub UnsetForeColor(Button As CommandButton)
With Button
RemoveProp .hWnd, PropCustom
RemoveProp .hWnd, PropForeColor
RemoveProp .hWnd, PropAlign
.Refresh
End With
End Sub

Private Function DrawButtonProc(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
Dim s As String
Dim VA As AlignText
lOldProc = GetProp(hWnd, PropSubclass)
DrawButtonProc = CallWindowProc(lOldProc, hWnd, wMsg, wParam, lParam)
Select Case wMsg
Case WM_DRAWITEM
CopyMemory di, ByVal lParam, Len(di)
With di
If .CtlType = ODT_BUTTON Then
If GetProp(.hWndItem, PropCustom) Then
VA = GetProp(.hWndItem, PropAlign)
With .rcItem
Select Case VA
Case DT_TOP
.Top = .Top + 4
Case DT_BOTTOM
.Bottom = .Bottom - 4
Case ThreeD
.Left = .Left - 1
.Top = .Top - 1
.Right = .Right - 1
.Bottom = .Bottom - 1
VA = AlignCenter
End Select
If (di.ItemState And ODS_SELECTED) = ODS_SELECTED Then
.Left = .Left + 1
.Top = .Top + 1
.Right = .Right + 1
.Bottom = .Bottom + 1
End If
End With
SetBkMode .hDC, TRANSPARENT
s = String$(255, 0)
GetWindowText .hWndItem, s, Len(s)
s = Left$(s, InStr(s, Chr$(0)) - 1)
SetTextColor .hDC, GetProp(.hWndItem, PropForeColor)
If di.CtlID <> 2 Then
DrawText .hDC, s, Len(s), .rcItem, DT_SINGLELINE Or DT_HCENTER Or VA
Else
With .rcItem
.Top = .Top + 46
End With
DrawText .hDC, s, Len(s), .rcItem, DT_WORDBREAK Or TA_CENTER Or DT_HCENTER
End If
End If
End If
End With
Case WM_DESTROY
If lOldProc Then
SetWindowLong hWnd, GWL_WNDPROC, lOldProc
RemoveProp hWnd, PropSubclass
End If
End Select
End Function


调用 --->>> 在窗体上加入一个按钮，写入代码：

'Command1.Style = 1　这个运行前设置

Private Sub Form_Load()
Command1.BackColor = &HFFC0C0
SetCommandButtonFontColor Command1, vbBlue
End Sub

Private Sub Form_Unload(Cancel As Integer)
UnSetCommandButtonFontColor Command1
End Sub

[唐古拉山]

我把调用函数名称改了，上面贴错误了：这确模块：

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
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 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 Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
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 As Long = 1
Private Const GWL_WNDPROC As Long = -4
Private Const ODT_BUTTON As Long = 4
Private Const ODS_SELECTED As Long = &H1
Private Const WM_DESTROY As Long = &H2
Private Const WM_DRAWITEM As Long = &H2B
Private Const DT_HCENTER As Long = &H1
Private Const DT_TOP As Long = &H0
Private Const DT_VCENTER As Long = &H4
Private Const DT_BOTTOM As Long = &H8
Private Const DT_SINGLELINE As Long = &H20

Private Const DT_WORDBREAK As Long = &H10
Public Const DT_CHARSTREAM = 4 ' Character-stream, PLP
Public Const DT_EXPANDTABS = &H40
Public Const DT_EXTERNALLEADING = &H200
Public Const DT_LEFT = &H0
Public Const DT_NOCLIP = &H100
Public Const DT_CENTER As Long = &H1
Public Const DT_CALCRECT = &H400
Public Const DT_INTERNAL = &H1000

Public Const TA_CENTER = 6
Public Const TA_UPDATECP = 1
Public Const TA_BASELINE = 24
Public Const DT_METAFILE = 5 ' Metafile, VDM
Public Const DT_PLOTTER = 0 ' Vector plotter
Public Const DUPLICATE = &H6

Public Const WM_GETTEXT = &HD
Public Const WM_GETMINMAXINFO = &H24
Public Const WM_GETFONT = &H31
Public Const WM_COPY = &H301
Public Const WM_GETTEXTLENGTH = &HE
Public Const WM_COPYDATA = &H4A
Public Const WM_PASTE = &H302

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

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

Public Enum AlignText
AlignTop = DT_TOP
AlignCenter = DT_VCENTER
AlignBottom = DT_BOTTOM
ThreeD = DT_VCENTER Or DT_BOTTOM
End Enum

Private Const PropCustom = "UMGCustom"
Private Const PropForeColor = "UMGForeColor"
Private Const PropAlign = "UMGVAlign"
Private Const PropSubclass = "UMGDrawProc"

Public Sub SetCommandButtonFontColor(Button As CommandButton, ByVal ForeColor As OLE_COLOR, Optional ByVal Alignment As AlignText = AlignCenter)
Dim hWndPnt As Long
With Button
hWndPnt = GetParent(.hWnd)
If GetProp(hWndPnt, PropSubclass) = 0 Then
SetProp hWndPnt, PropSubclass, GetWindowLong(hWndPnt, GWL_WNDPROC)
SetWindowLong hWndPnt, GWL_WNDPROC, AddressOf DrawButtonProc
End If
SetProp .hWnd, PropCustom, True
SetProp .hWnd, PropForeColor, ForeColor
SetProp .hWnd, PropAlign, Alignment
.Refresh
End With
End Sub

Public Sub UnSetCommandButtonFontColor(Button As CommandButton)
With Button
RemoveProp .hWnd, PropCustom
RemoveProp .hWnd, PropForeColor
RemoveProp .hWnd, PropAlign
.Refresh
End With
End Sub

Private Function DrawButtonProc(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
Dim s As String
Dim VA As AlignText
lOldProc = GetProp(hWnd, PropSubclass)
DrawButtonProc = CallWindowProc(lOldProc, hWnd, wMsg, wParam, lParam)
Select Case wMsg
Case WM_DRAWITEM
CopyMemory di, ByVal lParam, Len(di)
With di
If .CtlType = ODT_BUTTON Then
If GetProp(.hWndItem, PropCustom) Then
VA = GetProp(.hWndItem, PropAlign)
With .rcItem
Select Case VA
Case DT_TOP
.Top = .Top + 4
Case DT_BOTTOM
.Bottom = .Bottom - 4
Case ThreeD
.Left = .Left - 1
.Top = .Top - 1
.Right = .Right - 1
.Bottom = .Bottom - 1
VA = AlignCenter
End Select
If (di.ItemState And ODS_SELECTED) = ODS_SELECTED Then
.Left = .Left + 1
.Top = .Top + 1
.Right = .Right + 1
.Bottom = .Bottom + 1
End If
End With
SetBkMode .hDC, TRANSPARENT
s = String$(255, 0)
GetWindowText .hWndItem, s, Len(s)
s = Left$(s, InStr(s, Chr$(0)) - 1)
SetTextColor .hDC, GetProp(.hWndItem, PropForeColor)
If di.CtlID <> 2 Then
DrawText .hDC, s, Len(s), .rcItem, DT_SINGLELINE Or DT_HCENTER Or VA
Else
With .rcItem
.Top = .Top + 46
End With
DrawText .hDC, s, Len(s), .rcItem, DT_WORDBREAK Or TA_CENTER Or DT_HCENTER
End If
End If
End If
End With
Case WM_DESTROY
If lOldProc Then
SetWindowLong hWnd, GWL_WNDPROC, lOldProc
RemoveProp hWnd, PropSubclass
End If
End Select
End Function

[wzzwwz]

晕～

[白发程序猿]

我可以一个设置字体颜色的方法给你，但我没代码，就是这样，用image控件先设置好以后然后把image赋给command就行了。你可以上网搜搜。