XProfan

 $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 per Zeitanzeige Mostra 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 compilati 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 per 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 potuto hier auch direkt 59 eingeben, aber so bleibt es per 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 Mostra
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 Mostra.  Die Animation beginnt ca 1/2 Sekunde vorher

        If erledigt% <> Sekunden%

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

        EndIf

    EndIf

Wend

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

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