(-hg) 

Haben Sie schon einmal die Schriftart "Marlett" mit Entwickleraugen betrachtet? Auf den ersten Blick leicht wieder zu erkennen sind einige Symbole, die sich in der Titelleiste und im System-Menü nahezu jedes Anwendungsfensters wieder finden. Wir haben einmal mit diesen Symbolen Schaltflächen beschriftet.

	Mit dem Marlett-Font können Sie CheckBoxen oder OptionButtons selbst komponieren (auch transparent!) und System-Sonderzeichen nutzen.

Sieht doch täuschend echt aus, nicht wahr? So echt, wie es nur irgend sein kann, da Windows intern auch den Marlett-Font benutzt, um die Symbole ohne großen Aufwand nahezu stufenlos skalierbar darstellen zu können. Das gleiche gilt für verschiedene Pfeil-Symbole - auch sie lassen sich am flexibelsten als Marlett-Symbole darstellen. Die entsprechenden Zeichenzuordnungen haben wir für Sie in einem Standard-Modul als String-Konstanten angelegt, die Sie sich wahrscheinlicher einfacher merken können, wenn Sie sie per Code zur Laufzeit zuweisen.

Public Const marLeft = "3"
Public Const marRight = "4"

Public Const marUp = "5"
Public Const marDown = "6"
Public Const marUpDown = "v"

Public Const marBottom = "7"

Public Const marSmallRight = "8"
Public Const marSmallLeft = "w"

Public Const marSmallDown = "9"

Public Const marMinimize = "0"
Public Const marMaximize = "1"
Public Const marRestore = "2"

Public Const marClose = "r"
Public Const marHelp = "s"

Eine kleine Überraschung stellen die übrigen Symbole des bei weitem nicht voll belegten Fonts dar. Sie stellen nämlich die "Bausteine" dar, aus denen Windows offensichtlich die Darstellung von CheckBoxen und Optionsschaltflächen zuammensetzt. Das Kontruktionsprinzip ist einfach: Die einzelnen Zeichen werden nacheinander in den entsprechenden Farben an der gleichen Stelle übereinander ausgegeben.

Das Schöne daran ist: Sie können das genau so machen und damit etwas mehr Gestaltungsfreiheit für Ihre CheckBoxen und Optionsschaltflächen gewinnen. So können Sie die füllenden Zeichen einfach weglassen und erhalten so transparente Symbole. Oder sie legen einfach andere Farben fest. Kehren Sie die Zuweisung der Systemfarben zu den Kontur-Symbolen um, erscheint eine CheckBox oder eine Optionsschaltfläche erhaben statt eingraviert. Auch hierzu haben wir Ihnen die entsprechenden Konstanten vorbereitet:

Public Const marCheckOuterLT = "c"
Public Const marCheckOuterRB = "d"
Public Const marCheckInnerLT = "e"
Public Const marCheckInnerRB = "f"
Public Const marCheckFace = "g"
Public Const marCheckMark = "b"

Public Const marRadioOuterLT = "j"
Public Const marOptionOuterRB = "k"
Public Const marOptionInnerLT = "l"
Public Const marOptionInnerRB = "m"
Public Const marOptionFace = "n"
Public Const marOptionMark = "i"

Schließlich gibt es noch Symbole zur Darstellung der Griffecken in Fenstern: Ein Symbolpaar für eine standardmäßige Griffecke rechts unten, und ein Symbolpaar zur Darstellung einer Griffecke links unten für rechts-links-orientierte Landesversionen.

Public Const marGripRHighlight = "o"
Public Const marGripRShadow = "p"
Public Const marGripLHighlight = "x"
Public Const marGripLShadow = "y"

Damit Sie sich nicht selbst um die Positionierung, die Farben und dergleichen zu kümmern brauchen, haben wir einige Prozeduren vorbereitet, die die Darstellung von Griffecken, CheckBoxen und Optionsschaltflächen komplett abwickeln.

Schauen wir uns zunächst die Prozedur zum Zeichnen einer Griffecke an. Sie übergeben der Prozedur im ersten Parameter das Objekt, auf dem die Darstellung erfolgen soll. Das kann ein Form, eine PictureBox, ein UserControl, ein UserDocument oder eine PropertyPage sein. Dann übergeben Sie optional die beiden Darstellungsfarben und die Hintergrundfarbe (voreingestellt sind die Systemfarben). Beachten Sie, dass das Setzen der Hintergrundfarbe wie gewohnt die gesamte Zeichenfläche löscht. Das Löschen der Zeichenfläche können Sie alternativ auch erreichen, indem Sie den weiter hinten folgenden optionalen Parameter Clear auf True setzen. Die Angabe der Größe der Griffecke erfolgt als Schriftgröße - voreingestellt sind 12 Punkt. In X und Y können Sie eine beliebige Positionierung festlegen, die von AutoPos = True außer Kraft gesetzt werden kann - denn dann wird die Griffecke entsprechend der Angabe in Orientation automatisch in die rechte oder linke untere Ecke gesetzt. Schließlich legen Sie mit SetFont noch fest, dass der ursprüngliche Font des Objekts erhalten bleiben und nur innerhalb der Zeichenprozedur auf den Marlett-Font umgeschaltet werden soll.

