Imports System.Drawing Imports System.ComponentModel Imports System.Windows.Forms Imports DevExpress.XtraEditors Imports DevExpress.XtraEditors.Repository Imports DevExpress.XtraEditors.Registrator Imports DevExpress.XtraEditors.ViewInfo Imports DevExpress.XtraEditors.Drawing Imports DevExpress.Accessibility Imports DevExpress.XtraEditors.Controls Imports DevExpress.XtraGrid.Views.Base Imports DevExpress.XtraGrid.Columns Public Class LookupControl3 Inherits GridLookUpEdit Public Shadows ReadOnly Property Properties As RepositoryItemLookupControl3 Get Return TryCast(MyBase.Properties, RepositoryItemLookupControl3) End Get End Property Public Overrides ReadOnly Property EditorTypeName As String Get Return RepositoryItemLookupControl3.CustomEditName End Get End Property Shared Sub New() RepositoryItemLookupControl3.RegisterLookupControl() End Sub Private Sub LookupControl3_EditValueChanging(sender As Object, e As ChangingEventArgs) Handles Me.EditValueChanging e.Cancel = True End Sub Shadows WithEvents fProperties As RepositoryItemGridLookUpEdit Friend WithEvents fPropertiesView As DevExpress.XtraGrid.Views.Grid.GridView End Class Public Class RepositoryItemLookupControl3 Inherits RepositoryItemGridLookUpEdit Shared Sub New() RegisterLookupControl() End Sub Public Sub New() SetDropdownButtonEnabled(_MultiSelect) UpdateSelectedValues(New List(Of String)) End Sub Private Const NAME_DATATABLE_INTERNAL = "__INTERNAL_DATATABLE__" Private Const TAG_DROPDOWN = "openDropdown" Private Const TAG_BUTTON_LOOKUP_FORM = "openLookupForm" Public Const CustomEditName As String = "LookupControl3" Private _R As Resources.ResourceManager = My.Resources.Strings.ResourceManager Private _SelectedValues As New List(Of String) Private _MultiSelect As Boolean = False Private _ReadOnly As Boolean = False Public Property AllowAddNewValues As Boolean Public Property PreventDuplicates As Boolean Public Delegate Sub SelectedValuesChangedHandler(sender As Object, SelectedValues As List(Of String)) Public Event SelectedValuesChanged As SelectedValuesChangedHandler Public Overrides ReadOnly Property EditorTypeName As String Get Return CustomEditName End Get End Property Public Overloads Property [ReadOnly] As Boolean Get Return _ReadOnly End Get Set(value As Boolean) SetFormButtonEnabled(Not value) _ReadOnly = value End Set End Property Public Property MultiSelect As Boolean Get Return _MultiSelect End Get Set(value As Boolean) SetDropdownButtonEnabled(value) _MultiSelect = value End Set End Property Public Property SelectedValues As List(Of String) Get Return _SelectedValues End Get Set(value As List(Of String)) UpdateSelectedValues(value) End Set End Property Public Shared Sub RegisterLookupControl() Dim img As Image = Nothing Dim oClassInfo = New EditorClassInfo( CustomEditName, GetType(LookupControl3), GetType(RepositoryItemLookupControl3), GetType(GridLookUpEditBaseViewInfo), New ButtonEditPainter(), True, img, GetType(ButtonEditAccessible) ) EditorRegistrationInfo.Default.Editors.Add(oClassInfo) End Sub Private Sub SetFormButtonEnabled(pVisible As Boolean) Dim oButton As EditorButton = Buttons. Where(Function(b) b.Tag = TAG_BUTTON_LOOKUP_FORM). FirstOrDefault() If oButton IsNot Nothing Then oButton.Visible = pVisible End If End Sub Private Sub SetDropdownButtonEnabled(pVisible As Boolean) Dim oButton As EditorButton = Buttons. Where(Function(b) b.Tag = TAG_DROPDOWN). FirstOrDefault() If oButton IsNot Nothing Then oButton.Visible = pVisible ActionButtonIndex = oButton.Index End If End Sub ''' ''' Prevents Editvalue changing when multiselect is true ''' Private Sub HandleEditValueChanging(sender As Object, e As ChangingEventArgs) If MultiSelect Then e.Cancel = True End If End Sub Private Sub UpdateSelectedValues(Values As List(Of String)) If Values Is Nothing Then Exit Sub End If Values.RemoveAll(Function(v) String.IsNullOrEmpty(v)) If MultiSelect = True Then Select Case Values.Count Case 0 NullText = String.Format(_R.GetString("LookupControl_NoRecords")) Case 1 NullText = Values.FirstOrDefault() OwnerEdit.EditValue = Values.FirstOrDefault() Case Else NullText = String.Format(_R.GetString("LookupControl_NRecords"), Values.Count) End Select Else Select Case Values.Count Case 0 NullText = String.Format(_R.GetString("LookupControl_NoRecords")) Case Else NullText = Values.FirstOrDefault() ' JJ at 07.05.2021 ' Setting the EditValue Is crucial for making the Control work as a Cell Editor!!! OwnerEdit.EditValue = Values.FirstOrDefault() End Select End If ' If No external Datasource is supplied, create one containing the currently selected values ' If the current datasource is the internal one, update it If DataSource Is Nothing OrElse (TypeOf DataSource Is DataTable AndAlso DirectCast(DataSource, DataTable).TableName = NAME_DATATABLE_INTERNAL) Then Dim oDataTable As New DataTable() With { .TableName = NAME_DATATABLE_INTERNAL } oDataTable.Columns.Add(New DataColumn("Data", GetType(String))) For Each oValue In Values Dim oRow = oDataTable.NewRow() oRow.Item(0) = oValue oDataTable.Rows.Add(oRow) Next DataSource = oDataTable End If _SelectedValues = Values RaiseEvent SelectedValuesChanged(Me, Values) End Sub Protected Overrides Function ShouldSerializeNullText() As Boolean Return False End Function Public Overrides Sub CreateDefaultButton() Dim oButtons As New List(Of EditorButton) From { New EditorButton() With { .Kind = ButtonPredefines.Combo, .Tag = TAG_DROPDOWN, .Width = 25 }, New EditorButton() With { .Kind = ButtonPredefines.Search, .Tag = TAG_BUTTON_LOOKUP_FORM, .Width = 25 } } Buttons.AddRange(oButtons.ToArray) End Sub Private Function GetLookupForm() As frmLookupGrid Dim oForm As New frmLookupGrid() With { .MultiSelect = MultiSelect, .AddNewValues = AllowAddNewValues, .PreventDuplicates = PreventDuplicates, .DataSource = DataSource, .SelectedValues = SelectedValues, .StartPosition = FormStartPosition.Manual } Dim oScreen = Screen.FromControl(oForm) oForm.Location = GetFormLocation(oForm.Height, oForm.Width, oScreen) Return oForm End Function Private Function GetFormLocation(pFormHeight As Integer, pFormWidth As Integer, pScreen As Screen) As Point ' This is the location on the same height like the Lookup Control Dim oDefaultLocation = OwnerEdit.PointToScreen(New Point(OwnerEdit.Width, 0)) Dim oScreenheight = pScreen.Bounds.Height If oScreenheight < (oDefaultLocation.Y + pFormHeight) Then Return OwnerEdit.PointToScreen(New Point(OwnerEdit.Width, -pFormHeight + OwnerEdit.Height)) End If Return oDefaultLocation End Function Protected Overrides Sub RaiseButtonClick(e As ButtonPressedEventArgs) MyBase.RaiseButtonClick(e) If e.Button.Tag = TAG_BUTTON_LOOKUP_FORM Then Using oForm = GetLookupForm() Dim oResult = oForm.ShowDialog() If oResult = Windows.Forms.DialogResult.OK Then Dim oValues = oForm.SelectedValues UpdateSelectedValues(oValues) If oForm.NewValues.Count > 0 AndAlso TypeOf DataSource Is DataTable Then Dim oTable As DataTable = DirectCast(DataSource, DataTable) If oTable.TableName <> NAME_DATATABLE_INTERNAL Then For Each oValue In oForm.NewValues Dim oRow = oTable.NewRow() oRow.Item(0) = oValue oTable.Rows.Add(oRow) Next End If End If End If End Using End If End Sub Public Overrides Sub Assign(item As RepositoryItem) BeginUpdate() Try MyBase.Assign(item) Dim source As RepositoryItemLookupControl3 = TryCast(item, RepositoryItemLookupControl3) If source Is Nothing Then Return End If Finally EndUpdate() End Try End Sub Private Shadows Sub Popup(sender As LookupControl3, e As EventArgs) Handles Me.BeforePopup Try Dim oView As ColumnView = sender.Properties.View If DataSource IsNot Nothing AndAlso DataSource.Columns.Count > 0 Then Dim oFirstColumn As String = DataSource.Columns.Item(0).ColumnName Dim oOperator = New DevExpress.Data.Filtering.InOperator(oFirstColumn, SelectedValues) View.ActiveFilterCriteria = oOperator View.OptionsView.ShowFilterPanelMode = ShowFilterPanelMode.Never End If Catch ex As Exception 'noop End Try End Sub Public Sub HandleQueryPopup(sender As Object, e As CancelEventArgs) Handles Me.QueryPopUp If MultiSelect = False Then e.Cancel = True End If End Sub Protected Overrides Sub RaiseQueryPopUp(e As CancelEventArgs) If MultiSelect = False Then e.Cancel = True End If End Sub End Class