Problème mise à l'échelle police à l'impression

Bonjour,
J'ai créé une fonction me permettant d'imprimer une textbox multiligne. Cependant j'ai du mal à mettre la police à l'échelle lors de l'impression. La police est soit trop grosse, soit trop petite. Une idée ?

Voici mon code :

Code:

1
2
3
4
5
6
 Dim tmpFact As Single = Math.Round(TotalWidth / e.PageBounds.Width, 1)
 
FontPrint = New Font("Microsoft Sans Serif", CSng(Math.Floor(.TB_Chantier_Com.Font.SizeInPoints / tmpFact)), FontStyle.Regular)
TextPrint = PrintTB(TextPrint, New Size((.TB_Chantier_Com.Size.Width - .TB_Chantier_Com.Margin.Left - .TB_Chantier_Com.Margin.Right) / tmpFact,
                                               .TB_Chantier_Com.Size.Height / tmpFact), FontPrint, e)
e.Graphics.DrawString(TextPrint, FontPrint, Brushes.Black, Range.X, Range.Y)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Private Shared Function PrintTB(ByVal TextPrint As String, ByVal MaxSize As Size, ByVal FontPrint As Font, ByVal e As System.Drawing.Printing.PrintPageEventArgs) As String
 
        Dim LString, PosString, tmpCount, AddChar As Int16
        Dim tmpString, CtrlString As String
        Dim SizeString As SizeF
 
        PrintTB = ""
        Try
            LString = Strings.Len(TextPrint)
 
            For Count = 1 To LString
 
                PosString = 0
 
                'Recherche saut de ligne
                PosString = Strings.InStr(Count, TextPrint, Strings.Chr(10))
 
                tmpString = ""
 
                If PosString > 0 Then
                    tmpString = Strings.Mid(TextPrint, Count, PosString - Count)
                    SizeString = e.Graphics.MeasureString(tmpString, FontPrint)
                End If
 
                If SizeString.Width > MaxSize.Width Or tmpString = "" Then
                    SizeString.Width = 0
                    tmpCount = Count
                    tmpString = ""
 
                    Do While SizeString.Width <= MaxSize.Width
                        PosString = Strings.InStr(tmpCount + 1, TextPrint, " ")
 
                        If PosString > 0 Then
                            CtrlString = Strings.Mid(TextPrint, Count, PosString - Count + 1)
                            SizeString = e.Graphics.MeasureString(CtrlString, FontPrint)
                            If SizeString.Width <= MaxSize.Width Then
                                tmpString = CtrlString
                                tmpCount = PosString
                            End If
                        Else
                            If AddChar = 0 Then AddChar = 1
                            Exit Do
                        End If
 
                    Loop
 
                    Count = tmpCount
 
                    Do While SizeString.Width <= MaxSize.Width Or tmpString = ""
                        If Count + AddChar > LString Then Exit Do
                        tmpString += TextPrint.Chars(Count + AddChar - 1)
                        AddChar += 1
                        SizeString = e.Graphics.MeasureString(tmpString, FontPrint)
                    Loop
 
                    If AddChar > 0 Then Count += AddChar - 1
                    AddChar = 0
 
                    PrintTB += tmpString + vbCrLf
 
                Else
                    PrintTB += tmpString + vbCrLf
                    Count = PosString
                End If
 
                SizeString = e.Graphics.MeasureString(PrintTB, FontPrint)
 
                If SizeString.Height > MaxSize.Height Then Exit Function
 
            Next
        Catch ex As Exception
            MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End Try
 
 
    End Function

Pièce jointe 356828