VBNET中制作一个如VB6.0中的直线控件？

[sz_lgp]

VB6.0中的直线控件可以解决好多问题，vb.net中没有这个控件，觉得总是少了些什么？想写一个完成一样的控件，可就是无法去掉mybase所形成的方框，有谁写过？本人请教了。

[Knight94]

如果是水平直线的话，可以用label来模拟，或者自己画，
参看
http://www.syncfusion.com/faq/windowsforms/Search/488.aspx

[sz_lgp]

不仅是水平的，是任意角度的。

[coolstarhty]

方框我有办法去掉，不过去掉后直线又画不出来了，靠
继续尝试

[Knight94]

to 不仅是水平的，是任意角度的。

你直接画可能更好，用control来实现的话，增加的资源费用不少。

上面的文章已经给出直接画的方法。

[coolstarhty]

请留下邮箱，给你发个的例子

[fds2003]

帮顶！！

[Stephen_Ma]

Public Class Line
Inherits System.Windows.Forms.UserControl


#Region " Windows フォーム デザイナで生成されたコード "

Public Sub New()
MyBase.New()

' この呼び出しは Windows フォーム デザイナで必要です。
InitializeComponent()

' InitializeComponent() 呼び出しの後に初期化を追加します。

End Sub

'UserControl はコンポーネント一覧を消去するために dispose をオーバーライドします。
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub

' Windows フォーム デザイナで必要です。
Private components As System.ComponentModel.IContainer

' メモ : 以下のプロシージャは、Windows フォーム デザイナで必要です。
'Windows フォーム デザイナを使って変更してください。
' コード エディタを使って変更しないでください。
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
components = New System.ComponentModel.Container
End Sub

#End Region


#Region " Members "

Private _x1 As Integer = 0
Private _x2 As Integer = 0
Private _y1 As Integer = 0
Private _y2 As Integer = 0
Private _borderStyle As Integer
Private _borderWidth As Integer = 1
Private _drawMode As Integer

Private margin As Integer = 0

#End Region


#Region " New Propities "

<Category("Line"), Browsable(True)> _
Public Property BorderColor() As System.Drawing.Color
Get
Return Me.ForeColor
End Get
Set(ByVal Value As System.Drawing.Color)
Me.ForeColor = Value
redraw()
End Set
End Property

<Category("Line"), Browsable(True)> _
Public Property BorderStyle() As Integer
Get
Return Me._borderStyle
End Get
Set(ByVal Value As Integer)
Me._borderStyle = Value
redraw()
End Set
End Property

<Category("Line"), Browsable(True), DefaultValue(1)> _
Public Property BorderWidth() As Integer
Get
Return Me._borderWidth
End Get
Set(ByVal Value As Integer)
resetBounds(Me._x1, Me._y1, Me._x2, Me._y2, Value)
End Set
End Property

<Category("Line"), Browsable(True)> _
Public Property DrawMode() As Integer
Get
Return Me._drawMode
End Get
Set(ByVal Value As Integer)
Me._drawMode = Value
redraw()
End Set
End Property

<Category("Line"), Browsable(True)> _
Public Property X1() As Integer
Get
Return Me._x1
End Get
Set(ByVal Value As Integer)
resetBounds(Value, Me._y1, Me._x2, Me._y2, Me._borderWidth)
Me.Invalidate()
End Set
End Property

<Category("Line"), Browsable(True)> _
Public Property X2() As Integer
Get
Return Me._x2
End Get
Set(ByVal Value As Integer)
resetBounds(Me._x1, Me._y1, Value, Me._y2, Me._borderWidth)
Me.Invalidate()
End Set
End Property

<Category("Line"), Browsable(True)> _
Public Property Y1() As Integer
Get
Return Me._y1
End Get
Set(ByVal Value As Integer)
resetBounds(Me._x1, Value, Me._x2, Me._y2, Me._borderWidth)
Me.Invalidate()
End Set
End Property

<Category("Line"), Browsable(True)> _
Public Property Y2() As Integer
Get
Return Me._y2
End Get
Set(ByVal Value As Integer)
resetBounds(Me._x1, Me._y1, Me._x2, Value, Me._borderWidth)
Me.Invalidate()
End Set
End Property

#End Region

[Stephen_Ma]

#Region " Hide Propities "

<Browsable(False)> _
Public Shadows Property Location() As System.Drawing.Point
Get
Return MyBase.Location
End Get
Set(ByVal Value As System.Drawing.Point)
MyBase.Location = Value
End Set
End Property

<Browsable(False)> _
Public Shadows Property Size() As System.Drawing.Size
Get
Return MyBase.Size
End Get
Set(ByVal Value As System.Drawing.Size)
MyBase.Size = Value
End Set
End Property

