Deutsch
Quelltexte/ Codesnippets

Interessantes Konzept Uhr

 
- Seite 1 -



Jörg
Sellmeyer
[...] 

P.S.
Vielleicht sollte man doch den Mülleimer mal umbenennen in Dies & Das oder so. Das Löschen kann ja gerne weiter wie bisher gehandhabt werden aber es ist doch etwas merkwürdig, einen Beitrag, den man den Anderen nicht vorenthalten möchte im Mülleimer zu plazieren.
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
16.05.2007  
 



 
- Seite 1 -



Jörg
Sellmeyer
In diesem Zusammenhang ist mir mal bei Wikipedia eine Binäruhr  [...]  untergekommen und ich dachte mir: das will ich haben.
Et voilá...
 $H windows.ph
Randomize
Declare Hours%,Minutes%,Seconds%
Declare x%,y%,bottom%
Declare SecOn&[],SecOff&[],MaxIndexSec%
Declare MinOn&[],MinOff&[],MaxIndexMin%
Declare HoursOn&[],HoursOff&[],MaxIndexHours%
UserMessages $10
Var hFont& = ~GetStockObject(11)

Proc GetTimeValues

    Seconds% = dt("getsec",!now)
    Minutes% = dt("getmin",!now)
    Hours% = dt("gethour",!now)

EndProc

Proc ShowTime

    WhileLoop 0,MaxIndexSec%

        ShowWindow(SecOn&[&Loop], testbit(Seconds%,&loop))

    Wend

    WhileLoop 0,MaxIndexMin%

        ShowWindow(MinOn&[&Loop], testbit(Minutes%,&loop))

    Wend

    WhileLoop 0,MaxIndexHours%

        ShowWindow(HoursOn&[&Loop], testbit(Hours%,&loop))

    Wend

EndProc

WindowStyle %11010
WindowTitle "Binäruhr für Leute die %10 Augen haben."
Window 600,400
SetDialogFont hFont&
GetTimeValues
'Cls RGB((Hours% * 10.66) Mod $FF,$FF - (Minutes% * 4.25),(Seconds% * 4.25))
x% = 330
bottom% = 140
y% = bottom%
'Slots für Sekunden:

WhileLoop 0,6

    SecOff&[&Loop] = @Create("Icon",%hwnd,"Knopf2",x%,40 + y%)
    SecOn&[&Loop] = @Create("Icon",SecOff&[&Loop],"Knopf1",0,0)

    If &Loop = 3

        y% = bottom%
        Dec x%,36

    Else

        Dec y% ,34

    EndIf

    ShowWindow(SecOn&[&Loop],0)

Wend

MaxIndexSec% = SizeOf(SecOn&[]) - 1
Dec x%, 10 + 34
y% = bottom%
'Slots für Minuten:

WhileLoop 0,6

    MinOff&[&Loop] = @Create("Icon",%hwnd,"Knopf2",x%,40 + y%)
    MinOn&[&Loop] = @Create("Icon",MinOff&[&Loop],"Knopf1",0,0)

    If &Loop = 3

        y% = bottom%
        Dec x%,36

    Else

        Dec y% ,34

    EndIf

    ShowWindow(SecOn&[&Loop],0)

Wend

MaxIndexMin% = SizeOf(MinOn&[]) - 1
Dec x%, 10 + 34
y% = bottom%
'Slots für Stunden:

WhileLoop 0,5

    HoursOff&[&Loop] = @Create("Icon",%hwnd,"Knopf2",x%,40 + y%)
    HoursOn&[&Loop] = @Create("Icon",HoursOff&[&Loop],"Knopf1",0,0)

    If &Loop = 3

        y% = bottom%
        Dec x%,36

    Else

        Dec y% ,34

    EndIf

    ShowWindow(SecOn&[&Loop],0)

Wend

MaxIndexHours% = SizeOf(HoursOn&[]) - 1
Var hFarben& = Create("CheckBox",%hwnd,"Mit zeitentsprechender Hintergrundfarbe",10,Height(%hwnd)-30,350,24)
Var hHexUhr& = Create("CheckBox",%hwnd,("Es ist jetzt genau " + Hex$(dt("gethour",!now)) + ":" + Hex$(dt("getmin",!now)) + ":" + Hex$(dt("getsec",!now)) + " Uhr        :-)"),10,(Height(%hwnd)-60),350,24)
Var tt& = Create("Text",%hwnd,"",Width(%hwnd)-40,Height(%hwnd)-40,0,0)
ShowTime

