Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Навигация по списку Добавлено: 03.01.07 23:50  

Автор вопроса:  pstrkim
Подскажите как написать программу навигации по списку
с вводом символов с клавиатуры. Нашел один вариант, но он начинает ввод только с буквы "A":

Dim sLstSearch As String
Dim CurrentLetter As String
Dim sWaitForLetter As String
Dim dbBiblio As Database
Dim sSQL As String
Dim rs As DAO.Recordset

Private Sub Form_Load()
sWaitForLetter = ""
CurrentLetter = ""
Set dbBiblio = OpenDatabase("C:\Databases\BIBLIO.mdb")
sSQL = "SELECT Name FROM Publishers ORDER BY Name" 'WHERE Name LIKE '" & CurrentLetter & "*' ORDER BY Name"
Set rs = dbBiblio.OpenRecordset(sSQL)
While Not rs.EOF
lstSearch.AddItem rs.Fields("Name")
rs.MoveNext
Wend
rs.Close
Me.Caption = lstSearch.ListCount & " records loaded"
End Sub

Function SearchListBox(lstX As Control, KeyAscii As Integer)
Dim nSearchPos As Integer
Dim nSearchLen As Integer
Dim nResult As Integer

If CurrentLetter = "" Then
CurrentLetter = "A"
Else
CurrentLetter = Chr(Asc(CurrentLetter) + 1)
End If

nSearchPos = lstX.ListIndex
nSearchLen = Len(sLstSearch)
sWaitForLetter = ""
If KeyAscii = vbKeyBack Then
nSearchPos = 0
If nSearchLen > 0 Then sLstSearch = Left$(sLstSearch, _
nSearchLen - 1)
End If
KeyAscii = Asc(UCase$(Chr$(KeyAscii)))
If nSearchLen = 0 And KeyAscii > Asc(CurrentLetter) Then
lstX.ListIndex = lstX.ListCount - 1
sWaitForLetter = Chr$(KeyAscii)
Exit Function
End If
If KeyAscii >= Asc("A") And KeyAscii <= Asc("Z") Then
sLstSearch = sLstSearch & Chr$(KeyAscii)
End If
lblSrchtext = sLstSearch
nSearchLen = Len(sLstSearch)
While nSearchPos < lstX.ListCount
nResult = StrComp(sLstSearch, UCase$(Left$(lstX.List(nSearchPos), nSearchLen)))
If nResult <= 0 Then
lstX.ListIndex = nSearchPos
SearchListBox = 0
Exit Function
End If
nSearchPos = nSearchPos + 1
Wend
End Function

Private Sub lstSearch_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Exit Sub
End If
KeyAscii = SearchListBox(Me.ActiveControl, KeyAscii)
End Sub

Что нужно сделать?

Ответить

  Ответы Всего ответов: 9  

Номер ответа: 1
Автор ответа:
 GSerg



Вопросов: 0
Ответов: 1876


  Профиль | | #1 Добавлено: 04.01.07 07:09
Смотри-ка, и на этом форуме он тоже не пользуется тегами оформления кода.
Видать, такой он и есть.

Ответить

Номер ответа: 2
Автор ответа:
 Боцман



ICQ: 295725312 

Вопросов: 53
Ответов: 830
  Web-сайт: Rus-Skipper.narod.ru
 Профиль | | #2 		Добавлено: 04.01.07 11:36
Я не все понял что ты хочеш, но может так будет проще.
Private Sub lstSearch_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Exit Sub
End If

CurrentLetter  = Chr(KeyAscii)
End Sub

Ответить

Номер ответа: 3
Автор ответа:
 pstrkim



Вопросов: 13
Ответов: 16
  Профиль | | #3 Добавлено: 04.01.07 13:17
Как ими пользоваться?

Ответить

Номер ответа: 4
Автор ответа:
 pstrkim



Вопросов: 13
Ответов: 16
  Профиль | | #4 Добавлено: 04.01.07 13:22
Нет, стандартно список ищет значение только по первому введенному символу, а нужно чтобы при вводе символов с клавиатуры они запоминались и поиск производился по ближайшему совпадению с несколькими введеными симовлами(ну как в 1С в справочниках например)

Ответить

Номер ответа: 5
Автор ответа:
 pstrkim



Вопросов: 13
Ответов: 16
  Профиль | | #5 Добавлено: 04.01.07 14:37
Теперь отформатировал:

Dim sLstSearch As String    'Строка поиска
Dim CurrentLetter As String    'Загруженная в список буква
Dim sWaitForLetter As String    'Выбранная, но не загруженная буква
Dim dbBiblio As Database    'База данных
Dim sSQL As String     'Строка набора записей
Dim rs As DAO.Recordset     'Набор записей

'Загрузка формы
Private Sub Form_Load()
    sWaitForLetter = ""
    CurrentLetter = ""

    'Выполняем запрос к БД и заполняем список lstSearch
    Set dbBiblio = OpenDatabase("C:\Databases\BIBLIO.mdb";)
    sSQL = "SELECT Name FROM Publishers ORDER BY Name" 'WHERE Name LIKE '" & CurrentLetter & "*' ORDER BY Name"
    Set rs = dbBiblio.OpenRecordset(sSQL)
    While Not rs.EOF
        lstSearch.AddItem rs.Fields("Name";)
        rs.MoveNext
    Wend
    rs.Close
    Me.Caption = lstSearch.ListCount & " records loaded"
End Sub

'Функция поиска слова в списке
Function SearchListBox(lstX As Control, KeyAscii As Integer)
Dim nSearchPos As Integer
Dim nSearchLen As Integer
Dim nResult As Integer
    
    nSearchPos = lstX.ListIndex
    nSearchLen = Len(sLstSearch)
    sWaitForLetter = ""
    
    'Проверяем не нажата ли клавиша <BACKSPACE>
    If KeyAscii = vbKeyBack Then
        nSearchPos = 0
    If nSearchLen > 0 Then sLstSearch = Left$(sLstSearch, _
        nSearchLen - 1)
    End If

    'Преобразуем введеный символ в верхний регистр
    KeyAscii = Asc(UCase$(Chr$(KeyAscii)))

    'Если нажата буква 'X', а данные введены только до 'C', ждем...
    If nSearchLen = 0 And KeyAscii > Asc(CurrentLetter) Then
        lstX.ListIndex = lstX.ListCount - 1
        sWaitForLetter = Chr$(KeyAscii)
        Exit Function
    End If

    'Добавляем в строку поиска новый символ
    If KeyAscii >= Asc("A";) And KeyAscii <= Asc("Z";) Then
        sLstSearch = sLstSearch & Chr$(KeyAscii)
    End If

    'Отображаем строку поиска
    lblSrchtext = sLstSearch

    'Пересчитываем длину
    nSearchLen = Len(sLstSearch)

    'Простой поиск - сравниваем каждый элемент со строкой поиска
    While nSearchPos < lstX.ListCount
        nResult = StrComp(sLstSearch, UCase$(Left$(lstX.List(nSearchPos), nSearchLen)))
        If nResult <= 0 Then
            lstX.ListIndex = nSearchPos
            SearchListBox = 0
            Exit Function
        End If
    nSearchPos = nSearchPos + 1
    Wend
End Function

'Нажатие клавиши в списке
Private Sub lstSearch_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Exit Sub
    End If
    KeyAscii = SearchListBox(Me.ActiveControl, KeyAscii)
End Sub

Ответить

Номер ответа: 6
Автор ответа:
 Боцман



ICQ: 295725312 

Вопросов: 53
Ответов: 830
  Web-сайт: Rus-Skipper.narod.ru
 Профиль | | #6 		Добавлено: 04.01.07 15:21
Извени не видел 1С, но думаю вот тебе примерчик накатал может поможет.
Создай проект и кинь один TextBox
 Listbox и попробуй введи слова из листа
Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
 #If Win32 Then  ' 32-разрядная версия VB
   Private Const LB_FINDSTRING = &H18F
   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
 #Else  ' 16-разрядная версия VB
   Private Const WM_USER = &H400
   Private Const LB_FINDSTRING = (WM_USER + 16)
'   ***************************************есть или нет для команд1
   Private Declare Function SendMessage Lib _
     "User" (ByVal hwnd As Integer, ByVal wMsg _
     As Integer, ByVal wParam As Integer, lParam _
     As Any) As Long
 #End If
Private Sub Form_Load()
With List1
.AddItem "МП-Ком правда"
.AddItem "Мой додыр"
.AddItem "Мяу"
.AddItem "Московская правда"
.AddItem "Московский комсомолец"
.AddItem "Московские новости"
End With
End Sub

Private Sub Text1_Change()
 Dim pos As Long
  List1.ListIndex = SendMessage(List1.hwnd, _
    LB_FINDSTRING, -1, ByVal CStr(Text1.Text))
  If List1.ListIndex = -1 Then
    pos = Text1.SelStart
  Else

Ответить

Номер ответа: 7
Автор ответа:
 Боцман



ICQ: 295725312 

Вопросов: 53
Ответов: 830
  Web-сайт: Rus-Skipper.narod.ru
 Профиль | | #7 		Добавлено: 04.01.07 20:49
Блин при копировании упустил окончаниее.
Праздники сам понимаешь.
Вот код полностью надеюсь.
Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
 #If Win32 Then  ' 32-разрядная версия VB
   Private Const LB_FINDSTRING = &H18F
   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
 #Else  ' 16-разрядная версия VB
   Private Const WM_USER = &H400
   Private Const LB_FINDSTRING = (WM_USER + 16)
'   ***************************************есть или нет для команд1
   Private Declare Function SendMessage Lib _
     "User" (ByVal hwnd As Integer, ByVal wMsg _
     As Integer, ByVal wParam As Integer, lParam _
     As Any) As Long
 #End If
Private Sub Form_Load()
With List1
.AddItem "МП-Ком правда"
.AddItem "Мой додыр"
.AddItem "Мяу"
.AddItem "Московская правда"
.AddItem "Московский комсомолец"
.AddItem "Московские новости"
End With
End Sub

Private Sub Text1_Change()
 Dim pos As Long
  List1.ListIndex = SendMessage(List1.hwnd, _
    LB_FINDSTRING, -1, ByVal CStr(Text1.Text))
  If List1.ListIndex = -1 Then
    pos = Text1.SelStart
  Else
    pos = Text1.SelStart
    Text1.Text = List1
    Text1.SelStart = pos
    Text1.SelLength = Len(Text1.Text) - pos
    End If
End Sub

Ответить

Номер ответа: 8
Автор ответа:
 pstrkim



Вопросов: 13
Ответов: 16
  Профиль | | #8 Добавлено: 04.01.07 21:12
Спасибо тебе большое за пример. Он сработал даже без окончания! Я честно говоря в такие дебри (Windows API) еще не залезал. Очень познавательно.
Но я уже разобрался со своим вариантом. В общем у меня поиск работает при вводе слова непосредственно в лист, а внизу листа в надписи появляются введенные буквы.

Ответить

Номер ответа: 9
Автор ответа:
 Боцман



ICQ: 295725312 

Вопросов: 53
Ответов: 830
  Web-сайт: Rus-Skipper.narod.ru
 Профиль | | #9 		Добавлено: 04.01.07 21:20
Очень рад за тебя. Нестыдно спросить если незнаеш стыдно неузнать если есть возможность.
Удачи...

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам