See the example Make a line "symbiote" to help users draw rubberband lines for the basics.

This version adds a couple new twists. First, it has a Caption property that determines the text displayed on the line.

Private m_Caption As String

' Return the caption we will draw.
Public Property Get Caption() As String
    Caption = m_Caption
End Property

' Set the caption we will draw.
Public Property Let Caption(ByVal New_Caption As String)
    m_Caption = New_Caption
    PropertyChanged "Caption"
End Property

Public Event LineMoved(ByVal x0 As Single, ByVal y0 As _
    Single, ByVal x1 As Single, ByVal y1 As Single)
Public Event LineSelected(ByVal x0 As Single, ByVal y0 As _
    Single, ByVal x1 As Single, ByVal y1 As Single)

' Start rubberband drawing.
Private Sub m_Canvas_MouseDown(Button As Integer, Shift As _
    Integer, x As Single, y As Single)
    If Button <> vbLeftButton Then Exit Sub
    m_Drawing = True

    m_OldForeColor = m_Canvas.ForeColor
    m_OldFillColor = m_Canvas.FillColor
    m_OldFillStyle = m_Canvas.FillStyle
    m_Canvas.ForeColor = m_Canvas.BackColor
    m_Canvas.FillColor = m_Canvas.BackColor
    m_Canvas.FillStyle = vbFSSolid

    m_X0 = x
    m_Y0 = y
    m_X1 = x
    m_Y1 = y

    DrawLine m_X0, m_Y0, m_X1, m_Y1
End Sub

' Continue drawing.
Private Sub m_Canvas_MouseMove(Button As Integer, Shift As _
    Integer, x As Single, y As Single)
    If Not m_Drawing Then Exit Sub

    RaiseEvent LineMoved(m_X0, m_Y0, x, y)

    m_Canvas.Cls
    m_X1 = x
    m_Y1 = y
    DrawLine m_X0, m_Y0, m_X1, m_Y1
End Sub

' Finish drawing.
Private Sub m_Canvas_MouseUp(Button As Integer, Shift As _
    Integer, x As Single, y As Single)
    If Not m_Drawing Then Exit Sub
    m_Drawing = False

    m_Canvas.ForeColor = m_OldForeColor
    m_Canvas.FillColor = m_OldFillColor
    m_Canvas.FillStyle = m_OldFillStyle

    m_Canvas.Cls
    RaiseEvent LineSelected(m_X0, m_Y0, m_X1, m_Y1)
End Sub

' Draw the line with its caption.
Private Sub DrawLine(ByVal x0 As Single, ByVal y0 As _
    Single, ByVal x1 As Single, ByVal y1 As Single)