While 1

    WaitInput 1000
    Case %umessage = $10:Break
    GetTimeValues

    If GetCheck(hFarben&)

        StartPaint tt&
        Cls RGB((Seconds% * 4.25),(Hours% * 10.66) Mod $FF,$FF - (Minutes% * 4.25))
        EndPaint

    EndIf

    If GetCheck(hHexUhr&)

        SetText hHexUhr&,"Es ist jetzt genau " + Hex$(dt("gethour",!now)) + ":" + Hex$(dt("getmin",!now)) + ":" + Hex$(dt("getsec",!now)) + " Uhr " + Space$(seconds% \ 10) + " :-)"

    EndIf

    ShowTime

Wend

DeleteObject hFont&
 
XProfan X4
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
04.06.2018  
 



 
- Seite 2 -



p.specht
 
XProfan 11
So Computer sind halt auch nur Menschen...
04.06.2018  
 




Jörg
Sellmeyer
Irgendwie haben mich die Uhren gerade gepackt.
Die halte ich persönlich für sehr gut.
Probiert bitte mal aus, ob Unterschiede im Interpreter und im fertigen Compilat zu bemerken sind.
 $H Windows.ph
Def AppHeight(0) %WinBottom - %WinTop
Def AppWidth(0) %WinRight - %WinLeft
UserMessages $10
Var hFont& = ~GetStockObject(11)
SetDialogFont hFont&
Declare hStunden&[],hMinuten&[],hSekunden&[],MaxIndexSek%,MaxIndexMin%,MaxIndexStn%
Declare hStartIcon&[]
Declare hTimeTxt&[]
Declare Stunden%,Minuten%,Sekunden%
Declare erledigt%
Var xx% = 2
Var yy% = 16 + ~GetSystemMetrics(~SM_CYCAPTION)
WindowTitle "Push Me - Die Dezimaluhr"
WindowStyle %11010 | 1024
Window %maxx +10,0 - (60 * 18 -30),(3*22+~GetSystemMetrics(~SM_CYSMCAPTION)+1)
'Hauptfenster versteckt erstellen

Proc MakeTimeLine

    Parameters hParent&,AnzX%,AnzY%,Left%,Top%,Br%,H%,AbstX%,AbstY%,Icon1$,Icon2$,txt%
    Declare Arr&[],hdl&,x%,y%
    x% = Left%
    y% = Top%

    WhileLoop AnzY%

        WhileLoop 0,AnzX% -1

            If %pcount = 12

                'das hier sieht man im Moment nicht. War zu Testzwecken.
                Create("Text",hParent&,Str$((59-&Loop) mod 10),x%,y%,Br%,H%)
                Inc x%,Br% + AbstX%
                Continue

            EndIf

            hdl& = Create("Icon",%hwnd,Icon1$,x%,y%)
            SetWindowPos hdl& = (x%),(y%) - 16,16
            'Kästchen erzeugen
            Arr&[&Loop] = Create("Icon",hdl&,Icon2$,0,0)
            ShowWindow(Arr&[&Loop],0)
            'Icons für Zeitanzeige anzeigen und gleich verstecken
            Inc x%,Br% + AbstX%

        Wend

        hStartIcon&[Sizeof(hStartIcon&[])] = Create("Icon",hdl&,"Weg",0,0)
        'test& = Sizeof(hStartIcon&[])
        ShowWindow(hStartIcon&[Sizeof(hStartIcon&[])-1],0)
        Inc y%,H% + AbstY%
        x% = Left%

    Wend

    Return Arr&[]

EndProc

Proc GetTimeValues

    Sekunden% = dt("getsec",!now)
    Minuten% = dt("getmin",!now)
    Stunden% = dt("gethour",!now)

EndProc

Proc TF$

    Parameters t%
    Return Format$("00",t%)

EndProc

Proc tPrev

    Parameters t%
    Return If(t% = 59,0,t% - 1)

EndProc

Proc tNext

    Parameters t%
    Return If(t% = 0,59,t% - 1)

EndProc

