Color de letra de los botones - VB-MUNDO

clarita_1979 · #1 (**permalink**) 26-12-2007, 14:59:21

Buenas...

pues hoy me estreno aquí... no sé si os seré de mucha ayuda y ojalá vosotros me podáis ayudar pero intentaré hacerlo lo mejor posible.

Mi problema es el siguiente:

Tengo varios botones (command) de un formulario en visual basic 6 y quería ponerle color de letra (forecolor) pero por lo visto a los botones de vb6 no se le puede poner eso... luego pensé... bueno pos le ponemos una label por encima con el mismo texto y color y ya está.... pero tampoco funciona! aunque haya mandado el botón para el fondo y la label para el frente!!

¿alguna sugerencia?

Saludos

malm82 · #2 (**permalink**) 26-12-2007, 16:35:20

Checa este post
http://www.foro.vb-mundo.com/about25...tml&highlight=

seba123neo · #3 (**permalink**) 26-12-2007, 23:10:48

Hola,aca te dejo un ejemplo de como hacerlo,no necesitas ocx ni controles para hacerlo,solo usando codigo y api's de windows,pone un boton en el formulario y ponele el estilo en Graphical,y despues pone esto en un modulo(bas):

Código:

Option Explicit
Private colButtons  As New Collection
Private Const KeyConst = "K"
Private Const PROP_COLOR = "SMDColor"
Private Const PROP_HWNDPARENT = "SMDhWndParent"
Private Const PROP_LPWNDPROC = "SMDlpWndProc"
Private Const GWL_WNDPROC As Long = (-4)
Private Const ODA_SELECT As Long = &H2
Private Const ODS_SELECTED As Long = &H1
Private Const ODS_FOCUS As Long = &H10
Private Const ODS_BUTTONDOWN As Long = ODS_FOCUS Or ODS_SELECTED
Private Const WM_DESTROY As Long = &H2
Private Const WM_DRAWITEM As Long = &H2B
Private Const VER_PLATFORM_WIN32_NT As Long = 2

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 Type OSVERSIONINFO
  OSVSize         As Long
  dwVerMajor      As Long
  dwVerMinor      As Long
  dwBuildNumber   As Long
  PlatformID      As Long
  szCSDVersion    As String * 128
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 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 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 Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
  (lpVersionInformation As Any) 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 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.itemState And ODS_BUTTONDOWN) = 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 cnt As Integer
   
   UnsubclassForm hWndParent
   
   On Error GoTo RemoveForm_Exit
   
   For cnt = colButtons.Count - 1 To 0 Step -1
   
      hWndButton = colButtons(cnt).hWnd
      
      If GetProp(hWndButton, PROP_HWNDPARENT) = hWndParent Then
         RemoveProp hWndButton, PROP_COLOR
         RemoveProp hWndButton, PROP_HWNDPARENT
         colButtons.Remove cnt
      End If
      
   Next cnt
   
RemoveForm_Exit:

End Sub


Private Function UnsubclassForm(hWnd As Long) As Boolean

   Dim lpWndProC As Long
   
   lpWndProC = GetProp(hWnd, PROP_LPWNDPROC)
   
   If lpWndProC = 0 Then
   
      UnsubclassForm = False
      
   Else
   
      Call SetWindowLong(hWnd, GWL_WNDPROC, lpWndProC)
      RemoveProp hWnd, PROP_LPWNDPROC
      UnsubclassForm = True
      
   End If

End Function


Private Function ButtonColorProc(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)
      ButtonColorProc = CallWindowProc(lpWndProC, hWnd, uMsg, wParam, lParam)

      If uMsg = WM_DESTROY Then RemoveForm hWnd
      
   End If

End Function


Public Function ColorBoton(Button As CommandButton, _
                               Forecolor As Long) As Boolean

   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 = GetParent(Button.hWnd)
      If (hWndParent = 0) Then
         ColorBoton = 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 ButtonColorProc)
         SetProp hWndParent, PROP_LPWNDPROC, lpWndProC
      End If
   
   End If
   
   ColorBoton = 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


Private Function IsWinXPPlus() As Boolean


   Dim osv As OSVERSIONINFO

   osv.OSVSize = Len(osv)

   If GetVersionEx(osv) = 1 Then
   
      IsWinXPPlus = (osv.PlatformID = VER_PLATFORM_WIN32_NT) And _
                    (osv.dwVerMajor >= 5 And osv.dwVerMinor >= 1)

   End If

End Function

y en el formulario solo llamas a la funcion pasandole el boton y le pones el color que queres al la letra:

Código:

Private Sub Form_Load()
ColorBoton Command1, vbRed
End Sub

saludos.

clarita_1979 · #4 (**permalink**) 11-01-2008, 17:24:01

muchas gracias seba... no lo usé hasta hoy! pero el tema es que este código me pone bien todo aquello que esté en un botón con una línea... pero si el botón tiene dos líneas... olvidate! no lo hace... pone el texto en color negro y luego por el medio el texto en el color establecido... como si fuera una label a mayores. :smt010

¿Alguna idea para corregirlo?
Gracias
saludos

malm82 · #5 (**permalink**) 11-01-2008, 18:21:42

Hola, el problema que tienes lo solucionas como te dije en mi comentario anterior checa el ejemplo que adjunto el post http://www.foro.vb-mundo.com/about25...tml&highlight=

y para que puedas ponerle un color de letra solo tienes que poner el valor (2-custom) a la propiedad ColorScheme y esto hara lo que necesitas.

clarita_1979 · #6 (**permalink**) 14-01-2008, 09:39:32

Muchísimas gracias malm82!! :smt004 :smt023

Ahora sí funciona! Pero me he encontrado con otro problema... Igual esto debería ponerlo en otro hilo distinto pero es que si lo pongo en otro hilo nadie va a saber de qué tipo de botón se trata por eso decidí ponerlo aquí:

El caso es que yo ya tenía creados todos los botones de todos los formularios de mi aplicación y si ahora los hago bajo este tipo tendría que volver a crearlos mirando cada una de sus propiedades (left,width,top....) y sus eventos (click, mouseover....) :smt015 :smt017 ... ¿habría alguna forma de convertir el botón de tipo command a tipo mxpbutton?

Estuve mirando pero no encontré nada!

Saludos

malm82 · #7 (**permalink**) 14-01-2008, 15:56:06

Hola,
que yo sepa no hay otra forma que no sea la manual es decir quitar y poner el otro control con el mismo nombre, y no te preocupes por sus metodos, ya este boton tiene las mismas propiedades del command.

clarita_1979 · #8 (**permalink**) 15-01-2008, 10:12:39

Muchas gracias por vuestra ayuda, sobre todo a ti malm82...

Ahora estoy modificando varios botones, mirando previamente las propiedades que tienen y reemplazandolos por los anteriores. Utilizo los mxpbuttons! y es muy fácil cambiar el estilo y color de los botones!

Saludos y hasta la próxima

:smt004 :smt006 :smt023 :smt024