| Вопрос: Автопоиск в ComboBox не работает для русск шрифта | Добавлено: 19.04.10 02:19 |
Автор вопроса:  ЯZ
|
|
Программа на VB6, БД в Access. Во всех ComboBox с длинными списками работает автопоиск: ввожу с клавиатуры первые 1-2-3 буквы = в ComboBox автоматически появляется вариант с таким началом из справочного списка. Но на практике оказалось, что автопоиск работает на РУССКИЙ ШРИФТ только в среде Win’95, а в Win’XP и выше – реагирует только на английский!
Помогите найти ответ, я не профессиональный программист, но кое-что жизнеспособное удаётся. А вчера упёрлась в эту проблему, два дня бьюсь - сдвинуться с места не могу! Нужен автопоиск в ComboBox из справочника РУССКИХ названий. Или как в форме Anketaf для всех Combo1 написать функцию автопоиска в моём случае? *** Private Sub Combo1_Click(Index As Integer) Dim PrReady As Integer If PrReadyForChangeComboText Then PrChangeComboText = True End Sub *** Private Sub combo1_KeyPress(KeyAscii As Integer) If KeyAscii = KEY_RETURN Then SendKeys Chr$(KEY_TAB), True End If End Sub *** Private Sub Combo1_LostFocus(Index As Integer) If Not Combo1(Index).Visible Then Exit Sub If PrReadyForChangeComboText And PrChangeComboText Then Sub_Combo_LostFocus Anketaf, Index End Sub |
| Ответы | Всего ответов: 5 |
|
Номер ответа: 1 Автор ответа:    Администратор ICQ: 278109632 Вопросов: 42 Ответов: 3949 |
Web-сайт: Профиль | | #1 | Добавлено: 19.04.10 08:18 |
| Пришлите, пожалуйста, код организации автопоиска, а не это. | ||
|
Номер ответа: 2 Автор ответа: VβÐUηìtВопросов: 246 Ответов: 3333 |
Web-сайт: Профиль | | #2 | Добавлено: 19.04.10 08:50 |
Если кому надо (для удобства):
|
||
|
Номер ответа: 3 Автор ответа: ЯZ Вопросов: 4 Ответов: 4 |
Профиль | | #3 | Добавлено: 20.04.10 03:05 |
|
Доброе утро, Олег, спасибо за отклик.
Где описан порядок автопоиска сказать точно не могу. Извините, что передаю много лишнего. Заранее спасибо за ответ. (А как к сообщению прикрепить файл?, на будущее...) ************************** Option Explicit '---- toolhelp ------ Type POINTAPI X As Long Y As Long End Type Type InfFields Base As String Field As String Type As Integer Width As Integer SIZE As Integer RusName As String SprBase As String SprViewField As String KodField As String RemField As String Relation As String AsBase As String End Type ****************************** Sub SetCombo(Combo As Control, Txt As String, Id As Variant) PrReadyForChangeComboText = False Combo.Clear Combo.AddItem Txt Combo.ItemData(0) = Id Combo.ListIndex = 0 PrReadyForChangeComboText = True End Sub ******************************* Sub Sub_Combo_LostFocus(Frm As Form, ByVal Index As Integer) Dim NameSprBase As String Dim NameMainField As String Dim Temp As String Dim NumPos As Integer If Frm.Combo1(Index).ListIndex = -1 Then Exit Sub NameMainField = Frm.Combo1(Index).Tag If Len(NameMainField) > 0 Then NumPos = InStr(NameMainField, ";" 
NameMainField = Mid$(NameMainField, NumPos + 1) NumPos = InStr(NameMainField, ";"
NameSprBase = Mid$(NameMainField, NumPos + 1) NameMainField = Left$(NameMainField, NumPos - 1) Temp = Trim$(Frm.Combo1(Index)) NumPos = InStr(Temp, " ("
If NumPos > 0 Then Temp = Trim$(Left$(Temp, NumPos - 1)) If Frm.Combo1(Index).ListIndex = -1 Then ' в справочник нужно внести новое значение NumPos = NewDataInSprav(NameSprBase, Temp) Else NumPos = Frm.Combo1(Index).ItemData(Frm.Combo1(Index).ListIndex) End If gAnketa.Edit gAnketa(NameMainField) = NumPos gAnketa.Update SetCombo Frm.Combo1(Index), Temp, NumPos End If End Sub ****************************** Sub Sub_Combo_GotFocus(Frm As Form, ByVal Index As Integer) Dim Temp As String Dim NumPos As Integer Dim StrMain As String Dim NameSprBase As String Dim KodOrder As String If Frm.Combo1(Index).ListCount = 1 Then StrMain = Frm.Combo1(Index).Tag NumPos = InStr(StrMain, ";"
If NumPos <> 0 Then StrMain = Mid$(StrMain, NumPos + 1) NumPos = InStr(StrMain, ";"
If NumPos <> 0 Then NameSprBase = Mid$(StrMain, NumPos + 1) KodOrder = Left$(StrMain, NumPos - 1) Temp = "Select * from " + NameSprBase If NameSprBase = "Hospit" And KodOrder = "LPUPrik" Then Temp = Temp + " Where Hospit.PrLPU" End If If NameSprBase = "Status" Then Temp = Temp + " Order By Status.KodStatus" End If ' If Left$(KodOrder, 3) = "Kod" Then ' If InStr(KodOrder, NameSprBase) > 0 Then ' Temp = "Select * from " + NameSprBase + " Order By " + KodOrder ' End If ' End If PrReadyForChangeComboText = False LoadCombo Frm.Combo1(Index), Temp, "", False PrReadyForChangeComboText = True End If End If End If End Sub ****************************** ' Модуль загружает результат запроса в COMBO BOX. ' Результат может содержать либо ОДНО ПОЛЕ, либо ДВА. ' если 1 поле - ITEMDATA не используется, и наоборот. ' после вызова модуля необходимо сделать ME.refresh Sub LoadCombo(Combo As Control, SQL As String, ByVal ViewField As String, ByVal PrSetFocus As Integer) Dim ss As Recordset Dim Last As Long Dim Before As Long Dim SQLStr As String Dim i As Long If Combo.Visible And Combo.Enabled And PrSetFocus Then Combo.SetFocus If Combo.ListIndex >= 0 Then Last = Combo.ItemData(Combo.ListIndex) ' - код из базы Else Last = -1 End If Combo.Clear Set ss = gDB.OpenRecordset(SQL, dbOpenSnapshot) If ss.RecordCount > 0 Then ss.MoveFirst If ss.Fields.Count > 1 Then If (ss(0).Name = "KodNation" Or ss(0).Name = "KodHospit" Or ss(0).Name = "KodCntr" Or ss(0).Name = "KodRespub" Or ss(0).Name = "KodTown" Or ss(0).Name = "KODREG" And InStr(UCase$(SQL), "ORDER" = 0 And InStr(UCase$(SQL), "WHERE" = 0 Then
i = ss(0) Combo.AddItem GetTxt(ss(1)) Combo.ItemData(Combo.NewIndex) = i If i = Last Then Combo.ListIndex = Combo.NewIndex ss.MoveNext If Not ss.EOF Then i = ss(0): Before = i Combo.AddItem GetTxt(ss(1)) Combo.ItemData(Combo.NewIndex) = i If i = Last Then Combo.ListIndex = Combo.NewIndex SQLStr = SQL SQLStr = SQLStr + " Where " + ss(0).Name + " > " + Trim$(Str$(Before)) SQLStr = SQLStr + " Order By " + ss(1).Name ss.Close Set ss = gDB.OpenRecordset(SQLStr, dbOpenSnapshot) If ss.RecordCount > 0 Then While Not ss.EOF i = ss(0) Combo.AddItem GetTxt(ss(1)) Combo.ItemData(Combo.NewIndex) = i If i = Last Then Combo.ListIndex = Combo.NewIndex ss.MoveNext Wend End If End If Else While Not ss.EOF i = ss(0) If ViewField = "" Then Combo.AddItem GetTxt(ss(1)) Else Combo.AddItem GetTxt(ss(ViewField)) End If Combo.ItemData(Combo.NewIndex) = i If i = Last Then Combo.ListIndex = Combo.NewIndex End If ss.MoveNext Wend End If Else While Not ss.EOF: Combo.AddItem GetTxt(ss(0)) ss.MoveNext Wend End If End If ss.Close End Sub ****************************** Sub FillPoles(Frm As Form, gBase As Recordset, ByVal StrIndex As String) Dim TempIndex As String Dim StrMain As String Dim NameMainField As String Dim NameSprBase As String Dim TempTxt As String Dim NumPos As Integer Dim TempKod As Integer Dim i As Long Dim tContrl As Control On Error GoTo errFillPoles PrReadyForChangeComboText = False MDI.Enabled = False Frm.Enabled = False If StrIndex = "-1" Then ShowStatusDialog "Считывание данных из архива", Frm.Text1.Count + Frm.Combo1.Count ' Обработка Text1 i = 0 For Each tContrl In Frm.Text1 If StrIndex = "-1" Then UpdateStatus i StrMain = Trim$(tContrl.Tag) If Len(StrMain) > 0 Then NumPos = InStr(StrMain, ";"
If NumPos <> 0 Then TempIndex = Left$(StrMain, NumPos - 1) StrMain = Mid$(StrMain, NumPos + 1) End If If StrIndex = "-1" Or StrIndex = TempIndex Or TempIndex = "0" Then tContrl = GetTxt(gBase(StrMain)) End If Else tContrl = "" End If i = i + 1 Next tContrl For Each tContrl In Frm.Combo1 If StrIndex = "-1" Then UpdateStatus i StrMain = tContrl.Tag If Len(StrMain) > 0 Then NumPos = InStr(StrMain, ";"
If NumPos <> 0 Then TempIndex = Left$(StrMain, NumPos - 1) StrMain = Mid$(StrMain, NumPos + 1) End If If StrIndex = "-1" Or StrIndex = TempIndex Or TempIndex = "0" Then NumPos = InStr(StrMain, ";"
If NumPos <> 0 Then NameMainField = Left$(StrMain, NumPos - 1) NameSprBase = Mid$(StrMain, NumPos + 1) Else NameSprBase = StrMain End If If NumPos = 0 Then tContrl = GetNameSpr(NameSprBase, gBase(NameMainField), 1) Else TempKod = NullToZero(gBase(NameMainField)) TempTxt = GetNameSpr(NameSprBase, TempKod, 1) SetCombo tContrl, TempTxt, TempKod End If End If End If i = i + 1 Next tContrl errFillPoles: If StrIndex = "-1" Then Unload StatusDlg PrReadyForChangeComboText = True PrChangeComboText = False Frm.Enabled = True MDI.Enabled = True End Sub ****************************** Sub FindInCombo(Combo As Control, Id As Variant) Dim i As Integer Combo.ListIndex = -1 For i = 0 To Combo.ListCount - 1 If Combo.ItemData(i) = Id Then Combo.ListIndex = i Exit Sub End If Next i End Sub Sub GetInfField(ByVal PrViewError As Boolean, Mode As Integer, ByVal tBase As String, ByVal Field As String, Ret As InfFields) Dim PrNoFind As Boolean Ret.Base = "": Ret.Field = "": Ret.Type = 0: Ret.Width = 0: Ret.SIZE = 0: Ret.RusName = "" Ret.SprBase = "": Ret.SprViewField = "": Ret.KodField = "": Ret.RemField = "" Ret.SprBase = "": Ret.SprViewField = "": Ret.KodField = "" … ****************************** Sub GetFields() Dim Info As InfFields Dim tName As String Dim tBase As String 'Gets all the fields so that the Sort Menu item can be set up Dim ct As Integer Dim ctMenu As Integer Dim ctTotal As Integer Dim ct2 As Integer 'Loop through all the valid database fields ctMenu = -1 GetInfField True, 1, Sect, "-", Info SetInfGlob.Top = -1: SetInfGlob.Caption = Info.RemField: SetInfGlob.DefColWidth = 2 SetInfGlob.NumColumns = MainForm.Data1.Recordset.Fields.Count - 1 SetInfGlob.HeadLines = 2 SetInfGlob.AllowUpdate = True ReDim SetInfColumns(0 To MainForm.Data1.Recordset.Fields.Count - 1) As InfTrueGrigColumn ctTotal = 0 For ct = 0 To MainForm.Data1.Recordset.Fields.Count - 1 tName = MainForm.Data1.Recordset(ct).Name If Left$(tName, 2) <> "s_" Then ctMenu = ctMenu + 1 'tBase = MainForm.Data1.Recordset.Name 'tBase = GetNameBase(tBase, tName) tBase = curTable tBase = GetNameBase(tBase, tName) GetInfField True, 0, tBase, tName, Info SetInfColumns(ct).NameBase = tBase SetInfColumns(ct).DataField = MainForm.Data1.Recordset(ct).Name SetInfColumns(ct).Caption = Info.RusName … |
||
|
Номер ответа: 4 Автор ответа: Администратор ICQ: 278109632 Вопросов: 42 Ответов: 3949 |
Web-сайт: Профиль | | #4 | Добавлено: 20.04.10 08:28 |
| Может лучше просто пришлете программу с базой? xak.cannopm(ПЕС)gmail.com | ||
|
Номер ответа: 5 Автор ответа: ЯZВопросов: 4 Ответов: 4 |
Профиль | | #5 | Добавлено: 10.05.10 14:08 |
|
Executioner, добрый день.
Прошу помочь изменить порядок вывода данных в таблице Программа на VB6, БД Access. В БД хранятся карты пациентов, в каждой карте есть таблица со списком Видов исследования, назначенных пациенту. По команде формируется сводная таблица, где в первых столбцах перечислены Фамилии пациентов, а далее, в заголовке каждого отдельного столбца идут названия Видов исследования. Задача. Надо, наоборот: в строках первого столбца перечислить названия Видов исследования, а далее, в заголовке каждого отдельного столбца - Фамилии пациентов. Пожалуйста, помогите. Очень важно. Как Вам передать Файлы? |
||
Страница: 1 |