MUDAR COR DO CAPTION DO COMMAND BUTTON

F001E 20/07/2010 11:52:49
#347905
Boa Tarde a Todos...
Existe alguma maneira do Mudar a Cor do Caption do Componente Command Button do VB6...?
Eu sei que consigo mudar a Cor de Fundo do Command, colocar o Caption do Negrito...mas a Cor do Caption nao tem opção para Mudar....
Existe alguma Programação para isso....sem ter que Trocar os Command Button por Outro Componente ?
JONATHANSTECKER 20/07/2010 12:03:27
#347910
Acredito que não seja possível mudar a cor da fonte de um commandbutton, vc tem que escolher outro tipo de botão.
Para mudar de botão: menu Project/Components../Guia Controls/selecione a opção Microsoft Forms 2.0 Library/e clique em aplicar.
Irá aparecer vários outros objetos escolha o Command Button e altere suas propriedades....

Não tenho certeza... Mas acho que não é possível.
IRENKO 20/07/2010 12:35:36
#347914
Resposta escolhida
Jeito tem. Ou vc usa os componentes Microsoft Forms 2.0 object library ou API como segue:

Em um Módulo:

[ô]==================================================================
[ô]
[ô] Found at Visual Basic Thunder, www.vbthunder.com
[ô]
[ô]
[ô] This module provides an easy way to change the text color
[ô] of a VB CommandButton control. To use the code with a
[ô] CommandButton, you should:
[ô]
[ô] - Set the button[ô]s Style property to [Ô]Graphical[Ô] at design time.
[ô]
[ô] - Optionally set its BackColor and Picture properties.
[ô]
[ô] SetButtonForeColor Command1, vbBlue, Alignment
[ô]
[ô] - Call UnsetButtonForeColor in the Form_Unload event:
[ô] UnsetButtonForeColor Command1
[ô]
[ô]==================================================================
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
[ô]chris added
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

[ô]property names
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 [ô]not yet subclassed
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
[ô]Button is in down state - offset the text
.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)
[ô]Command4 was chosen as the
[ô]multi line button, let[ô]s do
[ô]all the others first
[ô](Command4[ô]s ID# is 2)
If di.CtlID <> 2 Then
DrawText .hDC, s, Len(s), .rcItem, DT_SINGLELINE Or DT_HCENTER Or VA
Else
[ô]we have to fiddle with the
[ô]RECT to move the text down
[ô]vertically depending upon the
[ô]size of the button. This method
[ô]could use some help.
With .rcItem
.Top = .Top + 46
End With
[ô]draw the multi line text.
[ô]it is centered horizontally but
[ô]at a Y coordinate of 0 unless
[ô]we do the above
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 [ô]is subclassed
SetWindowLong hwnd, GWL_WNDPROC, lOldProc
RemoveProp hwnd, PropSubclass
End If
End Select

End Function

No Load do Form:

SetForeColor CmdSair, vbRed

No Unload do Form:

UnsetForeColor CmdSair

Testa ai.
IRENKO 20/07/2010 12:41:44
#347916
Segue arquivo. Lembrado, a propriedade Style tem que ser Grafhical.
ROBIU 20/07/2010 12:51:12
#347918
Já que vai precisar tanto código para fazer isso, Usa este usercontrol que tem vários estilos.
F001E 20/07/2010 14:32:39
#347934
entao...vou testar o Código do IRENKO....pois nao quero mudar todos os Botões do meu Projeto....
F001E 20/07/2010 15:31:34
#347941
blz IRENKO..deu certo...só fiz algums reajuste pq quando o Botão fica em Enabled = False...o Caption não ficava...dai Arrumei isso...valews...
Tópico encerrado , respostas não são mais permitidas