Botones al estilo de Office 97
y un pequeño truco para mostrar los ToolTips

Primera: 6/Ago/97, revisado: 7/Ago/97
Pulsa aquí para ver los cambios añadidos el 7/Ago/97


Espero que este pequeño "truco" te sirva para dar el nuevo "look" de los botones de Office y VB5 a tus programas.
Este código sirve igualmente para VB4-16 como para 32 bits, no lo he probado con VB3, pero igualmente sirve, al menos si cambias la rutina del efecto 3D usando Parent en lugar de Container....

El "truco" consiste en dibujar el botón cuando se está encima del botón, el ToolTip se hace mediante un label que se oculta cuando no lo necesitamos y que se muestra cuando estamos "encima" de uno de los botones.
Los botones son controles IMAGE y he usado para el ejemplo los gráficos que tengo para el ToolBar al estilo Windows95.
Estos gráficos puedes "fabricartelo" tu mismo, incluso te lo recomendaría, ya que son un "poco" pequeños y el efecto quedaría mejor si los bitmaps fuesen un poco más grandes. Pero para el ejemplo este, son válidos.

Si quieres bajarte los gráficos, pulsa este link.

Para bajar los listados del ejemplo, pulsa en este otro (botones.zip 4.02 KB)

La rutina que hace el efecto 3D

El código del Form de ejemplo


Rutina del Efecto 3D

Option Explicit
'--------------------------------------------------
'Efecto 3D (nueva versión)              ( 5/Nov/94)
' Usando Container en lugar de Parent   ( 3/Sep/96)
'--------------------------------------------------
Global Const E3D_INSET = 1
Global Const E3D_RAISED = 2
Sub Efecto3DN(QueEfecto As Integer, QueContenedor As Control, Optional QueControl)
    '------------------------------------------------------
    'Explicación de los parámetros a pasar:
    ' QueEfecto     Puede tener los valores: E3D_INSET o E3D_RAISED (tipo botón)
    ' ( 9/Nov/94)   Si QueEfecto > 10 DrawWidth=2...
    ' QueContenedor Si el contenedor es una Forma, se pondrá el mismo control,
    '               sino se pone el control contenedor de QueControl
    ' QueControl    Control al que se le hará el efecto 3D
    ' (10/Nov/95)   QueControl es opcional, usandose Quecontenedor
    '------------------------------------------------------

    Dim X As Long, Y As Long
    Dim CurrentX As Integer, CurrentY As Integer
    Dim Color_Gris As Long, Color_Blanco As Long
    Dim Ltmp As Long
    Dim Bevel As Integer

    If IsMissing(QueControl) Then
        Set QueControl = QueContenedor
    End If
    Color_Gris = RGB(92, 92, 92)
    Color_Blanco = RGB(255, 255, 255)

    'Ancho de la línea
    Bevel = 1
    Do While QueEfecto > 10
        QueEfecto = QueEfecto - 10
        Bevel = Bevel + 1
    Loop

    If QueEfecto = E3D_RAISED Then      'Estilo Command
        Ltmp = Color_Gris
        Color_Gris = Color_Blanco
        Color_Blanco = Ltmp
    End If

    X = Screen.TwipsPerPixelX
    Y = Screen.TwipsPerPixelY

    CurrentX = QueControl.Left - X
    CurrentY = QueControl.Top + QueControl.Height
    'Si se dibuja un Frame...                   (13/Nov/94)
    If TypeOf QueControl Is Frame Then
        Y = Y - 120
    End If

    If QueContenedor Is QueControl Then
        With QueControl
            .Container.DrawWidth = Bevel
            .Container.Line (CurrentX, CurrentY)-(CurrentX, CurrentY), Color_Gris
            .Container.Line -Step(0, -(.Height + Y)), Color_Gris
            .Container.Line -Step(.Width + X, 0), Color_Gris
            .Container.Line -Step(0, .Height + Y), Color_Blanco
            .Container.Line -Step(-(.Width + X), 0), Color_Blanco
        End With
    Else
        QueContenedor.DrawWidth = Bevel
        QueContenedor.Line (CurrentX, CurrentY)-(CurrentX, CurrentY), Color_Gris
        QueContenedor.Line -Step(0, -(QueControl.Height + Y)), Color_Gris
        QueContenedor.Line -Step(QueControl.Width + X, 0), Color_Gris
        QueContenedor.Line -Step(0, QueControl.Height + Y), Color_Blanco
        QueContenedor.Line -Step(-(QueControl.Width + X), 0), Color_Blanco
    End If

End Sub

El código del Form de ejemplo

'-----------------------------------------------------------------
'Ejemplo para simular un toolbar al estilo de Office   ( 5/Ago/97)
'(c)Guillermo Som, 1997
'-----------------------------------------------------------------
Option Explicit

Dim nBoton As Integer   'Para controlar en que imagen se está
Dim sTips() As String   'Nombres de los botones
'Constantes para lo botones
Const cNuevo = 0
Const cAbrir = 1
Const cGuardar = 2
Const cCortar = 3
Const cCopiar = 4
Const cPegar = 5
Const cAcerca = 6
Const cSalir = 7


Private Sub Form_Load()
    ReDim sTips(0 To 7)
    sTips(0) = "Nuevo"
    sTips(1) = "Abrir"
    sTips(2) = "Guardar"
    sTips(3) = "Cortar"
    sTips(4) = "Copiar"
    sTips(5) = "Pegar"
    sTips(6) = "Acerca de"
    sTips(7) = "Salir"
    lblTip.Visible = False
    lblTip.Top = picTool.Height
End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    QuitarBoton
End Sub


Private Sub imgTool_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Si es el botón izquierdo...
    If Button = 1 Then
        'Efecto de pulsado
        imgTool(Index).BorderStyle = 1
        lblTip.Visible = False
        'cargar la rutina correspondiente
        Accion Index
        'quitar el efecto
        imgTool(Index).BorderStyle = 0
    End If
End Sub


Private Sub imgTool_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If nBoton Then
        If nBoton <> Index + 1 Then
            picTool.Cls     'Borrar el efecto anterior
        Else
            'Si estamos en el mismo botón, salir
            Exit Sub
        End If
    End If
    nBoton = Index + 1
    'Dibujar el efecto "botón"
    Efecto3DN E3D_RAISED, picTool, imgTool(Index)
    lblStatus = "Está seleccionado el botón de " & sTips(Index)
    With lblTip
        .Caption = " " & sTips(Index) & " "
        .Left = imgTool(Index).Left
        .Visible = True
    End With
End Sub


Private Sub picTool_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    QuitarBoton
End Sub


Private Sub picTool_Resize()
    If WindowState <> vbMinimized Then
        'Ajustar el tamaño de las líneas
        Line1(0).X2 = picTool.ScaleWidth
        Line1(1).X2 = Line1(0).X2
    End If
End Sub


Private Sub mnuAcerca_Click()
    MsgBox "Programa de prueba de barra de botones al estilo Office 97" & vbCrLf & vbCrLf _
	& "(c)Guillermo Som, 1997", vbInformation, "Pueba de botones"
End Sub


Private Sub mnuSalir_Click()
    Unload Me
    End
End Sub


'Deberás poner en esta rutina tus propias acciones
'
Private Sub Accion(Index As Integer)
    'Según el índice, se ejecutará la acción correspondiente
    Select Case Index
    Case cNuevo
        'Nuevo
        MsgBox "Has pulsado en " & sTips(Index)
    Case cAbrir
        'Abrir
        MsgBox "Has pulsado en " & sTips(Index)
    Case cGuardar
        'guardar
        MsgBox "Has pulsado en " & sTips(Index)
    Case cCortar
        'Cortar
        MsgBox "Has pulsado en " & sTips(Index)
    Case cCopiar
        'Copiar
        MsgBox "Has pulsado en " & sTips(Index)
    Case cPegar
        'Pegar
        MsgBox "Has pulsado en " & sTips(Index)
    Case cAcerca
        mnuAcerca_Click
    Case cSalir
        'Salir
        mnuSalir_Click
    End Select
End Sub


Private Sub QuitarBoton()
    'Quitar el efecto del botón y el ToolTip
    If nBoton Then
        picTool.Cls
    End If
    nBoton = 0
    lblStatus = ""
    lblTip.Visible = False
End Sub

NUEVO:
He añadido otro ejemplo, usando una clase para simular el objeto que se pasa a la rutina de Efecto3D.
De esta forma se puede indicar un tamaño y posición diferente del que tiene el control Imagen usado para hacer de botón. Esto lo he hecho, porque los dibujos que tengo, están "justillos" y quedaba un poco "feos" al hacerle el efecto 3D.

También he añadido una nueva opción a la rutina Efecto3DN de forma que "quite" el efecto que antes se dibujó, con esto se consigue que no parpadee tanto la barra de botones al hacer CLS al picture contenedor.

La clase contiene las propiedades que se manipulan dentro de la rutina de efecto tridimensional, además de incluir el ToolTip de cada botón.
Se pueden añadir más propiedades a la clase, por ejemplo el Picture que debe mostrar... es cuestión de buscarle la utilidad.

Para bajar los listados del segundo ejemplo, pulsa en este link (botones2.zip 5.06 KB)

La rutina que hace el efecto 3D

La clase para simular el objeto

El código del Form de ejemplo


Rutina Efecto3DN

Option Explicit
'--------------------------------------------------
'Efecto 3D (nueva versión)              ( 5/Nov/94)
' Usando Container en lugar de Parent   ( 3/Sep/96)
' Revisado				( 6/Ago/97)
'--------------------------------------------------
Global Const E3D_QUITAR = 0
Global Const E3D_INSET = 1
Global Const E3D_RAISED = 2


Sub Efecto3DN(QueEfecto As Integer, QueContenedor As Control, Optional QueControl)
    '------------------------------------------------------
    'Explicación de los parámetros a pasar:
    ' QueEfecto     Puede tener los valores: E3D_INSET o E3D_RAISED (tipo botón)
    ' ( 9/Nov/94)   Si QueEfecto > 10 DrawWidth=2...
    ' QueContenedor Si el contenedor es una Forma, se pondrá el mismo control,
    '               sino se pone el control contenedor de QueControl
    ' QueControl    Control al que se le hará el efecto 3D
    ' (10/Nov/95)   QueControl es opcional, usandose Quecontenedor
    '------------------------------------------------------

    Dim X As Long, Y As Long
    Dim CurrentX As Integer, CurrentY As Integer
    Dim Color_Gris As Long, Color_Blanco As Long
    Dim Ltmp As Long
    Dim Bevel As Integer

    If IsMissing(QueControl) Then
        Set QueControl = QueContenedor
    End If
    Color_Gris = RGB(92, 92, 92)
    Color_Blanco = RGB(255, 255, 255)

    'Ancho de la línea
    Bevel = 1
    Do While QueEfecto > 10
        QueEfecto = QueEfecto - 10
        Bevel = Bevel + 1
    Loop

    If QueEfecto = E3D_RAISED Then      'Estilo Command
        Ltmp = Color_Gris
        Color_Gris = Color_Blanco
        Color_Blanco = Ltmp
    ElseIf QueEfecto = E3D_QUITAR Then  'Quitar el dibujo ( 6/Ago/97)
        Color_Gris = QueControl.Container.BackColor
        Color_Blanco = QueControl.Container.BackColor
    End If

    X = Screen.TwipsPerPixelX
    Y = Screen.TwipsPerPixelY

    CurrentX = QueControl.Left - X
    CurrentY = QueControl.Top + QueControl.Height
    'Si se dibuja un Frame...                   (13/Nov/94)
    If TypeOf QueControl Is Frame Then
        Y = Y - 120
    End If

    If QueContenedor Is QueControl Then
        With QueControl
            .Container.DrawWidth = Bevel
            .Container.Line (CurrentX, CurrentY)-(CurrentX, CurrentY), Color_Gris
            .Container.Line -Step(0, -(.Height + Y)), Color_Gris
            .Container.Line -Step(.Width + X, 0), Color_Gris
            .Container.Line -Step(0, .Height + Y), Color_Blanco
            .Container.Line -Step(-(.Width + X), 0), Color_Blanco
        End With
    Else
        QueContenedor.DrawWidth = Bevel
        QueContenedor.Line (CurrentX, CurrentY)-(CurrentX, CurrentY), Color_Gris
        QueContenedor.Line -Step(0, -(QueControl.Height + Y)), Color_Gris
        QueContenedor.Line -Step(QueControl.Width + X, 0), Color_Gris
        QueContenedor.Line -Step(0, QueControl.Height + Y), Color_Blanco
        QueContenedor.Line -Step(-(QueControl.Width + X), 0), Color_Blanco
    End If

End Sub

El código de la Clase

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cControl"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
'--------------------------------------------------------------
'Clase para usar con Efecto3DN                      ( 6/Ago/97)
'
'(c)Guillermo Som, 1997
'--------------------------------------------------------------
Option Explicit
'Propiedades del objeto:
Private objContainer As Object
Private objParent As Object
Private iLeft As Integer
Private iTop As Integer
Private iHeight As Integer
Private iWidth As Integer
Private sToolTip As String


Public Property Get Parent() As Object
    Set Parent = objParent
End Property

Public Property Get Container() As Object
    'Devuelve un puntero al objeto contenedor
    Set Container = objContainer
End Property

Public Property Set Parent(vNewParent As Object)
    Set objParent = vNewParent
End Property

Public Property Set Container(vNewContainer As Object)
    Set objContainer = vNewContainer
End Property

Public Property Get Width() As Variant
    Width = iWidth
End Property

Public Property Get Top() As Variant
    Top = iTop
End Property

Public Property Get ToolTip() As Variant
    ToolTip = sToolTip
End Property

Public Property Get Left() As Variant
    Left = iLeft
End Property

Public Property Get Height() As Variant
    Height = iHeight
End Property

Public Property Let Width(vNewWidth As Variant)
    iWidth = CInt(vNewWidth)
End Property

Public Property Let Top(vNewTop As Variant)
    iTop = CInt(vNewTop)
End Property

Public Property Let ToolTip(vNewTip As Variant)
    sToolTip = " " & CStr(vNewTip) & " "
End Property

Public Property Let Left(vNewLeft As Variant)
    iLeft = CInt(vNewLeft)
End Property

Public Property Let Height(vNewHeight As Variant)
    iHeight = CInt(vNewHeight)
End Property

El código del Form de ejemplo

'-----------------------------------------------------------------
'Ejemplo para simular un toolbar al estilo de Office   ( 5/Ago/97)
'Revisado con el uso de una clase y una colección      ( 6/Ago/97)
'
'(c)Guillermo Som, 1997
'-----------------------------------------------------------------
Option Explicit

Dim Botones As New Collection

Dim nBoton As Integer   'Para controlar en que imagen se está

'Constantes para lo botones
Const cNuevo = 0
Const cAbrir = 1
Const cGuardar = 2
Const cCortar = 3
Const cCopiar = 4
Const cPegar = 5
Const cAcerca = 6
Const cSalir = 7

Private Sub Form_Load()
    InicializarBotones

    Botones(1).ToolTip = "Nuevo"
    Botones(2).ToolTip = "Abrir"
    Botones(3).ToolTip = "Guardar"
    Botones(4).ToolTip = "Cortar"
    Botones(5).ToolTip = "Copiar"
    Botones(6).ToolTip = "Pegar"
    Botones(7).ToolTip = "Acerca de"
    Botones(8).ToolTip = "Salir"

    lblTip.Visible = False
    lblTip.Top = picTool.Height + picTool.Top + 60

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    QuitarBoton
End Sub

