Binäre Uhr

Anwendungen, Tools, Userlibs und anderes nützliches.
Benutzeravatar
ZeHa
Beiträge: 4760
Registriert: 15.09.2004 23:57
Wohnort: Friedrichshafen
Kontaktdaten:

Binäre Uhr

Beitrag von ZeHa »

Hallo!

Mir hat vorhin einer 'ne coole Uhr gezeigt, die gibt's bei ThinkGeek.com zu kaufen. Da die mir aber ein wenig zu teuer ist, begnüge ich mich nun einfach mit der Software-Lösung ;)

Hier erstmal der Link zu der Hardware-Uhr:
http://www.thinkgeek.com/cubegoodies/lights/59e0/

Und hier nun der Code:

Code: Alles auswählen

Dim b$(6)

Global hell, dunkel, hintergrund
Global size, radius

size = 16
radius = 6

Procedure ChangeColor(farbe.b)
  Select farbe
    Case 0
      hell = RGB(255,0,0)
      dunkel = RGB(96,0,0)
      hintergrund = RGB(0,0,0)
    Case 1
      hell = RGB(0,96,255)
      dunkel = RGB(0,32,96)
      hintergrund = RGB(192,192,192)
    Case 2
      hell = RGB(0,255,0)
      dunkel = RGB(0,128,0)
      hintergrund = RGB(0,96,0)  
  EndSelect
EndProcedure

ChangeColor(0)

If OpenWindow(0,0,0,size*9,size*7,#PB_Window_ScreenCentered | #PB_Window_SystemMenu,"Binary Clock")
  CreateImage(0,size*9,size*7)
  If CreateGadgetList(WindowID(0))
    ImageGadget(0,0,0,size*9,size*7,UseImage(0))
    Repeat
      Event = WindowEvent()
      Delay(50)
      
      b$(1) = RSet(Bin(Val(Left(RSet(Str(Hour(Date())),2,"0"),1))),2,"0")
      b$(2) = RSet(Bin(Val(Right(RSet(Str(Hour(Date())),2,"0"),1))),4,"0")
      
      b$(3) = RSet(Bin(Val(Left(RSet(Str(Minute(Date())),2,"0"),1))),3,"0")
      b$(4) = RSet(Bin(Val(Right(RSet(Str(Minute(Date())),2,"0"),1))),4,"0")
      
      b$(5) = RSet(Bin(Val(Left(RSet(Str(Second(Date())),2,"0"),1))),3,"0")
      b$(6) = RSet(Bin(Val(Right(RSet(Str(Second(Date())),2,"0"),1))),4,"0")
      
      
      StartDrawing(ImageOutput())
      Box(0,0,size*9,size*7,hintergrund)
      For j = 1 To 6
        For i = 1 To Len(b$(j))
          If Val(Mid(b$(j),i,1))
            Circle(j*size+size,i*size+(4-Len(b$(j)))*size+size,radius,hell)
          Else
            Circle(j*size+size,i*size+(4-Len(b$(j)))*size+size,radius,dunkel)
          EndIf
        Next i
      Next j
      StopDrawing()
      SetGadgetState(0,UseImage(0))
      
      If Event = #PB_Event_Gadget
        farbe+1
        If farbe=3
          farbe=0
        EndIf
        ChangeColor(farbe)
      EndIf
      
    Until Event = #PB_Event_CloseWindow
  EndIf
EndIf
Wenn euch die Größe der Uhr nicht paßt, einfach oben Size und Radius entsprechend anpassen!
Ein Klick auf das Fenster ändert übrigens das Farbschema. Auch hier ist es natürlich leicht, neue hinzuzufügen bzw. die alten zu ändern...

Das Lesen der Uhr ist auch nicht allzu schwer. Man muß es sich so vorstellen: Die Uhrzeit wird in 6 Stellen angegeben, z.B. 15:30:42, und jede dieser Stellen bekommt eine vertikale Binär-Säule von max. 4 Bit. Diese werden ganz einfach von unten nach oben gelesen. Auf der ThinkGeek-Homepage ist ein Bild, da wird das ebenfalls erklärt.

Ach, noch was... ich weiß, der Code ist nich grad super optimal geschrieben (besonders wenn die b$-Strings ermittelt werden :mrgreen: ), aber darauf kam's mir jetzt auch nicht an ;)

Viel Spaß!
merlin
Beiträge: 157
Registriert: 30.07.2005 22:15

Beitrag von merlin »

hi ZeHa!
Ganz nettes teil (hardware wie auch deine version)... jedoch sind in deiner version noch ein paar kleine bugs, die du aber einfach mit einer If/Endif Abfrage fixen kannst!

Teste mal als Std 01 - Es wird laut LDS aber 11 angezeigt! ;) das gleiche gilt auch bei minuten und sekunden ;)

