PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Binäre Uhr

https://www.purebasic.fr/german/viewtopic.php?t=5094

Seite 1 von 4

Binäre Uhr

Verfasst: 10.10.2005 01:05
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ß!

Verfasst: 10.10.2005 01:27
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 ;)

Verfasst: 10.10.2005 01:32
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)

Verfasst: 10.10.2005 01:57
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...

Verfasst: 10.10.2005 03:07
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!

Verfasst: 10.10.2005 03:17
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.

Verfasst: 10.10.2005 12:09
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

Verfasst: 10.10.2005 12:17
von ZeHa
LOL geil! Hatte ich auch vor, aber hätte niemals gewußt wo ich da anfangen soll ;)

Verfasst: 10.10.2005 12:22
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 ;)

Verfasst: 10.10.2005 14:33
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
Alle Zeiten sind UTC+02:00
Seite 1 von 4

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de