Newsgroup: it.comp.lang.visual-basic
Titolo: AIUTOOOOO TESI & ComboBox

Devo realizzare in formato elettronico il questionario della "Rilevazione
trimestrale delle forze di lavoro ISTAT".
Premetto che la mia conoscenza del VB6 non è eccelsa ma io cerco di
mettercela tutta.
Il mio più grande problema, "per adesso", è quello di implementare delle
ComboBox simili a quelle presenti in moltissimi form di registrazione
presenti in Internet che effettuano il completamento automatico
dell'informazione immessa se questa è presente nell'elenco a discesa. A
quanto ho capito la ComboBox non presenta questa proprietà.
1)Visto che credo che un simile controllo esiste ed è utilizzato dove posso
reperirlo?
2)Sono a conoscenza della proprietà MatchEntry del controllo DBCombo che
credo faccia al caso mio ma il problema è che non voglio appesantire
l'applicazione utilizzando un database come fonte dati ed a quanto sembra
tale controllo non può essere popolato con Additem o mi sbaglio?Posso
utilizzare tale proprietà facendola ereditare alla ComboBox? Spreste darmi
qualche dritta su come fare?
3) Ho cercato di implementare il tutto tramite codice ma non ci sono
riuscito ancora anche perchè come posso far comparire l'elenco a discesa
quando digito nella casella di testo?
Vi ringrazio per il vostro interessamento e l'aiuto ed i consigli che
sicuramente mi fornirete e mi scuso per la lunghezza della missiva.
VINX



Sono sicuro che la Combo fa il completamento della parola in iserimento...
Guarda meglio nell'help
Purtroppo non ho sottomano VB6 e non mi ricordo quale proprietà è.
ciao

 trimestrale delle forze di lavoro ISTAT".
se e' tipo quelli sistan che ogni anno mi capocollano, auguri...

visto che la domanda torna abbastanza spesso, posto anche se lunga tutta la
relativa pagina da
http://www.scottandmichelle.net
sito simpatico e ben organizzato.
ciao, a.
AutoComplete (ComboBox)
Description:
 This class adds autocomplete functionality to a combobox. It requires a
collection of strings that it uses to provide the autocomplete text, and the
textbox to add the functionality to. See the sample usage at the end of the
page for an example of how to use this class. The class isn't perfect, I've
done some work to reduce flicker while the combobox is emptied and refilled
as the user types, but there is still a small bit of flicker.
Code:
 '----- Class: clsACCombo
