ABOUT Visual Basic - das Webmagazin: Digital & Co. (ActiveX-Control)

ABOUT Visual Basic Programmieren Programmierung Download Downloads Tips & Tricks Tipps & Tricks Know-How Praxis VB VBA Visual Basic for Applications VBS VBScript Scripting Windows ActiveX COM OLE API ComputerPC Microsoft Office Microsoft Office 97 Office 2000 Access Word Winword Excel Outlook Addins ASP Active Server Pages COMAddIns ActiveX-Controls OCX UserControl UserDocument Komponenten DLL EXE

(-hg)

Ein schlichtes Label-Steuerelement zur Anzeige von Zahlen, Datum oder Uhrzeit reicht Ihnen nicht? Sie hätten lieber gerne eine grafische Anzeige, etwa mit LED-Ziffern? Hier bekommen Sie eine solche Anzeige mit einem Standardsatz an LED-Ziffern, deren Leuchtfarbe Sie beliebig wählen können. Sollten Ihnen die Ziffern-Bilder nicht gefallen, oder zu klein oder zu groß sein, können Sie beliebig eigene Ziffernbilder laden und anzeigen. Und wenn Sie wollen, können Sie das folgende UserControl auch so abwandeln oder erweitern, dass es anderes oder mehr als nur 10 Ziffern und 4 Trennsymbole (Leerstelle, ".", ":" und "-") anzuzeigen vermag - etwa das ganze Alphabet und mehr.



	Digitale Ziffern oder andere Zeichen in grafischer Darstellung in beliebiger Farbe und Größe

Der Standard-Ziffernsatz besteht aus GIF-Bildern mit einer schwarzen Fläche und transparenten LED-Symbolen. Da die Anzeige normalerweise (Eigenschaft AutoSize = True) die Fläche des UserControls völlig bedeckt, scheint die Hintergrundfarbe (Eigenschaft BackColor) durch die transparenten Teile der Ziffern-Bilder durch und legt damit die Leuchtfarbe fest. In der Eigenschaft BorderStyle können Sie noch den Rahmenstil (ohne Rahmen oder versenkter Rahmen) wählen.

In der Eigenschaft Digit wählen Sie einen Wert aus der Konstanten-Enumeration ptDigitConstants und bestimmen damit, für welche Ziffer- bzw. für welches Trennzeichen in der Eigenschaft DigitPicture ein Bild geladen werden soll. Löschen Sie später ein geladenes Bild, wird wieder das Standard-Bild für die betreffende Ziffer bzw. für das Trennzeichen verwendet. Über die Eigenschaft DigitPictures und Angabe eines Index-Wertes (wie in der Eigenschaft Digit) haben Sie direkten Zugriff auf die Bilderliste. Diese beiden verschiedenen Zugriffswege sind notwendig, da die Eigenschaft DigitPictures mit ihrer Index-Angabe nicht im Eigenschaften-Fenster dargestellt werden kann.

Die Standard-Bilder der Ziffern, der Leerstelle und des Trennstrichs "-" sind 15 Pixels breit und 20 Pixels hoch, die Bilder für den Punkt und den Doppelpunkt sind abweichend davon nur 5 Pixels breit. Sie können die Abmessungen für eigene Bilder natürlich vollkommen frei wählen, doch sollten zumindest die Ziffern die gleiche Breite haben und alle Bilder die gleiche Höhe.

Den darzustellenden Wert übergeben Sie als String in der Eigenschaft Value. Die Formatierung dieses Strings bleibt Ihnen überlassen. Sie können so Zahlen, Datums- und Zeitwerte in beliebiger, etwa landesabhängiger Formatierung darstellen. Sollte der String Zeichen enthalten, die nicht dargestellt werden können, bleibt die Anzeige unverändert.

Mit der Methode Clear löschen Sie alle nachträglich geladenen Bilder und setzen die Anzeige komplett auf die Standard-Bilder zurück. Mit der Refresh-Methode aktualisieren Sie die Anzeige, falls aus irgendeinem Grunde die Darstellung nicht korrekt sein sollte.

Private Type DigitPictureType
  Picture As StdPicture
  UserDefined As Boolean
End Type

Public Enum ptBorderStyleConstants
  ptBSFlat
  ptBS3D
End Enum

Public Enum ptDigitConstants
  ptDigit0
  ptDigit1
  ptDigit2
  ptDigit3
  ptDigit4
  ptDigit5
  ptDigit6
  ptDigit7
  ptDigit8
  ptDigit9
  ptSpace
  ptDot
  ptColon
  ptHyphen
