| Cemalizim | 19 Temmuz 2008 17:16 |
Binary Saat
PHP- Kodu:
Private Sub cmdPause_Click()
If cmdPause.Caption = "Pause" Then 'we must be running. Pause the timer
cmdPause.Caption = "Resume"
Timer1.Enabled = False
Else ' we must be paused so start the timer
cmdPause.Caption = "Pause"
Timer1.Enabled = True
End If
End Sub
Private Sub Timer1_Timer()
Dim Hours As Single, Minutes As Single, Seconds As Single
Dim TensHours, OnesHours, TensMinutes, OnesMinutes, TensSeconds, OnesSeconds As Single
Dim binTensHours, binOnesHours, binTinsMinutes, binOnesMinutes, binTensSeconds, binOnesSeconds As String
Hours = Hour(Time)
Minutes = Minute(Time)
Seconds = Second(Time)
Label6.Caption = Time
'if Hours > 12 we need to convert to 12-hour clock format
Select Case Hours
Case 13: Hours = 1
Case 14: Hours = 2
Case 15: Hours = 3
Case 16: Hours = 4
Case 17: Hours = 5
Case 18: Hours = 6
Case 19: Hours = 7
Case 20: Hours = 8
Case 21: Hours = 9
Case 22: Hours = 10
Case 23: Hours = 11
Case 24: Hours = 12
End Select
'break out hours, minutes, seconds into tens and ones
'break out hours
If Hours <= 10 Then 'tens of hours must be zero
TensHours = 0
Else
TensHours = Left(Hours, 1)
End If
If Len(Hours) = 1 Then 'there is no trailing zero
OnesHours = Hours
Else
OnesHours = Right(Hours, 1)
End If
'break out minutes
TensMinutes = Left(Minutes, 1)
OnesMinutes = Right(Minutes, 1)
'break out seconds
TensSeconds = Left(Seconds, 1)
OnesSeconds = Right(Seconds, 1)
'by now we should have hours, minutes and seconds broken out
'into tens and ones so we can now convert the stings to binary
binTensHours = CBin(TensHours)
binOnesHours = CBin(OnesHours)
binTensMinutes = CBin(TensMinutes)
binOnesMinutes = CBin(OnesMinutes)
binTensSeconds = CBin(TensSeconds)
binOnesSeconds = CBin(OnesSeconds)
' all strings are converted to binary now we can display the data
Label6.Caption = Time
Label10.Caption = CStr(binTensHours) + " " + " " + CStr(binOnesHours) + " " + ":" + " " + CStr(binTensMinutes) + " " + " " + CStr(binOnesMinutes) + " " + ":" + " " + CStr(binTensSeconds) + " " + " " + CStr(binOnesSeconds) + " " 'testing
'update the form to display the binary clock
'now to make all the lights work!
' lights for TensHours
If Mid(binTensHours, 8, 1) = 1 Then
Shape1(18).FillColor = &HFF&
Else: Shape1(18).FillColor = &H0&
End If
If Mid(binTensHours, 7, 1) = 1 Then
Shape1(19).FillColor = &HFF&
Else: Shape1(19).FillColor = &H0&
End If
' lights for OnesHours
If Mid(binOnesHours, 8, 1) = 1 Then
Else: Shape1(14).FillColor = &H0&
End If
If Mid(binOnesHours, 7, 1) = 1 Then
Shape1(15).FillColor = &HFF&
Else: Shape1(15).FillColor = &H0&
End If
If Mid(binOnesHours, 6, 1) = 1 Then
Shape1(16).FillColor = &HFF&
Else: Shape1(16).FillColor = &H0&
End If
If Mid(binOnesHours, 5, 1) = 1 Then
Shape1(17).FillColor = &HFF&
Else: Shape1(17).FillColor = &H0&
End If
' lights for TensMinutes
If Mid(binTensMinutes, 8, 1) = 1 Then
Shape1(11).FillColor = &HFF&
Else: Shape1(11).FillColor = &H0&
End If
If Mid(binTensMinutes, 7, 1) = 1 Then
Shape1(12).FillColor = &HFF&
Else: Shape1(12).FillColor = &H0&
End If
If Mid(binTensMinutes, 6, 1) = 1 Then
Shape1(13).FillColor = &HFF&
Else: Shape1(13).FillColor = &H0&
End If
' lights for OnesMinutes
If Mid(binOnesMinutes, 8, 1) = 1 Then
Shape1(7).FillColor = &HFF&
Else: Shape1(7).FillColor = &H0&
End If
If Mid(binOnesMinutes, 7, 1) = 1 Then
Shape1(8).FillColor = &HFF&
Else: Shape1(8).FillColor = &H0&
End If
If Mid(binOnesMinutes, 6, 1) = 1 Then
Shape1(9).FillColor = &HFF&
Else: Shape1(9).FillColor = &H0&
End If
If Mid(binOnesMinutes, 5, 1) = 1 Then
Shape1(10).FillColor = &HFF&
Else: Shape1(10).FillColor = &H0&
End If
' lights for TensSeconds
If Mid(binTensSeconds, 8, 1) = 1 Then
Shape1(4).FillColor = &HFF&
Else: Shape1(4).FillColor = &H0&
End If
If Mid(binTensSeconds, 7, 1) = 1 Then
Shape1(5).FillColor = &HFF&
Else: Shape1(5).FillColor = &H0&
End If
If Mid(binTensSeconds, 6, 1) = 1 Then
Shape1(6).FillColor = &HFF&
Else: Shape1(6).FillColor = &H0&
End If
' lights for OnesSeconds
If Mid(binOnesSeconds, 8, 1) = 1 Then
Shape1(0).FillColor = &HFF&
Else: Shape1(0).FillColor = &H0&
End If
If Mid(binOnesSeconds, 7, 1) = 1 Then
Shape1(1).FillColor = &HFF&
Else: Shape1(1).FillColor = &H0&
End If
If Mid(binOnesSeconds, 6, 1) = 1 Then
Shape1(2).FillColor = &HFF&
Else: Shape1(2).FillColor = &H0&
End If
If Mid(binOnesSeconds, 5, 1) = 1 Then
Shape1(3).FillColor = &HFF&
Else: Shape1(3).FillColor = &H0&
End If
End Sub
Public Function CBin(ByVal Nr As Long, _
Optional Precision As Integer = 8) As String
Do Until Nr = 0
CBin = CStr((Nr Mod 2)) + CBin
Nr = Nr \ 2
Loop
CBin = Format(Val(CBin), String(Precision, "0"))
End Function
Alıntıdır. |
