Nachfolgendes Usercontrol fand ich auf dem Link www.voidnish.com als C#-Code, habe den Code in VB übersetzt und dem Control noch ein paar weitere interessante Eigenschaften mitgegeben. Imports System Imports System.Collections.Generic Imports System.Text Imports System.Windows.Forms Imports System.ComponentModel Imports System.Drawing Imports System.Globalization Namespace MultiColumnComboBox Public Class MultiColumnComboBox Inherits ComboBox Dim vNotShowingCols() As String Dim vDisplayMemberColor As Color = Me.ForeColor Dim vFirstRowColor As Color = Me.BackColor Dim vSecondRowColor As Color = Me.BackColor Dim vSelectedRowBackcolor As Color = SystemColors.Highlight Dim vSelectedRowForecolor As Color = SystemColors.HighlightText Dim vDisplayMemberFontStyle As FontStyle = Me.Font.Style Dim vColumnPadding As Short = 5 Public Sub New() DrawMode = DrawMode.OwnerDrawVariable End Sub Public Overloads Property DrawMode() As DrawMode Get Return MyBase.DrawMode End Get Set(ByVal value As DrawMode) If value <> DrawMode.OwnerDrawVariable Then Throw New NotSupportedException( _ "Modus muss DrawMode.OwnerDrawVariable sein.") End If MyBase.DrawMode = value End Set End Property Public Overloads Property DropDownStyle() As ComboBoxStyle Get Return MyBase.DropDownStyle End Get Set(ByVal value As ComboBoxStyle) If value = ComboBoxStyle.Simple Then Throw New NotSupportedException( _ "ComboBoxStyle.Simple ist nicht unterstützt.") End If MyBase.DropDownStyle = value End Set End Property ' Feld der Feldnamen, die nicht in der Box gezeigt werden sollen Public Property NotShowingColumns() As Array Get Return vNotShowingCols End Get Set(ByVal value As Array) vNotShowingCols = value End Set End Property ' Farbe für den Displaymember (hervorgehobenes Feld) Public Property DisplayMemberColor() As Color Get Return vDisplayMemberColor End Get Set(ByVal value As Color) vDisplayMemberColor = value End Set End Property ' Fontstyle für den Displaymember Public Property DisplayMemberFontStyle() As FontStyle Get Return vDisplayMemberFontStyle End Get Set(ByVal value As FontStyle) vDisplayMemberFontStyle = value End Set End Property ' Hintergrundfarbe für gerade Zeilennummer Public Property BackFirstRowColor() As Color Get Return vFirstRowColor End Get Set(ByVal value As Color) vFirstRowColor = value End Set End Property ' Hintergrundfarbe für ungerade Zeilennummer Public Property BackSecondRowColor() As Color Get Return vSecondRowColor End Get Set(ByVal value As Color) vSecondRowColor = value End Set End Property ' Hintergrundfarbe für selektierte Zeile Public Property SelectedRowBackcolor() As Color Get Return vSelectedRowBackcolor End Get Set(ByVal value As Color) vSelectedRowBackcolor = value End Set End Property ' Vordergrundfarbe für selektierte Zeile Public Property SelectedRowForecolor() As Color Get Return vSelectedRowForecolor End Get Set(ByVal value As Color) vSelectedRowForecolor = value End Set End Property ' Textpadding zwischen den Spalten Public Property ColumnPadding() As Short Get Return vColumnPadding End Get Set(ByVal value As Short) vColumnPadding = value End Set End Property Protected Overloads Overrides Sub OnDataSourceChanged( _ ByVal e As EventArgs) MyBase.OnDataSourceChanged(e) InitializeColumns() End Sub Protected Overloads Overrides Sub OnValueMemberChanged( _ ByVal e As EventArgs) MyBase.OnValueMemberChanged(e) InitializeValueMemberColumn() End Sub Protected Overloads Overrides Sub OnDisplaymemberChanged( _ ByVal e As EventArgs) MyBase.OnDisplayMemberChanged(e) InitializeDisplayMemberColumn() End Sub Protected Overloads Overrides Sub OnDropDown(ByVal e As EventArgs) MyBase.OnDropDown(e) Me.DropDownWidth = CInt(CalculateTotalWidth()) End Sub Private columnWidths As Single() = New Single(-1) {} Private columnNames As [String]() = New [String](-1) {} Private valueMemberColumnIndex As Integer = 0 Private displayMemberColumnIndex As Integer = 0 Private Sub InitializeColumns() If Me.DataSource Is Nothing Then Exit Sub Dim propertyDescriptorCollection As _ PropertyDescriptorCollection = DataManager.GetItemProperties() columnWidths = New Single(propertyDescriptorCollection.Count - 1) {} columnNames = New [String](propertyDescriptorCollection.Count - 1) {} With propertyDescriptorCollection For colIndex As Integer = 0 To .Count - 1 Dim name As [String] = .Item(colIndex).Name columnNames(colIndex) = name Next End With End Sub Private Sub InitializeValueMemberColumn() Dim colIndex As Integer = 0 For Each columnName As [String] In columnNames If [String].Compare(columnName, ValueMember, True, _ CultureInfo.CurrentUICulture) = 0 Then valueMemberColumnIndex = colIndex Exit For End If colIndex += 1 Next End Sub Private Sub InitializeDisplayMemberColumn() Dim colIndex As Integer = 0 For Each columnName As [String] In columnNames If [String].Compare(columnName, DisplayMember, True, _ CultureInfo.CurrentUICulture) = 0 Then displayMemberColumnIndex = colIndex Exit For End If colIndex += 1 Next End Sub Private Function CalculateTotalWidth() As Single Dim totWidth As Single = 0 For Each width As Integer In columnWidths totWidth += (width + ColumnPadding) Next Return totWidth + SystemInformation.VerticalScrollBarWidth End Function Protected Overloads Overrides Sub OnMeasureItem( _ ByVal e As MeasureItemEventArgs) MyBase.OnMeasureItem(e) If DesignMode Then Exit Sub Dim sizeF As SizeF Dim eHeight As Short = 0 For colIndex As Integer = 0 To columnNames.Length - 1 Dim item As String = Convert.ToString( _ FilterItemOnProperty(Items(e.Index), columnNames(colIndex))) sizeF = e.Graphics.MeasureString(item, Font) columnWidths(colIndex) = Math.Max(columnWidths(colIndex), sizeF.Width) If eHeight < sizeF.Height Then eHeight = sizeF.Height Next Dim totWidth As Single = CalculateTotalWidth() e.ItemWidth = CInt(totWidth) e.ItemHeight = eHeight End Sub Protected Overloads Overrides Sub OnDrawItem(ByVal e As DrawItemEventArgs) MyBase.OnDrawItem(e) If DesignMode Then Exit Sub Dim boundsRect As Rectangle = e.Bounds Dim lastRight As Integer = 0 Dim nColor As Color Dim linePen As New Pen(SystemColors.ActiveBorder) Dim brush As New SolidBrush(Me.ForeColor) If (e.State And DrawItemState.HotLight) Or _ (e.State And DrawItemState.Selected) Then ' wenn Eintrag selektiert, Hintergrundfarbe für den ' Selektionsbalken(verwenden) If Not vSelectedRowBackcolor.Equals(SystemColors.Highlight) Then e.Graphics.FillRectangle(New SolidBrush( _ vSelectedRowBackcolor), boundsRect) brush.Color = vSelectedRowForecolor Else e.DrawBackground() End If Else ' wenn Eintrag nicht selektiert, abwechselnde Hintergrundfarbe nColor = IIf(e.Index Mod 2 = 0, vFirstRowColor, vSecondRowColor) e.Graphics.FillRectangle(New SolidBrush(nColor), boundsRect) brush.Color = Me.ForeColor End If Using linePen Using brush If columnNames.Length = 0 Then e.Graphics.DrawString(Convert.ToString(Items(e.Index)), _ Font, brush, boundsRect) Else For colIndex As Integer = 0 To columnNames.Length - 1 Dim nsc As Boolean = _ (Array.IndexOf(vNotShowingCols, columnNames(colIndex)) < 0) If nsc Then Dim item As String = _ Convert.ToString(FilterItemOnProperty(Items(e.Index), _ columnNames(colIndex))) boundsRect.X = lastRight boundsRect.Width = CInt(columnWidths(colIndex)) + ColumnPadding * 2 lastRight = boundsRect.Right + ColumnPadding If colIndex = displayMemberColumnIndex Then Dim bc As Color = brush.Color ' selektiert oder nicht If (e.State And DrawItemState.HotLight) _ Or (e.State And DrawItemState.Selected) Then brush.Color = vSelectedRowForecolor Else brush.Color = vDisplayMemberColor End If Using boldFont As New Font(Font, vDisplayMemberFontStyle) e.Graphics.DrawString(item, boldFont, brush, _ boundsRect.Left + ColumnPadding, boundsRect.Top) End Using brush.Color = bc Else e.Graphics.DrawString(item, Font, brush, _ boundsRect.Left + ColumnPadding, boundsRect.Top) End If If colIndex < columnNames.Length - 1 Then e.Graphics.DrawLine(linePen, boundsRect.Right + ColumnPadding, _ boundsRect.Top, _ boundsRect.Right + ColumnPadding, _ boundsRect.Bottom) End If End If Next colIndex End If End Using End Using e.DrawFocusRectangle() End Sub End Class End Namespace Wenn man die Combobox datengebunden verwenden will, kann man bei DataSource verschiedene Parameter angeben Bindingsource, Datatable etc. Wichtige Eigenschaft in dem Fall, dass die Datenquelle recht viele Datenfelder bietet, ist das angebbare Feld für "NotShowingColumns", das die Datenfeldnamen derjenigen Felder beinhalten soll, die nicht in der Combobox mit angezeigt werden sollen. Der Displaymember kann in ener anderen Farbe und anderem Fontstyle gezeigt werden als alle anderen Spalten. Es können alternierende Zeilenfarben vorgegeben werden, als auch die Farben für die selektierte Zeile können definiert werden. Hier ein Aufrufbeispiel für die MultiColumnCombobox: With MultiColumnComboBox .DataSource = myBindingsource .DisplayMember = "Nachname" .ValueMember = "PersonID" .NotShowingColumns = feld .BackFirstRowColor = Color.FloralWhite .BackSecondRowColor = Color.MistyRose .SelectedRowBackcolor = Color.LightCoral .SelectedRowBackcolor = Color.Brown .SelectedRowForecolor = Color.White End With Dim feld() As String = {"PersonID", "Gehalt", "Geschlecht"} Ich setze voraus, dass der Umgang mit Datasourcen u.ä. bekannt ist. Man sieht, welche datenfelder nicht in der Box angezeigt werden sollen. Eventuell gibt es im Datensatz das Feld "Vorname", dann wird dieses in der Box mit angezeigt. Viel Spaß damit! Dieser Tipp wurde bereits 13.056 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. sevWizard für VB5/6 Professionelle Assistenten im Handumdrehen Erstellen Sie eigene Assistenten (Wizards) im Look & Feel von Windows 2000/XP - mit allem Komfort und zwar in Windeseile :-) |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |