VB Label过长的文本显示

Option Explicit
'API定义：
Private Declare Function GetTextExtentExPoint Lib "gdi32" Alias "GetTextExtentExPointA" (ByVal hdc As Long, ByVal lpszStr As String, ByVal cchString As Long, ByVal nMaxExtent As Long, lpnFit As Long, alpDx As Long, lpSize As Size) As Long
Private Type Size
  cx As Long
  cy As Long
End Type

'按Label控件宽度来修剪Label控件文字长度
'参数：objLabel为Label控件名称
'参数：IsFontChanged，表示窗体字体与Label字体不相同时为True，缺省为False（相同）
Private Sub TrimLabel(objLabel As Control, Optional ByVal IsFontChanged As Boolean = False)
  Dim sz   As Size 'GetTextExtentExPoint函数调用使用
  Dim lBytesLen  As Long '字符串长度（汉字＝2,Ascii＝1）
  Dim lLabelWidth As Long 'Label的宽度（像素单位）
  Dim lMaxBytes  As Long 'Label能容纳的最大字节长度
  Dim sTemp   As String '临时字符串
  
  sTemp = StrConv(objLabel.Caption, vbFromUnicode)
  lBytesLen = LenB(sTemp)
  lLabelWidth = Int(Me.ScaleX(objLabel.Width, Me.ScaleMode, vbPixels))
  If IsFontChanged Then
   Dim fntTemp As IFontDisp
   Set fntTemp = Me.Font
   Set Me.Font = objLabel.Font
   GetTextExtentExPoint Me.hdc, objLabel.Caption, lBytesLen, lLabelWidth, lMaxBytes, ByVal 0, sz
   Set Me.Font = fntTemp
   Set fntTemp = Nothing
  Else
   GetTextExtentExPoint Me.hdc, objLabel.Caption, lBytesLen, lLabelWidth, lMaxBytes, ByVal 0, sz
  End If
  
  If lBytesLen > lMaxBytes Then 'Label容纳不下文字时
   If LenB(StrConv(LeftB(sTemp, lMaxBytes - 3), vbUnicode)) Mod 2 Then '去掉最后3个后，最后一个汉字被截成两半
    objLabel.Caption = StrConv(LeftB(sTemp, lMaxBytes - 4), vbUnicode)
   Else
    objLabel.Caption = StrConv(LeftB(sTemp, lMaxBytes - 3), vbUnicode)
   End If
   objLabel.Caption = objLabel.Caption & "..."
  End If
End Sub

'调用实例，请在窗体加入Label1控件与Command1控件
Private Sub Command1_Click()
  '调用，这里Label1字体与Form字体不一样，如果Form字体在你的程序无关紧要,也可以这样写：
  'Set Me.Font = Label1.Font
  'TrimLabel
  TrimLabel Label1, True
  TrimLabel Command2, True
End Sub