ansonsten, sauberes teil ;)
Benutzeravatar
ZeHa
Beiträge: 4760
Registriert: 15.09.2004 23:57
Wohnort: Friedrichshafen
Kontaktdaten:

Beitrag von ZeHa »

Jo, in dem Fall hast Du es zu früh ausprobiert - hab's nämlich grad eben geändert ;) also einfach nochmal versuchen!

(Zum Glück haben wir grad 1 Uhr, sonst hätt ich das wohl auch nicht gemerkt)
Benutzeravatar
AND51
Beiträge: 5220
Registriert: 01.10.2005 13:15

Beitrag von AND51 »

einfach lolig muss ich sagen...
echt geil.
stell ich mir ziemlich lustig vor: du hast die besagte uhr und liest vor anderen staunenden mitmenschen die uhrzeit an einer solchen uhr ab... =)

aber dass man mit so wenig code die uhr nachmachen kann hätt ich nicht gedacht.. wenn ich sowas programmieren sollte (beui meinem anfängerwissen) hätt ich bestimmt viel mehr hingecoded... ich werd den code mal durchgehen vllt. kann ichmir ja die ein oder anderen tipps abgucken...
PB 4.30

Code: Alles auswählen

Macro Happy
 ;-)
EndMacro

Happy End
Benutzeravatar
ZeHa
Beiträge: 4760
Registriert: 15.09.2004 23:57
Wohnort: Friedrichshafen
Kontaktdaten:

Beitrag von ZeHa »

Ja, hätte selbst erst nicht gedacht, daß der Code so kurz wird.

Aber zum Lernen wird der Code wohl nich grad das beste sein ;) ist halt alles sehr verwurschtelt (besonders eben jene 6 Zeilen mit den b$).
Das Grundprinzip ist aber recht einfach: Du holst Dir per Hour(), Minute() und Second() die einzelnen Werte, davon wiederum die einzelnen Stellen (jeweils 2), und machst 'nen binären Wert draus, den Du als String speicherst. Dann gehst Du jedes Zeichen der Strings einzeln durch, und zeigst bei 'ner 1 'nen hellen, bei 'ner 0 'nen dunklen Kreis an. Also recht simpel das ganze.

Wenn Du trotzdem irgendwelche Fragen haben solltest, nur zu!
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag von ts-soft »

Sehr schöne Uhr :allright:
Ob ich mich an das ablesen gewöhnen kann/möchte weiß ich noch nicht :freak: Der Code ist auch übersichtlich, weiß nicht was Du hast.

Nachtrag: Habs mal auf WaitWindowEvent geändert, mit API-Timer alle 100 ms, CPU-Belastung schwankt zwischen 0 und 2%, also nach der Änderung auch für den Dauerbetrieb geeignet.
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
Deeem2031
Beiträge: 1232
Registriert: 29.08.2004 00:16
Wohnort: Vorm Computer
Kontaktdaten:

Beitrag von Deeem2031 »

Wie wärs damit? ;)

Code: Alles auswählen

Dim b$(6) 

Global hell, dunkel, hintergrund 
Global size.f, radius 

size.f = 40/7
radius = 2 

