Visual Basic - Reducir tamaño de letra gradualmente cuando el Listcount rebase cierto limite

Dim BA As Double

            Dim BB As Double

            Dim BC As Double

            BB = 100 'Es la mitad del espacio donde debe ir colocado el texto del itinerario sobre el eje Y

            BA = 350 'Es el punto en Y donde comienza a escribirse el itinerario y las escalas

            BC = 200

            'AT = Tamaño del texto que se va a poner

            'AC = Tamaño del campo en que se va a colocar ITINERARIO y Escalas

            Dim AT As Double 'Ancho del texto 

            Dim AC As Double 'Variable del Ancho del campo donde va AT

            AC = 355 'Asignación de valor del Ancho del Campo

            Dim TF As Int32 = 12 'Variable para asignar Tamaño de Fuente

            Dim TFN As Int32 'Variable para tomar el Temaño de Fuente nuevo

            Dim FD As Drawing.Font 'Variable asignada para Fuente Dinámica

            TFN = (TrasladosPasaje.Count - 9) * 0.5

            If TFN > 0 Then

                TF -= TFN

            Else

                TF = 12

            End If

            FD = New Drawing.Font("Segoe UI", TF, FontStyle.Regular, GraphicsUnit.World)

            'Palabra Itinerario y escalas del viaje

            'py = 373

            AT = eve.Graphics.MeasureString("ITINERARIO:", Fuente12Bold).Width / 2

            px = AC - AT

            BC = (eve.Graphics.MeasureString("•  ", FD).Height * TrasladosPasaje.Count) / 2

            py = BA + BB - BC + TrasladosPasaje.Count

            eve.Graphics.DrawString("ITINERARIO:", Fuente12Bold, Brush, New Point(px, py))

            py += 15

            For i As Int32 = 0 To TrasladosPasaje.Count - 1

                If TrasladosPasaje(i).Destino <> "" Then

                    AT = eve.Graphics.MeasureString("•  " & TrasladosPasaje(i).Origen & "  -  " & TrasladosPasaje(i).Destino, FD).Width / 2

                    px = AC - AT

                    eve.Graphics.DrawString("•  " & TrasladosPasaje(i).Origen & "  -  " & TrasladosPasaje(i).Destino, FD, Brush, New Point(px, py))

                    py += TF + 1

                End If

            Next

            py += Rn