<Browsable(False)> _
Public Overrides Property ForeColor() As System.Drawing.Color
Get
Return MyBase.ForeColor
End Get
Set(ByVal Value As System.Drawing.Color)
MyBase.ForeColor = Value
End Set
End Property

#End Region


#Region " Overirdes "

Protected Overrides Sub OnCreateControl()

MyBase.OnCreateControl()

If Me._x1 = 0 AndAlso Me._y1 = 0 AndAlso Me._x2 = 0 AndAlso Me._y2 = 0 Then
resetBounds(Me.Left + margin, Me.Top + margin, Me.Left + Me.Width - margin, Me.Top + Me.Height - margin, Me._borderWidth)
End If

End Sub

Protected Overrides Sub OnLocationChanged(ByVal e As System.EventArgs)

MyBase.OnLocationChanged(e)

Dim xOffset As Integer
Dim yOffset As Integer

If Me._x1 > Me._x2 Then
xOffset = Me.Location.X + margin - Me._x2
Else
xOffset = Me.Location.X + margin - Me._x1
End If

If Me._y1 > Me._y2 Then
yOffset = Me.Location.Y + margin - Me._y2
Else
yOffset = Me.Location.Y + margin - Me._y1
End If

If (xOffset = 0) AndAlso (yOffset = 0) Then
Return
End If

drawLine(Me._x1 + xOffset, Me._y1 + yOffset, Me._x2 + xOffset, Me._y2 + yOffset)

End Sub

Protected Overrides Sub OnResize(ByVal e As System.EventArgs)

MyBase.OnResize(e)

If Me._x1 > Me._x2 Then
Me._x1 = Me._x2 + Me.Width
Else
Me._x2 = Me._x1 + Me.Width
End If

If Me._y1 > Me._y2 Then
Me._y1 = Me.Height + Me._y2
Else
Me._y2 = Me.Height + Me._y1
End If

redraw()

End Sub

#End Region


#Region " Method "

Private Sub resetBounds(ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer, ByVal width As Integer)

If (Me._x1 = x1) AndAlso (Me._y1 = y1) AndAlso (Me._x2 = x2) AndAlso (Me._y2 = y2) AndAlso (Me._borderWidth = width) Then
Return
End If

Me._borderWidth = width

margin = width / 2 + 1

If x1 > x2 Then
MyBase.Left = x2 - margin
MyBase.Width = x1 - x2 + margin * 2
Else
MyBase.Left = x1 - margin
MyBase.Width = x2 - x1 + margin * 2
End If

If y1 > y2 Then
MyBase.Top = y2 - margin
MyBase.Height = y1 - y2 + margin * 2
Else
MyBase.Top = y1 - margin
MyBase.Height = y2 - y1 + margin * 2
End If

drawLine(x1, y1, x2, y2)

End Sub

Private Sub drawLine(ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer)

Me._x1 = x1
Me._y1 = y1
Me._x2 = x2
Me._y2 = y2

redraw()

End Sub

Private Sub redraw()

Dim winRegion As System.Drawing.Region
winRegion = GetLineWindowRegion(Me, Me._x1 - Me.Left, Me._y1 - Me.Top, _
Me._x2 - Me.Left, Me._y2 - Me.Top, Me._borderWidth, Me._drawMode)

Me.Region = winRegion
Me.BackColor = Me.ForeColor

End Sub

Protected Function GetLineWindowRegion(ByVal sender As Control, _
ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer, _
ByVal width As Integer, ByVal style As Integer) As Region

' Parameter check
If (sender.Width = 0 Or sender.Height = 0) Then
Return (New Region(New Rectangle(Point.Empty, System.Drawing.Size.Empty)))
End If

' Create bitmap
Dim bmp As System.Drawing.Bitmap
bmp = New System.Drawing.Bitmap(sender.Width, sender.Height, sender.CreateGraphics())

' Get bitmap graphics
Dim gcBmp As System.Drawing.Graphics
gcBmp = Graphics.FromImage(bmp)

' Get drawing text fore color
If sender.BackColor.ToArgb = sender.ForeColor.ToArgb Then
If sender.ForeColor.ToArgb = Color.Blue.ToArgb Then
sender.BackColor = Color.Red
Else
sender.BackColor = Color.Blue
End If
End If

' Draw text on bitmap
gcBmp.FillRectangle(New SolidBrush(sender.ForeColor), 0, 0, sender.Width, sender.Height)
gcBmp.DrawLine(New Pen(New SolidBrush(sender.BackColor), width), x1, y1, x2, y2)

' Get window region
Return GetWindowRegion(New Point(0, 0), bmp, sender.ForeColor)