Option Explicit
Private m_col As Collection
Private WithEvents m_cbo As ComboBox
Private m_bEnabled As Boolean
Private m_bLastKeyDel As Boolean
Private m_sLast As String
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
        (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As _
        String, ByVal lpsz2 As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal _
        hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd 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 ShowWindow Lib "user32" (ByVal hwnd As Long, _
        ByVal nCmdShow As Long) As Long
Private Const SW_HIDE = 0
Private Const SW_NORMAL = 1
Public Property Get Enabled() As Boolean
    Enabled = m_bEnabled
End Property
Public Property Let Enabled(bNew As Boolean)
    Debug.Assert bNew And Not (m_col Is Nothing)
    Debug.Assert bNew And Not (m_cbo Is Nothing)
    m_bEnabled = bNew
End Property
Public Property Get ComboBox() As ComboBox
    Set ComboBox = m_cbo
End Property
Public Property Set ComboBox(cboNew As ComboBox)
    Set m_cbo = cboNew
End Property
Public Property Get Collection() As Collection
    Set Collection = m_col
End Property
Public Property Set Collection(colNew As Collection)
    Set m_col = colNew
End Property
Public Sub ResortCollection()
    Debug.Assert Not (m_col Is Nothing)
    If m_col.Count <= 1 Then
        Exit Sub
    End If
    Dim i As Long
    Dim j As Long
    Dim nGap As Long
    Dim bResult As Boolean
    Dim tmp
    Dim tmp2
    nGap = m_col.Count / 2
    Do While nGap > 0
        For i = nGap To m_col.Count - 1
            tmp = m_col(i + 1)
            j = i
            bResult = (StrComp(tmp, m_col(j - nGap + 1), _
                    vbBinaryCompare) = -1)
            Do While j >= nGap And bResult
                tmp2 = m_col(j - nGap + 1)
                m_col.Remove j + 1
                If j + 1 > m_col.Count Then
                    m_col.Add tmp2
                Else
                    m_col.Add tmp2, , j + 1
                End If
                j = j - nGap
                If j >= nGap Then
                    bResult = (StrComp(tmp, m_col(j - nGap + 1), _
                            vbBinaryCompare) = -1)
                End If
            Loop
            m_col.Remove j + 1
            If j + 1 > m_col.Count Then
                m_col.Add tmp
            Else
                m_col.Add tmp, , j + 1
            End If
        Next
        nGap = nGap / 2
    Loop
End Sub
Private Sub m_cbo_Change()
    Dim nStart As Long
    Dim nEnd As Long
    Dim sTemp As String
    Dim bFix As Boolean
    Dim bNewState As Boolean
    Dim bOldState As Boolean
    Dim bAddItems As Boolean
    Dim bCompleted As Boolean
    Dim i As Long
    If Not m_bEnabled Or m_bLastKeyDel Then
        Exit Sub
    End If
    If m_cbo.SelStart <> Len(m_cbo.Text) Then
        Exit Sub
    End If
    If m_cbo.Text = "" Then
        Exit Sub
    End If
    bOldState = (SendMessage(m_cbo.hwnd, &H157, 0, ByVal 0) <> 0)
    If bOldState Then
        ShowWindow FindComboLBox, SW_HIDE
    End If
    bAddItems = True
    If LCase(Mid(m_cbo.Text, 1, Len(m_sLast))) = m_sLast Then
        If m_sLast <> "" Then
            bAddItems = False
            For i = m_cbo.ListCount - 1 To 0 Step -1
                If LCase(Mid(m_cbo.List(i), 1, Len(m_cbo.Text))) <> _
                      LCase(m_cbo.Text) Then
                    m_cbo.RemoveItem i
                End If
            Next
        End If
    End If
    Dim vItem As Variant
    Dim sContain As String
    sContain = LCase(m_cbo.Text)
    bCompleted = False
    If bAddItems Then
        While m_cbo.ListCount > 0
            m_cbo.RemoveItem 0
        Wend
    End If
    For Each vItem In m_col
        If Mid(LCase(vItem), 1, Len(sContain)) = sContain Then
            If Not bCompleted Then
                bCompleted = True
                m_cbo = m_cbo & Mid(vItem, Len(sContain) + 1)
                m_cbo.SelStart = Len(sContain)
                m_cbo.SelLength = Len(m_cbo) - Len(sContain)
            End If
            If bAddItems Then
                m_cbo.AddItem vItem
            Else
                Exit For
            End If
        End If
    Next
    bNewState = (m_cbo.ListCount <> 0)
    Do While m_cbo.ListCount < 8
        m_cbo.AddItem ""
    Loop
    If bOldState <> bNewState Then
        bFix = True
    End If
    If bFix Then
        sTemp = m_cbo.Text
        nStart = m_cbo.SelStart
        nEnd = m_cbo.SelLength
        SendMessage m_cbo.hwnd, &H14F, bNewState, ByVal 0
        m_cbo.Text = sTemp
        m_cbo.SelStart = nStart
        m_cbo.SelLength = nEnd
    End If
    m_sLast = LCase(m_cbo.Text)
    If bOldState And bNewState Then
        ShowWindow FindComboLBox, SW_NORMAL
    End If
End Sub
Private Sub m_cbo_KeyDown(KeyCode As Integer, Shift As Integer)
    If Not m_bEnabled Then
        Exit Sub
    End If
    If KeyCode = vbKeyBack Or KeyCode = vbKeyDelete Then
        m_bLastKeyDel = True
    Else
        m_bLastKeyDel = False
    End If
End Sub
Private Function FindComboLBox() As Long
    Static hWndMyCombo As Long
    If hWndMyCombo <> 0 Then
        FindComboLBox = hWndMyCombo
        Exit Function
    End If
    Dim pidThis As Long
    Dim pidRemote As Long
    Dim hWndCombo As Long
    pidThis = GetCurrentProcessId
    hWndCombo = FindWindowEx(0, hWndCombo, "ComboLBox", vbNullString)
    Do Until hWndCombo = 0 Or hWndMyCombo <> 0
        GetWindowThreadProcessId hWndCombo, pidRemote
        If pidRemote = pidThis And IsWindowVisible(hWndCombo) Then
            hWndMyCombo = hWndCombo
        End If
        hWndCombo = FindWindowEx(0, hWndCombo, "ComboLBox", _
                  vbNullString)
    Loop
    FindComboLBox = hWndMyCombo
End Function
'----- End of class
Sample Usage:
     Set m_acCombo = New clsACCombo     'Create the class
    Set m_acCombo.Collection = m_col   'Point the class to the collection
    Set m_acCombo.ComboBox = Me.Combo1 ' and the ComboBox
    m_acCombo.ResortCollection         'Resort the collection to
                                       ' make things faster
    m_acCombo.Enabled = True           'And enable it

 2)Sono a conoscenza della proprietà MatchEntry del controllo DBCombo
