(-hg) 

In Visual Basic fehlt die Möglichkeit, einen Text lediglich als Kontur darzustellen ("Outline") die Kontur mit einer Farbe oder einem Füllmuster zu füllen. Wenn Sie mit Print einen Text ausgeben, wird dieser sofort in der eingestellten Vordergrundfarbe dargestellt. Einstellungen in Eigenschaften wie FillColor oder FillStyle haben keine Auswirkungen. Mit Hilfe von einigen API-Funktionen können Sie jedoch dafür sorgen, dass diese Eigenschaften zum Tragen kommen.

	Mit Hilfe einiger weniger API-Funktionen kann Text mit Kontur und Füllmustern ausgegeben werden

Von der Grafik-Maschinerie in Windows, dem "GDI", wird ein Text nämlich auch nur als Linienzug betrachtet, der bei der normalen, direkten Ausgabe sogleich mit der Schriftfarbe (das ist die eingestellte Vordergrundfarbe) gefüllt wird. Mit der API-Funktion BeginPath können Sie jedoch dafür sorgen, dass ein mit Print ausgegebener Text tatsächlich erst einmal nur als Linienzug ("Path") behandelt wird. Zu dieser Funktion gehört dann zum Abschluss ihr Gegenstück, die Funktion EndPath. Diesen beiden Funktionen ist als Parameter der Geräte-Kontext (Device Context, "hDC") mitzuteilen, in dem die Ausgabe erfolgen soll. Das Handle des Geräte-Kontextes, beispielsweise eines Forms, erhalten Sie von dessen hDC-Eigenschaft.

Private Declare Function BeginPath Lib "gdi32" _
 (ByVal hdc As Long) As Long
Private Declare Function EndPath Lib "gdi32" _
 (ByVal hdc As Long) As Long

With Me
  BeginPath .hDC
  Me.Print "Text"
  EndPath .hDC
End With

Allerdings ist damit die Darstellung noch nicht abgeschlossen - Sie werden noch nichts zu sehen bekommen. Denn nun ist lediglich der Linienzug intern festgelegt. Erst die

API-Funktion StrokeAndFillPath sorgt für die tatsächliche Ausgabe unter Berücksichtigung der Eigenschaften FillColor, FillStyle und auch DrawWidth. Die letztere Eigenschaft gibt die Strichstärke der Kontur an.

Private Declare Function StrokeAndFillPath Lib "gdi32" _
 (ByVal hdc As Long) As Long

With Me
  BeginPath .hDC
  Me.Print "Text"
  EndPath .hDC
  StrokeAndFillPath .hDC
End With

Mittels dieser kleinen Sequenz von API-Aufrufen können Sie nun Text als Kontur und mit verschiedenen Füllungen ausgeben. Falls Sie von den aktuellen Werten der Eigenschaften einer Zeichenfläche (Form, PictureBox, UserControl usw.) abweichende Werte zur Ausgabe eines konturierten Textes verwenden sollen, müssen Sie die aktuellen Einstellungen zuvor sichern und hinterher wieder restaurieren.

Falls Sie eines der Linien-Füllmuster eingestellt haben sollten, werden Sie feststellen, dass der Hintergrund des Füllmusters nicht deckend ist - es gibt keine Möglichkeit, dies einzustellen. Sie müssen daher den Text zuerst wie gewohnt in der gewünschten Hintergrundfarbe und erst dann an der gleichen Position noch einmal darüber als Kontur mit Füllmuster ausgeben.

Dim nX As Single
Dim nY As Single

With Me
  nX = .CurrentX
  nY = .CurrentY
  .ForeColor = HintergrundFarbe
  Me.Print Text
  .CurrentX = nX
  .CurrentY = nY
  .ForeColor = KonturFarbe
  BeginPath .hDC
  Me.Print Text
  EndPath .hDC
  StrokeAndFillPath .hDC
End With

Ein weiterer optischer Effekt ist der Schattenwurf eines Textes. Auch hierzu muss der Text wie gewohnt, aber nun in der Schattenfarbe und ein wenig versetzt ausgegeben werden. Damit der Schatten hinter der eigentlichen Ausgabe des Textes erscheint, muss er zuerst ausgegeben werden.

Dim nX As Single
Dim nY As Single

With Me
  nX = .CurrentX
  nY = .CurrentY
  .CurrentX = .ScaleX(VersatzXPixels, vbPixels)
  .CurrentY = .ScaleY(VersatzYPixels, vbPixels)
  .ForeColor = SchattenFarbe
  Me.Print Text
  .CurrentX = nX
  .CurrentY = nY
  .ForeColor = HintergrundFarbe
  Me.Print Text
  .CurrentX = nX
  .CurrentY = nY
  .ForeColor = KonturFarbe
  BeginPath .hDC
  Me.Print Text
  EndPath .hDC
  StrokeAndFillPath .hDC
End With

Die folgende Prozedur PrintOutline fasst die verschiedenen Ausgabemöglichkeiten zusammen und sorgt für die Restaurierung der entsprechenden Eigenschaften der Zeichenfläche, wenn Sie in einem der optionalen Parameter einen Wert dafür ausdrücklich angeben. Die Formatierungsmöglichkeit der Print-Anweisung durch ein nachgestelltes Komma (die nächste Ausgabe erfolgt um einen Tabulatorschritt versetzt) oder durch ein nachgestelltes Semikolon (die nächste Ausgabe erfolgt auf gleicher Zeilenhöhe unmittelbar anschließend) können Sie im optionalen Parameter NextPos anhand der Enumerations-Konstanten poNextPosConstants angeben (voreingestellt ist poNewLine entsprechend dem Standard der Print-Anweisung).

