Tipp 0188 Exakte Positionsberechnung langer Texte (GDI)
Autor/Einsender:
Datum:
  Thomas Becker
22.12.2008
Entwicklungsumgebung:   VB.Net 2005
Framework:   2.0
Längere Texte lassen sich recht exakt mit TextRenderer-Klasse ausmessen. Zu beachten ist jedoch, dass dann Graphics.DrawString ungeeignet ist und dafür TextRenderer.DrawText Anwendung finden sollte. Der Tipp zeigt, wie unabhängig von der Schriftgröße der Text der 2. Zeile stets bündig an der gleichen Position am Ende der 1. Zeile beginnt.
Weiterhin wird gezeigt, wie durch Addieren mehrerer Schrift-Stile und casten in den Typ FontStyle mehrere Schriftstile wie z.B. kursiv, fett und unterstrichen für ein Fontobjekt möglich sind.
 
Public Class Form1
  Dim fntstyle As FontStyle = FontStyle.Regular
  Dim fsInt() As Integer = New Integer() {0, 1, 2, 4, 8}
  Dim fsStr() As String, fsActive() As String

  Private Sub Form1_Load(ByVal sender As Object, ByVal e As _
     EventArgs) Handles MyBase.Load
    Dim fs As FontStyle
    fsStr = System.Enum.GetNames(fs.GetType)
    fsActive = New String() {fsStr(0)}
    ListBox1.Items.AddRange(System.Enum.GetNames(fs.GetType))
    ListBox1.SelectedIndex = 0

    For Each ff As FontFamily In FontFamily.Families
      ComboBox1.Items.Add(ff.Name)
    Next
    ComboBox1.SelectedIndex = 0
  End Sub

  Private Sub Form1_Paint(ByVal sender As Object, ByVal e As _
     System.Windows.Forms.PaintEventArgs) Handles Me.Paint
    Dim g As Graphics = e.Graphics
    Dim MeasureSize As Size

    Dim FontGroesse As Integer = CInt(NumericUpDown1.Value)
    Dim FontName As String = ComboBox1.SelectedItem.ToString
    Dim Fnt As New Font(FontName, FontGroesse, fntstyle, _
        GraphicsUnit.Pixel)

    Dim drawPoint As New Point(CInt(HScrollBar1.Value) _
        * -1 + 10, 10)
    Dim drawStr As String = "Erfahrung ist wie eine Laterne " _
        & "im Rücken, sie beleuchtet stets nur das Stück Weg, " _
        & "das wir bereits hinter uns haben."

    TextRenderer.DrawText(g, drawStr, Fnt, drawPoint, Color.Blue)
    MeasureSize = TextRenderer.MeasureText(drawStr, Fnt)

    g.DrawRectangle(New Pen(Color.Red, 1), drawPoint.X, _
    drawPoint.Y, MeasureSize.Width, MeasureSize.Height)
    drawPoint.X += MeasureSize.Width
    drawPoint.Y += Fnt.Height
    drawStr = "Konfuzius"

    TextRenderer.DrawText(g, drawStr, Fnt, drawPoint, _
       Color.BlueViolet)
    MeasureSize = TextRenderer.MeasureText(drawStr, Fnt)

    g.DrawRectangle(New Pen(Color.Red, 1), drawPoint.X, _
       drawPoint.Y, MeasureSize.Width, MeasureSize.Height)
  End Sub

  Private Sub MakeFont()
    With ListBox1
      If .Items.Contains("Regular") And _
         .SelectedItems.Count > 1 Then
         .SetSelected(0, False)

      ElseIf .SelectedItems.Count = 0 Then
         .SetSelected(0, True)
      End If

      Dim idxArr(.SelectedItems.Count - 1) As String
         .SelectedItems.CopyTo(idxArr, 0)

      Dim Summe As Integer
      For Each txt As String In idxArr
        Dim idx As Integer = Array.IndexOf(fsStr, txt)
        Summe += fsInt(idx)
      Next
      fntstyle = DirectCast(Summe, FontStyle)
      Me.Refresh()

      ' Manuelles Verwenden mehrerer Stile im Fontobjekt:
      ' Dim fntstyle As FontStyle = _
      '   DirectCast(FontStyle.Bold + FontStyle.Underline, _
      '   FontStyle)
    End With

  End Sub

  Private Sub ListBox1_Click(ByVal sender As Object, ByVal e As _
     EventArgs) Handles ListBox1.Click
    Call MakeFont()
    Dim myStr(ListBox1.SelectedItems.Count - 1) As String
    ListBox1.SelectedItems.CopyTo(myStr, 0)
    fsActive = myStr
  End Sub

  Private Sub Buttons_Click(ByVal sender As Object, ByVal e As _
     EventArgs) Handles Button1.Click
    ' Beenden
    Me.Close()
  End Sub

  Private Sub NumericUpDown1_ValueChanged(ByVal sender As Object, _
     ByVal e As EventArgs) Handles NumericUpDown1.ValueChanged
    Me.Refresh()
  End Sub

  Private Sub HScrollBar1_Scroll(ByVal sender As Object, _
     ByVal e As System.Windows.Forms.ScrollEventArgs) _
     Handles HScrollBar1.Scroll
    Me.Refresh()
  End Sub

  Private Sub ComboBox1_SelectedIndexChanged(ByVal sender _
     As Object, ByVal e As EventArgs) Handles _
     ComboBox1.SelectedIndexChanged
    If ComboBox1.SelectedItem Is Nothing Then Exit Sub

    Dim fIdx As Integer = ComboBox1.SelectedIndex
    Dim ff As FontFamily = FontFamily.Families(fIdx)

    With ListBox1
      .Items.Clear()
      For Each i As Integer In fsInt
        Dim fs As FontStyle = DirectCast(i, FontStyle)

        If ff.IsStyleAvailable(fs) Then
          Dim fsName As String = fs.ToString
          Dim idx As Integer = .Items.Add(fsName)
          If Array.IndexOf(fsActive, fsName) > -1 _
                      Then .SetSelected(idx, True)
        End If
      Next

    End With
    Call MakeFont()
  End Sub
End Class
 
Weitere Links zum Thema
Text zeichnen

Windows-Version
98/SE
ME
NT
2000
XP
Vista
Win 7


Download  (15 kB) Downloads bisher: [ 212 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Tipps | Projekte | Tutorials | Bücherecke | VB-/VBA-Tipps | API-Referenz | Komponenten | VB.Net-Forum | VB/VBA-Forum | DirectX-Forum | Foren-Archiv | DirectX | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Montag, 26. Dezember 2011