Proc ShowTimeDec

    Parameters Arr&[],time%,Aufruf%
    Var mxi% = SizeOf(Arr&[])-1
    Var Sleep% = 40 - time%\4
    Var tPrev% = tPrev(time%)-1
    Var tNext% = tNext(time%)-1

    WhileLoop 0,mxi%

        ShowWindow( Arr&[mxi% - &Loop],1)
         $IFDEF COMPILER
        'sieht bei mir zumindest besser aus, als wenn ich
        'Sleep auch im compilierten Programm nehme.
        WaitInput Sleep%

        If %umessage = $10

            'auch hier auf Abbruch checken, damit der Klick aufs Kreuz direkt wirkt
            Break

        EndIf

         $ELSE
        Sleep Sleep%
         $ENDIF
        ShowWindow( Arr&[mxi% - &Loop],&Loop = time%)
        SetText hTimeTxt&[Aufruf%-1],TF$(&Loop)
        Dec Sleep%,1
        Case Sleep% < 0:Sleep% = 1

        If &Loop > time%

            ShowWindow(Arr&[0],0)
            Break

        EndIf

    Wend

    var Icon& = SizeOf(hStartIcon&[])

    If Aufruf% = 1

        WhileLoop SizeOf(hStartIcon&[])-1,0,-1

            Icon& = hStartIcon&[&Loop]
            ShowWindow(Icon&,1)
            WaitInput 10
            ShowWindow(Icon&,0)
            Waitinput 10
            Case %umessage = $10:Break

        Wend

        ShowWindow(Arr&[mxi%],1)

    EndIf

    SetText hTimeTxt&[Aufruf%-1],TF$(time%)

EndProc

GetTimeValues' Uhr Initialisieren
'MakeTimeLine(%hwnd,60,1,18,130,16,16,1,-4,"","",1)
hSekunden&[]=MakeTimeLine(%hwnd,60,1,xx%,yy%,16,16,1,-4,"Knopf2","Weg")
hTimeTxt&[0] = Create("Text",%hwnd,TF$(Sekunden%),AppWidth() - 26,yy%,20,12)
'Kästchen für Anzeige erzeugen
Dec yy%,20
hMinuten&[]=MakeTimeLine(%hwnd,60,1,xx%,yy%,16,16,1,-4,"Knopf2","Wasser")
hTimeTxt&[1] = Create("Text",%hwnd,TF$(Minuten%),AppWidth() - 26,yy%,20,12)
Dec yy%,20
Inc xx%,612
hStunden&[]=MakeTimeLine(%hwnd,24,1,xx%,yy%,16,16,1,-4,"Knopf2","Muenze")
hTimeTxt&[2] = Create("Text",%hwnd,TF$(Stunden%),AppWidth() - 26,yy%,20,12)
MaxIndexSek% = SizeOf(hSekunden&[]) - 1
'man könnte hier auch direkt 59 eingeben, aber so bleibt es für weitere Entwicklungen flexibler
MaxIndexMin% =  SizeOf(hMinuten&[]) - 1
MaxIndexStn% =  SizeOf(hStunden&[]) - 1
GetTimeValues' Uhr Initialisieren
Cls ~GetSysColor(~COLOR_3DFACE)
SetWindowPos %hwnd = 0,0 - (60 * 18 -30),(3*22+~GetSystemMetrics(~SM_CYSMCAPTION)+1);-1
'fenster anzeigen
ShowTimeDec(hSekunden&[],Sekunden%,1)
SetText hTimeTxt&[0],TF$(Sekunden%)
ShowTimeDec(hMinuten&[],Minuten%,2)
SetText hTimeTxt&[0],TF$(Sekunden%)
ShowTimeDec(hStunden&[],Stunden%,3)
SetText hTimeTxt&[0],TF$(Sekunden%)
'Sekunden aktualisieren

While 1

    WaitInput 1
    GetTimeValues' Uhrzeit aktualisieren

    If %Umessage = $10

        Break

    ElseIf Val(Right$(dt("getTime",1),3)) > 500

        'Zeit anzeigen.  Die Animation beginnt ca 1/2 Sekunde vorher

        If erledigt% <> Sekunden%

            erledigt% = Sekunden%
            '    Sekunden anzeigen.
            ShowTimeDec(hSekunden&[],Sekunden%,1)
            Case Sekunden% = MaxIndexSek%:ShowTimeDec(hMinuten&[],Minuten%,2)
            '   Minuten anzeigen
            Case Stunden% = MaxIndexStn%:ShowTimeDec(hStunden&[],Stunden%,3)
            '   Stunden anzeigen

        EndIf

    EndIf

Wend

 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
05.06.2018  
 




