Preview :
Berikut Cara menambahkan kolom pada ComboBox , monggo download ae contohe:
Download Project
Multibox(user Control) :
Imports System.Math
Imports System.Drawing
Imports System.Windows.Forms
Public Class Multibox
#Region "Dimensions"
Dim charSeperator As Char = "," 'Character seperation in the main box
Dim intSelectedItem As Int16 = 0 'Index of the currently selected item
#End Region
#Region "Properties"
Public Property Seperator() As Char 'The column seperator property
Get
Return charSeperator
End Get
Set(ByVal value As Char)
charSeperator = value
End Set
End Property
'Hide this property from designer window
<System.ComponentModel.Browsable(False)> _
ReadOnly Property Columns() As ListView.ColumnHeaderCollection 'Columns in the Listview
Get
Return ListView1.Columns
End Get
End Property
'Hide this property from designer window
<System.ComponentModel.Browsable(False)> _
ReadOnly Property Items() As ListView.ListViewItemCollection 'Items in the listview
Get
Return ListView1.Items
End Get
End Property
#End Region
#Region "Show list"
Private Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.Click
'Hide and show the listview as the drop list for the box
If ListView1.Visible Then
ListView1.Visible = False
Me.Height = Me.Height - ListView1.Height - 5
Else
ListView1.Left = TextBox1.Left
ListView1.Width = TextBox1.Width
ListView1.Top = TextBox1.Bottom
ListView1.Visible = True
Me.Height = Me.Height + ListView1.Height + 5
ListView1.Items(intSelectedItem).Selected = True
End If
End Sub
Private Sub TextBox1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox1.Click
Button1_Click(sender, e)
End Sub
Private Sub ListView1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles ListView1.Click
Button1_Click(sender, e)
End Sub
#End Region
#Region "Select Item"
Private Sub ListView1_ItemSelectionChanged(ByVal sender As Object, ByVal e As System.Windows.Forms.ListViewItemSelectionChangedEventArgs) Handles ListView1.ItemSelectionChanged
Try
'Set the selected index number
intSelectedItem = ListView1.SelectedItems(0).Index
'Set the count to 0 for Item seperator
Dim i As Int16 = 0
'Loop through the items and get the values
For Each tmpItem In ListView1.SelectedItems(0).SubItems
If i = 0 Then
TextBox1.Text = tmpItem.Text
Else
TextBox1.Text += charSeperator & " " & tmpItem.Text
End If
i += 1
Next
Catch ex As Exception
'Just leave the exception and move on.
End Try
End Sub
#End Region
#Region "Fade in and out"
Private Sub TextBox1_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox1.MouseEnter
Fade(Button1, True)
End Sub
Private Sub TextBox1_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox1.MouseLeave
Fade(Button1, False)
End Sub
Private Sub Button1_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.MouseEnter
Dim cntrl As Control = CType(sender, Control)
Fade(cntrl, True)
End Sub
Private Sub Button1_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.MouseLeave
Dim cntrl As Control = CType(sender, Control)
Fade(cntrl, False)
End Sub
Private Sub Fade(ByVal ctrl As Control, ByVal hovering As Boolean)
Dim Sb_R, Sb_G, Sb_B As Int16 ' <--- RGB values for the starting backcolor
Dim Sf_R, Sf_G, Sf_B As Int16 ' <--- RGB values for the starting forecolor
Dim Eb_R, Eb_G, Eb_B As Int16 ' <--- RGB values for the ending backcolor
Dim Ef_R, Ef_G, Ef_B As Int16 ' <--- RGB values for the ending forecolor
Select Case hovering ' True for MouseEnter, False for MouseLeave
Case True
Sb_R = SystemColors.Window.R ' Assign the variables the
Sb_G = SystemColors.Window.G ' appropriate values based
Sb_B = SystemColors.Window.B ' on system-defined colors
' for control and control
Sf_R = SystemColors.Window.R ' text.
Sf_G = SystemColors.Window.G
Sf_B = SystemColors.Window.B
Eb_R = SystemColors.ActiveCaption.R ' Assign the variables the
Eb_G = SystemColors.ActiveCaption.G ' appropriate values based
Eb_B = SystemColors.ActiveCaption.B ' on system-defined colors
' for the title bar and the
Ef_R = SystemColors.ActiveCaptionText.R ' title bar's text.
Ef_G = SystemColors.ActiveCaptionText.G
Ef_B = SystemColors.ActiveCaptionText.B
Case False
Sb_R = SystemColors.ActiveCaption.R ' Assign the variables the
Sb_G = SystemColors.ActiveCaption.G ' appropriate values based
Sb_B = SystemColors.ActiveCaption.B ' on system-defined colors
' for the title bar and the
Sf_R = SystemColors.ActiveCaptionText.R ' title bar's text.
Sf_G = SystemColors.ActiveCaptionText.G
Sf_B = SystemColors.ActiveCaptionText.B
Eb_R = SystemColors.Window.R ' Assign the variables the
Eb_G = SystemColors.Window.G ' appropriate values based
Eb_B = SystemColors.Window.B ' on system-defined colors
' for control and control
Ef_R = SystemColors.Window.R ' text.
Ef_G = SystemColors.Window.G
Ef_B = SystemColors.Window.B
End Select
Dim b_RIncrement As Int16 = Round(((Eb_R - Sb_R) / 16), 0) ' Find the increments that
Dim b_GIncrement As Int16 = Round(((Eb_G - Sb_G) / 16), 0) ' the RGB values will take;
Dim b_BIncrement As Int16 = Round(((Eb_B - Sb_B) / 16), 0) ' 1/16th of the difference
' between the start and end
Dim f_RIncrement As Int16 = Round(((Ef_R - Sf_R) / 16), 0) ' values, rounded to the
Dim f_GIncrement As Int16 = Round(((Ef_G - Sf_G) / 16), 0) ' nearest integer.
Dim f_BIncrement As Int16 = Round(((Ef_B - Sf_B) / 16), 0)
Dim bR As Int16 = Sb_R ' \
Dim bG As Int16 = Sb_G ' }-- the RGB values for the backcolor as it changes.
Dim bB As Int16 = Sb_B ' /
Dim fR As Int16 = Sf_R ' \
Dim fG As Int16 = Sf_G ' }-- the RGB values for the forecolor as it changes.
Dim fB As Int16 = Sf_B ' /
Dim count As Int16
For count = 0 To 14
bR += b_RIncrement ' Add the appropriate increments to the
bG += b_GIncrement ' RGB values. The result is a nifty
bB += b_BIncrement ' "cross-fade" effect.
fR += f_RIncrement
fG += f_GIncrement
fB += f_BIncrement
'ctrl.BackColor = Color.FromArgb(bR, bG, bB) ' Repaint the button using the
ctrl.ForeColor = Color.FromArgb(fR, fG, fB) ' current RGB values, and refresh
ctrl.Refresh() ' the button.
Threading.Thread.Sleep(30 - (count * 2)) ' Wait a certain number of milliseconds,
' which is a factor of the current count.
' I tweaked these numbers to get a decent
' effect; feel free to adjust these
' numbers to achieve an effect you like.
Next
Select Case hovering
Case True
ctrl.BackColor = SystemColors.ActiveCaption ' Finish the effect by painting
ctrl.ForeColor = SystemColors.ActiveCaptionText ' the control with it's final
Case False ' look, depending on whether
ctrl.BackColor = SystemColors.Window ' we're fading in or out.
ctrl.ForeColor = SystemColors.Window
End Select
End Sub
#End Region
#Region "Component resize and new"
Private Sub Multibox_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
If ListView1.Visible = False Then
Me.Height = 26
End If
End Sub
Public Sub New()
' This call is required by the Windows Form Designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
ListView1.MultiSelect = False
ListView1.FullRowSelect = True
End Sub
#End Region
Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged
End Sub
End Class
Form:
Multibox1.Columns.Add("Nama")
Multibox1.Columns.Add("Panggilan")
Multibox1.Items.Add("Mas Semar")
Multibox1.Items(0).SubItems.Add("Semar")
Multibox1.Items.Add("Petruk")
Multibox1.Items(1).SubItems.Add("Truk")
3) Lalu Masukan field parameter "nomor" tadi kedalam crystalreport