Public Enum marGripOrientationConstants
  marGripR
  marGripL
End Enum

Public Sub PaintGrip(Object As Object, _
 Optional ByVal Highlight As Long = vb3DHighlight, _
 Optional ByVal Shadow As Long = vb3DShadow, _
 Optional ByVal BackColor As Long = -1, _
 Optional ByVal Size As Single = 12, _
 Optional ByVal X As Single, _
 Optional ByVal Y As Single, _
 Optional ByVal AutoPos As Boolean = True, _
 Optional ByVal Orientation As _
  marGripOrientationConstants = marGripR, _
 Optional ByVal Clear As Boolean, Optional ByVal SetFont As Boolean)

  Dim nOldFont As StdFont
  
  With Object
    On Error Resume Next
    If SetFont Then
      Set nOldFont = .Font
      Set .Font = New StdFont
      With .Font
        .Size = Size
        .Name = "Marlett"
      End With
    End If
    .FontTransparent = True
    If .BackColor <> BackColor Then
      If BackColor >= 0 Then
        .BackColor = BackColor
      ElseIf Clear Then
        .Cls
      End If
    ElseIf Clear Then
      .Cls
    End If
    If Size > 0 Then
      With .Font
        If .Size <> Size Then
          .Size = Size
        End If
      End With
    End If
    If AutoPos Then
      Y = .ScaleHeight - .TextHeight(marGripRHighlight)
      Select Case Orientation
        Case marGripR
          X = .ScaleWidth - .TextWidth(marGripRHighlight)
        Case marGripL
          X = 0
      End Select
    End If
    .CurrentX = X
    .CurrentY = Y
    .ForeColor = Highlight
    Select Case Orientation
      Case marGripR
        Object.Print marGripRHighlight
        .CurrentX = X
        .CurrentY = Y
        .ForeColor = Shadow
        Object.Print marGripRShadow
      Case marGripL
        Object.Print marGripLHighlight
        .CurrentX = X
        .CurrentY = Y
        .ForeColor = Shadow
        Object.Print marGripLShadow
    End Select
    If SetFont Then
      Set .Font = nOldFont
    End If
  End With
End Sub

Die Prozedur PaintCheckBox ist erheblich aufwändiger. Sie sehen es an der Unzahl der Parameter, über die Sie die Darstellung beeinflussen können. Zunächst übergeben Sie auch hier wieder das Zeichenflächen-Objekt. Dann folgt die Angabe des Schaltzustandes - es sind alle drei Standard-Zustände möglich (vbUnchecked, vbChecked und vbGrayed). In Style geben Sie an, ob die CheckBox erhaben oder eingraviert erscheinen soll. Für die vier Farben für das äußere und das innere Rechteck als auch die Farben der Innenfläche und der Markierung (das Häkchen) sind die jeweiligen Systemfarben voreingestellt, ebenso für die Farben des Grayed-Zustandes. Soll die Innenfläche transparent erscheinen (außer im Grayed-Zustand), setzen Sie den Parameter Transparent auf True. In Size geben Sie die Größe (auch hier ist dies wieder die Schriftgröße) an, und in X und Y die Position. Die Parameter BackColor, Clear und SetFont haben die gleiche Bedeutung und Wirkung wie bei der Griffecke. Schließlich können Sie noch die Beschriftung ausgeben lassen und dazu den Text, gegebenenfalls einen Font, die Schriftfarbe und den Abstand zur CheckBox in Pixels.

Public Enum marCheckOptionStyle
  marSunken
  marRaised
End Enum

