Binäre Uhr

[redacid]

Nette Idee!

Hier die fast unveränderte Version (die erste, welche kein WinAPI benötigt) unter MacOS X (ich habe nur bei Size 36 und bei Radius 16 eingetragen, um es besser "sehen" zu können):


(Qualität leicht heruntergerechnet)

[ts-soft]

Deem2031 sein letzter Code mal mit WaitWindowEvent. Durch den verwendeten Timer fällt das Delay(50) weg, es reicht alle 200ms zu aktualisieren und trotzdem alle Ereignisse korrekt abzuarbeiten
ACHTUNG: Läuft nur unter Windows

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)
  SetTimer_(WindowID(0), 0, 200, 0)
  CreateImage(0,Window_Width,Window_Height)
  If CreateGadgetList(WindowID(0))
    ImageGadget(0,0,0,Window_Width,Window_Height,UseImage(0))
    Repeat
      Select WaitWindowEvent()
        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 #WM_TIMER
     
      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))
     EndSelect
    Until quit
    KillTimer_(WindowID(0), 0(
  EndIf
EndIf

[DarkDragon]

Ja geil, ich glaub ich wünsch mir das zu Weihnachten.

[Batze]

Ich muss mir mal Überlegen, wie ich mir das ding selber baue.

[ZeHa]

@ redacid: Kannst Du Deine veränderte Version auch posten? Also den Code?

[redacid]

@ redacid: Kannst Du Deine veränderte Version auch posten? Also den Code?

ist nicht nötig. mit "fast unverändert" meinte ich, dass ich grundsätzlich nichts verändert habe, nur eben die Maße (bei Size und Radius). Ansonsten lief der Code absolut ohne Veränderungen.

[ZeHa]

Achso... ein Kumpel von mir hat sich grad die Linux-Demo gesaugt von PB, aber leider funktioniert bei ihm die Uhr nicht... lag erstmal am ImageGadget(), aber nach einer Änderung auf WindowOutput() etc hat auch das nicht funktioniert...

[ts-soft]

Habs mal den original-source unter linux getestet: funzt
Lediglich die Farbumschaltung wird ignoriert. Bei Gelegenheit werde ich die Linux-Version auch mal auf Timer umstellen, Delay() ist ätzend

[NicTheQuick]

Bei mir wird die Uhr nicht so richtig angezeigt, wie man hier sieht. Sie
scheint bei der Hälfte abgeschnitten zu werden.

[bommelid]

Na da weiß ich ja endlich, was ich mal wieder basteln kann. Das Einzige was mir an der Uhr (Hardware) nicht gefällt, ist diese Pseudo-Binärausgabe. Da sollt bei 20 Uhr auch ne 10100 stehen und nicht ne Zwei und eine Null.
ann sinds drei Reihen mit Leds. Find ich jedenfalls besser. Und man muß sicher noch ne zehntel Sekunde länger umrechnen.

00100
010011
100101

also 4:19:37

Gruß
bommelid