你的信息是旧的,但由于我有同样的问题,我在这里张贴了我发现的解决方案。
我用的是实用程序类:
Imports System.Drawing
Imports System.IO
Imports System.Text.RegularExpressions
Imports System.Windows.Forms
Namespace AutoEllipsis
Public Enum EllipsisFormat
None = 0
AtEnd = 1
AtStart = 2
AtMiddle = 3
Path = 8
Word = 16
End Enum
''' <remarks>
''' Adapted from Auto Ellipsis project published by Thomas Polaert under The Code Project Open License (CPOL) 1.02
''' http://www.codeproject.com/Articles/37503/Auto-Ellipsis
''' </remarks>
Public Class Ellipsis
Public Shared ReadOnly EllipsisChars = "..."
Private Shared PrevWord As Regex = New Regex("\W*\w*$")
Private Shared NextWord As Regex = New Regex("\w*\W*")
Private TargetWidth As Integer
Private TargetFont As Font
Private Ctrl As Control
Private Sub New(ByRef Ctrl As Control)
Me.Ctrl = Ctrl
End Sub
Private Sub New(ByVal MaxWidth As Integer, ByVal TargetFont As Font)
Me.TargetWidth = MaxWidth
Me.TargetFont = TargetFont
End Sub
Private ReadOnly Property Width() As Integer
Get
If Me.Ctrl IsNot Nothing Then
Return Me.Ctrl.Width
Else
Return Me.TargetWidth
End If
End Get
End Property
Private ReadOnly Property MeasureText(ByVal Text As String) As Size
Get
If Me.Ctrl IsNot Nothing Then
Using Dc As Graphics = Ctrl.CreateGraphics()
Return TextRenderer.MeasureText(Dc, Text, Me.Ctrl.Font)
End Using
Else
Return TextRenderer.MeasureText(Text, Me.TargetFont)
End If
End Get
End Property
Public Shared Function Compact(ByVal Text As String, ByVal MaxWidth As Integer, ByVal TargetFont As Font, ByVal Options As EllipsisFormat) As String
If MaxWidth = Nothing Then
Throw New ArgumentNullException("MaxWidth")
End If
If TargetFont Is Nothing Then
Throw New ArgumentNullException("TargetFont")
End If
Return Ellipsis.Compact(Text, New Ellipsis(MaxWidth, TargetFont), Options)
End Function
Public Shared Function Compact(ByVal Text As String, ByRef Ctrl As Control, ByVal Options As EllipsisFormat) As String
If Ctrl Is Nothing Then
Throw New ArgumentNullException("Ctrl")
End If
Return Ellipsis.Compact(Text, New Ellipsis(Ctrl), Options)
End Function
Private Shared Function Compact(ByVal Text As String, Elp As Ellipsis, ByVal Options As EllipsisFormat) As String
If String.IsNullOrEmpty(Text) Then
Return Text
End If
If EllipsisFormat.AtMiddle & Options = 0 Then
Return Text
End If
Dim TextSize As Size = Elp.MeasureText(Text)
If TextSize.Width <= Elp.Width Then
Return Text
End If
Dim Pre As String = ""
Dim Mid As String = Text
Dim Post As String = ""
Dim IsPath As Boolean = (EllipsisFormat.Path & Options) <> 0
If IsPath Then
Pre = Path.GetPathRoot(Text)
Mid = Path.GetDirectoryName(Text).Substring(Pre.Length)
Post = Path.GetFileName(Text)
End If
Dim Len As Integer = 0
Dim Seg As Integer = Mid.Length
Dim Fit As String = ""
While Seg > 1
Seg -= Seg / 2
Dim Left As Integer = Len + Seg
Dim Right As Integer = Mid.Length
If Left > Right Then
Continue While
End If
If EllipsisFormat.AtMiddle & Options = EllipsisFormat.AtMiddle Then
Left = Left / 2
Right = Right / 2
ElseIf EllipsisFormat.AtStart & Options <> 0
Right -= Left
Left = 0
End If
If EllipsisFormat.Word & Options <> 0 Then
If EllipsisFormat.AtEnd & Options <> 0 Then
Left -= PrevWord.Match(Mid, 0, Left).Length
End If
If EllipsisFormat.AtStart & Options <> 0 Then
Right += NextWord.Match(Mid, Right).Length
End If
End If
Dim Tst As String = Mid.Substring(0, Left) + EllipsisChars + Mid.Substring(Right)
If IsPath Then
Tst = Path.Combine(Path.Combine(Pre, Tst), Post)
End If
TextSize = Elp.MeasureText(Tst)
If TextSize.Width <= Elp.Width Then
Len += Seg
Fit = Tst
End If
End While
If Len = 0 Then
If Not IsPath Then
Return EllipsisChars
End If
If Pre.Length = 0 And Mid.Length = 0 Then
Return Post
End If
Fit = Path.Combine(Path.Combine(Pre, EllipsisChars), Post)
TextSize = Elp.MeasureText(Fit)
If TextSize.Width > Elp.Width Then
Fit = Path.Combine(EllipsisChars, Post)
End If
End If
Return Fit
End Function
End Class
End Namespace
用法(ToolStripStatusLabel):
Dim Lbl As New ToolStripStatusLabel()
Dim SomeText As String = "C:\Program Files (x86)\Microsoft Visual Studio 14.0\Xml\Schemas"
Lbl.Text = Ellipsis.Compact(SomeText, Lbl.Width - Lbl.Padding.Horizontal, Lbl.Font, EllipsisFormat.AtMiddle & EllipsisFormat.Path)
用法(标签):
Dim Lbl As New Label()
Dim SomeText As String = "C:\Program Files (x86)\Microsoft Visual Studio 14.0\Xml\Schemas"
Lbl.Text = Ellipsis.Compact(SomeText, Lbl, EllipsisFormat.AtMiddle & EllipsisFormat.Path)
