English
Source / code snippets

Interessantes concept watch

 
- Page 1 -



Jörg
Sellmeyer
[...] 

P.s.
Perhaps ought to one still whom Trashcan time rename in this & the or so. the Delete can Yes gladly moreover How yet gehandhabt go but its still something strange, a Posting, whom one whom others not vorenthalten would like in the Trashcan To place.
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
05/16/07  
 



 
- Page 2 -



p.specht

 
XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
06/04/18  
 




Jörg
Sellmeyer
somehow having me The watches straight gepackt.
The stops I personally for very well.
Probiert please times from, whether differences in the Interpreter and in the finished Compilat To notice are.
 $H windows.ph
Def AppHeight(0) %WinBottom - %WinTop
Def AppWidth(0) %WinRight - %WinLeft
User Messages $10
Var hFont& = ~GetStockObject(11)
SetDialogFont hFont&
Declare hStunden&[],hMinuten&[],hSekunden&[],MaxIndexSek%,MaxIndexMin%,MaxIndexStn%
Declare hStartIcon&[]
Declare hTimeTxt&[]
Declare hours%,minutes%,sec%
Declare Done%
Var xx% = 2
Var yy% = 16 + ~GetSystemMetrics(~SM_CYCAPTION)
Window Title "Push Me - The Dezimaluhr"
Window Style %11010 | 1024
Window %maxx +10,0 - (60 * 18 -30),(3*22+~GetSystemMetrics(~SM_CYSMCAPTION)+1)
'Mainwindow cache create

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

                'that here sees one in the momentum not. was To 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 produce
            Arr&[&Loop] = Create("Icon",hdl&,Icon2$,0,0)
            ShowWindow(Arr&[&Loop],0)
            'Icons for Zeitanzeige Show and same hide
            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

    sec% = dt("getsec",!now)
    minutes% = dt("getmin",!now)
    hours% = dt("gethour",!now)

ENDPROC

Proc TF$

    Parameters t%
    Return stature$("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%,appeal%
    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
        'sees by me at least rather from, as if I
        'Sleep in compilierten Program take.
        WaitInput Sleep%

        If %umessage = $10

            'here on discontinue checken, so the Click aufs Cross directly works
            Break

        EndIf

         $ELSE
        Sleep Sleep%
         $ENDIF
        ShowWindow( Arr&[mxi% - &Loop],&Loop = time%)
        SetText hTimeTxt&[appeal%-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 appeal% = 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&[appeal%-1],TF$(time%)

ENDPROC

GetTimeValues' watch 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$(sec%),AppWidth() - 26,yy%,20,12)
'Kästchen for display produce
Dec yy%,20
hMinuten&[]=MakeTimeLine(%hwnd,60,1,xx%,yy%,16,16,1,-4,"Knopf2","Wasser")
hTimeTxt&[1] = Create("Text",%hwnd,TF$(minutes%),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$(hours%),AppWidth() - 26,yy%,20,12)
MaxIndexSek% = SizeOf(hSekunden&[]) - 1
'one could here too directly 59 prompt, but so remaining it for further developments flexibler
MaxIndexMin% =  SizeOf(hMinuten&[]) - 1
MaxIndexStn% =  SizeOf(hStunden&[]) - 1
GetTimeValues' watch Initialisieren
Cls ~GetSysColor(~COLOR_3DFACE)
SetWindowPos %hwnd = 0,0 - (60 * 18 -30),(3*22+~GetSystemMetrics(~SM_CYSMCAPTION)+1);-1
'window Show
ShowTimeDec(hSekunden&[],sec%,1)
SetText hTimeTxt&[0],TF$(sec%)
ShowTimeDec(hMinuten&[],minutes%,2)
SetText hTimeTxt&[0],TF$(sec%)
ShowTimeDec(hStunden&[],hours%,3)
SetText hTimeTxt&[0],TF$(sec%)
'sec update

While 1

    WaitInput 1
    GetTimeValues' Uhrzeit update

    If %Umessage = $10

        Break

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

        'Time Show.  The Animation begins ca 1/2 second before

        If Done% <> sec%

            Done% = sec%
            '    sec Show.
            ShowTimeDec(hSekunden&[],sec%,1)
            Case sec% = MaxIndexSek%:ShowTimeDec(hMinuten&[],minutes%,2)
            '   minutes Show
            Case hours% = MaxIndexStn%:ShowTimeDec(hStunden&[],hours%,3)
            '   hours Show

        EndIf

    EndIf

Wend

 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
06/05/18  
 




p.specht

"Potthässliche Uhr"
Windowtitle "POTTHÄSSLICHE UHR":Window Style 16 | 64
'Window (%maxx-%maxy)/2,0 - %maxy,%maxy-41:Cls
Window 0,0 - %maxx,%maxy
'(CL)CopyLeft 2017-11 by P.woodpecker, Wien; No however 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:ellipsis xh!+r0&+2,yh!+r0&+2 - xh!-r0&+2,yh!-r0&+2
usebrush 0,$E0E0E0:usepen 0,b0&,$A0A000:ellipsis 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
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
06/05/18  
 



[OFFTOPIC]6 itself in a Sanduhr drehenden Sanduhren:  [...]  [/OFFTOPIC]
 
06/06/18  
 




p.specht

sees interestingly from!
 
XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
06/07/18  
 




Jörg
Sellmeyer
your "Potthässliche Uhr" would I but sooner in "Schön adjust Uhr" rename. Gefällt me very well.
 
XProfan X4
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
06/07/18  
 




p.specht

only so to that comparison: Online-Flash-watches (hope, The Site is sure): [...] 
this is hold already something other ...
greeting
 
XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
06/07/18  
 




Jörg
Sellmeyer
well Yes - are so simply unterschiediche Grafinken with (probably) the same "Mechanik". is you noticed, that they not any The same Time Show?
 
XProfan X4
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
06/07/18  
 




p.specht

different Zeitzonen?
 
XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
06/07/18  
 




Jörg
Sellmeyer
Nö - only Sekundenbereich.
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
06/07/18  
 




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 since "+st$((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  "+st$((tm&-&gettickcount)\1000)+" s"

    endif

    waitinput 1000

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

END
 
XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
10/06/19  
 



p.woodpecker (06.10.2019)
'Simple Eieruhr'


4 ???
 
09/24/20  
 




Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

16.841 Views

Untitledvor 0 min.
RudiB.03/15/21
ByteAttack01/21/21
Langer12/30/20
Michael W.12/29/20
More...

Themeninformationen



Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.


all rightDatenschutzerklärung
i want none Cookie