Public Sub PaintCheckBox(Object As Object, _
 Optional ByVal Checked As CheckBoxConstants, _
 Optional ByVal Style As marCheckOptionStyle = marSunken, _
 Optional ByVal Highlight As Long = vb3DHighlight, _
 Optional ByVal Shadow As Long = vb3DShadow, _
 Optional ByVal DarkShadow As Long = vb3DDKShadow, _
 Optional ByVal Light As Long = vb3DLight, _
 Optional ByVal Face As Long = vbWindowBackground, _
 Optional ByVal CheckMark As Long = vbWindowText, _
 Optional ByVal GrayedFace As Long = vb3DHighlight, _
 Optional ByVal GrayedCheckmark As Long = vbGrayText, _
 Optional ByVal Transparent As Boolean, _
 Optional ByVal Size As Single = 10, _
 Optional ByVal X As Single, _
 Optional ByVal Y As Single, _
 Optional ByVal BackColor As Long = vb3DFace, _
 Optional ByVal Clear As Boolean, _
 Optional ByVal SetFont As Boolean, _
 Optional Caption As String, _
 Optional CaptionFont As StdFont, _
 Optional ByVal CaptionColor As Long = vbWindowText, _
 Optional ByVal CaptionOffsetPixels As Long = 5)
 
  Dim nOldFont As StdFont
  Dim nOldForeColor As Long
  Dim nSymbolHeight As Single
  Dim nSymbolWidth As Single
  Dim nSetFontDone As Boolean
  
  With Object
    On Error Resume Next
    If SetFont Then
      Set nOldFont = .Font
      Set .Font = New StdFont
      With .Font
        .Size = Size
        .Name = "Marlett"
      End With
    End If
    .FontTransparent = True
    If .BackColor <> BackColor Then
      If BackColor >= 0 Then
        .BackColor = BackColor
      ElseIf Clear Then
        .Cls
      End If
    ElseIf Clear Then
      .Cls
    End If
    If Size > 0 Then
      With .Font
        If .Size <> Size Then
          .Size = Size
        End If
      End With
    End If
    nOldForeColor = .ForeColor
    Select Case Checked
      Case vbUnchecked
        If Transparent Then
          If Not Clear Then
            .CurrentX = X
            .CurrentY = Y
            .ForeColor = .BackColor
            Object.Print marCheckFace
          End If
        Else
          .CurrentX = X
          .CurrentY = Y
          .ForeColor = Face
          Object.Print marCheckFace
        End If
      Case vbChecked
        If Not Transparent Then
          .CurrentX = X
          .CurrentY = Y
          .ForeColor = Face
          Object.Print marCheckFace
        End If
        .CurrentX = X
        .CurrentY = Y
        .ForeColor = CheckMark
        Object.Print marCheckMark
      Case vbGrayed
        If Not Transparent Then
          .CurrentX = X
          .CurrentY = Y
          .ForeColor = GrayedFace
          Object.Print marCheckFace
        End If
        .CurrentX = X
        .CurrentY = Y
        .ForeColor = GrayedCheckmark
        Object.Print marCheckMark
    End Select
    .CurrentX = X
    .CurrentY = Y
    If Style Then
      .ForeColor = Highlight
      Object.Print marCheckOuterLT
      .CurrentX = X
      .CurrentY = Y
      .ForeColor = Shadow
      Object.Print marCheckOuterRB
      .CurrentX = X
      .CurrentY = Y
      .ForeColor = Light
      Object.Print marCheckInnerLT
      .CurrentX = X
      .CurrentY = Y
      .ForeColor = DarkShadow
      Object.Print marCheckInnerRB
    Else
      .ForeColor = Shadow
      Object.Print marCheckOuterLT
      .CurrentX = X
      .CurrentY = Y
      .ForeColor = Highlight
      Object.Print marCheckOuterRB
      .CurrentX = X
      .CurrentY = Y
      .ForeColor = DarkShadow
      Object.Print marCheckInnerLT
      .CurrentX = X
      .CurrentY = Y
      .ForeColor = Light
      Object.Print marCheckInnerRB
    End If
    If StrPtr(Caption) <> 0 Then
      nSymbolHeight = .TextHeight(marCheckOuterLT)
      nSymbolWidth = .TextWidth(marCheckOuterLT)
      If CaptionFont Is Nothing Then
        If SetFont Then
          Set .Font = nOldFont
          nSetFontDone = True
        Else
          Set nOldFont = .Font
        End If
      Else
        Set .Font = CaptionFont
      End If
      .ForeColor = CaptionColor
      .CurrentX = X + nSymbolWidth + _
       .ScaleX(CaptionOffsetPixels, vbPixels)
      .CurrentY = Y + nSymbolHeight - .TextHeight(Caption)
      Object.Print Caption
      If Not (nOldFont Is Nothing) And Not nSetFontDone Then
        Set .Font = nOldFont
      End If
    End If
    .ForeColor = nOldForeColor
    If Not nSetFontDone Then
      If SetFont Then
        Set .Font = nOldFont
      End If
    End If
  End With
End Sub

Die Prozedur PaintOptionButton unterscheidet sich von paintCheckBox lediglich darin, dass sie keine drei, sondern nur zwei Schaltzustände kennt (Parameter Value statt Checked). Dementsprechend fehlen auch die Farben-Parameter für den dritten Zustand.

