Imports System.ComponentModel '<System.ComponentModel.DefaultBindingProperty("Text")> _ Public Class MultiColumnCombobox : Inherits ComboBox #Region " Property DataSource " Private bindingSourceValue As BindingSource Public Property BindingSource() As BindingSource Get Return bindingSourceValue End Get Set(ByVal value As BindingSource) bindingSourceValue = value End Set End Property #End Region Private Sub MultiColumnCombobox_DropDown( _ ByVal sender As Object, _ ByVal e As System.EventArgs) _ Handles Me.DropDown Dim rect = New Rectangle(sender.Location.X, sender.Location.Y, sender.Width, sender.Height) Dim maxRect As Rectangle maxRect = Screen.GetWorkingArea(sender) rect = Me.Parent.RectangleToScreen(rect) Console.WriteLine("x:" & rect.X - rect.Width / 2 & ",y:" & rect.Y & ",width:" & rect.Width & ",height:" & rect.Height) Dim LookUpGrid As New CreateLookUpGrid(sender, BindingSource, rect, maxRect) End Sub Private Sub MultiColumnCombobox_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.TextChanged If Me.Text.IndexOf("%") <> -1 Then MultiColumnCombobox_DropDown(sender, e) End If End Sub End Class Public Class CreateLookUpGrid : Inherits System.Windows.Forms.Form Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, _ ByVal dx As Long, _ ByVal dy As Long, _ ByVal cButtons As Long, _ ByVal dwExtraInfo As Long) Const MOUSEEVENTF_LEFTDOWN As Short = &H2S Const MOUSEEVENTF_LEFTUP As Short = &H4S Const MOUSEEVENTF_MIDDLEDOWN As Short = &H20S Const MOUSEEVENTF_MIDDLEUP As Short = &H40S Const MOUSEEVENTF_MOVE As Short = &H1S Const MOUSEEVENTF_ABSOLUTE As Short = &H8000S Const MOUSEEVENTF_RIGHTDOWN As Short = &H8S Const MOUSEEVENTF_RIGHTUP As Short = &H10S Const WM_NCHITTEST As Integer = &H84 Const HTLEFT As Integer = 10 Const HTRIGHT As Integer = 11 Const HTTOP As Integer = 12 Const HTTOPLEFT As Integer = 13 Const HTTOPRIGHT As Integer = 14 Const HTBOTTOM As Integer = 15 Const HTBOTTOMLEFT As Integer = &H10 Const HTBOTTOMRIGHT As Integer = 17 Protected Overloads Overrides Sub WndProc(ByRef m As Message) MyBase.WndProc(m) Select Case m.Msg Case WM_NCHITTEST Dim vPoint As New Point(CInt(m.LParam) And &HFFFF, CInt(m.LParam) >> 16 And &HFFFF) vPoint = PointToClient(vPoint) If vPoint.X <= 5 Then If vPoint.Y <= 5 Then m.Result = CType(HTTOPLEFT, IntPtr) ElseIf vPoint.Y >= ClientSize.Height - 5 Then m.Result = CType(HTBOTTOMLEFT, IntPtr) Else m.Result = CType(HTLEFT, IntPtr) End If ElseIf vPoint.X >= ClientSize.Width - 5 Then If vPoint.Y <= 5 Then m.Result = CType(HTTOPRIGHT, IntPtr) ElseIf vPoint.Y >= ClientSize.Height - 5 Then m.Result = CType(HTBOTTOMRIGHT, IntPtr) Else m.Result = CType(HTRIGHT, IntPtr) End If ElseIf vPoint.Y <= 5 Then m.Result = CType(HTTOP, IntPtr) ElseIf vPoint.Y >= ClientSize.Height - 5 Then m.Result = CType(HTBOTTOM, IntPtr) End If Exit Select End Select End Sub Friend WithEvents lookupGrid As New DataGridView Friend WithEvents lblClose As New Label Friend WithEvents statusStripChangeSize As New System.Windows.Forms.StatusStrip Private rect As Rectangle Private bindingSource As BindingSource #Region " Customize Property " Private sizeValue As Size Public Overloads Property Size() As Size Get Return sizeValue End Get Set(ByVal value As Size) sizeValue = value End Set End Property Private ReadOnly Property DataTable() As DataTable Get Return CType(bindingSource.DataSource, DataSet).Tables(bindingSource.DataMember) End Get End Property Private callObjectValue As Object Private Property CallObject() As Object Get Return callObjectValue End Get Set(ByVal value As Object) callObjectValue = value End Set End Property #End Region Public Function CalcRectangle(ByVal _rect As Rectangle, ByVal _maxRect As Rectangle) If _rect.X < 0 AndAlso _ (_rect.Top + _rect.Height + Size.Height) < _maxRect.Height Then rect = New Rectangle(0, _ _rect.Y + _rect.Height, _ _rect.Width, _ _rect.Height) ElseIf _rect.X < 0 AndAlso _ (_rect.Top + _rect.Height + Size.Height) > _maxRect.Height Then rect = New Rectangle(0, _ _rect.Top - Size.Height, _ _rect.Width, _ _rect.Height) ElseIf (_rect.Top + _rect.Height + Size.Height) > _maxRect.Height AndAlso _ (_rect.Left + Size.Width) < _maxRect.Width Then rect = New Rectangle(_rect.X, _ _rect.Top - Size.Height, _ _rect.Width, _ _rect.Height) ElseIf (_rect.Left + Size.Width) > _maxRect.Width AndAlso _ (_rect.Top + _rect.Height + Size.Height) < _maxRect.Height Then rect = New Rectangle(_maxRect.Width - Size.Width, _ _rect.Top + _rect.Height, _ _rect.Width, _ _rect.Height) ElseIf (_rect.Left + Size.Width) > _maxRect.Width AndAlso _ (_rect.Top + _rect.Height + Size.Height) > _maxRect.Height Then rect = New Rectangle(_maxRect.Width - Size.Width, _ _rect.Top - Size.Height, _ _rect.Width, _ _rect.Height) Else rect = New Rectangle(_rect.X, _ _rect.Top + _rect.Height, _ _rect.Width, _ _rect.Height) End If Return rect End Function Public Sub InitLookupGrid() With lookupGrid .AllowUserToAddRows = False .AllowUserToDeleteRows = False .AllowUserToResizeColumns = True .AllowUserToResizeRows = False .RowHeadersVisible = False .DataSource = bindingSource .RowTemplate.Height = 20 .Dock = DockStyle.Top .AutoSizeColumnsMode = DataGridViewAutoSizeColumnsMode.DisplayedCells .AlternatingRowsDefaultCellStyle.BackColor = Color.WhiteSmoke .ReadOnly = True End With End Sub Private Sub InitCloseLabel() lblClose.Text = "x" lblClose.Size = New Size(10, 10) lblClose.Location = New Point(5, Me.Bounds.Height - 15) End Sub Private Sub InitStatusStrip() With statusStripChangeSize .AutoSize = False .BackColor = System.Drawing.Color.Transparent .Dock = System.Windows.Forms.DockStyle.None .GripStyle = System.Windows.Forms.ToolStripGripStyle.Visible .Name = "Change Size" .Size = New System.Drawing.Size(12, 12) .Location = New System.Drawing.Point(Me.Bounds.Width - .Width - 3, Me.Bounds.Height - .Height - 3) .Stretch = False .Text = "Change Size" End With End Sub Public Sub InitLookupForm() With Me .ShowInTaskbar = False .StartPosition = FormStartPosition.Manual .FormBorderStyle = FormBorderStyle.None .ClientSize = Size lookupGrid.Height = .Height - 20 InitCloseLabel() InitStatusStrip() With .Controls .Add(lookupGrid) .Add(lblClose) .Add(statusStripChangeSize) End With .Top = rect.Top .Left = rect.Left .BackColor = Color.LightSteelBlue .ShowDialog() End With Console.WriteLine("form X:{0} - Y:{1}", Me.Location.X, Me.Location.Y) End Sub Public Sub New(ByVal sender As Object, _ ByVal _bindingSource As BindingSource, _ ByVal _rect As Rectangle, _ ByVal _maxRect As Rectangle, _ Optional ByVal _formWidth As Integer = 300, _ Optional ByVal _formHeight As Integer = 200) CallObject = sender If _bindingSource Is Nothing Then Throw New IndexOutOfRangeException("未指定数据源") Else bindingSource = _bindingSource End If InitLookupGrid() If (lookupGrid.Width + 50) < _rect.Width Then Size = New Size(_rect.Width, _formHeight) Else Size = New Size(lookupGrid.Width + 50, _formHeight) End If CalcRectangle(_rect, _maxRect) If Not String.IsNullOrEmpty(CallObject.Text) Then Executefilter() End If InitLookupForm() End Sub Public Sub Executefilter() If bindingSource.DataSource Is Nothing Then Exit Sub If CallObject.Text.IndexOf("%") = -1 Then Dim index As Integer = bindingSource.Find(DataTable.Columns(0).ColumnName, CallObject.Text) If index <> -1 Then bindingSource.Position = index Else bindingSource.MoveFirst() End If Else bindingSource.Filter = DataTable.Columns(0).ColumnName + " like '" + CallObject.Text + "'" End If End Sub Private Sub CreateLookUpGrid_KeyDown(ByVal sender As Object, _ ByVal e As System.Windows.Forms.KeyEventArgs) _ Handles Me.KeyDown If e.KeyCode = Keys.Escape Then CloseForm() End If End Sub Private Sub lookupGrid_CellMouseDown(ByVal sender As Object, _ ByVal e As System.Windows.Forms.DataGridViewCellMouseEventArgs) _ Handles lookupGrid.CellMouseDown If e.RowIndex = -1 Then Exit Sub If e.Button = Windows.Forms.MouseButtons.Left Then If lookupGrid.CurrentCell.RowIndex <> e.RowIndex Then lookupGrid.CurrentCell = lookupGrid(e.ColumnIndex, e.RowIndex) End If CallObject.Text = lookupGrid.CurrentRow.Cells(0).Value.ToString CloseForm() End If End Sub Private Sub lookupGrid_KeyDown(ByVal sender As Object, _ ByVal e As System.Windows.Forms.KeyEventArgs) _ Handles lookupGrid.KeyDown If e.KeyCode = Keys.Escape Then CloseForm(True) ElseIf e.KeyCode = Keys.Enter Then CallObject.Text = lookupGrid.CurrentRow.Cells(0).Value.ToString CloseForm() End If End Sub Private Sub CloseForm(Optional ByVal cancel As Boolean = False) Me.Close() CallObject.Focus() If cancel = True Then mouse_event(MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0) End If End Sub Private Sub CreateLookUpGrid_SizeChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.SizeChanged With lookupGrid .Height = Me.Height - 20 End With lblClose.Location = New Point(5, Me.Bounds.Height - 15) statusStripChangeSize.Location = New System.Drawing.Point( _ Me.Bounds.Width - statusStripChangeSize.Width - 3, _ Me.Bounds.Height - statusStripChangeSize.Height - 3) End Sub Private Sub lblClose_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles lblClose.Click CloseForm(True) End Sub Private Sub lblClose_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles lblClose.MouseEnter Dim lbl As Label = CType(sender, Label) lbl.Cursor = Cursors.Hand lbl.BackColor = Color.Bisque End Sub Private Sub lblClose_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles lblClose.MouseLeave sender.Cursor = Cursors.Default sender.BackColor = Color.Transparent End Sub End Class