VB6: ComboBox con "Separador" de texto

[bizco]

la opcion de leandro seria lo mejor, aparte de eso, implementas un form sin bordes y cuando se hace click en el combo lo muestras como si fuese el dropdown original. de esta forma puedes personalizarlo 100%. incluso si en el segundo form metes un treeview vas a poder tener items con subitems dentro .

[ProgramadorVB]

hola amigos... muy buenos días a todos...


rob1104,
Sí ya probé tu ejemplo... es bueno... pero no es exactamente lo que me gustaría usar... igualmente te agradezco por tu ayuda, de verdad.


ctlon,
Lo de Leandro es poderoso, sería LA SOLUCIÓN... pero no tengo ni la capacidad... ni el tiempo físico para hacerlo yo mismo... ya que me llevaría varios días, con suerte...

Igualmente, estoy pensando (publiqué pensandolo desde el principio)... en que alguien sepa donde encontrar esa solución, ya resuelta... ya que seguramente eso que quiero hacer... o algo muy similar... ya fue creado por otro programador, en este mismo lenguaje VB6... no creo que esa ocurrencia, sea exclusiva mia... ni que eso no exista publicado en internet al día de hoy... el asunto es... que no lo pude encontrar... puse varios terminos de busqueda alternativos... y nada... nada para este lenguaje.

Desde ya muchas gracias... si acaso, accidentalmente encuentro la solución... la publicaré...

Un saludo!!!!

[Tokes]

Buen día, muchacho(a):

Prueba con este sencillo código y si no te sirve (o no te gusta), lo siento, no puedo hacer más por tí.

Para correrlo necesitas un Combo1 y un Text1. En el combo seleccionas la comida o bebida y en el Text te muestra el precio.

Código [Seleccionar] Expandir

Option Explicit

Dim precios As New Collection

Private Sub Combo1_Click()
    Text1.Text = precios.Item(Combo1.ListIndex + 1)
    If Val(Text1.Text) = 0 Then
        Text1.Text = " - "
    End If
End Sub

Private Sub Form_Load()
    Text1.Text = ""
    Combo1.AddItem ("----comidas----")
    precios.Add ""
    Combo1.AddItem ("pizza")
    precios.Add 110
    Combo1.AddItem ("pollo")
    precios.Add 65
    Combo1.AddItem ("choripan")
    precios.Add 20
    Combo1.AddItem ("----bebidas----")
    precios.Add ""
    Combo1.AddItem ("agua")
    precios.Add 8.5
    Combo1.AddItem ("cerveza")
    precios.Add 15
    Combo1.AddItem ("gaseosa")
    precios.Add 10.5
    Combo1.AddItem ("vino")
    precios.Add 30

    Combo1.ListIndex = 0
End Sub

                  Saludos.

[ProgramadorVB]

Tokes,

Excelente aporte, muchas gracias...


Sin más comentarios...


Un saludo

[BlackZeroX]

Es mejor SubClasificar el ComboBox asi evitamos un PArpadeo como el codigo siguente, es algo cutre pero bueno de algo te servira!¡.

En un Modulo de Clase

Cls_CmbBox.cls

Código (Vb) [Seleccionar] Expandir



Option Explicit

Public WithEvents CmbBox                    As ComboBox
Public StrToVerific                         As String
Public StrExplicit                          As Boolean
Private SwitchErr                           As Boolean
Event ErrorSel()

Private Sub CmbBox_click()
Dim CmbBox_Index            As Long
Dim LenV                    As Long
   If SwitchErr = False Then SwitchErr = Not SwitchErr: Exit Sub
   With CmbBox
       LenV = Len(StrToVerific)
       If LenV <= 0 Then Exit Sub
       For CmbBox_Index = .ListIndex To 1 Step -1
           If Len(.List(CmbBox_Index)) >= LenV Then
               If StrComp(Left$(.List(CmbBox_Index), Len(StrToVerific)), StrToVerific, Abs(Not StrExplicit)) = 0 Then
'                    CmbBox.Text = .List(CmbBox_Index)
                   .ListIndex = CmbBox_Index ' // "es lo mismo que la linea de arriba" solo que rehubica el item seleccionado
                   Exit For
               End If
           End If
       Next CmbBox_Index
       If CmbBox_Index <= 0 Then RaiseEvent ErrorSel
   End With
End Sub



Codigo prueba en un Form.

Agrega run ComboBox con nombre Combo1

Código (Vb) [Seleccionar] Expandir



Option Explicit