End Function
Protected Function GetWindowRegion(ByVal location As Point, _
ByVal bitmap As System.Drawing.Bitmap, _
ByVal TransColor As Color) As Region

' Create Window region，initialize region with 0
Dim region As Region = New Region(New Rectangle(location, System.Drawing.Size.Empty))
Dim width As Integer = bitmap.Width
Dim height As Integer = bitmap.Height
Dim iX As Integer = 0

Dim x As Integer
Dim y As Integer
For y = 0 To height - 1
For x = 0 To width - 1

iX = x
' Skip transparent color and find next nontransparent point.
While iX < width
If bitmap.GetPixel(iX, y).ToArgb() = TransColor.ToArgb() Then
iX += 1
' Remember this hori-start point
Dim iLeftX As Integer = iX
' Find next trans-color point
While iX < width
If bitmap.GetPixel(iX, y).ToArgb() <> TransColor.ToArgb() Then
iX += 1
Else
Exit While
End If
End While
' Create a region include these nontrans-color point
If iX <> iLeftX Then
Dim rgnTemp As Region = New Region(New Rectangle(location.X + iLeftX, location.Y + y, iX - iLeftX, 1))
' Combine to main region
region.Union(rgnTemp)
rgnTemp.Dispose()
End If
x = iX
Else
Exit While
End If
End While

Next
Next

Return region

End Function

#End Region


End Class

[Stephen_Ma]

随便贴贴，希望对你有帮助。

[sz_lgp]

怎么去掉？能说出来吗？我的想法是：在mybase中放二个label，设定label的高宽为线宽，让mybase失去焦点，label得到焦点，在二个label之间画线，移动label时重画。

[wangwei155]

UP

[迈克揉索芙特]

画线是最终解决之道

[sz_lgp]

谢谢大家啦，问题还是没有解决，不过心情还好。

[coolstarhty]

我写的例子，见：

http://community.csdn.net/Expert/topic/4992/4992430.xml?temp=.346081

[wangwei155]

顶

[zpengenpz]

帮顶

[laidon]

看了coolstarhty(语言多了，编程不好学啊)的例子，感觉楼主应该解决问题了吧
好像实现方法应该很多啊

[沐NeMo]

制作自己的分隔线控件-VB.Net

http://www.linjimu.com.cn/mumu/ViewArticle.asp?id=11

参考网上的C#代码，自己还是喜欢用VB.Net，就写了两个类。

新建一个Visual Basic的 Windows 控件库。在项目中添加两个用户控件，一个为：LineH 水平分隔线 ，一个为:LineV垂直分隔线 ,代码如下。经过生成.dll,在其他项目引用，就可以使用。


''''''''水平分隔线 LineH.vb的完整代码
Public Class LineH
Inherits System.Windows.Forms.UserControl

#Region &quot; Windows 窗体设计器生成的代码 &quot;

Public Sub New()
MyBase.New()

''''''''该调用是 Windows 窗体设计器所必需的。
InitializeComponent()

''''''''在 InitializeComponent() 调用之后添加任何初始化

End Sub

''''''''UserControl1 重写 dispose 以清理组件列表。
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub

''''''''Windows 窗体设计器所必需的
Private components As System.ComponentModel.IContainer

''''''''注意: 以下过程是 Windows 窗体设计器所必需的
''''''''可以使用 Windows 窗体设计器修改此过程。
''''''''不要使用代码编辑器修改它。
&lt;System.Diagnostics.DebuggerStepThrough()&gt; Private Sub InitializeComponent()
''''''''
''''''''LineH
''''''''
Me.Name = &quot;LineH&quot;
Me.Size = New System.Drawing.Size(10, 2)

End Sub

#End Region

Private Sub LineH_Paint(ByVal sender As Object, ByVal e As PaintEventArgs) Handles MyBase.Paint
Dim g As Graphics = e.Graphics
Dim r As Rectangle = Me.ClientRectangle
Dim darkPen As Pen = New Pen(SystemColors.ControlDark, 1)
Dim LightPen As Pen = New Pen(Color.White)
''''''''用暗色调处理上边缘
g.DrawLine(darkPen, r.Left, r.Top, r.Right, r.Top)
''''''''用亮色调处理下边缘
g.DrawLine(LightPen, r.Left, r.Top + 1, r.Right, r.Top + 1)
End Sub

End Class

------------------------------------------------------
''''''''垂直分隔线 LineV.vb的完整代码
Public Class LineV
Inherits System.Windows.Forms.UserControl

#Region &quot; Windows 窗体设计器生成的代码 &quot;

Public Sub New()
MyBase.New()

''''''''该调用是 Windows 窗体设计器所必需的。
InitializeComponent()

