You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

735 lines
24 KiB

Imports System.ComponentModel
Imports System.Drawing
Imports System.Windows.Forms
Public Class MultiComboBox
Inherits Windows.Forms.ComboBox
#Region "Deklarationen"
Private _imageList As ImageList
Private _imageindexmember As String
Private _columns As New ColumnCollection()
Private _showColumns As Boolean = False
Private _showColumnHeaders As Boolean = False
Private _CheckNullValue As Boolean = False
Private _NulLValueMessage As String = ""
Private _DisplayColumnName As String
Private _ValueColumnName As String
Private _NoValue As Boolean
Public Property ImageList() As ImageList
Get
Return _imageList
End Get
Set(ByVal value As ImageList)
_imageList = value
End Set
End Property
Public Property ImageIndexMember() As String
Get
Return _imageindexmember
End Get
Set(ByVal value As String)
_imageindexmember = value
End Set
End Property
Public ReadOnly Property Columns() As ColumnCollection
Get
Return _columns
End Get
End Property
Public Property ShowColumns() As Boolean
Get
Return _showColumns
End Get
Set(ByVal value As Boolean)
_showColumns = value
End Set
End Property
Public Property ShowColumnHeader() As Boolean
Get
Return _showColumnHeaders
End Get
Set(ByVal value As Boolean)
_showColumnHeaders = value
End Set
End Property
Public Property CheckNullValue() As Boolean
Get
Return _CheckNullValue
End Get
Set(ByVal Value As Boolean)
_CheckNullValue = Value
End Set
End Property
Public Property NullValueMessage() As String
Get
Return _NulLValueMessage
End Get
Set(ByVal Value As String)
_NulLValueMessage = Value
End Set
End Property
Property DisplayColumnName() As String
Get
Return _DisplayColumnName
End Get
Set(ByVal Value As String)
_DisplayColumnName = Value
End Set
End Property
Property ValueColumnName() As String
Get
Return _ValueColumnName
End Get
Set(ByVal Value As String)
_ValueColumnName = Value
End Set
End Property
Property NoValue() As Boolean
Get
Return _NoValue
End Get
Set(ByVal Value As Boolean)
_NoValue = Value
End Set
End Property
#End Region
#Region "Methoden"
Protected Overrides Sub OnDrawItem(ByVal ea As DrawItemEventArgs)
ea.DrawBackground()
ea.DrawFocusRectangle()
Dim iwidth As Integer = 0
Try
Dim imageindex As Integer = -1
Dim imageSize As Size = ImageList.ImageSize
imageindex = Items(ea.Index).GetType.GetProperty(Me.ImageIndexMember).GetValue(Items(ea.Index), Nothing)
ImageList.Draw(ea.Graphics, ea.Bounds.Left, ea.Bounds.Top, imageindex)
iwidth = imageSize.Width
Catch exi As Exception
End Try
Try
If ea.Index <> -1 Then
If _showColumns Then
Dim col As Column
Dim cnt As Integer
For Each col In Me.Columns
cnt += 1
Static prevWidth As Integer
If cnt = 1 Then prevWidth = ea.Bounds.X
Dim useX As Integer = ea.Bounds.X + col.Width
Dim useY As Integer = ea.Bounds.Y + ea.Bounds.Height
Dim display As String
Try
If Items(ea.Index).GetType Is GetType(Data.DataRowView) Then
Dim d As Data.DataRowView = CType(Items(ea.Index), Data.DataRowView)
display = CType(d.Item(col.ColumnMember), String)
Else
display = CType(Items(ea.Index).GetType.GetProperty(col.ColumnMember).GetValue(Items(ea.Index), Nothing), String)
End If
Catch ext As Exception
display = Items(ea.Index).ToString()
End Try
Dim rectf As New RectangleF((ea.Bounds.X + prevWidth) + iwidth, ea.Bounds.Y, useX, ea.Bounds.Height)
ea.Graphics.DrawString(display, ea.Font, New SolidBrush(ea.ForeColor), rectf)
If cnt > 1 Then
ea.Graphics.DrawLine(System.Drawing.Pens.LightGray, prevWidth + iwidth, ea.Bounds.Y, prevWidth + iwidth, useY)
End If
prevWidth += col.Width
Next
Else
Dim display As String
Try
display = CType(Items(ea.Index).GetType.GetProperty(Me.DisplayMember).GetValue(Items(ea.Index), Nothing), String)
Catch ext As Exception
display = Items(ea.Index).ToString()
End Try
ea.Graphics.DrawString(display, ea.Font, New SolidBrush(ea.ForeColor), ea.Bounds.Left + iwidth, ea.Bounds.Top)
End If
Else
ea.Graphics.DrawString(Me.Text, ea.Font, New SolidBrush(ea.ForeColor), Bounds.Left, Bounds.Top)
End If
Catch ex As Exception
ea.Graphics.DrawString(Me.Text, ea.Font, New SolidBrush(ea.ForeColor), Bounds.Left, Bounds.Top)
End Try
MyBase.OnDrawItem(ea)
End Sub
Public Sub New()
Me.DrawMode = DrawMode.OwnerDrawFixed
End Sub
Public Sub New(ByRef cbo As ComboBox)
Me.Anchor = cbo.Anchor
Me.BackColor = cbo.BackColor
Me.BackgroundImage = cbo.BackgroundImage
Me.CausesValidation = cbo.CausesValidation
Me.ContextMenu = cbo.ContextMenu
Me.DataSource = cbo.DataSource
Me.DisplayMember = cbo.DisplayMember
Me.Dock = cbo.Dock
Me.DropDownStyle = cbo.DropDownStyle
Me.DropDownWidth = cbo.DropDownWidth
Me.Enabled = cbo.Enabled
Me.Font = cbo.Font
Me.ForeColor = cbo.ForeColor
Me.IntegralHeight = cbo.IntegralHeight
If cbo.Items.Count > 0 Then
Dim tmp(cbo.Items.Count) As Object
cbo.Items.CopyTo(tmp, 0)
Me.Items.AddRange(tmp)
End If
Me.MaxDropDownItems = cbo.MaxDropDownItems
Me.MaxLength = cbo.MaxLength
Me.Sorted = cbo.Sorted
Me.Text = cbo.Text
Me.TabStop = cbo.TabStop
Me.ValueMember = cbo.ValueMember
Me.Visible = cbo.Visible
Me.Location = cbo.Location
Me.Size = cbo.Size
Me.TabIndex = cbo.TabIndex
Dim parent As Object = cbo.Parent
parent.Controls.Remove(cbo)
parent.Controls.Add(Me)
Me.CheckNullValue = True
Me.NullValueMessage = "NullValueMessage"
End Sub
Private Sub ComboBoxAutoComplete(ByVal combo As ComboBox, ByVal str As String)
Dim index As Integer
If str.Length = 0 Then
combo.SelectedIndex = -1
combo.Text = ""
Else
index = combo.FindString(str)
If index <> -1 Then
combo.SelectedIndex = index
combo.SelectionStart = str.Length
combo.SelectionLength = combo.Text.Length - combo.SelectionStart
End If
End If
End Sub
'Neue Methoden
Dim pressedkey As Boolean = False
Protected Overrides Sub OnKeyPress(ByVal e As System.Windows.Forms.KeyPressEventArgs)
'AUTOCOMPLETE: we have to know when a key has been really pressed
If Me.DropDownStyle = ComboBoxStyle.DropDown Then
pressedkey = True
Else
'ReadOnly AutoComplete Management
Dim sTypedText As String
Dim iFoundIndex As Integer
Dim currentText As String
Dim Start, selLength As Integer
If Asc(e.KeyChar) = 8 Then
If Me.SelectedText = Me.Text Then
pressedkey = True
Exit Sub
End If
End If
If Me.SelectionLength > 0 Then
Start = Me.SelectionStart
selLength = Me.SelectionLength
'This is equivalent to Me.Text, but sometimes using Me.Text it doesn't work
currentText = Me.Text
currentText = currentText.Remove(Start, selLength)
currentText = currentText.Insert(Start, e.KeyChar)
sTypedText = currentText
Else
Start = Me.SelectionStart
sTypedText = Me.Text.Insert(Start, e.KeyChar)
End If
iFoundIndex = Me.FindString(sTypedText)
If (iFoundIndex >= 0) Then
pressedkey = True
Else
e.Handled = True
End If
End If
End Sub
Protected Overrides Sub OnKeyDown(ByVal e As System.Windows.Forms.KeyEventArgs)
If Me.DropDownStyle = ComboBoxStyle.DropDownList AndAlso e.KeyCode = Keys.Delete Then
If Me.Text <> Me.SelectedText Then
e.Handled = True
End If
End If
MyBase.OnKeyDown(e)
End Sub
Protected Overrides Sub OnKeyUp(ByVal e As System.Windows.Forms.KeyEventArgs)
'AUTOCOMPLETING
'WARNING: With VB.Net 2003 there is a strange behaviour. This event is raised not just when any key is pressed
'but also when the Me.Text property changes. Particularly, it happens when you write in a fast way (for example you
'you press 2 keys and the event is raised 3 times). To manage this we have added a boolean variable PressedKey that
'is set to true in the OnKeyPress Event
Dim sTypedText As String
Dim iFoundIndex As Integer
Dim oFoundItem As Object
Dim sFoundText As String
Dim sAppendText As String
If PressedKey Then
'Ignoring alphanumeric chars
Select Case e.KeyCode
Case Keys.Back, Keys.Left, Keys.Right, Keys.Up, Keys.Delete, Keys.Down, Keys.End, Keys.Home
Return
End Select
'Get the Typed Text and Find it in the list
sTypedText = Me.Text
iFoundIndex = Me.FindString(sTypedText)
'If we found the Typed Text in the list then Autocomplete
If iFoundIndex >= 0 Then
'Get the Item from the list (Return Type depends if Datasource was bound
' or List Created)
oFoundItem = Me.Items(iFoundIndex)
'Use the ListControl.GetItemText to resolve the Name in case the Combo
' was Data bound
sFoundText = Me.GetItemText(oFoundItem)
'Append then found text to the typed text to preserve case
sAppendText = sFoundText.Substring(sTypedText.Length)
Me.Text = sTypedText & sAppendText
'Select the Appended Text
Me.SelectionStart = sTypedText.Length
Me.SelectionLength = sAppendText.Length
If e.KeyCode = Keys.Enter Then
iFoundIndex = Me.FindStringExact(Me.Text)
Me.SelectedIndex = iFoundIndex
SendKeys.Send(vbTab)
e.Handled = True
End If
End If
End If
pressedkey = False
End Sub
Protected Overrides Sub OnLeave(ByVal e As System.EventArgs)
'Selecting the item which text is showed in the text area of the ComboBox
Dim iFoundIndex As Integer
'The Me.AccessibilityObject.Value is used instead of Me.Text to manage
'the event when you write in the combobox text and the DropDownList
'is open. In this case, if you click outside the combo, Me.Text mantains
'the old value and not the current one
iFoundIndex = Me.FindStringExact(Me.Text)
Me.SelectedIndex = iFoundIndex
End Sub
' Public Sub AutoCompleteCombo_KeyUp(ByVal cbo As ComboBox, ByVal e As KeyEventArgs) Handles MyBase.KeyUp
'Public Sub AutoCompleteCombo_KeyUp(ByVal sender As Object, ByVal e As KeyEventArgs) Handles MyBase.KeyUp
' Dim cbo As ComboBox
' cbo = sender
' Dim sTypedText As String
' Dim iFoundIndex As Integer
' Dim oFoundItem As Object
' Dim sFoundText As String
' Dim sAppendText As String
' Select Case e.KeyCode
' Case Keys.Back, Keys.Left, Keys.Right, Keys.Up, Keys.Delete, Keys.Down
' Return
' End Select
' sTypedText = cbo.Text
' iFoundIndex = cbo.FindString(sTypedText)
' If iFoundIndex >= 0 Then
' oFoundItem = cbo.Items(iFoundIndex)
' sFoundText = cbo.GetItemText(oFoundItem)
' sAppendText = sFoundText.Substring(sTypedText.Length)
' cbo.Text = sTypedText & sAppendText
' cbo.SelectionStart = sTypedText.Length
' cbo.SelectionLength = sAppendText.Length
' End If
'End Sub
Public Sub AutoCompleteCombo_Leave(ByVal cbo As ComboBox)
Dim iFoundIndex As Integer
iFoundIndex = cbo.FindStringExact(cbo.Text)
cbo.SelectedIndex = iFoundIndex
End Sub
'hutter
'Private Sub Me_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles MyBase.KeyPress
' Dim FindString As String
' Dim ipos As Integer = Me.SelectionStart
' Select Case Asc(e.KeyChar)
' Case Keys.Escape, Keys.Back
' Me.SelectedIndex = -1
' Me.Text = ""
' Case Else
' ComboBoxAutoComplete(Me, Me.Text.Substring(0, ipos) & e.KeyChar.ToString)
' End Select
' e.Handled = True
' 'If Asc(e.KeyChar) = Keys.Escape Then
' ' Me.SelectedIndex = -1
' ' Me.Text = ""
' 'ElseIf Asc(e.KeyChar) = Keys.Back Then
' ' 'If Me.Text.Substring(0, ipos).Length > 0 Then
' ' ' 'ComboBoxAutoComplete(Me, Me.Text.Remove(Me.Text.Length - 1, 1))
' ' ' Me.Text = Me.Text.Substring(0, ipos - 1)
' ' ' Me.SelectedIndex = -1
' ' 'Else
' ' Me.SelectedIndex = -1
' ' Me.Text = ""
' ' 'End If
' 'Else
' ' ComboBoxAutoComplete(Me, Me.Text.Substring(0, ipos) & e.KeyChar.ToString)
' 'End If
' 'e.Handled = True
'End Sub
Private Sub Me_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyUp
'Dim FindString As String
'Dim ipos As Integer = Me.SelectionStart
'If e.KeyCode.ToString.Length > 1 And e.KeyCode <> Keys.Escape And e.KeyCode <> Keys.Back Then
' e.Handled = True
' Exit Sub
'End If
'If e.KeyCode = Keys.Escape Then
' Me.SelectedIndex = -1
' Me.Text = ""
'ElseIf e.KeyCode = Keys.Back Then
' Me.SelectedIndex = -1
' Me.Text = ""
'Else
' ComboBoxAutoComplete(Me, Me.Text.Substring(0, ipos))
'End If
'e.Handled = True
End Sub
Public Sub MultiComboBox_Leave(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Leave
Dim swert As String
swert = Me.SelectedValue
If Me.CheckNullValue = True Then
If swert = "" Or swert Is System.DBNull.Value Then
MsgBox(Me.NullValueMessage, MsgBoxStyle.Exclamation)
Me.Focus()
Me.NoValue = True
Exit Sub
End If
End If
Me.NoValue = False
End Sub
Public Sub Fill_Data(ByVal da As DataTable, ByVal addblankrow As Boolean)
Dim al As New ArrayList()
Dim xvalue As String
Dim i As Integer
If addblankrow Then
al.Add(New GenericList("", "", 0, 0))
End If
If da.Rows.Count = 0 Then Exit Sub
For i = 0 To da.Rows.Count - 1
If da.Rows(i).Item(DisplayColumnName) Is System.DBNull.Value Then
xvalue = ""
Else
xvalue = da.Rows(i).Item(DisplayColumnName)
End If
al.Add(New GenericList(xvalue, "", da.Rows(i).Item(ValueColumnName), i + 1))
Next
Me.DataSource = al
Me.DisplayMember = "Display"
Me.ValueMember = "ID"
Me.Columns.Add(New MultiComboBox.Column(-1, "ID"))
Me.Columns.Add(New MultiComboBox.Column(180, "Display"))
Me.ShowColumns = True
End Sub
Public Sub Fill_Data(ByVal da As DataTable, ByVal addblankrow As Boolean, ByVal blankrowtext As String)
Dim al As New ArrayList()
Dim xvalue As String
Dim i As Integer
If addblankrow Then
al.Add(New GenericList(blankrowtext, blankrowtext, 0, 0))
End If
If da.Rows.Count = 0 Then Exit Sub
For i = 0 To da.Rows.Count - 1
If da.Rows(i).Item(DisplayColumnName) Is System.DBNull.Value Then
xvalue = ""
Else
xvalue = da.Rows(i).Item(DisplayColumnName)
End If
al.Add(New GenericList(xvalue, "", da.Rows(i).Item(ValueColumnName), i + 1))
Next
Me.DataSource = al
Me.DisplayMember = "Display"
Me.ValueMember = "ID"
Me.Columns.Add(New MultiComboBox.Column(-1, "ID"))
Me.Columns.Add(New MultiComboBox.Column(180, "Display"))
Me.ShowColumns = True
End Sub
#End Region
#Region "Classes"
#Region "Column"
Public Class Column
Private _Width As Integer
Private _ColumnMember As String
Private _Header As String
Public Property Width() As Integer
Get
Return _Width
End Get
Set(ByVal Value As Integer)
_Width = Value
End Set
End Property
Public Property ColumnMember() As String
Get
Return _ColumnMember
End Get
Set(ByVal Value As String)
_ColumnMember = Value
End Set
End Property
Public Property Header() As String
Get
Return _Header
End Get
Set(ByVal Value As String)
_Header = Value
End Set
End Property
Public Sub New()
MyBase.new()
End Sub
Public Sub New(ByVal width As Integer, ByVal columnmember As String)
Me.New(Width, columnmember, String.Empty)
End Sub
Public Sub New(ByVal width As Integer, ByVal columnmember As String, ByVal header As String)
MyBase.new()
Me.Width = Width
Me.ColumnMember = columnmember
Me.Header = header
End Sub
End Class
#End Region
#Region "ColumnCollection"
Public Class ColumnCollection
Implements IEnumerable
Private _Col As New Collection()
Public ReadOnly Property Count() As Integer
Get
Return _Col.Count
End Get
End Property
Default Public ReadOnly Property Item(ByVal Key As String) As Column
Get
Return _Col(Key)
End Get
End Property
Default Public ReadOnly Property Item(ByVal Index As Integer) As Column
Get
Return _Col(Index)
End Get
End Property
Public Function Add(ByVal NewItem As Column, Optional ByVal Key As String = Nothing) As Column
If Key Is Nothing Then
_Col.Add(NewItem)
Else
_Col.Add(NewItem, Key)
End If
End Function
Public Sub Remove(ByVal Key As String)
_Col.Remove(Key)
End Sub
Public Sub Remove(ByVal Index As Integer)
_Col.Remove(Index)
End Sub
Public Sub Clear()
Dim cnt As Integer
Dim cntMax As Integer
cntMax = _Col.Count
For cnt = cntMax To 1 Step -1
_Col.Remove(cnt)
Next
End Sub
Public Function Contains(ByVal Key As String) As Boolean
Try
Dim obj As Object = _Col(Key)
Return True
Catch ex As Exception
Return False
End Try
End Function
Public Sub New()
MyBase.new()
End Sub
Public Function GetEnumerator() As System.Collections.IEnumerator Implements System.Collections.IEnumerable.GetEnumerator
Return _Col.GetEnumerator
End Function
End Class
#End Region
#End Region
Protected Overrides Sub OnLostFocus(ByVal e As System.EventArgs)
'Selecting the item which text is showed in the text area of the ComboBox
Dim iFoundIndex As Integer
'The Me.AccessibilityObject.Value is used instead of Me.Text to manage
'the event when you write in the combobox text and the DropDownList
'is open. In this case, if you click outside the combo, Me.Text mantains
'the old value and not the current one
iFoundIndex = Me.FindStringExact(Me.Text)
Me.SelectedIndex = iFoundIndex
End Sub
Private Sub MultiComboBox_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.TextChanged
'Selecting the item which text is showed in the text area of the ComboBox
Dim iFoundIndex As Integer
'The Me.AccessibilityObject.Value is used instead of Me.Text to manage
'the event when you write in the combobox text and the DropDownList
'is open. In this case, if you click outside the combo, Me.Text mantains
'the old value and not the current one
iFoundIndex = Me.FindStringExact(Me.Text)
Me.SelectedIndex = iFoundIndex
End Sub
End Class
#Region "GenericList"
Public Class GenericList
Private _Display As String
Private _AlternateDisplay As String
Private _ID As Integer
Private _Index As Integer = -1
Public Property Display() As String
Get
Return _Display
End Get
Set(ByVal Value As String)
_Display = Value
End Set
End Property
Public Property AlternateDisplay() As String
Get
Return _AlternateDisplay
End Get
Set(ByVal Value As String)
_AlternateDisplay = Value
End Set
End Property
Public Property ID() As Integer
Get
Return _ID
End Get
Set(ByVal Value As Integer)
_ID = Value
End Set
End Property
Public Property Index() As Integer
Get
Return _Index
End Get
Set(ByVal Value As Integer)
_Index = Value
End Set
End Property
Public Sub New()
MyBase.new()
End Sub
Public Sub New(ByVal display As String, ByVal id As Integer)
Me.Display = display
Me.ID = id
End Sub
Public Sub New(ByVal display As String, ByVal altdisplay As String, ByVal id As Integer)
Me.Display = display
Me.AlternateDisplay = altdisplay
Me.ID = id
End Sub
Public Sub New(ByVal display As String, ByVal id As Integer, ByVal index As Integer)
Me.Display = display
Me.ID = id
Me.Index = index
End Sub
Public Sub New(ByVal display As String, ByVal altdisplay As String, ByVal id As Integer, ByVal index As Integer)
Me.Display = display
Me.AlternateDisplay = altdisplay
Me.ID = id
Me.Index = index
End Sub
End Class
#End Region