Private WithEvents ClsCmbBox            As Cls_CmbBox

Private Sub ClsCmbBox_ErrorSel()
   Caption = "Error"
End Sub

Private Sub Combo1_Click()
   Caption = Combo1.Text
End Sub

Private Sub Form_Load()
   Set ClsCmbBox = New Cls_CmbBox
   With ClsCmbBox
       Set .CmbBox = Combo1
       .StrExplicit = True
       .StrToVerific = "----"
   End With
   Combo1.AddItem ("Miguel")
   Combo1.AddItem ("Angel")
   Combo1.AddItem ("Ortega")
   Combo1.AddItem ("Avila")
   Combo1.AddItem ("----comidas----")
   Combo1.AddItem ("pizza")
   Combo1.AddItem ("pollo")
   Combo1.AddItem ("choripan")
   Combo1.AddItem ("----bebidas----")
   Combo1.AddItem ("agua")
   Combo1.AddItem ("cerveza")
   Combo1.AddItem ("gaseosa")
   Combo1.AddItem ("vino")
   Combo1.ListIndex = 0
End Sub



Dulces Lunas!¡.

[seba123neo]

o tambien guardar en algun lado los items que no podes seleccionar y cuando el usuario los seleccione simplemente no haces nada...

aca te paso un ejemplo que se me ocurrio, el ejemplo principal pinta los items de diferentes colores, en este ejemplo pinte los deshabilitados de color gris...probalo y me contas.


En un Modulo (bas)

Código (vb) [Seleccionar] Expandir

Option Explicit

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

Private Type CWPSTRUCT
    lParam As Long
    wParam As Long
    message As Long
    hWnd As Long
End Type

Private Type CREATESTRUCT
    lpCreateParams As Long
    hInstance As Long
    hMenu As Long
    hWndParent As Long
    cy As Long
    cx As Long
    y As Long
    x As Long
    style As Long
    lpszName As Long
    lpszClass As Long
    ExStyle As Long
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor 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 GetSysColor Lib "user32" (ByVal nIndex As Long) 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 FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Private Const WH_CALLWNDPROC = 4
Private Const CBS_OWNERDRAWVARIABLE = &H20&
Private Const CB_GETLBTEXT = &H148
Private Const COLOR_HIGHLIGHT = 13
Private Const COLOR_HIGHLIGHTTEXT = 14
Private Const COLOR_WINDOW = 5
Private Const COLOR_WINDOWTEXT = 8
Private Const GWL_WNDPROC = (-4)
Private Const GWL_STYLE = (-16)
Private Const ODS_SELECTED = &H1
Private Const ODT_COMBOBOX = 3
Private Const WM_CREATE = &H1
Private Const WM_DRAWITEM = &H2B

Private lPrevWndProc As Long
Private lHook As Long
Private lSubCombo As Long

Sub Main()
    lHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HookApp, App.hInstance, App.ThreadID)
    Form1.Show
    Call UnhookWindowsHookEx(lHook)
End Sub

Public Sub SubClassForm(ByVal hWnd As Long)
    lPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf SubClassedForm)
End Sub

Public Sub RemoveSubClassing(ByVal hWnd As Long)
    Call SetWindowLong(hWnd, GWL_WNDPROC, lPrevWndProc)
End Sub