End Enum

Public Event Click()
Public Event DblClick()
Public Event MouseDown(ByVal Button As Integer, _
 ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Public Event MouseMove(ByVal Button As Integer, _
 ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Public Event MouseUp(ByVal Button As Integer, _
 ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

Private pAutoSize As Boolean
Private pBorderStyle As ptBorderStyleConstants
Private pDigit As ptDigitConstants
Private pDigitPictures(0 To 13) As DigitPictureType
Private pValue As String

Public Property Get AutoSize() As Boolean
  AutoSize = pAutoSize
End Property

Public Property Let AutoSize(New_AutoSize As Boolean)
  If pAutoSize <> New_AutoSize Then
    pAutoSize = New_AutoSize
    UserControl_Resize
  End If
End Property

Public Property Get BackColor() As OLE_COLOR
  BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(New_BackColor As OLE_COLOR)
  UserControl.BackColor = New_BackColor
  PropertyChanged "BackColor"
End Property

Public Property Get BorderStyle() As ptBorderStyleConstants
  BorderStyle = pBorderStyle
End Property

Public Property Let BorderStyle(New_BorderStyle _
 As ptBorderStyleConstants)

  Select Case New_BorderStyle
    Case ptBSFlat, ptBS3D
      pBorderStyle = New_BorderStyle
      UserControl_Resize
    Case Else
      Err.Raise 380
  End Select
End Property

Public Property Get Digit() As ptDigitConstants
  Digit = pDigit
End Property

Public Property Let Digit(New_Digit As ptDigitConstants)
  Select Case New_Digit
    Case pDigit
    Case ptDigit0 To ptHyphen
      pDigit = New_Digit
    Case Else
      Err.Raise 380
  End Select
  PropertyChanged "Digit"
End Property

Public Property Get DigitPicture() As StdPicture
  Set DigitPicture = pDigitPictures(pDigit).Picture
End Property

Public Property Let DigitPicture(New_DigitPicture As StdPicture)
  zSetDigitPictures pDigit, New_DigitPicture
  PropertyChanged "DigitPicture"
End Property

Public Property Set DigitPicture(New_DigitPicture As StdPicture)
  zSetDigitPictures pDigit, New_DigitPicture
  PropertyChanged "DigitPicture"
End Property

Public Property Get DigitPictures(ByVal Index _
 As ptDigitConstants) As StdPicture

  Select Case Index
    Case ptDigit0 To ptHyphen
      Set DigitPictures = pDigitPictures(Index).Picture
    Case Else
      Err.Raise 380
  End Select
End Property

Public Property Let DigitPictures(ByVal Index _
 As ptDigitConstants, New_DigitPictures As StdPicture)

  zSetDigitPictures Index, New_DigitPictures
End Property

Public Property Set DigitPictures(ByVal Index _
 As ptDigitConstants, New_DigitPictures As StdPicture)

  zSetDigitPictures Index, New_DigitPictures
End Property

Private Sub zSetDigitPictures(ByVal Index _
 As ptDigitConstants, New_DigitPictures As StdPicture)

  Dim i As Integer
  
  Select Case Index
    Case ptDigit0 To ptHyphen
      With pDigitPictures(Index)
        Select Case True
          Case New_DigitPictures Is Nothing
            Set .Picture = imgDefDigit(Index).Picture
            .UserDefined = False
          Case New_DigitPictures = 0
            Set .Picture = imgDefDigit(Index).Picture
            .UserDefined = False
          Case Else
            Set .Picture = New_DigitPictures
            .UserDefined = True
        End Select
      End With
      For i = 1 To imgDigit.UBound
        With imgDigit(i)
          If CInt(.Tag) = Index Then
            Set .Picture = pDigitPictures(Index).Picture
          End If
        End With
      Next 'i
    Case Else
      Err.Raise 380
  End Select
  PropertyChanged "DigitPictures"
End Sub

Public Property Get Value() As String
  Value = pValue
End Property

Public Property Let Value(New_Value As String)
  If pValue <> New_Value Then
    If Len(New_Value) = 0 Then
      New_Value = " "
    End If
    If zShowValue(New_Value) Then
      pValue = New_Value
    Else
      If Not Ambient.UserMode Then
        Err.Raise 380
      End If
    End If
  End If
  PropertyChanged "Value"
End Property

Public Sub Clear()
  zSetDefaultPictures
  zShowValue pValue, True
End Sub

Public Sub Refresh()
  zShowValue pValue, True
End Sub

Private Sub UserControl_Click()
  RaiseEvent Click
End Sub

Private Sub UserControl_DblClick()
  RaiseEvent DblClick
End Sub

Private Sub UserControl_Initialize()
  With imgDigit(1)
    .Tag = ptSpace
    Set .Picture = imgDefDigit(ptSpace).Picture
  End With
End Sub

Private Sub UserControl_InitProperties()
  zSetDefaultPictures
  pBorderStyle = ptBS3D
  UserControl.BackColor = Ambient.BackColor
  pAutoSize = True
  pValue = " "
  zShowValue pValue
End Sub

Private Sub UserControl_MouseDown(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)

  RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseMove(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)

  RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseUp(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)

  RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  Dim i As Integer
  
  On Error Resume Next
  For i = ptDigit0 To ptHyphen
    With pDigitPictures(i)
      Set .Picture = PropBag.ReadProperty("Digit" & i, Nothing)
      If .Picture Is Nothing Then
        Set .Picture = imgDefDigit(i).Picture
      Else
        .UserDefined = True
      End If
    End With
  Next 'i
  On Error GoTo 0
  With PropBag
    pAutoSize = .ReadProperty("AutoSize", True)
    UserControl.BackColor = .ReadProperty("BackColor", _
     Ambient.BackColor)
    pBorderStyle = .ReadProperty("BorderStyle", ptBS3D)
    pValue = .ReadProperty("Value", " ")
  End With
  zShowValue pValue
End Sub

Private Sub UserControl_Resize()
  Dim i As Integer
  Dim nLeft As Single
  Dim nDiffX As Single
  Dim nDiffY As Single
  
  Static sInProc
    
  If sInProc Then
    Exit Sub
  Else
    sInProc = True
  End If
  With UserControl
    .BorderStyle = pBorderStyle
    For i = 1 To imgDigit.UBound
      With imgDigit(i)
        .Move nLeft, 0
        nLeft = nLeft + .Width
        .Visible = True
      End With
    Next 'i
    If pAutoSize Then
      If pBorderStyle Then
        nDiffX = .Width - .ScaleWidth
        nDiffY = .Height - .ScaleHeight
      End If
      .Size nLeft + nDiffX, imgDigit(1).Height + nDiffY
    End If
  End With
  sInProc = False
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  Dim i As Integer
  
  With PropBag
    .WriteProperty "AutoSize", pAutoSize, True
    .WriteProperty "BackColor", UserControl.BackColor, _
     Ambient.BackColor
    .WriteProperty "BorderStyle", pBorderStyle, ptBS3D
    .WriteProperty "Value", pValue, " "
  End With
  For i = ptDigit0 To ptHyphen
    With pDigitPictures(i)
      If .UserDefined Then
        PropBag.WriteProperty "Digit" & i, .Picture, Nothing
      End If
    End With
  Next 'i
End Sub

Private Function zShowValue(NewValue As String, _
 Optional ByVal Force As Boolean) As Boolean

  Dim i As Integer
  Dim nPos As Integer
  Dim nIndex As ptDigitConstants
  Dim nOldIndex As ptDigitConstants
  
  Const kDigits = "0123456789 .:-"
  
  For i = 1 To Len(NewValue)
    nPos = InStr(kDigits, Mid$(NewValue, i, 1))
    If nPos = 0 Then
      Exit Function
    Else
      If i > imgDigit.UBound Then
        Load imgDigit(i)
      End If
      With imgDigit(i)
        nOldIndex = CInt(.Tag)
        nIndex = nPos - 1
        If CBool(nIndex <> nOldIndex) Or Force Then
          .Tag = nIndex
          Set .Picture = pDigitPictures(nIndex).Picture
        End If
      End With
    End If
  Next 'i
  For i = Len(NewValue) + 1 To imgDigit.UBound
    Unload imgDigit(i)
  Next 'i
  UserControl_Resize
  zShowValue = True
End Function

Private Sub zSetDefaultPictures()
  Dim i As Integer
  
  For i = ptDigit0 To ptHyphen
    Set pDigitPictures(i).Picture = imgDefDigit(i).Picture
  Next 'i
End Sub

Das Projekt avbDigital (digital.zip - ca. 18,7 KB)