Зачем? Если есть встроенный. Встроенный есть и встроенного нет. То есть есть но не совсем тот.
Встроенный DatabaseList и DatabaseCombobox имеет два очень неприятных ограничения. Первое — количество вывдоимых данных ограничено примерно 30 тас. (2 в степени там сколько-то). Второе — работает только в таблицах но не в диалогах. (А надо бы)
Итак создаем компонент для диалогов неограниченный и удобный навроде Google autocompeet.
Пробовал взять за основу Combobox с палитры диалогов — не вышло. Там не поддерживается индекс выбранной строки и проблематично хранить суррогатный индекс записи — только текстовое поле. Итак пришлось польоваться обычным текстовым полем. Для автоматизации назовем его с префикса _combo_.
Тогда по-порядку.
Диалог вызываем и закрываем такой процедурой. (Диалоги у нас неасинхронные).
Sub Dogovor_Edit(Event)
Dim oDialog As Object
Dim f_dogovor As Object
f_dogovor = Thiscomponent.DrawPage.Forms.GetByName("f_dogovor")
oDialog = GetDialog("ctl", "dogovor")
'xRay oDialog
CreateDatabaseComboBox(oDialog, "_combo_contragent_id", "contragent",Array("name","uaname","egr"), "name || '(' || uaname || ') ЕГР=' || egr" , "name || '(' || uaname || ') ЕГР=' || egr" , "ID")
CreateDatabaseComboBox(oDialog, "_combo_dogovor_id", "dogovor",Array("nd", "dated", "memo"), "type || ' ' || nd || ' ' || dated || ' ' || memo" , "type || ' ' || nd || ' ' || dated || ' ' || memo" , "ID")
If Event.Source.Model.Tag = "edit" then
ctl.util.FromBaseToDialog(f_dogovor, oDialog)
End If
If oDialog.Execute() = 1 Then
If Event.Source.Model.Tag = "new" Then
f_dogovor.MoveToInsertRow()
ctl.util.FromDialogToBase(oDialog, f_dogovor)
f_dogovor.InsertRow()
Else
ctl.util.FromDialogToBase(oDialog, f_dogovor)
f_dogovor.UpdateRow()
EndIf
Else
End If
End Sub
Создаем комбобокс конструктрором
01Sub CreateDatabaseComboBox(oDialog as Variant, sTextName as String, sTable as String, aFields as Array, sList as String, sText As String, sID As String)
02 Dim oText As Variant
03 Dim oList As Variant
04 Dim oConnection As Variant
05 Dim sProp As String
06 Dim Listener As Object
07 oText = oDialog.GetControl(sTextName)
08 sProp = "ctl.databasecombobox." & oDialog.GetModel.Name & "." & oText.GetModel().Name
09 Listener = createUnoListener("oText_", "com.sun.star.awt.XKeyListener")
10 oText.addKeyListener(Listener)
11 Listener = createUnoListener("ctl.databasecombobox.mText_", "com.sun.star.awt.XMouseListener")
12 oText.addMouseListener(Listener)
13 Dim vList
14 vList=CreateUnoService("com.sun.star.awt.UnoControlListBox")
15 vList.SetModel(CreateUnoService("com.sun.star.awt.UnoControlListBoxModel"))
16 Dim vTextPosSize As Variant
17 vTextPosSize = oText.GetPosSize(15)
18 vList.setDropDownLineCount(15)
19 vList.SetPosSize(vTextPosSize.X,vTextPosSize.Y + vTextPosSize.HEIGHT,vTextPosSize.WIDTH, 250,1+2+4+8)
20 vList.AddItems(Array(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,111111111111111111111111111111111),0)
21 Listener = createUnoListener("ctl.databasecombobox.mList_", "com.sun.star.awt.XMouseListener")
22 vList.addMouseListener(Listener)
23 oDialog.AddControl(sTextName & "_List", vList)
24 vList.SetContext(oText)
25 vList.RemoveItems(0,vList.ItemCount)
26 vList.SetVisible(False)
27 Dim aString(0,1) As String
28 ' 0 1 2 3 4 5-ID 6-IDs 7-Texts
29 ctl.SetUserProperty(sProp, Array(sTable,aFields,sList,sText,sID,Null,Null,Null)
30End Sub
Небольшие разьяснения.
Строка 09+11 слушателей событий создаем по префиксу.
Строка 14+15 программно создаем список и подгоняем его под срез текстового поля (19).
Строка 21 созает запоненный данными список только для того чтобы позиционировать его (в противном случае несть смещениен на величину полосок прокрутки, хотя не олжно быть — непофикшеный баг)
Строка 29 сохраняет в некторой области нужные значения. Функционала такого я не нашел поэтому дописал сам.
Function GetUserProperty(Prop As String) As Variant
Dim Tag As Variant
Tag = ThisComponent.DrawPage.Forms(0).GetByName("Tag")
ON ERROR GOTO ERR
GetUserProperty = Tag.GetPropertyValue(Prop)
EXIT FUNCTION
ERR: GetUserProperty = null
End Function
Sub AddUserProperty(Prop As String, Val)
Dim Tag As Variant
Tag = ThisComponent.DrawPage.Forms(0).GetByName("Tag")
ON ERROR GOTO ERR
Tag.AddProperty(Prop, 0, Val)
EXIT SUB
ERR:
Tag.RemoveProperty(Prop)
Tag.AddProperty(Prop, 0, Val)
End Sub
Sub SetUserProperty(Prop As String, Val)
Dim Tag As Variant
Tag = ThisComponent.DrawPage.Forms(0).GetByName("Tag")
ON ERROR GOTO ERR
Tag.SetPropertyValue(Prop, Val)
EXIT SUB
ERR:
ctl.AddUserProperty(Prop, Val)
End Sub
Довольно мутный код связан с отрабткой ошибок. Не все всегда бывает удобно.
Далее компонент инициируется текущим значением, а затем реализуется поиск по введенному тексту и выбор по мыши.
Из интересных моментов. Поиск реализован по полям от одног и более. Фраза поиска может не соответсововать отображаемому тексту (например может выводиться дополительная информация).
Ну во пока и все.