Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Commandbutton caption color...

Status
Not open for further replies.

keeyean

MIS
Sep 29, 2001
32
US
how do i change the color of the commandbutton's caption??
 

this is simple way,go to commandbutton properties
change in to fore color and background color
u want to pic , properties have a pic properties also
o.k.

shanmugham(india)

 
but it doesn't have forecolor.. it's only have backcolor and maskcolor in the commondbutton's properties.
 
I don't know that you can.

You could also put a picture on the button with the color scheme that you want.
 
so you mean.. i can't change the fore color like the way i change the fore color of label (change the fore properties of the label )??
 
Its possible, I got this from the net somewhere...

Set Command Button's Caption Color

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 1 Command Button to your form. Set the Command Button
'Style property to 1 - Graphical.
'Insert the following code to your module:

Private colButtons As New Collection
Private Const KeyConst = "K"
Private Const FormName = "ThunderFormDC"
Private Const PROP_COLOR = "SMDColor"
Private Const PROP_HWNDPARENT = "SMDhWndParent"
Private Const PROP_LPWNDPROC = "SMDlpWndProc"
Private Const GWL_WNDPROC = -4
Private Const ODA_SELECT = &H2
Private Const ODS_SELECTED = &H1
Private Const ODS_FOCUS = &H10
Private Const ODS_BUTTONDOWN = ODS_FOCUS + ODS_SELECTED
Private Const WM_DESTROY = &H2
Private Const WM_DRAWITEM = &H2B

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

Private Type Size
cx As Long
cy 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

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, _
ByVal wParam As Long, lParam As DRAWITEMSTRUCT) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long

Private Declare Function GetParent Lib "user32" (ByVal hWnd 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 GetTextExtentPoint32 Lib "gdi32" Alias _
"GetTextExtentPoint32A" (ByVal hDC As Long, ByVal lpSz As String, _
ByVal cbString As Long, lpSize As Size) As Long

Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" _
(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 SetTextColor Lib "gdi32" _
(ByVal hDC As Long, ByVal crColor 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 Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" _
(ByVal hDC As Long, ByVal x As Long, ByVal y As Long, _
ByVal lpString As String, ByVal nCount As Long) As Long

Private Function FindButton(sKey As String) As Boolean
Dim cmdButton As CommandButton
On Error Resume Next
Set cmdButton = colButtons.Item(sKey)
FindButton = (Err.Number = 0)
End Function

Private Function GetFormHandle(hWndButton As Long) As Long
Dim hWndParent As Long
Dim l As Long
Dim ClassName As String * 128
hWndParent = GetParent(hWndButton)
Do Until (hWndParent = 0)
l = GetClassName(hWndParent, ClassName, Len(ClassName))
If Left(ClassName, l) = FormName Then Exit Do
hWndParent = GetParent(hWndParent)
Loop
GetFormHandle = hWndParent
End Function

Private Function GetKey(hWnd As Long) As String
GetKey = KeyConst & hWnd
End Function

Private Function ProcessButton(ByVal hWnd As Long, _
ByVal uMsg As Long, ByVal wParam As Long, _
lParam As DRAWITEMSTRUCT, sKey As String) As Long
Dim cmdButton As CommandButton
Dim bRC As Boolean
Dim lRC As Long
Dim x As Long
Dim y As Long
Dim lpWndProc As Long
Dim lButtonWidth As Long
Dim lButtonHeight As Long
Dim lPrevColor As Long
Dim lColor As Long
Dim TextSize As Size
Dim sCaption As String
Const PushOffset = 2
Set cmdButton = colButtons.Item(sKey)
sCaption = cmdButton.Caption
lColor = GetProp(cmdButton.hWnd, PROP_COLOR)
lPrevColor = SetTextColor(lParam.hDC, lColor)
lRC = GetTextExtentPoint32(lParam.hDC, _
sCaption, Len(sCaption), TextSize)
lButtonHeight = lParam.rcItem.Bottom - lParam.rcItem.Top
lButtonWidth = lParam.rcItem.Right - lParam.rcItem.Left
If (lParam.itemAction = ODA_SELECT) And (lParam.itemState = ODS_BUTTONDOWN) Then
cmdButton.SetFocus
DoEvents
x = (lButtonWidth - TextSize.cx + PushOffset) \ 2
y = (lButtonHeight - TextSize.cy + PushOffset) \ 2
Else
x = (lButtonWidth - TextSize.cx) \ 2
y = (lButtonHeight - TextSize.cy) \ 2
End If
lpWndProc = GetProp(hWnd, PROP_LPWNDPROC)
ProcessButton = CallWindowProc(lpWndProc, hWnd, uMsg, wParam, lParam)
bRC = TextOut(lParam.hDC, x, y, sCaption, Len(sCaption))
lRC = SetTextColor(lParam.hDC, lPrevColor)
ProcessButton_Exit:
Set cmdButton = Nothing
End Function

Private Sub RemoveForm(hWndParent As Long)
Dim hWndButton As Long
Dim i As Integer
UnsubclassForm hWndParent
On Error GoTo RemoveForm_Exit
For i = colButtons.Count - 1 To 0 Step -1
hWndButton = colButtons(i).hWnd
If GetProp(hWndButton, PROP_HWNDPARENT) = hWndParent Then
RemoveProp hWndButton, PROP_COLOR
RemoveProp hWndButton, PROP_HWNDPARENT
colButtons.Remove i
End If
Next i
RemoveForm_Exit:
Exit Sub
End Sub

Private Function UnsubclassForm(hWnd As Long) As Boolean
Dim lRC As Long
Dim lpWndProc As Long
lpWndProc = GetProp(hWnd, PROP_LPWNDPROC)
If lpWndProc = 0 Then
UnsubclassForm = False
Else
lRC = SetWindowLong(hWnd, GWL_WNDPROC, lpWndProc)
RemoveProp hWnd, PROP_LPWNDPROC
UnsubclassForm = True
End If
End Function

Private Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, lParam As DRAWITEMSTRUCT) As Long
Dim lpWndProc As Long
Dim bProcessButton As Boolean
Dim sButtonKey As String
bProcessButton = False
If (uMsg = WM_DRAWITEM) Then
sButtonKey = GetKey(lParam.hWndItem)
bProcessButton = FindButton(sButtonKey)
End If
If bProcessButton Then
ProcessButton hWnd, uMsg, wParam, lParam, sButtonKey
Else
lpWndProc = GetProp(hWnd, PROP_LPWNDPROC)
WindowProc = CallWindowProc(lpWndProc, hWnd, uMsg, wParam, lParam)
If uMsg = WM_DESTROY Then RemoveForm hWnd
End If
End Function

Public Function RegisterButton(Button As CommandButton, Forecolor As Long)
Dim hWndParent As Long
Dim lpWndProc As Long
Dim sButtonKey As String
sButtonKey = GetKey(Button.hWnd)
If FindButton(sButtonKey) Then
SetProp Button.hWnd, PROP_COLOR, Forecolor
Button.Refresh
Else
hWndParent = GetFormHandle(Button.hWnd)
If (hWndParent = 0) Then
RegisterButton = False
Exit Function
End If
colButtons.Add Button, sButtonKey
SetProp Button.hWnd, PROP_COLOR, Forecolor
SetProp Button.hWnd, PROP_HWNDPARENT, hWndParent
lpWndProc = GetProp(hWndParent, PROP_LPWNDPROC)
If (lpWndProc = 0) Then
lpWndProc = SetWindowLong(hWndParent, _
GWL_WNDPROC, AddressOf WindowProc)
SetProp hWndParent, PROP_LPWNDPROC, lpWndProc
End If
End If
RegisterButton = True
End Function

Public Function UnregisterButton(Button As CommandButton) As Boolean
Dim hWndParent As Long
Dim sKeyButton As String
sKeyButton = GetKey(Button.hWnd)
If (FindButton(sKeyButton) = False) Then
UnregisterButton = False
Exit Function
End If
hWndParent = GetProp(Button.hWnd, PROP_HWNDPARENT)
UnregisterButton = UnsubclassForm(hWndParent)
colButtons.Remove sKeyButton
RemoveProp Button.hWnd, PROP_COLOR
RemoveProp Button.hWnd, PROP_HWNDPARENT
End Function

'Insert this code to your form:

Private Sub Form_Load()
'Replace 'Command1' with the name of your Command Button,
'Replace 'vbRed' with the caption color. You can put here the Hex value
'of the color.
RegisterButton Command1, vbRed
End Sub
 
Of course, there's an easier way...

Add the Microsoft Forms 2.0 component to your project, and use the Command button from that. It supports a ForeColor property.
 
wow... it really save a lot of steps...:)
thanz you guys ...:)
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top