Tra i componente dovresti trovare il riferimento a Microsoft Forms control
2.0. Ci sono tutti i controlli standard di vb ma in questa versione vengono
implementati in modo windowless (credo si dica così) e con qualche features
in più. Giusto l'altro giorno stavo gocherellando con la combo e ho scoperto
che per esempi dispone di una lista oganizzabile in piu colonne con check
box o option button.  Di questo magari non te ne frega nulla però ho visto
anche una proprietà con lo stesso nome di quelle che hai indicato per la
DBCombo. Non ho visto ha cosa serviva ne come funzionava, ma se i nomi
valgono ancora qualcosa è possibile che ci sia ciò che fa al caso tuo. Se
poi riesci a fare quello che volevi, posta un msg che interesserebbe anche a
me.
Ciao, Rick.

 in piů.
se il programma e' per se stessi ok.
seno', sono piu' che sicuro di avere letto tempo fa su vbpj che i ms forms
2.0 *non* possono essere redistribuiti. purtroppo non mi ricordo su che
numero, ma lo stelloncino ce l'ho ancora davanti agli occhi.
ciao, a.

 presenti in Internet che effettuano il completamento automatico
scrivo in ritardo ma vedi se ti puo servire: l'ho' scritta in VB5 non ti
servono API ne Controlli aggiuntivi sono poche righe di codice su evento
keyup del combo
prova a fare un form con un combobox e incolla queste righe di codice
Private Sub Combo1_KeyUp(KeyCode As Integer, Shift As Integer)
Print KeyCode
' filtro key TAB e Key Del per consentire edit del combo
If KeyCode = 8 Then
   If Combo1.SelLength <> 0 Then
        Combo1.Text = Mid(Combo1.Text, 1, Combo1.SelStart - 1)
        KeyCode = 0
    End If
    ElseIf KeyCode = 46 Then
        If Combo1.SelLength <> 0 And Combo1.SelStart <> 0 Then
        Combo1.Text = ""
        KeyCode = 0
        End If '
     Else
    ' selezione e scrittura text del combo
    Dim pos As Long
    Dim TESTO As String
    Dim A As Integer
    ' passo alla function dolo il testo editato
    A = TROVAELEMENTO(Left(Combo1.Text, Combo1.SelStart + 1))
'SendMessage(Combo1.hWnd, &H18F, -1, ByVal CStr(Left(Combo1.Text,
Combo1.SelStart)))
    TESTO = Combo1.List(A)
    ' scrivo il text nel combo
    pos = Combo1.SelStart
    Combo1.Text = TESTO
    Combo1.SelStart = pos
    Combo1.SelLength = Len(Combo1.Text) - pos