p.specht
"Potthässliche Uhr"
Windowtitle "POTTHÄSSLICHE UHR":WindowStyle 16 | 64
'Window (%maxx-%maxy)/2,0 - %maxy,%maxy-41:Cls
Window 0,0 - %maxx,%maxy
'(CL)CopyLeft 2017-11 by P.Specht, Wien; Keine wie auch immer geartete Gewähr!
var xx&=width(%hwnd):var yy&=height(%hwnd):var xh!=xx&/2:var yh!=yy&/2
declare t!,r0&,r1&,r2&,r3&,b0&,b1&,b2&,b3&,b9& ,pi2!
r0&=300 : r1&=130 : r2&=210 : r3&=260: pi2!=2*pi()
b0&=7   : b1&=28  : b2&=20  : b3&=8  : b9&=3
MCls xx&,yy&:REPEAT
t!=(val(mid$(time$(0),1,2))*60+val(mid$(time$(0),4,2))+val(mid$(time$(1),1,2))/60)*pi2!
StartPaint -1:ClS if(between(t!,2260,6785),$F0F0F0,$707070)':locate 1,1:print t!;"    ";
usebrush 1,$E0E0E0:usepen 0,2*b0&,$000000:Ellipse xh!+r0&+2,yh!+r0&+2 - xh!-r0&+2,yh!-r0&+2
usebrush 0,$E0E0E0:usepen 0,b0&,$A0A000:Ellipse xh!+r0&,yh!+r0& - xh!-r0&,yh!-r0&
usepen 0,b9&,0:line xh!,0 - xh!,yy& : line 0,yh! - xx&,yh!
usepen 0,b1&,$A00000:line xh!,yh! - xh!+r1&*sin(t!/720),yh!-r1&*cos(t!/720)
usepen 0,b2&,0:line xh!,yh! - xh!+r2&*sin(t!/60),yh!-r2&*cos(t!/60)
usepen 0,b3&,200:line xh!,yh! - xh!+r3&*sin(t!),yh!-r3&*cos(t!)
EndPaint:MCopyBMP 0,0-xx&,yy& > 0,0;0
waitinput 1000:UNTIL (%key>0) or %mousepressed
end
 
XProfan 11
So Computer sind halt auch nur Menschen...
05.06.2018  
 



[OFFTOPIC]6 sich in einer Sanduhr drehenden Sanduhren:  [...]  [/OFFTOPIC]
 
06.06.2018  
 




p.specht
Sieht interessant aus!
 
XProfan 11
So Computer sind halt auch nur Menschen...
07.06.2018  
 




Jörg
Sellmeyer
Deine "Potthässliche Uhr" würde ich aber eher in "Schön schlichte Uhr" umbenennen. Gefällt mir sehr gut.
 
XProfan X4
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
07.06.2018  
 




p.specht
Nur so zum Vergleich: Online-Flash-Uhren (hoffe, die Site ist sicher): [...] 
Das ist halt schon etwas anderes ...
Gruss
 
XProfan 11
So Computer sind halt auch nur Menschen...
07.06.2018  
 




Jörg
Sellmeyer
Na ja - sind ja einfach unterschiediche Grafinken mit (wahrscheinlich) der selben "Mechanik". Ist dir aufgefallen, dass sie nicht alle die gleiche Zeit anzeigen?
 
XProfan X4
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
07.06.2018  
 




p.specht
Verschiedene Zeitzonen?
 
XProfan 11
So Computer sind halt auch nur Menschen...
07.06.2018  
 




Jörg
Sellmeyer
Nö - nur im Sekundenbereich.
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
07.06.2018  
 




p.specht
'Simple Eieruhr'
Windowstyle 24
Window %maxx/2-100,(%maxy/2-100) - 200,77
UseIcon "MUENZE":Font 2
Declare tm&
tm&=&gettickcount + 1000*60*4\1
Showmin

Repeat

    if &gettickcount>tm&

        showNormal
        Windowtitle "ALARM seit "+str$((tm&-&gettickcount)\1000)+" s"
        CLS rgb(Rnd(256),Rnd(256),Rnd(256))
        locate 2,2
        print " FENSTER SCHLIESSEN!  "
        sound 1000,60

    else

        Windowtitle "Alarm in  "+str$((tm&-&gettickcount)\1000)+" s"

    endif

    waitinput 1000

until (%key=27) or (%key=32)

END
 
XProfan 11
So Computer sind halt auch nur Menschen...
06.10.2019  
 




Zum Quelltext


Thementitel, max. 100 Zeichen.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Beitrag  Schrift  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Themenoptionen

5.799 Betrachtungen

Unbenanntvor 0 min.
p.specht vor 13 Tagen
RICOSCH vor 16 Tagen
Stephan Sonneborn vor 23 Tagen
Michael W. vor 30 Tagen
Mehr...

Themeninformationen



AGB  |  Chat  |  Datenschutz  |  Download  |  Eingangshalle  |  Hilfe  |  Impressum  |  Mart  |  Support  |  Suche

Ein Projekt aller XProfaner, die es gibt!


Mein XProfan
Private Nachrichten
Eigenes Ablageforum
Themen-Merkliste
Eigene Beiträge
Eigene Themen
Zwischenablage
Abmelden
 Deutsch English Français Español Italia
Übersetzungen

Datenschutz


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Ich möchte keinen Cookie