Results 1 to 19 of 19

Thread: [RESOLVED] Changing ComboBox Style at Runtime

  1. #1

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,817

    Resolved [RESOLVED] Changing ComboBox Style at Runtime

    Has anyone worked out how to change the style of a ComboBox at runtime?

    I've got a situation where some of my users want to be restricted to a pre-defined list whereas others want the option to type in something that's not in the list.

    The option will be a setting in my "settings" area. I can certainly do it with a pair of Combo-Boxes and the visible property, but it'd be nice if I didn't have to do that. I've got to do it for about half-a-dozen fields.

    Hmmm, I suppose I could write a custom UC to do it (using a pair of internal Combo-Boxes). I'll probably be working on that while I wait to see if someone can do it more directly.

    Thanks,
    Elroy
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  2. #2
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: Changing ComboBox Style at Runtime

    This isn't a VB issue, but a limitation of the underlying Win32 control. Some people will destroy and re-create the window but in VB that isn't so practical. Instead you may need to have two controls and swap Visible settings.

  3. #3
    PowerPoster jdc2000's Avatar
    Join Date
    Oct 2001
    Location
    Idaho Falls, Idaho USA
    Posts
    2,391

    Re: Changing ComboBox Style at Runtime


  4. #4
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,857

    Re: Changing ComboBox Style at Runtime

    I would wrap it in a usercontrol

  5. #5
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: Changing ComboBox Style at Runtime

    Quote Originally Posted by Elroy View Post
    I've got a situation where some of my users want to be restricted to a pre-defined list whereas others want the option to type in something that's not in the list.
    An option would be to use the standard style (allow users to enter whatever they want). If it isn't in the list, the ListIndex value will be -1. But you have to check if it's in the list...
    Code:
    Private Sub Combo1_LostFocus()
        If Combo1.Text <> "" Then
            Combo1.ListIndex = SendMessage(Combo1.hwnd, CB_FINDSTRINGEXACT, -1, ByVal Combo1.Text)
        End If
    End Sub
    Above can optionally be placed in the Validate event. CB_FINDSTRINGEXACT is not case-sensitive
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  6. #6

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,817

    Re: Changing ComboBox Style at Runtime

    Hmmm, LaVolpe, that's not the worst of ideas. The only problem is, most users will want to restrict it to the dropdown list. Therefore, allowing typing will seem strange to them. It's only a couple of users who will actually want the typing.

    I could explain further, but it's really a bad idea in these cases to allow typing. It causes database problems down the road, but they're insistent, so what's a programmer to do. It's a strange situation. You may be thinking, "well, just let them jump into setup and add the item if they need it." Yep, that's an option, but some users will want to have a department meeting before new items get added as options. This is just one of those cases where everyone isn't going to be happy.

    I've managed to put together a UC that gets it done, I think. I'm just going to paste the whole module. Just copy-and-paste it with Notepad into a .CTL file if you wish to play with it. Then, just pull this .CTL file into your test project. I call it ComboBoxEx. Specifically, notice the new AllowTyping property.

    Here it is:

    Code:
    
    VERSION 5.00
    Begin VB.UserControl ComboBoxEx
       ClientHeight    =   3600
       ClientLeft      =   0
       ClientTop       =   0
       ClientWidth     =   4800
       BeginProperty Font
          Name            =   "Microsoft Sans Serif"
          Size            =   8.25
          Charset         =   0
          Weight          =   400
          Underline       =   0   'False
          Italic          =   0   'False
          Strikethrough   =   0   'False
       EndProperty
       ScaleHeight     =   3600
       ScaleWidth      =   4800
       Begin VB.ComboBox cboListOnly
          Height          =   315
          Left            =   1800
          Style           =   2  'Dropdown List
          TabIndex        =   1
          Top             =   1380
          Width           =   1635
       End
       Begin VB.ComboBox cboListOrText
          Height          =   315
          Left            =   1800
          TabIndex        =   0
          Top             =   780
          Visible         =   0   'False
          Width           =   1635
       End
    End
    Attribute VB_Name = "ComboBoxEx"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = True
    Attribute VB_PredeclaredId = False
    Attribute VB_Exposed = False
    Option Explicit
    '
    Event Click()
    Event Change()
    '
    ' The following aren't needed but wouldn't be difficult to do.  Just do them on both combo-boxes.
    '        Event KeyDown(KeyCode As Integer, Shift As Integer)
    '        Event KeyPress(KeyAscii As Integer)
    '        Event KeyUp(KeyCode As Integer, Shift As Integer)
    '        Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    '        Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    '        Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    '
    ' Also, there are other members of combo-boxes I didn't include, such as:
    '   Appearance, IntegralHeight, NewIndex, OLE stuff, Sel..., and others.
    '   RemoveItem, and others.
    ' But again, this gets done what I need.
    '
    
    Public Property Get AllowTyping() As Boolean
        AllowTyping = cboListOrText.Visible
    End Property
    
    Public Property Let AllowTyping(ByVal New_AllowTyping As Boolean)
        ' This should be set VERY early, like Form_Load.
        ' It can also be set at design-time and then changed in Form_Load.
        ' The problem with changing it after it's already being used is that the Text property is not mirrored between the two internal controls.
        ' This mirroring can't take place because one allows anything in Text whereas the other does not.
        cboListOrText.Visible = New_AllowTyping
        cboListOnly.Visible = Not New_AllowTyping
        PropertyChanged "AllowTyping"
    End Property
    
    Public Property Get Text() As String
    Attribute Text.VB_MemberFlags = "200"
        Select Case True
        Case cboListOrText.Visible
            Text = cboListOrText.Text
        Case cboListOnly.Visible
            Text = cboListOnly.Text
        End Select
    End Property
    
    Public Property Let Text(ByVal New_Text As String)
        ' This is NOT stored in the PropertyBag.
        Select Case True
        Case cboListOrText.Visible
            cboListOrText.Text = New_Text
        Case cboListOnly.Visible
            cboListOnly.Text = New_Text ' This will error if not in list.
        End Select
    End Property
    
    Public Sub AddItem(sItem As String)
        ' There's also an Index argument, but I won't use it for these.
        cboListOrText.AddItem sItem
        cboListOnly.AddItem sItem
    End Sub
    
    Public Sub Clear()
        cboListOrText.Clear
        cboListOnly.Clear
    End Sub
    
    Public Property Get List(iIndex As Long) As String
        List = cboListOrText.List(iIndex)
    End Property
    
    Public Property Let List(iIndex As Long, sItem As String)
        cboListOrText.List(iIndex) = sItem
        cboListOnly.List(iIndex) = sItem
    End Property
    
    Public Property Get ListIndex() As Long
    Attribute ListIndex.VB_MemberFlags = "400"
        ListIndex = cboListOnly.ListIndex ' Either will do.
    End Property
    
    Public Property Let ListIndex(New_Index As Long)
        cboListOrText.ListIndex = New_Index
        cboListOnly.ListIndex = New_Index
    End Property
    
    Public Function ListCount()
        ListCount = cboListOnly.ListCount ' Either will do.
    End Function
    
    Private Sub cboListOnly_Change()
        RaiseEvent Change
    End Sub
    
    Private Sub cboListOnly_Click()
        RaiseEvent Click
    End Sub
    
    Private Sub cboListOrText_Change()
        RaiseEvent Change
    End Sub
    
    Private Sub cboListOrText_Click()
        RaiseEvent Click
    End Sub
    
    Private Sub UserControl_Initialize()
        cboListOnly.Top = 0
        cboListOnly.Left = 0
        cboListOnly.Width = Width
        '
        cboListOrText.Top = 0
        cboListOrText.Left = 0
        cboListOrText.Width = Width
        '
        UserControl.Height = cboListOrText.Height   ' Height is read-only on combo-boxes.
    End Sub
    
    Private Sub UserControl_Resize()
        cboListOnly.Width = Width
        cboListOrText.Width = Width
        UserControl.Height = cboListOrText.Height   ' Height is read-only on combo-boxes.
    End Sub
    
    Public Property Get BackColor() As OLE_COLOR
        BackColor = cboListOnly.BackColor ' Either will do.
    End Property
    
    Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
        cboListOnly.BackColor = New_BackColor
        cboListOrText.BackColor = New_BackColor
        PropertyChanged "BackColor"
    End Property
    
    Public Property Get ForeColor() As OLE_COLOR
        ForeColor = cboListOnly.ForeColor ' Either will do.
    End Property
    
    Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
        cboListOnly.ForeColor = New_ForeColor
        cboListOrText.ForeColor = New_ForeColor
        PropertyChanged "ForeColor"
    End Property
    
    Public Property Get Font() As StdFont
        Set Font = cboListOnly.Font ' Either will do.
    End Property
    
    Public Property Set Font(ByVal New_Font As StdFont)
        Set cboListOnly.Font = New_Font
        Set cboListOrText.Font = New_Font
        PropertyChanged "Font"
        If cboListOnly.Visible Then
            UserControl.Height = cboListOnly.Height
            cboListOnly.Width = UserControl.Width
        End If
        If cboListOrText.Visible Then
            UserControl.Height = cboListOrText.Height
            cboListOrText.Width = UserControl.Width
        End If
    End Property
    
    Public Property Get Locked() As Boolean
        Locked = cboListOnly.Locked ' Either will do.
    End Property
    
    Public Property Let Locked(ByVal New_Locked As Boolean)
        cboListOnly.Locked = New_Locked
        cboListOrText.Locked = New_Locked
        PropertyChanged "Locked"
    End Property
    
    Public Property Get Enabled() As Boolean
        Enabled = cboListOnly.Enabled ' Either will do.
    End Property
    
    Public Property Let Enabled(New_Enabled As Boolean)
        cboListOnly.Enabled = New_Enabled
        cboListOrText.Enabled = New_Enabled
        PropertyChanged "Enabled"
    End Property
    
    Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
        Dim b As Boolean
        '
        b = PropBag.ReadProperty("AllowTyping", cboListOrText.Visible)
        cboListOrText.Visible = b
        cboListOnly.Visible = Not b
        '
        cboListOnly.BackColor = PropBag.ReadProperty("BackColor", cboListOnly.BackColor)
        cboListOrText.BackColor = cboListOnly.BackColor
        '
        cboListOnly.ForeColor = PropBag.ReadProperty("ForeColor", cboListOnly.ForeColor)
        cboListOrText.ForeColor = cboListOnly.ForeColor
        '
        Set cboListOnly.Font = PropBag.ReadProperty("Font", cboListOnly.Font)
        Set cboListOrText.Font = cboListOnly.Font
        '
        cboListOnly.Locked = PropBag.ReadProperty("Locked", cboListOnly.Locked)
        cboListOrText.Locked = cboListOnly.Locked
        '
        cboListOnly.Enabled = PropBag.ReadProperty("Enabled", cboListOnly.Enabled)
        cboListOrText.Enabled = cboListOnly.Enabled
    End Sub
    
    Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
        PropBag.WriteProperty "AllowTyping", cboListOrText.Visible
        PropBag.WriteProperty "BackColor", cboListOnly.BackColor
        PropBag.WriteProperty "ForeColor", cboListOnly.ForeColor
        PropBag.WriteProperty "Font", cboListOnly.Font
        PropBag.WriteProperty "Locked", cboListOnly.Locked
        PropBag.WriteProperty "Enabled", cboListOnly.Enabled
    End Sub
    
    Enjoy and Critique at your discretion,
    Elroy

    EDIT1: During testing, I found a couple of improvements. As a last line in the Clear method, add this line:

    Code:
    
        cboListOrText.Text = vbNullString
    
    And also, the following line should go as the last line in the Let ListIndex method:

    Code:
    
        If New_Index = -1 Then cboListOrText.Text = vbNullString
    
    Last edited by Elroy; Oct 25th, 2017 at 03:53 PM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  7. #7
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: Changing ComboBox Style at Runtime

    Hmmm, LaVolpe, that's not the worst of ideas. The only problem is, most users will want to restrict it to the dropdown list. Therefore, allowing typing will seem strange to them. It's only a couple of users who will actually want the typing.
    In the past when this was an issue for me, I simply had 2 comboboxes and a form-level variable. I swapped the combos as needed, ensuring the content was moved from one to the other and made it visible. The unused one was cleared and made invisible. The form-level variable was used so I didn't need to test which was the active one...
    Code:
    If [restrict to contents] Then
        Add ComboRestrict Items
        Set m_ComboToUse = ComboRestrict
        ComboRestrict.Visible = True
        ComboUnrestricted.Visible = False
        ComboUnrestricted.Clear
    Else
        Add ComboUnrestricted Items
        Set m_ComboToUse = ComboUnrestricted
        ComboUnrestricted.Visible = True
        ComboRestrict.Visible = False
        ComboRestrict.Clear
    End If
    
    ' now in code, I would simply query m_ComboToUse, i.e., Select Case m_ComboToUse.ListIndex
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  8. #8
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: Changing ComboBox Style at Runtime

    And yet another option. This one assumes the ItemData of the combo isn't used.

    Set the style to 2 (restrict selections). Then as the need arises to toggle whether user can enter new items or not...
    Allowed:
    Code:
    Dim bAdd As Boolean
    If combo1.ListCount = 0 Then
        bAdd = True
    ElseIf combo1.ItemData(0) = 0 Then
        bAdd = True
    End If
    If bAdd Then
        combo1.AddItem "[Manually Enter Item]", 0
        combo1.ItemData(0) = 1
    End If
    Not Allowed:
    Code:
    If combo1.ListCount Then
        If combo1.ItemData(0) = 1 Then combo1.RemoveItem 0
    End If
    When the click event occurs. The only gotcha here is if the combo is sorted. You want to ensure the '[Manually Enter Item]' entry is always 1st in list after new items are added.
    Code:
    If combo1.ListIndex = -1 Then Exit Sub
    If combo1.ItemData(Combo1.ListIndex) = 1 Then
        Dim sValue As String, n As Long
        sValue = Trim$(InputBox("Enter new item", "Manual Entry"))
        If sValue = vbNullString Then 
            combo1.ListIndex = -1  ' reset combo
        Else
            ' optionally validate the new sValue. If invalid, reset combo else....
            n = SendMessage(Combo1.hwnd, CB_FINDSTRINGEXACT, -1, ByVal sValue)
            If n > 0 Then
                combo1.ListIndex = n
                MsgBox "That item is already in the list and has been selected for you", vbInformation + vbOkOnly
                ' optionally. maybe it was duplicated to correct case-sensitivity & if so, may want to update the selected item instead
                '      i.e., combo1.List(n) = sValue
            Else
                 combo1.AddItem sValue
                 If combo1.NewIndex = 0 Then ' added as 1st item in list
                     combo1.RemoveItem 1 ' remove the manual entry option & re-add it
                     combo1.AddItem "[Manually Enter Item]", 0
                     combo1.ItemData(0) = 1
                  End If
            End If    
        End If
    End If
    Edited. P.S.
    In my most recent projects I tend to use this method, though I've used several different ones in the past. I feel this is the cleanest and is similar to other professional applications I've seen, including web forms. Note. Yes, ItemData is assumed unused. But even if it is used and this option is desirable, then one can instead check the wording of the item used to indicate manual entry, i.e., combo1.List(0) vs combo1.ItemData(0)

    Edited again... Turned remarks in sample to sample code. Usage of InputBox for input is only an option. Can use a modal form or any other method for user-selection/input.
    Last edited by LaVolpe; Oct 25th, 2017 at 06:46 PM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  9. #9

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,817

    Re: Changing ComboBox Style at Runtime

    Hmm, LaVolpe, your last option would probably work. I need to study everything you've outlined.

    Also, I've got my UC working, but I have found a couple of improvements to it. I've listed them under "EDIT1" in post #6.

    You're the man, LaVolpe.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  10. #10
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: Changing ComboBox Style at Runtime

    Is there some reason you don't just use an API-based combobox? (Note, your 'ComboBoxEx' title conflicts with a Windows Common Control of the same name)
    You'd just call DestroyWindow then reinitialize with whatever new styles desired.

  11. #11
    Fanatic Member Spooman's Avatar
    Join Date
    Mar 2017
    Posts
    868

    Re: Changing ComboBox Style at Runtime

    Elroy

    Picking up on LaVolpe's post #7 and #8, here is another variation .. add 2 OptionButtons in a Frame

    First, for demo purposes, an image of 2 ComboBoxes side-by-side
    • left one has Style = 2 .. list is preset
    • right one has Style = 0 .. adding new is allowed


    Name:  ElroyCombo1.png
