Ich hoffe das Dir das so passt.
Ein bisschen darfst Du auch noch machen


Code:
' Bascom
' 7-Segment Multiplexer
' by darwin.nuernberg (roboternetz.de)
' Nicht vergessen entweder die Compiler Direktiven oder den Chip und Oszillatorfequenz einstellen.

Const Dekaden = 4                                           ' Anzahl der Anzeigen (dekaden)
Const Pulsdauer = 10000                                     ' Dauer eines Impulses


Declare Function Segmentdecoder(byval C As String) As Byte
Declare Sub Selector(byval Wert As Integer)


Dim Segment(dekaden) As Byte                                ' Array für die Fertig berecheten Segmente
Dim Demo As Byte

' Hauptprogramm
' -----------------------------------------------------------------------------

Call Selector(1234)                                         ' Berechnet die Segmente der einzelnen Dekaden
                                                             ' und legt diese im Array Segment() ab.


' Die folgenden Zeilen Zeigen Dir was rauskommt und können gelöscht werden.

For Demo = 1 To Dekaden
   Print Bin(segment(demo))
Next Demo


' Ein bisschen darfst Du auch naoch was tun...
' Jetzt muß noch die Ausgabe erfolgen.
' Frage das Array ab, weise dem Port den Wert Zu
' z.B. Portb = segment(1)
'      pulseout portd, 1 pulsdauer
'      Portb = segment(2)
'      pulseout portd, 2 pulsdauer
' usw.



End                                                         'end program

' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------




Sub Selector(byval Wert As Integer)
   Dim S As String * Dekaden                                ' Stringvariable Länge = Anzeige
   Dim L As Byte                                            ' Variable für Länge des Strings
   Dim X As Byte                                            ' Zählervariable
   Dim Pos As Byte                                          ' Variable für MID Funktion
   Dim Z As String * 1
   Dim Segcode As Byte



    S = Str(wert)                                           ' Wandle Wert in String
    L = Len(s)                                              ' ermittle Länge des Strings
    If L > Dekaden Then L = Dekaden                         ' Verhindern dass mehr Anzeigen berechent werden
                                                            ' als definiert und vorhanden sind.


    For X = 1 To L
      Pos = L - X
      Pos = Pos + 1                                            ' Beginne mit den Einer Stellen (rechts)
      Z = Mid(s , Pos , 1)                                     ' Picke eine einzelnes Zeichen heraus

      Segcode = Segmentdecoder(z)                              ' Ermittle den Portcode für die Segmente
      Segment(x) = Segmentdecoder(z)
    Next X

End Sub

' -----------------------------------------------------------------------------

Function Segmentdecoder(byval C As String) As Byte
   Select Case C
      Case "0" : Segmentdecoder = &B00111111                ' Bit 0 = Segment A
      Case "1" : Segmentdecoder = &B00000110                ' Bit 1 = Segment B
      Case "2" : Segmentdecoder = &B01011011                ' Bit 2 = Segment C
      Case "3" : Segmentdecoder = &B01001111                ' Bit 3 = Segment D
      Case "4" : Segmentdecoder = &B01100110                ' Bit 4 = Segment E
      Case "5" : Segmentdecoder = &B01101101                ' Bit 5 = Segment F
      Case "6" : Segmentdecoder = &B01111101                ' Bit 6 = Segment G
      Case "7" : Segmentdecoder = &B00000111                ' Bit 7 = Segment dp
      Case "8" : Segmentdecoder = &B01111111
      Case "9" : Segmentdecoder = &B01101111
      Case "." : Segmentdecoder = &B10000000
      Case Else : Segmentdecoder = &B000000000              ' unerwartes Zeichen keine Ausgabe
   End Select

                                             'Bit   Segmente

                                             '   || G | F | E | D | C | B | A |
                                             ' --||---+---+---+---+---+---+---|
                                             ' 0 || 0 | 1 | 1 | 1 | 1 | 1 | 1 |
                                             ' 1 || 0 | 0 | 0 | 0 | 1 | 1 | 0 |
                                             ' 2 || 1 | 0 | 1 | 1 | 0 | 1 | 1 |
                                             ' 3 || 1 | 0 | 0 | 1 | 1 | 1 | 1 |
                                             ' 4 || 1 | 1 | 0 | 0 | 1 | 1 | 0 |
                                             ' 5 || 1 | 1 | 0 | 1 | 1 | 0 | 1 |
                                             ' 6 || 1 | 1 | 1 | 1 | 1 | 0 | 1 |
                                             ' 7 || 0 | 0 | 0 | 0 | 1 | 1 | 1 |
                                             ' 8 || 0 | 1 | 1 | 1 | 1 | 1 | 1 |
                                             ' 9 || 1 | 1 | 0 | 1 | 1 | 1 | 1 |
End Function
' -----------------------------------------------------------------------------


End