MyDesign | Kod Arivi - Anasayfaya Dn   No banner in farm
Anasayfa Aratr Forum Gelimi Arama Siteniz in En Hit erikler RSS erik Ekle Scriptler Destekleyenler Kadromuz Reklam letiim Giri Sayfas Yap  Sk Kullanlanlara Ekle
Bu Kategorinin En Yeni Kodlar:


Bu Kategorinin En ok Grntlenen Kodlar:






Arama:
Gelimi Arama


No banner in farm



En ok Grntlenen Kodlar:


ye Girii:
 ye Ol



Anasayfa > VisualBasic > Kodlar

Binary Saat

Geçerli tarih ve saati binary olarak görüntüler

Kategori : VisualBasic
Gnderen : LonG
Telif :
Tarih : 26 Kasım 2005
rnek Dosya : �ndir
Okunma Says : 8632
Puan
: 6,6 / 10 (5 Oy)
Puan Verin :
Google Bookmarks  del.icio.us  Digg  Yahoo! MyWeb  Windows Live  Furl
 
 

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
 
 

Binary Saat iin yazlan yorumlar

Hen�z yorum eklenmedi.

Yorum ekleyin

Anasayfa > VisualBasic > Kodlar > Binary Saat
Kategoriler:


Forum:



Balantlar:



    En Son Yorumlanan erikler:


    Murat Yavuz | Site Haritas | Gizlilik Bildirimi | 35.171.146.16 | 0,14 Saniye
    © Copyright 2004-2019 MyDesign | Kod Arivi. Tm Haklar Sakldr.
    MyDesign | Kod Arivi, en iyi grnm iin, 1024x768 ve zeri znrlk tavsiye eder.