$crystal = 11059200 '11,0592 MHz Quarz Config Pind.0 = Output Config Pind.1 = Output Config Pind.3 = Output Config Pind.4 = Input Config Pind.5 = Input Dim Serbyte As Byte Dim N As Integer Dim L As Integer Dim Ziffer As String * 1 Dim Stelle As Integer Dim H As Integer Dim M As Integer Dim S As Integer Dim Timestring As String * 4 Dim Hs As String * 2 Dim Ms As String * 2 Dim Ss As String * 2 Portd.4 = 1 Portd.5 = 1 H = 0 M = 0 S = 0 Sdata Alias Portd.0 Sclk Alias Portd.3 Strobe Alias Portd.1 Ocr1a = 10800 Config Timer1 = Timer , Prescale = 1024 , Clear Timer = 1 , Compare A = Disconnect On Oc1a Int_t1 Enable Oc1a Enable Interrupts Do Debounce Pind.5 , 0 , Stunden , Sub Debounce Pind.4 , 0 , Minuten , Sub Ss = Str(s) Ss = Format(ss , "00") Hs = Str(h) Hs = Format(hs , "00") Ms = Str(m) Ms = Format(ms , "00") Timestring = Hs + Ms Ziffer = Mid(timestring , 4 , 1) Gosub Schieben Ziffer = Mid(timestring , 3 , 1) Gosub Schieben Ziffer = Mid(timestring , 2 , 1) Gosub Schieben Ziffer = Mid(timestring , 1 , 1) Gosub Schieben Strobe = 1 Gosub Verz Strobe = 0 Loop Stunden: Incr H If H > 23 Then H = 0 End If Return Minuten: Incr M If M > 59 Then M = 0 End If S = 0 Return Int_t1: Incr S If S > 59 Then S = 0 Incr M End If If M > 59 Then M = 0 Incr H End If If H > 23 Then H = 0 End If Return Schieben: If Ziffer = "0" Then Serbyte = &B11011110 Elseif Ziffer = "1" Then Serbyte = &B00000110 Elseif Ziffer = "2" Then Serbyte = &B11101010 Elseif Ziffer = "3" Then Serbyte = &B01101110 Elseif Ziffer = "4" Then Serbyte = &B00110110 Elseif Ziffer = "5" Then Serbyte = &B01111100 Elseif Ziffer = "6" Then Serbyte = &B11111100 Elseif Ziffer = "7" Then Serbyte = &B00001110 Elseif Ziffer = "8" Then Serbyte = &B11111110 Elseif Ziffer = "9" Then Serbyte = &B01111110 End If For N = 0 To 7 If Serbyte.n = 1 Then Sdata = 1 Else Sdata = 0 End If Sclk = 1 Gosub Verz Sclk = 0 Next N Return Verz: Waitus 20 Return