Public Enum poNextPosConstants
  poNewLine
  poTab
  poNoSpace
End Enum

Public Sub PrintOutline(Object As Object, Text As String, _
 Optional ByVal NextPos As poNextPosConstants, _
 Optional ByVal ForeColor As Long = -1, _
 Optional ByVal FillBackColor As Long = -1, _
 Optional ByVal FillColor As Long = -1, _
 Optional ByVal FillStyle As FillStyleConstants = -1, _
 Optional ByVal DrawWidth As Single, _
 Optional Font As StdFont, _
 Optional ByVal Shadow As Boolean, _
 Optional ByVal ShadowColor As Long = vbApplicationWorkspace, _
 Optional ByVal OffsetX As Long = 1, _
 Optional ByVal OffsetY As Long = 1)

  Dim nOldForeColor As Long
  Dim nOldFillColor As Long
  Dim nOldFillStyle As Long
  Dim nOldDrawWidth As Single
  Dim nOldFont As StdFont
  Dim nX As Single
  Dim nY As Single
  
  With Object
    If FillColor >= 0 Then
      nOldFillColor = .FillColor
      .FillColor = FillColor
    End If
    If FillStyle >= 0 Then
      nOldFillStyle = .FillStyle
      .FillStyle = FillStyle
    End If
    If DrawWidth > 0 Then
      nOldDrawWidth = .DrawWidth
      .DrawWidth = DrawWidth
    End If
    If Not (Font Is Nothing) Then
      Set nOldFont = .Font
      Set .Font = Font
    End If
    If Shadow Then
      nOldForeColor = .ForeColor
      .ForeColor = ShadowColor
      nX = .CurrentX
      nY = .CurrentY
      .CurrentX = nX + .ScaleX(OffsetX, vbPixels)
      .CurrentY = nY + .ScaleY(OffsetY, vbPixels)
      Object.Print Text
      .CurrentX = nX
      .CurrentY = nY
      If FillBackColor >= 0 Then
        .ForeColor = FillBackColor
        Object.Print Text
        .CurrentX = nX
        .CurrentY = nY
      End If
      If ForeColor >= 0 Then
        .ForeColor = ForeColor
      Else
        .ForeColor = nOldForeColor
      End If
    Else
      If FillBackColor >= 0 Then
        nOldForeColor = .ForeColor
        .ForeColor = FillBackColor
        Object.Print Text
        .CurrentX = nX
        .CurrentY = nY
        If ForeColor >= 0 Then
          .ForeColor = ForeColor
        Else
          .ForeColor = nOldForeColor
        End If
      Else
        If ForeColor >= 0 Then
          nOldForeColor = .ForeColor
          .ForeColor = ForeColor
        End If
      End If
    End If
    BeginPath .hDC
    Select Case NextPos
      Case poNewLine
        Object.Print Text
      Case poTab
        Object.Print Text,
      Case poNoSpace
        Object.Print Text;
    End Select
    EndPath .hDC
    StrokeAndFillPath .hDC
    If ForeColor >= 0 Or FillBackColor >= 0 Then
      .ForeColor = nOldForeColor
    End If
    If FillColor >= 0 Then
      .FillColor = nOldFillColor
    End If
    If FillStyle >= 0 Then
      .FillStyle = nOldFillStyle
    End If
    If DrawWidth > 0 Then
      .DrawWidth = nOldDrawWidth
    End If
    If Not (Font Is Nothing) Then
      Set .Font = nOldFont
    End If
  End With
End Sub

Die Ausgabe eines Textes mit Schatten, aber ohne Kontur und Füllmuster erledigt die folgende Prozedur PrintShadow:

Public Sub PrintShadow(Object As Object, Text As String, _
 Optional ByVal ShadowColor As Long = vbApplicationWorkspace, _
 Optional ByVal OffsetX As Long = 1, _
 Optional ByVal OffsetY As Long = 1, _
 Optional ByVal ForeColor As Long = -1, _
 Optional ByVal NextPos As poNextPosConstants)

  Dim nOldForeColor As Long
  Dim nX As Single
  Dim nY As Single
  
  With Object
    nOldForeColor = .ForeColor
    .ForeColor = ShadowColor
    nX = .CurrentX
    nY = .CurrentY
    .CurrentX = nX + .ScaleX(OffsetX, vbPixels)
    .CurrentY = nY + .ScaleY(OffsetY, vbPixels)
    Object.Print Text
    .CurrentX = nX
    .CurrentY = nY
    If ForeColor >= 0 Then
      .ForeColor = ForeColor
    Else
      .ForeColor = nOldForeColor
    End If
    Select Case NextPos
      Case poNewLine
        Object.Print Text
      Case poTab
        Object.Print Text,
      Case poNoSpace
        Object.Print Text;
    End Select
    If ForeColor >= 0 Then
      .ForeColor = nOldForeColor
    End If
  End With
End Sub

Copyright © 1999 - 2011 Harald M. Genauck, ip-pro gmbh  /  Impressum