MyDesign | Kod Arşivi - Anasayfaya Dön   No banner in farm
Anasayfa Araştır Forum Gelişmiş Arama Siteniz İçin En Hit İçerikler RSS İçerik Ekle Scriptler Destekleyenler Kadromuz Reklam İletişim Giriş Sayfası Yap  Sık Kullanılanlara Ekle
Bu Kategorinin En Yeni Kodları:


Bu Kategorinin En Çok Görüntülenen Kodları:






Arama:
Gelişmiş Arama


No banner in farm



En Çok Görüntülenen Kodlar:


Üye Girişi:
 Üye Ol



Anasayfa > VisualBasic > Kodlar

Binary Saat

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

Kategori : VisualBasic
Gönderen : LonG
Telif :
Tarih : 26 Kas�m 2005
Örnek Dosya : İndir
Okunma Sayısı : 8322
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 için yazılan yorumlar

Henüz yorum eklenmedi.

Yorum ekleyin

Anasayfa > VisualBasic > Kodlar > Binary Saat
Kategoriler:


Forum:



Bağlantılar:


En Son Yorumlanan İçerikler:


Murat Yavuz | Site Haritası | Gizlilik Bildirimi | 54.80.93.19 | 0,12 Saniye
© Copyright 2004-2018 MyDesign | Kod Arşivi. Tüm Hakları Saklıdır.
MyDesign | Kod Arşivi, en iyi görünüm için, 1024x768 ve üzeri çözünürlük tavsiye eder.