End If
End Sub
Private Sub Form_Load()
' apertura del form popolo gli elementi del combo
Combo1.AddItem "pippo"
Combo1.AddItem "topolino"
Combo1.AddItem "qui quo qua"
Combo1.AddItem "paperino"
Combo1.AddItem "gambadilegno"
Combo1.AddItem "archimede"
Combo1.AddItem "paperogas"
Combo1.AddItem "pluto"
End Sub
' questa function e dedicata al combo1 del form ma puo essere modificata per
un combo generico
Function TROVAELEMENTO(TESTO As String) As Integer
Dim A As Integer
'scansione elemenmti del combo
For A = 1 To Combo1.ListCount
    If Left(Combo1.List(A - 1), Len(TESTO)) = TESTO Then Exit For
Next
TROVAELEMENTO = A - 1
End Function
Ciao stefano

(scusate se non e' nel thread, ma oe/tin mi hanno appena azzerato 1500 msg
che avevo giusto finito di scaricare.
in pratica: appena mi metto offline, oe marca come non scaricati
praticamente tutti i messaggi, compresi quelli cui ho risposto...)
per stefano spinelli:
ho provato il tuo codice. unica differenza: gli ho fatto caricare una
tabella di 710 elementi:
Private Sub Form_Load()
    Dim db As Database, rs As Recordset
    Set db = OpenDatabase("db1.mdb")
    Set rs = db.OpenRecordset("select lingue.desc from lingue order by
lingue.desc")
    Do Until rs.EOF
        Combo1.AddItem rs!Desc
        rs.MoveNext
    Loop
    rs.Close: db.Close
    Set rs = Nothing: Set db = Nothing
End Sub
quando si arriva alla sub:
    pos = Combo1.SelStart
    Combo1.Text = TESTO
    Combo1.SelStart = pos
    Combo1.SelLength = Len(Combo1.Text) - pos
se le ultime due linee sono eseguite, da'
error 380, invalid property value
se sono commentate, inghiotte nel nulla quello che digito e svuota il combo.
che devo fare ?
ciao e grazie, a.

 keyup del combo
stefano, avevo postato giorni fa ma forse non l'hai visto a causa dei casini
tin che fanno perdere il thread:


 error 380, invalid property value
anziche un combo con i recordset uso un dbcombo e invece che la sub di
ricerca   nel combo (si potrebbe anche usare sendmessage per recuperare il
listindex del combo) uso un findfirst sul recordset anche con recordset di
7000 record non mi da problemi
appena trovo i sorgenti (che ora non ho sottomano) te li posto
ciao stefano

 tabella di 710 elementi:
....................
ti posto il codice per l'autoriempimento di un dbcombo collegato ad una
datacontrol
come vedrai il codice e' simile e in questo caso non e' necessaria la
funzione di ricerca nel combo perche si applica direttamwente la ricerca sul
recordset
' questa sub viene implementata solo per gestire la selezione diretta sulla
lista
Private Sub DBCombo1_Click(Area As Integer)
' se faccio click su uno degli elementi della lista posiziono
' il recordset sul record  desiderato
If Area = 2 Then
    Data1.Recordset.Bookmark = DBCombo1.SelectedItem
End If
End Sub
' sub di riempimento automatico del text del dbcombo
Private Sub DBCombo1_KeyUp(KeyCode As Integer, Shift As Integer)
Dim POS As Integer
' filtro solo i campi alfanumerici
' in questo esempio il recordset contiene una lista di titoli di libri e la
ricerca avviene sul campo title
If KeyCode > 47 And KeyCode < 91 Then
    Data1.Recordset.FindFirst "Title Like " + Chr(34) + Left(DBCombo1.Text,
DBCombo1.SelStart) + "*" + Chr(34)
    ' condizione eventuale di non trovato
    If Data1.Recordset.NoMatch Then
    Else
    POS = DBCombo1.SelStart
        DBCombo1.Text = Data1.Recordset("Title")
        DBCombo1.SelStart = POS
        DBCombo1.SelLength = Len(DBCombo1.Text) - POS
    End If
End If
End Sub
ciao stefano