Public Sub PaintOptionButton(Object As Object, _
 Optional ByVal Value As Boolean, _
 Optional ByVal Style As marCheckOptionStyle = marSunken, _
 Optional ByVal Highlight As Long = vb3DHighlight, _
 Optional ByVal Shadow As Long = vb3DShadow, _
 Optional ByVal DarkShadow As Long = vb3DDKShadow, _
 Optional ByVal Light As Long = vb3DLight, _
 Optional ByVal Face As Long = vbWindowBackground, _
 Optional ByVal OptionMark As Long = vbWindowText, _
 Optional ByVal Transparent As Boolean, _
 Optional ByVal Size As Single = 10, _
 Optional ByVal X As Single, _
 Optional ByVal Y As Single, _
 Optional ByVal BackColor As Long = vb3DFace, _
 Optional ByVal Clear As Boolean, _
 Optional ByVal SetFont As Boolean, _
 Optional Caption As String, _
 Optional CaptionFont As StdFont, _
 Optional ByVal CaptionColor As Long = vbWindowText, _
 Optional ByVal CaptionOffsetPixels As Long = 5)
 
  Dim nOldFont As StdFont
  Dim nOldForeColor As Long
  Dim nSymbolHeight As Single
  Dim nSymbolWidth As Single
  Dim nSetFontDone As Boolean
  
  With Object
    On Error Resume Next
    If SetFont Then
      Set nOldFont = .Font
      Set .Font = New StdFont
      With .Font
        .Size = Size
        .Name = "Marlett"
      End With
    End If
    .FontTransparent = True
    If .BackColor <> BackColor Then
      If BackColor >= 0 Then
        .BackColor = BackColor
      ElseIf Clear Then
        .Cls
      End If
    ElseIf Clear Then
      .Cls
    End If
    If Size > 0 Then
      With .Font
        If .Size <> Size Then
          .Size = Size
        End If
      End With
    End If
    nOldForeColor = .ForeColor
    Select Case Value
      Case False
        If Transparent Then
          If Not Clear Then
            .CurrentX = X
            .CurrentY = Y
            .ForeColor = .BackColor
            Object.Print marOptionFace
          End If
        Else
          .CurrentX = X
          .CurrentY = Y
          .ForeColor = Face
          Object.Print marOptionFace
        End If
      Case True
        If Not Transparent Then
          .CurrentX = X
          .CurrentY = Y
          .ForeColor = Face
          Object.Print marOptionFace
        End If
        .CurrentX = X
        .CurrentY = Y
        .ForeColor = OptionMark
        Object.Print marOptionMark
    End Select
    .CurrentX = X
    .CurrentY = Y
    If Style Then
      .ForeColor = Highlight
      Object.Print marOptionOuterLT
      .CurrentX = X
      .CurrentY = Y
      .ForeColor = Shadow
      Object.Print marOptionOuterRB
      .CurrentX = X
      .CurrentY = Y
      .ForeColor = Light
      Object.Print marOptionInnerLT
      .CurrentX = X
      .CurrentY = Y
      .ForeColor = DarkShadow
      Object.Print marOptionInnerRB
    Else
      .ForeColor = Shadow
      Object.Print marOptionOuterLT
      .CurrentX = X
      .CurrentY = Y
      .ForeColor = Highlight
      Object.Print marOptionOuterRB
      .CurrentX = X
      .CurrentY = Y
      .ForeColor = DarkShadow
      Object.Print marOptionInnerLT
      .CurrentX = X
      .CurrentY = Y
      .ForeColor = Light
      Object.Print marOptionInnerRB
    End If
    If StrPtr(Caption) <> 0 Then
      nSymbolHeight = .TextHeight(marCheckOuterLT)
      nSymbolWidth = .TextWidth(marCheckOuterLT)
      If CaptionFont Is Nothing Then
        If SetFont Then
          Set .Font = nOldFont
          nSetFontDone = True
        Else
          Set nOldFont = .Font
        End If
      Else
        Set .Font = CaptionFont
      End If
      .ForeColor = CaptionColor
      .CurrentX = X + nSymbolWidth + _
       .ScaleX(CaptionOffsetPixels, vbPixels)
      .CurrentY = Y + nSymbolHeight - .TextHeight(Caption)
      Object.Print Caption
      If Not (nOldFont Is Nothing) And Not nSetFontDone Then
        Set .Font = nOldFont
      End If
    End If
    .ForeColor = nOldForeColor
    If Not nSetFontDone Then
      If SetFont Then
        Set .Font = nOldFont
      End If
    End If
  End With
End Sub

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