Views: 3033
Size:  4.0 KB

    Second, add a Frame with 2 OptionButtons
    • Top and Left of each ComboBox same
    • Visible depends on which OptionButton is clicked
    • Default would be Pre-set List .. which most of your uses prefer
    • In this case, the one with Style = 0 is shown, with New item about to be accepted


    Name:  ElroyCombo2.png
Views: 2943
Size:  5.0 KB

    I'm sure you can deal with the code
    I am just trying to illustrate how things might "look"

    HTH

  12. #12
    Fanatic Member
    Join Date
    Aug 2016
    Posts
    673

    Re: Changing ComboBox Style at Runtime

    Code:
    Private 
    Const GWL_STYLE = (-16) 
      Private Const GW_CHILD = 5 
      Private Declare 
    Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd 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 ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As 
    Long 
      Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As 
    Long) As Long 
      Private Declare Function CreateWindowEx Lib "user32" Alias 
    "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal 
    lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, 
    ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal 
    hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long 
      Const 
    SW_HIDE = 0 
      Const SW_SHOW = 5 
      Dim WithEvents cmbDropList As ComboBox 
    
      Private Sub cmbDropList_Click() 
      MsgBox cmbDropList.Text 
      End 
    Sub 
      Private Sub Command1_Click() 
      Dim ChildHwnd As Long 
      Set 
    cmbDropList = Controls.Add("VB.ComboBox", "cmbDropList") 
    
      cmbDropList.Visible = True 
      cmbDropList.AddItem "One" 
    
      cmbDropList.AddItem "Two" 
      ChildHwnd = GetWindow(cmbDropList.hwnd, 
    GW_CHILD) '
      Call DestroyWindow(ChildHwnd) 'Kill edit窗口 
    
      
      Call 
    SetWindowLong(cmbDropList.hwnd, GWL_STYLE, GetWindowLong(cmbDropList.hwnd, 
    GWL_STYLE) + 1) 
      End Sub

  13. #13
    Hyperactive Member
    Join Date
    Aug 2017
    Posts
    380

    Re: Changing ComboBox Style at Runtime

    For future readers, here are a couple more examples of the approach shown in jdc2000's link:

    Quote Originally Posted by Matthew Curland
    Re: MultiLine TextBox

    You'll have to use a CBT hook as the control is created, or use
    CreateWindowEx. The following code adds a MultiLine textbox with a vertical
    scrollbar. Note that the structure deref work is much cleaner and easier
    with a couple of module level ArrayOwner structures as described in my book
    (http://www.PowerVB.com), but this works as well.-Matt

    Code:
    'In a form with one command button on it
    Option Explicit
    
    Private Sub Command1_Click()
        Dim TB As TextBox
    
        hHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProcTextBox, 0, App.ThreadID)
        Set TB = Controls.Add("VB.TextBox", "TextBox1")
        UnhookWindowsHookEx hHook
        TB.Height = TB.Height * 5
        TB.Visible = True
        Debug.Print TB.MultiLine, TB.ScrollBars 'These don't reflect the real state, but the control itself does
    End Sub
    Code:
    'In a .bas module
    Option Explicit
    
    Public 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
    Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    
    Public Const WH_CBT As Long = 5
    Public Const HCBT_CREATEWND As Long = 3
    Public Const GWL_STYLE As Long = -16
    
    Public Type CBT_CREATEWNDA
        lpcs As Long
        hwndInsertAfter As Long
    End Type
    
    Public Type CREATESTRUCTA
        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
        dwExStyle As Long
    End Type
    
    Public Type SafeArray1D
        cDims As Integer
        fFeatures As Integer
        cbElements As Long
        cLocks As Long
        pvData As Long
        cElements As Long
        lLbound As Long
    End Type
    
    'VarPtrArray gets a pointer to the SAFEARRAY pointer
    Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
    Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
    Public Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (pDest As Any, ByVal ByteLen As Long)
    
    Public Sub ShareMemoryViaArray(ByVal ArrayPtr As Long, ByVal MemPtr As Long, SA1D As SafeArray1D, Optional ByVal ElemByteLen As Long)
        With SA1D
            'This is optional because this is a 1 element array,
            'so cbElements is not needed to walk the array. If Erase
            'is called on an array with .cbElements = 0, VB will still
            'free all pointer types, but non-pointer types will not get
            'zeroed out. Note that the compiler calculates the length
            'of a structure at compile time, so LenB(MyStruct(0)) is
            'valid regardless of whether or not MyStruct is actually allocated.
            .cbElements = ElemByteLen
            .cDims = 1
            '2 = FADF_STATIC. This means that if the
            'array goes out of scope, then the pointed
            'to memory will be cleaned, but no attempt
            'will be made to free the array pointer
            'or descriptor.
            .fFeatures = 2
            .pvData = MemPtr
            .cElements = 1
        End With
        CopyMemory ByVal ArrayPtr, VarPtr(SA1D), 4
    End Sub
    
    Function CBTProcTextBox(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        Dim saCreateWnd As SafeArray1D
        Dim psaCreateWnd() As CBT_CREATEWNDA
        Dim saCreateStruct As SafeArray1D
        Dim psaCreateStruct() As CREATESTRUCTA
    
        If lMsg = HCBT_CREATEWND Then
            ShareMemoryViaArray VarPtrArray(psaCreateWnd), lParam, saCreateWnd
            ShareMemoryViaArray VarPtrArray(psaCreateStruct),
            psaCreateWnd(0).lpcs, saCreateStruct
            'Changing the style in the CreateStruct is insufficient. SetWindowLong is required.
            'Note that the changes don't automatically show up in the pointed to structures.
            'Make the TB MultiLine with a vertical scrollbar. This is ES_MULTILINE Or ES_AUTOVSCROLL Or WS_VSCROLL,
            'with ES_AUTOHSCROLL turned off. (Note: use constants in real code)
            SetWindowLong wParam, GWL_STYLE, (psaCreateStruct(0).Style Or &H200044) And Not &H80
            ZeroMemory ByVal VarPtrArray(psaCreateStruct), 4
            ZeroMemory ByVal VarPtrArray(psaCreateWnd), 4
        End If
    End Function
    Quote Originally Posted by Victor Bravo VI View Post
    Here's how the window styles of intrinsic VB6 controls can be modified at run time:

    Code:
    'In ucComboBoxEx.ctl
    
    Public Property Get Style() As ComboBoxConstants
        Style = m_Style
    End Property
    Public Property Let Style(ByVal RHS As ComboBoxConstants)
        Dim hHook As Long
    
        If Ambient.UserMode Then
            Err.Raise 382&, Ambient.DisplayName 'Let/Set not supported at run time.
        End If
        If RHS < vbComboDropdown Or RHS > vbComboDropdownList Then
            Err.Raise 380&, Ambient.DisplayName 'Invalid property value
        End If
    
        If m_Style <> RHS Then
            m_Style = RHS
            g_Style = RHS
            Controls.Remove "m_CmbBox"
    
           'Hook ComboBox creation in order to set the specified style
            hHook = SetWindowsHookExW(WH_CBT, AddressOf CBTProc, 0&, App.ThreadID)
            Set m_CmbBox = Controls.Add("VB.ComboBox", "m_CmbBox")
            hHook = UnhookWindowsHookEx(hHook): Debug.Assert hHook
    
            UserControl_Resize
            m_CmbBox.Visible = True
        End If
    
        PropertyChanged "Style"
    End Property
    Code:
    Option Explicit     'In modCmbBoxHook.bas
    
    '#Const UseStructs = True
    
    Private Const CBS_SIMPLE       As Long = &H1
    Private Const CBS_DROPDOWN     As Long = &H2
    Private Const CBS_DROPDOWNLIST As Long = &H3
    Private Const GWL_STYLE        As Long = (-16&)
    Private Const HCBT_CREATEWND   As Long = 3
    
    #If UseStructs Then
    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
        dwExStyle      As Long
    End Type
    
    Private Type CBT_CREATEWND
        lpcs            As Long 'LPCREATESTRUCT
        hWndInsertAfter As Long
    End Type
    
    Private Declare Function CallWindowProcW Lib "user32.dll" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Sub PutMem4 Lib "msvbvm60.dll" (ByVal Addr As Long, ByVal NewVal As Long)
    #End If
    
    Private Declare Function CallNextHookEx Lib "user32.dll" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function GetClassNameW Lib "user32.dll" (ByVal hWnd As Long, ByVal lpClassName As Long, ByVal nMaxCount As Long) As Long
    Private Declare Function GetWindowLongW Lib "user32.dll" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLongW Lib "user32.dll" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function SysReAllocStringLen Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long, Optional ByVal Length As Long) As Long
    
    Public g_Style As ComboBoxConstants
    
    Public Function CBTProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        If nCode = HCBT_CREATEWND Then
            Select Case GetClassName(wParam)
                Case "ThunderRT6ComboBox", "ThunderComboBox"
                    #If UseStructs Then
                    CallWindowProcW AddressOf OnCreateWnd, wParam, 0&, 0&, lParam
                    #Else
                    CBTProc = GetWindowLongW(wParam, GWL_STYLE) And Not (CBS_SIMPLE Or CBS_DROPDOWN Or CBS_DROPDOWNLIST)
                    SetWindowLongW wParam, GWL_STYLE, CBTProc Or Choose(g_Style + 1&, CBS_DROPDOWN, CBS_SIMPLE, CBS_DROPDOWNLIST)
                    #End If
            End Select
        End If
    
        CBTProc = CallNextHookEx(0&, nCode, wParam, lParam)
    End Function
    
    Private Function GetClassName(ByVal hWnd As Long) As String
        Const MAX_CLASS_NAME = 256&
    
        SysReAllocStringLen VarPtr(GetClassName), , MAX_CLASS_NAME
        SysReAllocStringLen VarPtr(GetClassName), StrPtr(GetClassName), _
        GetClassNameW(hWnd, StrPtr(GetClassName), MAX_CLASS_NAME + 1&)
    End Function
    
    #If UseStructs Then
    Private Function OnCreateWnd(ByVal hWnd As Long, ByVal uMsg As Long, ByRef wParam As CREATESTRUCT, ByRef lParam As CBT_CREATEWND) As Long
        Const SIGN_BIT = &H80000000
    
        PutMem4 (VarPtr(uMsg) Xor SIGN_BIT) + 4& Xor SIGN_BIT, lParam.lpcs 'Make wParam point to the CREATESTRUCT pointed to by lParam.lpcs
        wParam.Style = wParam.Style And Not (CBS_SIMPLE Or CBS_DROPDOWN Or CBS_DROPDOWNLIST)
        SetWindowLongW hWnd, GWL_STYLE, wParam.Style Or Choose(g_Style + 1&, CBS_DROPDOWN, CBS_SIMPLE, CBS_DROPDOWNLIST)
    End Function
    #End If

  14. #14
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    4,382

    Re: Changing ComboBox Style at Runtime

    Quote Originally Posted by Elroy View Post
    Hmm, LaVolpe, your last option would probably work. I need to study everything you've outlined.

    Also, I've got my UC working, but I have found a couple of improvements to it. I've listed them under "EDIT1" in post #6.

    You're the man, LaVolpe.
    Not to sound stupid:
    Why not just set the Combo to Edit-Style, but use the Locked-Property?
    Last edited by Zvoni; Tomorrow at 31:69 PM.
    ----------------------------------------------------------------------------------------

    One System to rule them all, One Code to find them,
    One IDE to bring them all, and to the Framework bind them,
    in the Land of Redmond, where the Windows lie
    ---------------------------------------------------------------------------------
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    ---------------------------------------------------------------------------------
    Code is like a joke: If you have to explain it, it's bad

  15. #15

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,817

    Re: Changing ComboBox Style at Runtime

    Quote Originally Posted by Zvoni View Post
    Why not just set the Combo to Edit-Style, but use the Locked-Property?
    Hi Zvoni,

    That locks the ability to change it in any way. The request (which is solved), was to "optionally" have it allow you to type entries not in the pull-down. Just as an example, my software deals with patients. And all of these patients will have a "primary diagnosis". The complete list of primary diagnoses is maintained in a Maintenance area. Those go into a ComboBox for adding/editing a patient's info.

    Now, some of my users want to restrict everyone in the department to that list, having a departmental meeting to add new diagnoses. This is good because it prevents duplications, and also makes subsequent searches easier. However, other users don't like this restriction. They'd like the option of just typing a strange diagnosis in without messing with Maintenance.

    Therefore, I need to give my users the alternative of doing it either way (and that's yet another Maintenance setting).

    It's not that I want to "Lock" the ComboBox. I just want it to work like a "Dropdown List" for some users and a "Dropdown Combo" for others.

    Take Care,
    Elroy
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  16. #16
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    4,382

    Re: [RESOLVED] Changing ComboBox Style at Runtime

    OK, i know: resolved and all that, but i was actually talking about the Textbox-Part of the Combobox being locked, not the Dropdown-Part.
    I've seen some references about achieving that with SendMessage and EM_SETREADONLY or something like that
    Last edited by Zvoni; Tomorrow at 31:69 PM.
    ----------------------------------------------------------------------------------------

    One System to rule them all, One Code to find them,
    One IDE to bring them all, and to the Framework bind them,
    in the Land of Redmond, where the Windows lie
    ---------------------------------------------------------------------------------
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    ---------------------------------------------------------------------------------
    Code is like a joke: If you have to explain it, it's bad

  17. #17

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,817

    Re: [RESOLVED] Changing ComboBox Style at Runtime

    Quote Originally Posted by Zvoni View Post
    OK, i know: resolved and all that, but i was actually talking about the Textbox-Part of the Combobox being locked, not the Dropdown-Part.
    I've seen some references about achieving that with SendMessage and EM_SETREADONLY or something like that
    Hey, work it out and I'd be thrilled to take a look at it.

    You Take Care,
    Elroy
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  18. #18
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    4,382

    Re: [RESOLVED] Changing ComboBox Style at Runtime

    Here you go.
    http://www.aboutvb.de/khw/artikel/khwcombolock.htm

    Note: I could not test it, since i don't have VB6, but only vba (and in vba ComboBox doesn't have a hWnd)

    Eys, Website is in german, but VB-code is VB-code :-)
    Last edited by Zvoni; Tomorrow at 31:69 PM.
    ----------------------------------------------------------------------------------------

    One System to rule them all, One Code to find them,
    One IDE to bring them all, and to the Framework bind them,
    in the Land of Redmond, where the Windows lie
    ---------------------------------------------------------------------------------
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    ---------------------------------------------------------------------------------
    Code is like a joke: If you have to explain it, it's bad

  19. #19
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    4,382

    Re: [RESOLVED] Changing ComboBox Style at Runtime

    I cannot edit my own post?!?!?

    Ah, well.
    As an addition to my post above: As a sideeffect you get the capability to select and copy the content of the Textbox-Part
    Last edited by Zvoni; Tomorrow at 31:69 PM.
    ----------------------------------------------------------------------------------------

    One System to rule them all, One Code to find them,
    One IDE to bring them all, and to the Framework bind them,
    in the Land of Redmond, where the Windows lie
    ---------------------------------------------------------------------------------
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    ---------------------------------------------------------------------------------
    Code is like a joke: If you have to explain it, it's bad

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width