Private Sub imgTool_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Si es el botón izquierdo...
    If Button = 1 Then
        'Efecto de pulsado
        imgTool(Index).BorderStyle = 1
        lblTip.Visible = False
        'cargar la rutina correspondiente
        Accion Index
        'quitar el efecto
        imgTool(Index).BorderStyle = 0
    End If
End Sub

Private Sub imgTool_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If nBoton Then
        If nBoton <> Index + 1 Then
            'Borrar el efecto anterior
            Efecto3DN E3D_QUITAR, picTool, Botones(nBoton)
        Else
            'Si estamos en el mismo botón, salir
            Exit Sub
        End If
    End If
    nBoton = Index + 1
    'Dibujar el efecto "botón"
    Efecto3DN E3D_RAISED, picTool, Botones(nBoton)
    lblStatus = "Está seleccionado el botón de " & Botones(nBoton).ToolTip
    With lblTip
        .Caption = Botones(nBoton).ToolTip
        .Left = Botones(nBoton).Left + 60
        .Visible = True
    End With
End Sub

Private Sub mnuAcerca_Click()
    MsgBox "Programa de prueba de barra de botones al estilo Office 97" & vbCrLf & vbCrLf & "(c)Guillermo Som, 1997", vbInformation, "Pueba de botones"
End Sub

Private Sub mnuSalir_Click()
    Unload Me
    End
End Sub

Private Sub picStatus_Resize()
    If WindowState <> vbMinimized Then
        lblStatus.Width = picStatus.ScaleWidth
    End If
End Sub

Private Sub picTool_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    QuitarBoton
End Sub

Private Sub Accion(Index As Integer)
    'Según el índice, se ejecutará la acción correspondiente
    Select Case Index
    Case cNuevo
        'Nuevo
        MsgBox "Has pulsado en " & Botones(Index).ToolTip
    Case cAbrir
        'Abrir
        MsgBox "Has pulsado en " & Botones(Index).ToolTip
    Case cGuardar
        'guardar
        MsgBox "Has pulsado en " & Botones(Index).ToolTip
    Case cCortar
        'Cortar
        MsgBox "Has pulsado en " & Botones(Index).ToolTip
    Case cCopiar
        'Copiar
        MsgBox "Has pulsado en " & Botones(Index).ToolTip
    Case cPegar
        'Pegar
        MsgBox "Has pulsado en " & Botones(Index).ToolTip
    Case cAcerca
        mnuAcerca_Click
    Case cSalir
        'Salir
        mnuSalir_Click
    End Select
End Sub

Private Sub picTool_Resize()
    If WindowState <> vbMinimized Then
        'Ajustar el tamaño de las líneas
        Line1(0).X2 = picTool.ScaleWidth
        Line1(1).X2 = Line1(0).X2
    End If
End Sub

Private Sub QuitarBoton()
    'Quitar el efecto del botón y el ToolTip
    If nBoton Then
        'borrar el efecto anterior
        Efecto3DN E3D_QUITAR, picTool, Botones(nBoton)
    End If
    nBoton = 0
    lblStatus = ""
    lblTip.Visible = False
End Sub

Private Sub InicializarBotones()
    'Inicializar los controles de las imagenes
    Dim i As Integer
    Dim mBoton As New cControl

    'Hacer un bucle en todos los ImgTool
    For i = 0 To 7
        Set mBoton = Nothing
        With mBoton
            Set .Container = imgTool(i).Container
            Set .Parent = imgTool(i).Parent
            'Estas son las coordenadas para el efecto 3D
            .Left = imgTool(i).Left - 15
            .Top = imgTool(i).Top - 15
            .Width = imgTool(i).Width + 30
            .Height = imgTool(i).Height + 30
            'Añadir a la colección de botones
            Botones.Add mBoton
        End With
    Next
End Sub

la Luna del Guille o... el Guille que está en la Luna... tanto monta...