Procedure ChangeColor(farbe.b) 
  Select farbe 
    Case 0 
      hell = RGB(255,0,0) 
      dunkel = RGB(96,0,0) 
      hintergrund = RGB(0,0,0) 
    Case 1 
      hell = RGB(0,96,255) 
      dunkel = RGB(0,32,96) 
      hintergrund = RGB(192,192,192) 
    Case 2 
      hell = RGB(0,255,0) 
      dunkel = RGB(0,128,0) 
      hintergrund = RGB(0,96,0)  
    Case 3
      hell = RGB(255,255,0) 
      dunkel = RGB(0,0,0) 
      hintergrund = RGB(96,96,96)  
  EndSelect 
EndProcedure 

ChangeColor(0) 


hwnd = FindWindow_("Shell_TrayWnd",#Null)
parenthwnd = FindWindowEx_(hwnd,#Null,"TrayNotifyWnd",#Null)
GetWindowRect_(parenthwnd,@ParentRect.rect)
hwnd = FindWindowEx_(parenthwnd,#Null,"TrayClockWClass",#Null)
  
GetWindowRect_(hwnd,@Rect.rect)

Window_Width = Rect\right-Rect\left
Window_Height = Rect\bottom-Rect\Top - 4

  
If OpenWindow(0,Rect\left-ParentRect\Left+2,2,Window_Width,Window_Height,#PB_Window_BorderLess,"Binary Clock") 
  SetParent_(WindowID(0),parenthwnd)
  ShowWindow_(hwnd,#SW_HIDE)
  
  CreateImage(0,Window_Width,Window_Height) 
  If CreateGadgetList(WindowID(0)) 
    ImageGadget(0,0,0,Window_Width,Window_Height,UseImage(0)) 
    Repeat 
        Select WindowEvent() 
          Case #PB_Event_Gadget
            Select EventType()
              Case #PB_EventType_LeftClick
                farbe=(farbe+1)%4
                ChangeColor(farbe) 
              Case #PB_EventType_RightClick
                quit = #True
            EndSelect
          Case #PB_Event_CloseWindow
            quit = #True
          Case 0
            Delay(50) 
        EndSelect
      
      b$(1) = RSet(Bin(Val(Left(RSet(Str(Hour(Date())),2,"0"),1))),2,"0") 
      b$(2) = RSet(Bin(Val(Right(RSet(Str(Hour(Date())),2,"0"),1))),4,"0") 
      
      b$(3) = RSet(Bin(Val(Left(RSet(Str(Minute(Date())),2,"0"),1))),3,"0") 
      b$(4) = RSet(Bin(Val(Right(RSet(Str(Minute(Date())),2,"0"),1))),4,"0") 
      
      b$(5) = RSet(Bin(Val(Left(RSet(Str(Second(Date())),2,"0"),1))),3,"0") 
      b$(6) = RSet(Bin(Val(Right(RSet(Str(Second(Date())),2,"0"),1))),4,"0") 
      
      
      StartDrawing(ImageOutput()) 
      Box(0,0,Window_Width,Window_Height,hintergrund) 
      For j = 1 To 6 
        For i = 1 To Len(b$(j)) 
          If Val(Mid(b$(j),i,1)) 
            Circle(j*size,i*size+(4-Len(b$(j)))*size,radius,hell) 
          Else 
            Circle(j*size,i*size+(4-Len(b$(j)))*size,radius,dunkel) 
          EndIf 
        Next i 
      Next j 
      StopDrawing() 
      SetGadgetState(0,UseImage(0)) 
      
    Until quit
  EndIf 
  ShowWindow_(hwnd,#SW_SHOW)
EndIf
Bild
[url=irc://irc.freenode.org/##purebasic.de]irc://irc.freenode.org/##purebasic.de[/url]
Benutzeravatar
ZeHa
Beiträge: 4760
Registriert: 15.09.2004 23:57
Wohnort: Friedrichshafen
Kontaktdaten:

Beitrag von ZeHa »

LOL geil! Hatte ich auch vor, aber hätte niemals gewußt wo ich da anfangen soll ;)
Benutzeravatar
Deeem2031
Beiträge: 1232
Registriert: 29.08.2004 00:16
Wohnort: Vorm Computer
Kontaktdaten:

Beitrag von Deeem2031 »

Hm, funktioniert aber nicht 100%ig, wenn man ein Systray-Icon added und die Clock an ist wird das ganze verschoben. Anscheinend müsste man noch was am WindowCallback ändern... ich werd aber erstma was essen ;)
Bild
[url=irc://irc.freenode.org/##purebasic.de]irc://irc.freenode.org/##purebasic.de[/url]
Benutzeravatar
Deeem2031
Beiträge: 1232
Registriert: 29.08.2004 00:16
Wohnort: Vorm Computer
Kontaktdaten:

Beitrag von Deeem2031 »

Hm, es geht auch einfacher ;)

Code: Alles auswählen

Dim b$(6) 

Global hell, dunkel, hintergrund 
Global size.f, radius 

size.f = 40/7
radius = 2 

Procedure ChangeColor(farbe.b) 
  Select farbe 
    Case 0 
      hell = RGB(255,0,0) 
      dunkel = RGB(96,0,0) 
      hintergrund = RGB(0,0,0) 
    Case 1 
      hell = RGB(0,96,255) 
      dunkel = RGB(0,32,96) 
      hintergrund = RGB(192,192,192) 
    Case 2 
      hell = RGB(0,255,0) 
      dunkel = RGB(0,128,0) 
      hintergrund = RGB(0,96,0)  
    Case 3
      hell = RGB(255,255,0) 
      dunkel = RGB(0,0,0) 
      hintergrund = RGB(96,96,96)  
  EndSelect 
EndProcedure 

ChangeColor(0) 


hwnd = FindWindow_("Shell_TrayWnd",#Null)
hwnd = FindWindowEx_(hwnd,#Null,"TrayNotifyWnd",#Null)
hwnd = FindWindowEx_(hwnd,#Null,"TrayClockWClass",#Null)
  
GetWindowRect_(hwnd,@Rect.rect)

Window_Width = Rect\right-Rect\left
Window_Height = Rect\bottom-Rect\Top - 4
  
If OpenWindow(0,0,2,Window_Width,Window_Height,#PB_Window_BorderLess,"Binary Clock") 
  SetParent_(WindowID(0),hwnd)
  
  CreateImage(0,Window_Width,Window_Height) 
  If CreateGadgetList(WindowID(0)) 
    ImageGadget(0,0,0,Window_Width,Window_Height,UseImage(0)) 
    Repeat 
      Select WindowEvent() 
        Case #PB_Event_Gadget
          Select EventType()
            Case #PB_EventType_LeftClick
              farbe=(farbe+1)%4
              ChangeColor(farbe) 
            Case #PB_EventType_RightClick
              quit = #True
          EndSelect
        Case #PB_Event_CloseWindow
          quit = #True
        Case 0
          Delay(50) 
      EndSelect
      
      b$(1) = RSet(Bin(Val(Left(RSet(Str(Hour(Date())),2,"0"),1))),2,"0") 
      b$(2) = RSet(Bin(Val(Right(RSet(Str(Hour(Date())),2,"0"),1))),4,"0") 
      
      b$(3) = RSet(Bin(Val(Left(RSet(Str(Minute(Date())),2,"0"),1))),3,"0") 
      b$(4) = RSet(Bin(Val(Right(RSet(Str(Minute(Date())),2,"0"),1))),4,"0") 
      
      b$(5) = RSet(Bin(Val(Left(RSet(Str(Second(Date())),2,"0"),1))),3,"0") 
      b$(6) = RSet(Bin(Val(Right(RSet(Str(Second(Date())),2,"0"),1))),4,"0") 
      
      
      StartDrawing(ImageOutput()) 
      Box(0,0,Window_Width,Window_Height,hintergrund) 
      For j = 1 To 6 
        For i = 1 To Len(b$(j)) 
          If Val(Mid(b$(j),i,1)) 
            Circle(j*size,i*size+(4-Len(b$(j)))*size,radius,hell) 
          Else 
            Circle(j*size,i*size+(4-Len(b$(j)))*size,radius,dunkel) 
          EndIf 
        Next i 
      Next j 
      StopDrawing() 
      SetGadgetState(0,UseImage(0)) 
      
    Until quit
  EndIf 
EndIf
Bild
[url=irc://irc.freenode.org/##purebasic.de]irc://irc.freenode.org/##purebasic.de[/url]
Antworten