''''''''在 InitializeComponent() 调用之后添加任何初始化

End Sub

''''''''UserControl 重写 dispose 以清理组件列表。
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub

''''''''Windows 窗体设计器所必需的
Private components As System.ComponentModel.IContainer

''''''''注意: 以下过程是 Windows 窗体设计器所必需的
''''''''可以使用 Windows 窗体设计器修改此过程。
''''''''不要使用代码编辑器修改它。
&lt;System.Diagnostics.DebuggerStepThrough()&gt; Private Sub InitializeComponent()
''''''''
''''''''LineV
''''''''
Me.Name = &quot;LineV&quot;
Me.Size = New System.Drawing.Size(2, 10)

End Sub

#End Region

Private Sub LineV_Paint(ByVal sender As Object, ByVal e As PaintEventArgs) Handles MyBase.Paint
Dim g As Graphics = e.Graphics
Dim r As Rectangle = Me.ClientRectangle
Dim darkPen As Pen = New Pen(SystemColors.ControlDark, 1)
Dim LightPen As Pen = New Pen(Color.White)
''''''''用暗色调处理左边缘
g.DrawLine(darkPen, r.Left, r.Top, r.Left, r.Bottom)
''''''''用亮色调处理右边缘
g.DrawLine(LightPen, r.Left + 1, r.Top, r.Left + 1, r.Bottom)
End Sub

End Class

在win2000 + vs2003编译通过。

我的主页:http://www.linjimu.com.cn/mumu

[沐NeMo]

上面的代码中的"变成了：" 我改过来，如下。

'水平分隔线 LineH.vb的完整代码
Public Class LineH
Inherits System.Windows.Forms.UserControl

#Region " Windows 窗体设计器生成的代码 "

Public Sub New()
MyBase.New()

'该调用是 Windows 窗体设计器所必需的。
InitializeComponent()

'在 InitializeComponent() 调用之后添加任何初始化

End Sub

'UserControl1 重写 dispose 以清理组件列表。
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub

'Windows 窗体设计器所必需的
Private components As System.ComponentModel.IContainer

'注意: 以下过程是 Windows 窗体设计器所必需的
'可以使用 Windows 窗体设计器修改此过程。
'不要使用代码编辑器修改它。
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
'
'LineH
'
Me.Name = "LineH"
Me.Size = New System.Drawing.Size(10, 2)

End Sub

#End Region

Private Sub LineH_Paint(ByVal sender As Object, ByVal e As PaintEventArgs) Handles MyBase.Paint
Dim g As Graphics = e.Graphics
Dim r As Rectangle = Me.ClientRectangle
Dim darkPen As Pen = New Pen(SystemColors.ControlDark, 1)
Dim LightPen As Pen = New Pen(Color.White)
'用暗色调处理上边缘
g.DrawLine(darkPen, r.Left, r.Top, r.Right, r.Top)
'用亮色调处理下边缘
g.DrawLine(LightPen, r.Left, r.Top + 1, r.Right, r.Top + 1)
End Sub

End Class

------------------------------------------------------
'垂直分隔线 LineV.vb的完整代码
Public Class LineV
Inherits System.Windows.Forms.UserControl

#Region " Windows 窗体设计器生成的代码 "

Public Sub New()
MyBase.New()

'该调用是 Windows 窗体设计器所必需的。
InitializeComponent()

'在 InitializeComponent() 调用之后添加任何初始化

End Sub

'UserControl 重写 dispose 以清理组件列表。
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub

'Windows 窗体设计器所必需的
Private components As System.ComponentModel.IContainer

'注意: 以下过程是 Windows 窗体设计器所必需的
'可以使用 Windows 窗体设计器修改此过程。
'不要使用代码编辑器修改它。
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
'
'LineV
'
Me.Name = "LineV"
Me.Size = New System.Drawing.Size(2, 10)

End Sub

#End Region

Private Sub LineV_Paint(ByVal sender As Object, ByVal e As PaintEventArgs) Handles MyBase.Paint
Dim g As Graphics = e.Graphics
Dim r As Rectangle = Me.ClientRectangle
Dim darkPen As Pen = New Pen(SystemColors.ControlDark, 1)
Dim LightPen As Pen = New Pen(Color.White)
'用暗色调处理左边缘
g.DrawLine(darkPen, r.Left, r.Top, r.Left, r.Bottom)
'用亮色调处理右边缘
g.DrawLine(LightPen, r.Left + 1, r.Top, r.Left + 1, r.Bottom)
End Sub

End Class

在win2000+ vs2003编译通过。

我的主页:http://www.linjimu.com.cn

[沐NeMo]

"变成了：& quot;