Const PI As Double = 3.14159265
Dim angle As Double
Dim wgt As Long
Dim escapement As Long
Dim wid As Single
Dim hgt As Single
Dim dx As Single
Dim dy As Single
Dim ux As Single
Dim uy As Single
Dim px As Single
Dim py As Single
Dim dist As Single
Dim cx As Single
Dim cy As Single
Dim tx As Single
Dim ty As Single
Dim pts(0 To 4) As POINTAPI
Dim i As Integer

    ' Get the text's angle.
    angle = Atan2(-(y1 - y0), x1 - x0)

    ' Make and install the rotated font.
    If m_Canvas.Font.Bold Then
        wgt = 500
    Else
        wgt = 700
    End If
    escapement = 10 * angle * 180 / PI
    FontLoad m_Canvas, m_Canvas.Font.Name, _
        ScaleY(m_Canvas.Font.size, vbPoints, vbPixels), _
        wgt, escapement, m_Canvas.Font.Italic, _
        m_Canvas.Font.Underline, m_Canvas.Font.Strikethrough

    ' See how big the caption is.
    wid = m_Canvas.TextWidth(m_Caption)
    hgt = m_Canvas.TextHeight(m_Caption)

    ' Draw the line.
    m_Canvas.Line (x0, y0)-(x1, y1), vbBlack

    ' Get the unit vector along the line.
    dx = x1 - x0
    dy = y1 - y0
    dist = Sqr(dx * dx + dy * dy)
    If dist > 0 Then
        ux = dx / dist
        uy = dy / dist
    Else
        ux = 0
        uy = 0
    End If

    ' Get the perpendicular vector.
    px = -uy
    py = ux

    ' See where the text goes.
    cx = (x1 + x0) / 2
    cy = (y1 + y0) / 2
    tx = cx - (px * hgt / 3 + ux * wid / 2)
    ty = cy - (py * hgt / 3 + uy * wid / 2)

    ' Clear the area under the text.
    pts(0).x = cx + 1.2 * (px * hgt / 3 + ux * wid / 2)
    pts(0).y = cy + 1.2 * (py * hgt / 3 + uy * wid / 2)
    pts(1).x = cx + 1.2 * (-px * hgt / 3 + ux * wid / 2)
    pts(1).y = cy + 1.2 * (-py * hgt / 3 + uy * wid / 2)
    pts(2).x = cx + 1.2 * (-px * hgt / 3 - ux * wid / 2)
    pts(2).y = cy + 1.2 * (-py * hgt / 3 - uy * wid / 2)
    pts(3).x = cx + 1.2 * (px * hgt / 3 - ux * wid / 2)
    pts(3).y = cy + 1.2 * (py * hgt / 3 - uy * wid / 2)
    For i = 0 To 3
        pts(i).x = m_Canvas.ScaleX(pts(i).x, _
            m_Canvas.ScaleMode, vbPixels)
        pts(i).y = m_Canvas.ScaleY(pts(i).y, _
            m_Canvas.ScaleMode, vbPixels)
    Next i
    pts(4) = pts(3)

    m_Canvas.ForeColor = m_Canvas.BackColor
    Polygon m_Canvas.hdc, pts(0), 5

    ' Display the text.
    m_Canvas.ForeColor = vbBlack
    m_Canvas.CurrentX = tx
    m_Canvas.CurrentY = ty
    m_Canvas.Print m_Caption;

    ' Restore the original font.
    FontUnload m_Canvas
End Sub

Public Function Atan2(ByVal y As Double, ByVal x As Double) _
    As Double
Dim theta As Double

    If (Abs(x) < 0.0000001) Then
        If (Abs(y) < 0.0000001) Then
            theta = 0#
        ElseIf (y > 0#) Then
            theta = 1.5707963267949
        Else
            theta = -1.5707963267949
        End If
    Else
        theta = Atn(y / x)

        If (x < 0) Then
            If (y >= 0#) Then
                theta = 3.14159265358979 + theta
            Else
                theta = theta - 3.14159265358979
            End If
        End If
    End If

    Atan2 = theta
End Function

' Restore the original font.
Private Sub FontUnload(ByVal target As Object)
    ' Restore the original font.
    m_Newfont = SelectObject(target.hdc, m_Oldfont)

    ' Free font resources (important!)
    DeleteObject m_Newfont
    m_Newfont = 0
    m_Oldfont = 0
End Sub
' Make and install a rotated font.
Private Sub FontLoad(ByVal target As Object, ByVal _
    font_name As String, ByVal size As Long, ByVal weight _
    As Long, ByVal escapement As Long, ByVal use_italic As _
    Boolean, ByVal use_underline As Boolean, ByVal _
    use_strikethrough As Boolean)
Const CLIP_LH_ANGLES = 16   ' Needed for tilted fonts.
Const PI = 3.14159625
Const PI_180 = PI / 180#

    m_Newfont = CreateFont(size, 0, _
        escapement, escapement, weight, _
        use_italic, use_underline, _
        use_strikethrough, 0, 0, _
        CLIP_LH_ANGLES, 0, 0, font_name)

    ' Select the new font.
    m_Oldfont = SelectObject(target.hdc, m_Newfont)
End Sub