Public Function SubClassedForm(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim tItem As DRAWITEMSTRUCT
    Dim sItem As String
    Dim lBackBrush As Long
   
    If Msg = WM_DRAWITEM Then
        Call CopyMemory(tItem, ByVal lParam, Len(tItem))
        If tItem.CtlType = ODT_COMBOBOX Then
            sItem = Space(255)
            Call SendMessage(tItem.hwndItem, CB_GETLBTEXT, tItem.itemID, ByVal sItem)
            sItem = Left(sItem, InStr(sItem, Chr(0)) - 1)
            If (tItem.itemState And ODS_SELECTED) Then
                lBackBrush = CreateSolidBrush(GetSysColor(COLOR_HIGHLIGHT))
                Call SetBkColor(tItem.hdc, GetSysColor(COLOR_HIGHLIGHT))
                Call SetTextColor(tItem.hdc, GetSysColor(COLOR_HIGHLIGHTTEXT))
            Else
                lBackBrush = CreateSolidBrush(GetSysColor(COLOR_WINDOW))
                Call SetBkColor(tItem.hdc, GetSysColor(COLOR_WINDOW))
                Call SetTextColor(tItem.hdc, tItem.itemData)
            End If
            FillRect tItem.hdc, tItem.rcItem, lBackBrush
            TextOut tItem.hdc, tItem.rcItem.Left, tItem.rcItem.Top, ByVal sItem, Len(sItem)
            SubClassedForm = 0
            Exit Function
        End If
    End If
    SubClassedForm = CallWindowProc(lPrevWndProc, hWnd, Msg, wParam, lParam)
End Function

Private Function HookApp(ByVal lHookID As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim tCWP As CWPSTRUCT
    Dim sClass As String
   
    Call CopyMemory(tCWP, ByVal lParam, Len(tCWP))
    If tCWP.message = WM_CREATE Then
        sClass = Space(128)
        Call GetClassName(tCWP.hWnd, ByVal sClass, 128)
        sClass = Left(sClass, InStr(sClass, Chr(0)) - 1)
        If sClass = "ComboLBox" Then
            lSubCombo = SetWindowLong(tCWP.hWnd, GWL_WNDPROC, AddressOf SubComboCreate)
        End If
    End If
    HookApp = CallNextHookEx(lHook, lHookID, wParam, ByVal lParam)
End Function

Private Function SubComboCreate(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim tCreate As CREATESTRUCT
   
    If Msg = WM_CREATE Then
        Call CopyMemory(tCreate, ByVal lParam, Len(tCreate))
        tCreate.style = tCreate.style Or CBS_OWNERDRAWVARIABLE
        Call CopyMemory(ByVal lParam, tCreate, Len(tCreate))
        Call SetWindowLong(hWnd, GWL_STYLE, tCreate.style)
        Call SetWindowLong(hWnd, GWL_WNDPROC, lSubCombo)
    End If
    SubComboCreate = CallWindowProc(lSubCombo, hWnd, Msg, wParam, lParam)
End Function


En el Formulario, con un combobox llamado Combo1

Código (vb) [Seleccionar] Expandir

Option Explicit

Dim vIndiceAnterior As Long

Private Sub Combo1_Change()
    Call Combo1_Click
End Sub

Private Sub Combo1_Click()
    Select Case Combo1.ListIndex
        Case 2, 4, 6
            MsgBox "Item Deshabilitado"
            Combo1.ListIndex = vIndiceAnterior
        Case Else
            Me.Caption = "Item Seleccionado"
            vIndiceAnterior = Combo1.ListIndex
    End Select
End Sub

Private Sub Form_Load()

    With Combo1
        .AddItem ("Item Normal 1")
        .itemData(.NewIndex) = vbBlack
        .AddItem ("Item Normal 2")
        .itemData(.NewIndex) = vbBlack
        .AddItem ("Item Deshabilitado 1")
        .itemData(.NewIndex) = &HE0E0E0
        .AddItem ("Item Normal 3")
        .itemData(.NewIndex) = vbBlack
        .AddItem ("Item Deshabilitado 3")
        .itemData(.NewIndex) = &HE0E0E0
        .AddItem ("Item Normal 4")
        .itemData(.NewIndex) = vbBlack
        .AddItem ("Item Deshabilitado 3")
        .itemData(.NewIndex) = &HE0E0E0
        .ListIndex = 0
       
        vIndiceAnterior = .ListIndex
    End With
   
    Call SubClassForm(Me.hWnd)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call RemoveSubClassing(Me.hWnd)
End Sub

saludos.

[rob1104]

Jaja, me parece mucho esfuerzo y la verdad perdida de tiempo para una cosa de estetica y diseño. Pero bueno, cada quien tiene su forma de trabajar.

Suerte..

[ProgramadorVB]

seba123neo,

Impresionante... te felicito y agradezco mucho por tu esfuerzo...


Chicos, gracias por todo, doy por terminado este tema...

  Un saludo y suerte!!!

[ProgramadorVB]

Jaja, me parece mucho esfuerzo y la verdad perdida de tiempo para una cosa de estetica y diseño. Pero bueno, cada quien tiene su forma de trabajar.

Suerte..

He... gracias por el comentario, pero la verdad que no tiene valor de uso...

[rob1104]

Jaja, me parece mucho esfuerzo y la verdad perdida de tiempo para una cosa de estetica y diseño. Pero bueno, cada quien tiene su forma de trabajar.

Suerte..

He... gracias por el comentario, pero la verdad que no tiene valor de uso...

Eso dices ahora, pero espero nunca te encuentres en una situación contrareloj donde la funcionalidad sea más importante que el diseño. Mientras tanto puedes perder días en mejorar las situaciones secundarias de los programas.

Saludos