Text Overflow

Option Explicit



Private Type RECT

   Left As Long

   Top As Long

   Right As Long

   Bottom As Long

End Type



Private Const DT_PATH_ELLIPSIS As Long = &H4000

Private Const DT_MODIFYSTRING As Long = &H10000

Private Const DT_CALCRECT As Long = &H400

Private Const DT_NOPREFIX As Long = &H800



Private Declare Function DrawText Lib "user32.dll" Alias "DrawTextA" 
(ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, ByRef 
lpRect As RECT, ByVal wFormat As Long) As Long



Private Sub Form_Load()

   With Me.ReportControl1

      .SetCustomDraw xtpCustomBeforeDrawRow

      

      .Columns.Add .Columns.Count, "Test", 100, True

      .Columns.Add .Columns.Count, "Test", 100, True

      

      With .Records.Add

         .AddItem "C:\Program Files\Program Something or other\SomeProgram.exe"

         .AddItem ""

      End With

      

      .Populate

   End With

End Sub



Private Sub ReportControl1_BeforeDrawRow(ByVal Row As 
XtremeReportControl.IReportRow, ByVal Item As 
XtremeReportControl.IReportRecordItem, ByVal Metrics As 
XtremeReportControl.IReportRecordItemMetrics)

   Dim lt_Rect As RECT

   Dim l_Left As Long

   Dim l_Top As Long

   Dim l_Text As String

   Dim l_Null As Long

   

   Select Case Item.Index

   Case 0   ' First Column

      Row.GetItemRect Item, lt_Rect.Left, lt_Rect.Top, lt_Rect.Right, lt_Rect.Bottom

      lt_Rect.Right = lt_Rect.Right - 8   ' Why this magic number?? Prevents ReportControl from adding its own end ellipsis

      

      l_Text = Item.Value

      

      DrawText Me.hdc, l_Text, -1, lt_Rect, DT_PATH_ELLIPSIS + DT_MODIFYSTRING + DT_CALCRECT + DT_NOPREFIX

      

      l_Null = InStr(1, l_Text, vbNullChar) - 1

      If l_Null >= 0 Then

         l_Text = Left$(l_Text, l_Null)

      End If

      

      Metrics.Text = l_Text

   End Select

End Sub

Option Explicit

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Private Const DT_PATH_ELLIPSIS As Long = &H4000
Private Const DT_MODIFYSTRING As Long = &H10000
Private Const DT_CALCRECT As Long = &H400
Private Const DT_NOPREFIX As Long = &H800

Private Declare Function DrawText Lib "user32.dll" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, ByRef lpRect As RECT, ByVal wFormat As Long) As Long

Private Sub Form_Load()
   With Me.ReportControl1
      .SetCustomDraw xtpCustomBeforeDrawRow
      .EnableMarkup = True ' Enable Markup
      .PaintManager.ForceDynamicMarkupForCell = True  ' Make Metrics.Text render markup
     
      .Columns.Add .Columns.Count, "Test", 100, True
      .Columns.Add .Columns.Count, "Test", 100, True

      With .Records.Add
         .AddItem "C:\Program Files\Program Something or other\SomeProgram.exe"
         .AddItem ""
      End With
     
      .Populate
   End With
End Sub

Private Sub ReportControl1_BeforeDrawRow(ByVal Row As XtremeReportControl.IReportRow, ByVal Item As XtremeReportControl.IReportRecordItem, ByVal Metrics As XtremeReportControl.IReportRecordItemMetrics)
   Dim lt_Rect As RECT
   Dim l_Left As Long
   Dim l_Top As Long
   Dim l_Text As String
   Dim l_Null As Long
   Dim lo_OldFont As StdFont
  
   Select Case Item.Index
   Case 0   ' First Column
      Row.GetItemRect Item, lt_Rect.Left, lt_Rect.Top, lt_Rect.Right, lt_Rect.Bottom
      lt_Rect.Right = lt_Rect.Right - 3 ' Why this magic number?? Prevents ReportControl from adding its own end ellipsis

      l_Text = Item.Value

      Set lo_OldFont = Me.Font
      Set Me.Font = Me.ReportControl1.PaintManager.TextFont
      DrawText Me.hdc, l_Text, -1, lt_Rect, DT_PATH_ELLIPSIS + DT_MODIFYSTRING + DT_CALCRECT + DT_NOPREFIX
      Set Me.Font = lo_OldFont

      l_Null = InStr(1, l_Text, vbNullChar) - 1
      If l_Null >= 0 Then
         l_Text = Left$(l_Text, l_Null)
      End If

      Metrics.Text = "<TextBlock TextTrimming='None'>" & EncodePlainTextForXaml(l_Text) & "</TextBlock>"
   End Select
End Sub


Private Function EncodePlainTextForXaml(ByVal p_PlainText As String) As String
   ' Convert illegal characters to XAML entities
   p_PlainText = Replace$(p_PlainText, "&", "&amp;")
   p_PlainText = Replace$(p_PlainText, "<", "&lt;")
   p_PlainText = Replace$(p_PlainText, ">", "&gt;")
   p_PlainText = Replace$(p_PlainText, "'", "&apos;")
   p_PlainText = Replace$(p_PlainText, """", "&quot;")
   ' Normalize CRLF and CR to LF, then expand LF characters to XAML <LineBreak/> tags
   p_PlainText = Replace$(p_PlainText, vbNewLine, vbLf)
   p_PlainText = Replace$(p_PlainText, vbCr, vbLf)
   p_PlainText = Replace$(p_PlainText, vbLf, "<LineBreak/>")
  
   EncodePlainTextForXaml = p_PlainText
End Function