(-hg) 

Mit einfachen Visual Basic-Mitteln können Sie einfache 3D-Text-Effekte erhalten. Soll der Text eingraviert ("Sunken") erscheinen, wird der Text einmal in der dunkleren Farbe (vb3dShadow) um 1 Pixel nach links oben versetzt und in der helleren Farbe (vb3DHighlight) um 1 Pixel nach rechts unten versetzt ausgegeben. Soll er erhaben ("Raised") erscheinen, werden die beiden Farben vertauscht. Soll der Text selbst transparent erscheinen, wird er an der ursprünglichen Position noch einmal in der Hintergrundfarbe ausgegeben, anderenfalls in der eingestellten Vordergrundfarbe oder einer beliebigen anderen Farbe.

	Mit einfachen Mitteln geben Sie 3D-Texte aus

Die Berechnung des Versatzes unabhängig vom eingestellten ScaleMode der Zeichenfläche (Form, PictureBox, UserControl usw.) und die dreifache Ausgabe in den entsprechenden Farben übernimmt die folgende Prozedur Paint3D. Sie übergeben ihr das Zeichenflächen-Objekt und die Effekt-Angabe. Optional können Sie auch noch eine von der für die Zeichenfläche eingestellten Vordergrundfarbe abweichende Farbe angeben.

Public Enum Print3DEffectConstants
  p3dSunken
  p3dSunkenTransparent
  p3dRaised
  p3dRaisedTransparent
End Enum

Public Sub Print3D(Object As Object, Text As String, _
 Optional ByVal Effect As Print3DEffectConstants, _
 Optional ByVal ForeColor As Variant)

  Dim nX As Single
  Dim nY As Single
  Dim nPixelX As Single
  Dim nPixelY As Single
  Dim nOldForeColor As Long
  Dim nColorLeft As Long
  Dim nColorRight As Long
  
  With Object
    Select Case Effect
      Case p3dSunken, p3dSunkenTransparent
        nColorLeft = vb3DShadow
        nColorRight = vb3DHighlight
      Case p3dRaised, p3dRaisedTransparent
        nColorLeft = vb3DHighlight
        nColorRight = vb3DShadow
      Case Else
        Err.Raise 380
    End Select
    nOldForeColor = .ForeColor
    nPixelX = .ScaleX(1, vbPixels)
    nPixelY = .ScaleY(1, vbPixels)
    nX = .CurrentX + nPixelX
    nY = .CurrentY + nPixelY
    .ForeColor = nColorLeft
    .CurrentX = nX - nPixelX
    .CurrentY = nY - nPixelY
    Object.Print Text
    .ForeColor = nColorRight
    .CurrentX = nX + nPixelX
    .CurrentY = nY + nPixelY
    Object.Print Text
    .CurrentX = nX
    .CurrentY = nY
    If IsMissing(ForeColor) Then
      Select Case Effect
        Case p3dSunkenTransparent, p3dRaisedTransparent
          .ForeColor = .BackColor
          Object.Print Text
          .ForeColor = nOldForeColor
        Case Else
          .ForeColor = nOldForeColor
          Object.Print Text
      End Select
    Else
      .ForeColor = ForeColor
      Object.Print Text
      .ForeColor = nOldForeColor
    End If
  End With
End Sub

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