(674)  Registro

Español
Fuente/ Codesnippets

Interessantes Konzept Uhr

 

Jörg
Sellmeyer
[...] 

P.S.
Tal vez debería uno doch el Basura veces umbenennen en Dies & Das más o menos. Das Löschen de hecho puede gerne más como bisher gehandhabt voluntad pero es doch algo merkwürdig, una Contribución, el uno el Anderen no vorenthalten möchte en el Basura a plazieren.
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
16.05.2007  ▲
 




Frank
Abbing
Dazu kannst du el Stammtisch sí nutzen.
Hab deinen Hilo dorthin movido.

He, el Uhr es wirklich fresco! Dürfte aber schwer umzusetzen ser.
 
16.05.2007  ▲
 




Jörg
Sellmeyer
Stimmt - el Stammtisch Tuve nada en el Schirm. Pensé, como debería auch sólo profanes Zeug rein.

Besonders fresco a el Uhr finde Yo dieses sanfte Andocken a el nächste Zeiteineinheit. Also kein simples Klack - klack - klack pero mehr son SSSSSSsscht
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
16.05.2007  ▲
 




Frank
Abbing
Hab veces a la Anfang gemacht. Der Sekundenzeiger funktioniert schonmal. Wer mag, kann el código gerne más ausbauen...
KompilierenMarcaSeparación
Declare sx&,sy&,text$,x&,y&,bereich#,count&
Declare x1&, y1&, x2&, y2&, StartAngle!, StopAngle!, CenX&, CenY&
Def GetSysColor(1) !USER32,GetSysColor
Def LoadIcon(2) !USER32,LoadIconA
Def ArcApi(9) !GDI32,Arc
Def @Deg2Rad(1) (@Pi() * (@!(1)-90)) / 180
SETTRUECOLOR 1
sx&=640
sy&=480
Windowstyle 26+512
Windowtitle Test...
Window %maxx,0-x&,y&
SendMessage(%hwnd,$80,1,LoadIcon(0,32517))    WM_SetIcon  Application Icon setzen
Cls 0
SetWindowPos %hwnd=(%maxx/2-(sx&/2)),(%maxy/2-(sy&/2))-sx&,sy&
TextColor 0, -1
Set(CharSet, 0)
UseFont ARIAL,20, 0, 0, 0, 0
x1& = 120
y1& = 20
x2& = 520
y2& = 420
CenX& = (x2& - x1&) / 2
CenY& = (y2& - y1&) / 2
StopAngle! = 359
StartAngle! = 0
count&=1
SetTimer 1000

While 1

    WaitInput
    Case %key=2:BREAK
    UsePen 0,24,@RGB(0,count&+30,60-count&+30)

    Whileloop 6

        ArcAPI(%hdc,x1&, y1&, x2&, y2&, Int(x1& + CenX& + (CenX& * @Cos(@Deg2Rad(-StopAngle!)))), Int(y1& + CenY& + (CenY& * @Sin(@Deg2Rad(-StopAngle!)))), Int(x1& + CenX& + (CenX& * @Cos(@Deg2Rad(-StartAngle!)))), Int(y1& + CenY& + (CenY& * @Sin(@Deg2Rad(-StartAngle!)))))
        Orientation StopAngle!*10
        UseFont ARIAL,24, 0, 0, 0, 0
        x&=count&
        Case x&=60:x&=0
        DrawText Int(x1& + CenX& + (CenX& * 1.07*@Cos(@Deg2Rad(-StopAngle!-6)))), Int(y1& + CenY& + (CenY& * 1.07*@Sin(@Deg2Rad(-StopAngle!-6)))), Str$(x&)
        StopAngle! = StopAngle!-1
        Sleep 16

    Wend

    Inc count&

    If count&>60

        count&=1
        UsePen 0,26,0
        ArcAPI(%hdc,x1&, y1&, x2&, y2&, 0,0,0,0)

    EndIf

Wend

ref='./../../funktionsreferenzen/XProfan/end/'>End
 
17.05.2007  ▲
 




Sebastian
Sprenger
Hm, tja, como Yo También se ya veces angefangen tener , sólo el Vollständigkeit halber todavía una Code de me. SSSSSSsscht fehlt aber desafortunadamente.
KompilierenMarcaSeparación
declare polar#
def GetTextExtentPoint(4) !GDI32,GetTextExtentPoint32A

proc polarhand

    parameters x%,y%,r%,weight%,colors%,colore%,val%,max%
    declare s!,e!,x!,y!,r!,g!,b!
    val%=val% mod max%
    Einfärben
    r!=getrvalue(colors%)
    g!=getgvalue(colors%)
    b!=getbvalue(colors%)
    r!=r!+val%*(getrvalue(colore%)-r!)/max%
    g!=g!+val%*(getgvalue(colore%)-g!)/max%
    b!=b!+val%*(getbvalue(colore%)-b!)/max%
    usepen 0,weight%,rgb(r!,g!,b!)
    Ausrichten und malen
    s!=(val%/max%+.25)*pi()*2
    e!=pi()/2
    sub r%,weight% 2
    x!=x%-r%*cos(s!)
    y!=y%-r%*sin(s!)
    arc x%-r%,(y%-r%)-x%+r%,y%+r%;x!+1,y!;x%-r%*cos(e!),y%-r%*sin(e!)
    Beschriften
    orientation -val%/max%*3600
    usefont Arial,0,0,0,0,0
    textcolor 0,-1
    dim polar#,10
    char polar#,8=val%
    GetTextExtentPoint(%hdc,polar#+8,(val%>9)+1,polar#)
    s!=(val%/max%+.245)*pi()*2
    x!=x%-r%*cos(s!)-(weight%-long(polar#,0)2)*cos(s!)2
    y!=y%-r%*sin(s!)-(weight%-long(polar#,4)2)*sin(s!)2
    dispose polar#
    drawtext x!,y!,val%

endproc

proc polarclock

    parameters x%,y%,r%,weight%,space%,colorhs%,colorhe%,colorms%,colorme%,colorss%,colorse%
    polarhand x%,y%,r%,weight%,colorhs%,colorhe%,val(left$(time$(0),2)),12
    sub r%,weight%+space%
    polarhand x%,y%,r%,weight%,colorms%,colorme%,val(right$(time$(0),2)),60
    sub r%,weight%+space%
    polarhand x%,y%,r%,weight%,colorss%,colorse%,val(left$(time$(1),2)),60

endproc

declare a%
def min(2) if(&(1)<=&(2),&(1),&(2))
window 0,0-%maxx,%maxy
a%=min(width(%hwnd),height(%hwnd))
mcls a%,a%

while 1

    startpaint -1
    usepen 0,1,0
    usebrush 1,0
    rectangle 0,0-a%,a%
    polarclock a% 2,a% 2,a% 2,30,5,$0000C0,$C060FF,$00C000,$60FFC0,$C00000,$FFC060
    endpaint
    mcopybmp 0,0-a%,a%>0,0;0

endwhile

./../../funktionsreferenzen/XProfan/waitinput/'>waitinput
 
Profan² 7.0e, XProfan 9, 11.2a, FreeProfan32
Windows Vista Home Premium 32-Bit, 2.8 Ghz, 4 GB RAM
Windows Me, 1.8 Ghz, 256 MB RAM
17.05.2007  ▲
 




Frank
Abbing
Hab media Code todavía más gesponnen. Mir gefällt él así ya.
KompilierenMarcaSeparación
Declare sx&,sy&,text$,x&,y&,bereich#,seconds&,minutes&,hours&,z&,schlafen&
Declare x1&, y1&, x2&, y2&, StartAngle!, StopAngle!, CenX&, CenY&
Declare mx1&, my1&, mx2&, my2&, mStartAngle!, mStopAngle!, mCenX&, mCenY&,istmin&
Declare hx1&, hy1&, hx2&, hy2&, hStartAngle!, hStopAngle!, hCenX&, hCenY&,isthour&
Declare zusek&,zumin&,zuhour&
Def GetSysColor(1) !USER32,GetSysColor
Def LoadIcon(2) !USER32,LoadIconA
Def ArcApi(9) !GDI32,Arc
Def @Deg2Rad(1) (@Pi() * (@!(1)-90)) / 180
SETTRUECOLOR 1
sx&=496-%cyCaption
sy&=496
Windowstyle 26+512
Windowtitle Futuristische Uhr, http://frabbing.de
Window %maxx,0-x&,y&
SendMessage(%hwnd,$80,1,LoadIcon(0,32517))    WM_SetIcon  Application Icon setzen
Cls 0
SetWindowPos %hwnd=(%maxx/2-(sx&/2)),(%maxy/2-(sy&/2))-sx&,sy&
TextColor 0, -1
Set(CharSet, 0)
UseFont ARIAL,20, 0, 0, 0, 0
seconds&=val(left$(time$(1),2))
minutes&=val(right$(time$(0),2))
hours&=val(left$(time$(0),2))
Case hours&>=12:hours&=hours&-12
x1& = 80
y1& = 80
x2& = 300+x1&
y2& = 300+y1&
CenX& = (x2& - x1&) / 2
CenY& = (y2& - y1&) / 2
StopAngle! = 359.5 360-(seconds&*6)
StartAngle! = 0
mx1& = 50
my1& = 50
mx2& = 360+mx1&
my2& = 360+my1&
mCenX& = (mx2& - mx1&) / 2
mCenY& = (my2& - my1&) / 2
mStopAngle! = 359.5 360-(minutes&*6)
mStartAngle! = 0
hx1& = 20
hy1& = 20
hx2& = 420+hx1&
hy2& = 420+hy1&
hCenX& = (hx2& - hx1&) / 2
hCenY& = (hy2& - hy1&) / 2
hStopAngle! = 359.5 360-(hours&*30)
hStartAngle! = 0
zusek&=seconds&*6
Case zusek&=0:zusek&=3
zumin&=minutes&*6
Case zumin&=0:zumin&=3
zuhour&=hours&*30
Case zuhour&=0:zuhour&=3
schlafen&=1
SetTimer 50

While 1

    WaitInput
    Case %key=2:BREAK

    While 1

        If zusek&>0

            UsePen 0,28,0
            ArcAPI(%hdc2,x1&, y1&, x2&, y2&, 0,0,0,0)
            UsePen 0,26,@RGB(180-(StopAngle!/2),0,StopAngle!/2)
            ArcAPI(%hdc2,x1&, y1&, x2&, y2&, Int(x1& + CenX& + (CenX& * @Cos(@Deg2Rad(-StopAngle!)))), Int(y1& + CenY& + (CenY& * @Sin(@Deg2Rad(-StopAngle!)))), Int(x1& + CenX& + (CenX& * @Cos(@Deg2Rad(-StartAngle!)))), Int(y1& + CenY& + (CenY& * @Sin(@Deg2Rad(-StartAngle!)))))
            TextColor 0, -1
            Set(CharSet, 0)
            Orientation StopAngle!*10
            UseFont ARIAL,20, 0, 1, 0, 0
            x&=seconds&
            DrawText Int(x1& + CenX& + (CenX& * 1.09*@Cos(@Deg2Rad(-StopAngle!-6)))), Int(y1& + CenY& + (CenY& * 1.09*@Sin(@Deg2Rad(-StopAngle!-6)))), Str$(x&)
            StopAngle!=StopAngle!-1
            zusek&=zusek&-1

        EndIf

        If zumin&>0

            UsePen 0,28,0
            ArcAPI(%hdc2,mx1&, my1&, mx2&, my2&, 0,0,0,0)
            UsePen 0,26,@RGB(180-(mStopAngle!/2),0,mStopAngle!/2)
            ArcAPI(%hdc2,mx1&, my1&, mx2&, my2&, Int(mx1& + mCenX& + (mCenX& * @Cos(@Deg2Rad(-mStopAngle!)))), Int(my1& + mCenY& + (mCenY& * @Sin(@Deg2Rad(-mStopAngle!)))), Int(mx1& + mCenX& + (mCenX& * @Cos(@Deg2Rad(-mStartAngle!)))), Int(my1& + mCenY& + (mCenY& * @Sin(@Deg2Rad(-mStartAngle!)))))
            TextColor 0, -1
            Set(CharSet, 0)
            Orientation mStopAngle!*10
            UseFont ARIAL,20, 0, 1, 0, 0
            x&=minutes&
            DrawText Int(mx1& + mCenX& + (mCenX& * 1.07*@Cos(@Deg2Rad(-mStopAngle!-6)))), Int(my1& + mCenY& + (mCenY& * 1.07*@Sin(@Deg2Rad(-mStopAngle!-6)))), Str$(x&)
            mStopAngle!=mStopAngle!-1
            zumin&=zumin&-1

        EndIf

        If zuhour&>0

            UsePen 0,28,0
            ArcAPI(%hdc2,hx1&, hy1&, hx2&, hy2&, 0,0,0,0)
            UsePen 0,26,@RGB(180-(hStopAngle!/2),0,hStopAngle!/2)
            ArcAPI(%hdc2,hx1&, hy1&, hx2&, hy2&, Int(hx1& + hCenX& + (hCenX& * @Cos(@Deg2Rad(-hStopAngle!)))), Int(hy1& + hCenY& + (hCenY& * @Sin(@Deg2Rad(-hStopAngle!)))), Int(hx1& + hCenX& + (hCenX& * @Cos(@Deg2Rad(-hStartAngle!)))), Int(hy1& + hCenY& + (hCenY& * @Sin(@Deg2Rad(-hStartAngle!)))))
            TextColor 0, -1
            Set(CharSet, 0)
            Orientation hStopAngle!*10
            UseFont ARIAL,20, 0, 1, 0, 0
            x&=val(left$(time$(0),2))
            DrawText Int(hx1& + hCenX& + (hCenX& * 1.05*@Cos(@Deg2Rad(-hStopAngle!-6)))), Int(hy1& + hCenY& + (hCenY& * 1.05*@Sin(@Deg2Rad(-hStopAngle!-6)))), Str$(x&)
            hStopAngle!=hStopAngle!-1
            zuhour&=zuhour&-1

        EndIf

        If ((zusek&<=0) and (zumin&<=0) and (zuhour&<=0))

            BREAK

        EndIf

        Repaint

        If schlafen&

            Sleep 2

        Else

            Sleep 16

        EndIf

    Wend

    schlafen&=0
    x&=val(left$(time$(1),2))

    If x&<>seconds&

        seconds&=seconds&+1
        zusek&=6

        If seconds&>=60

            zusek&=3
            seconds&=0
            StopAngle! = 359.5 360-(seconds&*6)

        EndIf

    EndIf

    x&=val(right$(time$(0),2))

    If x&<>minutes&

        minutes&=minutes&+1
        zumin&=6

        If minutes&>=60

            zumin&=3
            minutes&=0
            mStopAngle! = 359.5 360-(minutes&*6)

        EndIf

    EndIf

    x&=val(left$(time$(0),2))
    Case x&>=12:x&=x&-12

    If hours&<>x&

        hours&=hours&+1
        zuhour&=30

        If hours&>=12

            zuhour&=3
            hours&=0
            hStopAngle! = 359.5 360-(hours&*30)

        EndIf

    EndIf

    Repaint

Wend

End
 
17.05.2007  ▲
 




Hubert
Binnewies
Sieht echt klasse de... y si al Conjunto(CharSet, 0) weglässt entonces se ejecuta lo incluso bajo XProfan 9.1

Hubert
 
WinXP Prof, XProfan 9.1 Newbie

Ein kluger Kopf sagte mal:
"Nach dem derzeitigen Stand der Technik ist es unmöglich Programme zu schreiben, die fehlerfrei laufen!"
18.05.2007  ▲
 




Jörg
Sellmeyer
Wow! Real beeindruckend! Kommt total bien.
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
18.05.2007  ▲
 




Frank
Abbing
Hab el Ventana aún en el Grösse veränderbar gemacht y algo Antialiasing instalado:
KompilierenMarcaSeparación
Declare sx&,sy&,text$,x&,y&,bereich#,seconds&,minutes&,hours&,z&,schlafen&,fenx&,feny&,ox&,oy&,glob&
Declare x1&, y1&, x2&, y2&, StartAngle!, StopAngle!, CenX&, CenY&
Declare mx1&, my1&, mx2&, my2&, mStartAngle!, mStopAngle!, mCenX&, mCenY&,istmin&
Declare hx1&, hy1&, hx2&, hy2&, hStartAngle!, hStopAngle!, hCenX&, hCenY&,isthour&
Declare zusek&,zumin&,zuhour&
Def GetSysColor(1) !USER32,GetSysColor
Def LoadIcon(2) !USER32,LoadIconA
Def ArcApi(9) !GDI32,Arc
Def @Deg2Rad(1) (@Pi() * (@!(1)-90)) / 180
Def @Deg2Rad2(1) (@Pi() * (@!(1)-98+((fenx&+feny&)/2)/180)) / 180
SETTRUECOLOR 1
sx&=496-%cyCaption
sy&=496
Windowstyle 31+512
Windowtitle Futuristische Uhr, http://frabbing.de
Window %maxx,0-x&,y&
SendMessage(%hwnd,$80,1,LoadIcon(0,32517))    WM_SetIcon  Application Icon setzen
Cls 0
SetWindowPos %hwnd=(%maxx/2-(sx&/2)),(%maxy/2-(sy&/2))-sx&,sy&
TextColor 0, -1
Set(CharSet, 0)
UseFont ARIAL,20, 0, 0, 0, 0
seconds&=val(left$(time$(1),2))
minutes&=val(right$(time$(0),2))
hours&=val(left$(time$(0),2))
Case hours&>=12:hours&=hours&-12
fenx&=%WinRight-%WinLeft
feny&=%WinBottom-%WinTop-%cyCaption
ox&=fenx&
oy&=feny&
x1& = 80
y1& = 80
x2& = fenx&-170+x1&
y2& = feny&-170+y1&
CenX& = (x2& - x1&) / 2
CenY& = (y2& - y1&) / 2
StopAngle! = 359.5 360-(seconds&*6)
StartAngle! = 0
mx1& = 50
my1& = 50
mx2& = fenx&-110+mx1&
my2& = feny&-110+my1&
mCenX& = (mx2& - mx1&) / 2
mCenY& = (my2& - my1&) / 2
mStopAngle! = 359.5 360-(minutes&*6)
mStartAngle! = 0
hx1& = 20
hy1& = 20
hx2& = fenx&-50+hx1&
hy2& = feny&-50+hy1&
hCenX& = (hx2& - hx1&) / 2
hCenY& = (hy2& - hy1&) / 2
hStopAngle! = 359.5 360-(hours&*30)
hStartAngle! = 0
zusek&=seconds&*6
Case zusek&=0:zusek&=3
zumin&=minutes&*6
Case zumin&=0:zumin&=3
zuhour&=hours&*30
Case zuhour&=0:zuhour&=3
schlafen&=1
SetTimer 50

While 1

    WaitInput
    Case %key=2:BREAK

    While 1

        If ((zusek&>0) or (glob&=1))

            UsePen 0,28,0
            ArcAPI(%hdc2,x1&, y1&, x2&, y2&, 0,0,0,0)
            UsePen 0,26,RGB((135-(StopAngle!/2)/1.5),0,(StopAngle!/2)/1.5)
            ArcAPI(%hdc2,x1&, y1&, x2&, y2&, Int(x1& + CenX& + (CenX& * @Cos(@Deg2Rad(-StopAngle!)))), Int(y1& + CenY& + (CenY& * @Sin(@Deg2Rad(-StopAngle!)))), Int(x1& + CenX& + (CenX& * @Cos(@Deg2Rad(-StartAngle!)))), Int(y1& + CenY& + (CenY& * @Sin(@Deg2Rad(-StartAngle!)))))
            UsePen 0,23,RGB(180-(StopAngle!/2),0,StopAngle!/2)
            ArcAPI(%hdc2,x1&, y1&, x2&, y2&, Int(x1& + CenX& + (CenX& * @Cos(@Deg2Rad(-StopAngle!)))), Int(y1& + CenY& + (CenY& * @Sin(@Deg2Rad(-StopAngle!)))), Int(x1& + CenX& + (CenX& * @Cos(@Deg2Rad(-StartAngle!)))), Int(y1& + CenY& + (CenY& * @Sin(@Deg2Rad(-StartAngle!)))))
            TextColor 0, -1
            Orientation StopAngle!*10
            UseFont ARIAL,20, 0, 1, 0, 0
            x&=seconds&
            DrawText Int(x1& + CenX& +(((x2& - x1&+24) / 2)*@Cos(@Deg2Rad2(-StopAngle!)))), Int(y1& + CenY& +(((y2& - y1&+24) / 2) *@Sin(@Deg2Rad2(-StopAngle!)))), Str$(x&)

            If glob&<>1

                StopAngle!=StopAngle!-1
                zusek&=zusek&-1

            EndIf

        EndIf

        If ((zumin&>0) or (glob&=1))

            UsePen 0,28,0
            ArcAPI(%hdc2,mx1&, my1&, mx2&, my2&, 0,0,0,0)
            UsePen 0,26,RGB((135-(mStopAngle!/2)/1.5),0,(mStopAngle!/2)/1.5)
            ArcAPI(%hdc2,mx1&, my1&, mx2&, my2&, Int(mx1& + mCenX& + (mCenX& * @Cos(@Deg2Rad(-mStopAngle!)))), Int(my1& + mCenY& + (mCenY& * @Sin(@Deg2Rad(-mStopAngle!)))), Int(mx1& + mCenX& + (mCenX& * @Cos(@Deg2Rad(-mStartAngle!)))), Int(my1& + mCenY& + (mCenY& * @Sin(@Deg2Rad(-mStartAngle!)))))
            UsePen 0,23,@RGB(180-(mStopAngle!/2),0,mStopAngle!/2)
            ArcAPI(%hdc2,mx1&, my1&, mx2&, my2&, Int(mx1& + mCenX& + (mCenX& * @Cos(@Deg2Rad(-mStopAngle!)))), Int(my1& + mCenY& + (mCenY& * @Sin(@Deg2Rad(-mStopAngle!)))), Int(mx1& + mCenX& + (mCenX& * @Cos(@Deg2Rad(-mStartAngle!)))), Int(my1& + mCenY& + (mCenY& * @Sin(@Deg2Rad(-mStartAngle!)))))
            TextColor 0, -1
            Orientation mStopAngle!*10
            UseFont ARIAL,20, 0, 1, 0, 0
            x&=minutes&
            DrawText Int(mx1& + mCenX& + (((mx2& - mx1&+24) / 2) *@Cos(@Deg2Rad2(-mStopAngle!)))), Int(my1& + mCenY& + (((my2& - my1&+24) / 2) * @Sin(@Deg2Rad2(-mStopAngle!)))), Str$(x&)

            If glob&<>1

                mStopAngle!=mStopAngle!-1
                zumin&=zumin&-1

            EndIf

        EndIf

        If ((zuhour&>0 ) or (glob&=1))

            UsePen 0,28,0
            ArcAPI(%hdc2,hx1&, hy1&, hx2&, hy2&, 0,0,0,0)
            UsePen 0,26,RGB((135-(hStopAngle!/2)/1.5),0,(hStopAngle!/2)/1.5)
            ArcAPI(%hdc2,hx1&, hy1&, hx2&, hy2&, Int(hx1& + hCenX& + (hCenX& * @Cos(@Deg2Rad(-hStopAngle!)))), Int(hy1& + hCenY& + (hCenY& * @Sin(@Deg2Rad(-hStopAngle!)))), Int(hx1& + hCenX& + (hCenX& * @Cos(@Deg2Rad(-hStartAngle!)))), Int(hy1& + hCenY& + (hCenY& * @Sin(@Deg2Rad(-hStartAngle!)))))
            UsePen 0,23,@RGB(180-(hStopAngle!/2),0,hStopAngle!/2)
            ArcAPI(%hdc2,hx1&, hy1&, hx2&, hy2&, Int(hx1& + hCenX& + (hCenX& * @Cos(@Deg2Rad(-hStopAngle!)))), Int(hy1& + hCenY& + (hCenY& * @Sin(@Deg2Rad(-hStopAngle!)))), Int(hx1& + hCenX& + (hCenX& * @Cos(@Deg2Rad(-hStartAngle!)))), Int(hy1& + hCenY& + (hCenY& * @Sin(@Deg2Rad(-hStartAngle!)))))
            TextColor 0, -1
            Orientation hStopAngle!*10
            UseFont ARIAL,20, 0, 1, 0, 0
            x&=val(left$(time$(0),2))
            DrawText Int(hx1& + hCenX& + (((hx2& - hx1&+24) / 2) *@Cos(@Deg2Rad2(-hStopAngle!)))), Int(hy1& + hCenY& + (((hy2& - hy1&+24) / 2) * @Sin(@Deg2Rad2(-hStopAngle!)))), Str$(x&)

            If glob&<>1

                hStopAngle!=hStopAngle!-1
                zuhour&=zuhour&-1

            EndIf

        EndIf

        glob&=0

        If ((zusek&<=0) and (zumin&<=0) and (zuhour&<=0))

            BREAK

        EndIf

        Repaint

        If schlafen&

            Sleep 2

        Else

            Sleep 16

        EndIf

    Wend

    schlafen&=0
    x&=val(left$(time$(1),2))

    If x&<>seconds&

        seconds&=seconds&+1
        zusek&=6

        If seconds&>=60

            zusek&=3
            seconds&=0
            StopAngle! = 359.5 360-(seconds&*6)

        EndIf

    EndIf

    x&=val(right$(time$(0),2))

    If x&<>minutes&

        minutes&=minutes&+1
        zumin&=6

        If minutes&>=60

            zumin&=3
            minutes&=0
            mStopAngle! = 359.5 360-(minutes&*6)

        EndIf

    EndIf

    x&=val(left$(time$(0),2))
    Case x&>=12:x&=x&-12

    If hours&<>x&

        hours&=hours&+1
        zuhour&=30

        If hours&>=12

            zuhour&=3
            hours&=0
            hStopAngle! = 359.5 360-(hours&*30)

        EndIf

    EndIf

    Repaint
    fenx&=%WinRight-%WinLeft
    feny&=%WinBottom-%WinTop-%cyCaption

    If ((ox&<>fenx&) or (oy&<>feny&))

        ox&=fenx&
        oy&=feny&
        x2& = fenx&-170+x1&
        y2& = feny&-170+y1&
        CenX& = (x2& - x1&) / 2
        CenY& = (y2& - y1&) / 2
        mx2& = fenx&-110+mx1&
        my2& = feny&-110+my1&
        mCenX& = (mx2& - mx1&) / 2
        mCenY& = (my2& - my1&) / 2
        hx2& = fenx&-50+hx1&
        hy2& = feny&-50+hy1&
        hCenX& = (hx2& - hx1&) / 2
        hCenY& = (hy2& - hy1&) / 2
        glob&=1
        Cls
class=s2>0 Endif Wend End
 
18.05.2007  ▲
 




Jörg
Sellmeyer
Es así bedauerlich, dass el Forumssoftware el Codes todos así zerschossen ha

Allein dieser Hilo enthält así schöne Schätze.

Hier veces el reparierter Code de Sebastian:
KompilierenMarcaSeparación
 $I profalt.inc
declarar polar#
def GetTextExtentPoint(4) "!GDI32","GetTextExtentPoint32A"

proc polarhand

    parámetros x%,y%,r%,weight%,colors%,colore%,val%,max%
    declarar s!,e!,x!,y!,r!,g!,b!
    val%=val% mod max%
    'Einfärben
    r!=getrvalue(colors%)
    g!=getgvalue(colors%)
    b!=getbvalue(colors%)
    r!=r!+val%*(getrvalue(colore%)-r!)/max%
    g!=g!+val%*(getgvalue(colore%)-g!)/max%
    b!=b!+val%*(getbvalue(colore%)-b!)/max%
    usepen 0,weight%,rgb(r!,g!,b!)
    'Ausrichten y malen
    s!=(val%/max%+.25)*pi()*2
    e!=pi()/2
    sub r%,weight% \ 2
    x!=x%-r%*cos(s!)
    y!=y%-r%*sin(s!)
    arc x%-r%,(y%-r%)-x%+r%,y%+r%;x!+1,y!;x%-r%*cos(e!),y%-r%*sin(e!)
    'Beschriften
    orientation -val%/max%*3600
    usefont Arial,0,0,0,0,0
    textcolor 0,-1
    dim polar#,10
    char polar#,8=val%
    GetTextExtentPoint(%hdc,polar#+8,(val%>9)+1,polar#)
    s!=(val%/max%+.245)*pi()*2
    x!=x%-r%*cos(s!)-(weight%-long(polar#,0)2)*cos(s!)2
    y!=y%-r%*sin(s!)-(weight%-long(polar#,4)2)*sin(s!)2
    disponer polar#
    drawtext x!,y!,val%

ENDPROC

proc polarclock

    parámetros x%,y%,r%,weight%,space%,colorhs%,colorhe%,colorms%,colorme%,colorss%,colorse%
    polarhand x%,y%,r%,weight%,colorhs%,colorhe%,val(left$(time$(0),2)),12
    sub r%,weight%+space%
    polarhand x%,y%,r%,weight%,colorms%,colorme%,val(right$(time$(0),2)),60
    sub r%,weight%+space%
    polarhand x%,y%,r%,weight%,colorss%,colorse%,val(left$(time$(1),2)),60

ENDPROC

declarar a%
def min(2) if(&(1)<=&(2),&(1),&(2))
window 0,0-%maxx,%maxy
a%=min(width(%hwnd),height(%hwnd))
mcls a%,a%

mientras que 1

    startpaint -1
    usepen 0,1,0
    usebrush 1,0
    rectangle 0,0-a%,a%
    polarclock a%\2,a%\2,a%\2,30,5,$0000C0,$C060FF,$00C000,$60FFC0,$C00000,$FFC060
    endpaint
    mcopybmp 0,0-a%,a%>0,0;0

endwhile

waitinput
 
XProfan X3
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
03.06.2018  ▲
 




Jörg
Sellmeyer
[OFFTOPIC]Sehr bedauerlich, IF. Wieviele Daten fallen porque en así ner Komplettsicherung a? Heutzutage juega lo doch wohl kaum ni Papel, como largo uno una Sicherung aufhebt. En el gigantischen Plattengrößen y trotzdem muy niedrigen Preisen. Wenn beim nächsten Tiempo así una Interruptor kommt, sag Bescheid y yo schick dir ne Festplatte [/OFFTOPIC]


Auch Franks Uhr se ejecuta otra vez. Aunque haut el con el Farben no hin.
Wahrscheinlich podría uno se vieles el Rechnerei sparen, como sí el Uhrzeit eigentlich ya el perfekten Gradzahlen liefert. Man debería el 0-59 siempre sólo en 0-360° umrechnen. Tal vez trau Yo mich como demnächst auch veces ran.

Aber el Funktionsungetüme son ya ne Wucht!
KompilierenMarcaSeparación
 $I profalt.inc
Declarar sx&,sy&,texto$,x&,y&,bereich#,seconds&,minutes&,hours&,z&,schlafen&,fenx&,feny&,ox&,oy&,glob&
Declarar x1&, y1&, x2&, y2&, StartAngle!, StopAngle!, CenX&, CenY&
Declarar mx1&, my1&, mx2&, my2&, mStartAngle!, mStopAngle!, mCenX&, mCenY&,istmin&
Declarar hx1&, hy1&, hx2&, hy2&, hStartAngle!, hStopAngle!, hCenX&, hCenY&,isthour&
Declarar zusek&,zumin&,zuhour&
Def GetSysColor(1) "!USER32","GetSysColor"
Def LoadIcon(2) "!USER32","LoadIconA"
Def ArcApi(9) "!GDI32","Arc"
Def @Deg2Rad(1) (@Pi() * (@!(1)-90)) / 180
Def @Deg2Rad2(1) (@Pi() * (@!(1)-98+((fenx&+feny&)/2)/180)) / 180
'SETTRUECOLOR 1
sx&=496-%cyCaption
sy&=496
Windowstyle 31+512
Windowtitle "Futuristische Uhr, https://frabbing.de"
Ventana %maxx,0-x&,y&
SendMessage(%hwnd,$80,1,LoadIcon(0,32517))'    WM_SetIcon  Application Icon conjunto
Cls 0
SetWindowPos %hwnd=(%maxx/2-(sx&/2)),(%maxy/2-(sy&/2))-sx&,sy&
Color del texto 0, -1
'hier tener Yo veces ne otro Textfarbe genommen. Franco hatte irgenwie el Principio ostfriesische Landesflagge verwendet:
'weißer Adler en weißem Grund...
Color del texto RGB($FF,0,0), -1
Conjunto("CharSet", 0)
UseFont "ARIAL",20, 0, 0, 0, 0
seconds&=val(left$(time$(1),2))
minutes&=val(right$(time$(0),2))
hours&=val(left$(time$(0),2))
Case hours&>=12:hours&=hours&-12
fenx&=%WinRight-%WinLeft
feny&=%WinBottom-%WinTop-%cyCaption
ox&=fenx&
oy&=feny&
x1& = 80
y1& = 80
x2& = fenx&-170+x1&
y2& = feny&-170+y1&
CenX& = (x2& - x1&) / 2
CenY& = (y2& - y1&) / 2
StopAngle! = 359.5 / 360-(seconds&*6)
StartAngle! = 0
mx1& = 50
my1& = 50
mx2& = fenx&-110+mx1&
my2& = feny&-110+my1&
mCenX& = (mx2& - mx1&) / 2
mCenY& = (my2& - my1&) / 2
mStopAngle! = 359.5 / 360-(minutes&*6)
mStartAngle! = 0
hx1& = 20
hy1& = 20
hx2& = fenx&-50+hx1&
hy2& = feny&-50+hy1&
hCenX& = (hx2& - hx1&) / 2
hCenY& = (hy2& - hy1&) / 2
hStopAngle! = 359.5 / 360-(hours&*30)
hStartAngle! = 0
zusek&=seconds&*6
Case zusek&=0:zusek&=3
zumin&=minutes&*6
Case zumin&=0:zumin&=3
zuhour&=hours&*30
Case zuhour&=0:zuhour&=3
schlafen&=1
SetTimer 50

Mientras que 1

    WaitInput
    Case %key=2:BREAK

    Mientras que 1

        If ((zusek&>0) or (glob&=1))

            USEP 0,28,0
            ArcAPI(%hdc2,x1&, y1&, x2&, y2&, 0,0,0,0)
            USEP 0,26,RGB((135-(StopAngle!/2)/1.5),0,(StopAngle!/2)/1.5)
            ArcAPI(%hdc2,x1&, y1&, x2&, y2&, Int(x1& + CenX& + (CenX& * @Cos(@Deg2Rad(-StopAngle!)))),\
            Int(y1& + CenY& + (CenY& * @Sin(@Deg2Rad(-StopAngle!)))), Int(x1& + CenX& + (CenX& * @Cos(@Deg2Rad(-StartAngle!)))), Int(y1& + CenY& + (CenY& * @Sin(@Deg2Rad(-StartAngle!)))))
            USEP 0,23,RGB(180-(StopAngle!/2),0,StopAngle!/2)
            ArcAPI(%hdc2,x1&, y1&, x2&, y2&, Int(x1& + CenX& + (CenX& * @Cos(@Deg2Rad(-StopAngle!)))), Int(y1& + CenY& + (CenY& * @Sin(@Deg2Rad(-StopAngle!)))),\
            Int(x1& + CenX& + (CenX& * @Cos(@Deg2Rad(-StartAngle!)))), Int(y1& + CenY& + (CenY& * @Sin(@Deg2Rad(-StartAngle!)))))
            'Alle Color del texto 0,-1 tener Yo de hier auskommentiert y luego sieht uno zumindest, qué passieren se
            'Color del texto 0, -1
            Orientation StopAngle!*10
            UseFont "ARIAL",20, 0, 1, 0, 0
            x&=seconds&
            DrawText Int(x1& + CenX& +(((x2& - x1&+24) / 2)*@Cos(@Deg2Rad2(-StopAngle!)))), Int(y1& + CenY& +(((y2& - y1&+24) / 2) *@Sin(@Deg2Rad2(-StopAngle!)))), Str$(x&)

            If glob&<>1

                StopAngle!=StopAngle!-1
                zusek&=zusek&-1

            EndIf

        EndIf

        If ((zumin&>0) or (glob&=1))

            USEP 0,28,0
            ArcAPI(%hdc2,mx1&, my1&, mx2&, my2&, 0,0,0,0)
            USEP 0,26,RGB((135-(mStopAngle!/2)/1.5),0,(mStopAngle!/2)/1.5)
            ArcAPI(%hdc2,mx1&, my1&, mx2&, my2&, Int(mx1& + mCenX& + (mCenX& * @Cos(@Deg2Rad(-mStopAngle!)))), Int(my1& + mCenY& + (mCenY& * @Sin(@Deg2Rad(-mStopAngle!)))), Int(mx1& + mCenX& + (mCenX& * @Cos(@Deg2Rad(-mStartAngle!)))), Int(my1& + mCenY& + (mCenY& * @Sin(@Deg2Rad(-mStartAngle!)))))
            USEP 0,23,@RGB(180-(mStopAngle!/2),0,mStopAngle!/2)
            ArcAPI(%hdc2,mx1&, my1&, mx2&, my2&, Int(mx1& + mCenX& + (mCenX& * @Cos(@Deg2Rad(-mStopAngle!)))), Int(my1& + mCenY& + (mCenY& * @Sin(@Deg2Rad(-mStopAngle!)))), Int(mx1& + mCenX& + (mCenX& * @Cos(@Deg2Rad(-mStartAngle!)))), Int(my1& + mCenY& + (mCenY& * @Sin(@Deg2Rad(-mStartAngle!)))))
            'Color del texto 0, -1
            Orientation mStopAngle!*10
            UseFont "ARIAL",20, 0, 1, 0, 0
            x&=minutes&
            DrawText Int(mx1& + mCenX& + (((mx2& - mx1&+24) / 2) *@Cos(@Deg2Rad2(-mStopAngle!)))), Int(my1& + mCenY& + (((my2& - my1&+24) / 2) * @Sin(@Deg2Rad2(-mStopAngle!)))), Str$(x&)

            If glob&<>1

                mStopAngle!=mStopAngle!-1
                zumin&=zumin&-1

            EndIf

        EndIf

        If ((zuhour&>0 ) or (glob&=1))

            USEP 0,28,0
            ArcAPI(%hdc2,hx1&, hy1&, hx2&, hy2&, 0,0,0,0)
            USEP 0,26,RGB((135-(hStopAngle!/2)/1.5),0,(hStopAngle!/2)/1.5)
            ArcAPI(%hdc2,hx1&, hy1&, hx2&, hy2&, Int(hx1& + hCenX& + (hCenX& * @Cos(@Deg2Rad(-hStopAngle!)))), Int(hy1& + hCenY& + (hCenY& * @Sin(@Deg2Rad(-hStopAngle!)))), Int(hx1& + hCenX& + (hCenX& * @Cos(@Deg2Rad(-hStartAngle!)))), Int(hy1& + hCenY& + (hCenY& * @Sin(@Deg2Rad(-hStartAngle!)))))
            USEP 0,23,@RGB(180-(hStopAngle!/2),0,hStopAngle!/2)
            ArcAPI(%hdc2,hx1&, hy1&, hx2&, hy2&, Int(hx1& + hCenX& + (hCenX& * @Cos(@Deg2Rad(-hStopAngle!)))), Int(hy1& + hCenY& + (hCenY& * @Sin(@Deg2Rad(-hStopAngle!)))), Int(hx1& + hCenX& + (hCenX& * @Cos(@Deg2Rad(-hStartAngle!)))), Int(hy1& + hCenY& + (hCenY& * @Sin(@Deg2Rad(-hStartAngle!)))))
            'Color del texto 0, -1
            Orientation hStopAngle!*10
            UseFont "ARIAL",20, 0, 1, 0, 0
            x&=val(left$(time$(0),2))
            DrawText Int(hx1& + hCenX& + (((hx2& - hx1&+24) / 2) *@Cos(@Deg2Rad2(-hStopAngle!)))), Int(hy1& + hCenY& + (((hy2& - hy1&+24) / 2) * @Sin(@Deg2Rad2(-hStopAngle!)))), Str$(x&)

            If glob&<>1

                hStopAngle!=hStopAngle!-1
                zuhour&=zuhour&-1

            EndIf

        EndIf

        glob&=0

        If ((zusek&<=0) and (zumin&<=0) and (zuhour&<=0))

            BREAK

        EndIf

        Repaint

        If schlafen&

            Sleep 2

        Más

            Sleep 16

        EndIf

    Wend

    schlafen&=0
    x&=val(left$(time$(1),2))

    If x&<>seconds&

        seconds&=seconds&+1
        zusek&=6

        If seconds&>=60

            zusek&=3
            seconds&=0
            StopAngle! = 359.5 / 360-(seconds&*6)

        EndIf

    EndIf

    x&=val(right$(time$(0),2))

    If x&<>minutes&

        minutes&=minutes&+1
        zumin&=6

        If minutes&>=60

            zumin&=3
            minutes&=0
            mStopAngle! = 359.5 / 360-(minutes&*6)

        EndIf

    EndIf

    x&=val(left$(time$(0),2))
    Case x&>=12:x&=x&-12

    If hours&<>x&

        hours&=hours&+1
        zuhour&=30

        If hours&>=12

            zuhour&=3
            hours&=0
            hStopAngle! = 359.5 / 360-(hours&*30)

        EndIf

    EndIf

    Repaint
    fenx&=%WinRight-%WinLeft
    feny&=%WinBottom-%WinTop-%cyCaption

    If ((ox&<>fenx&) or (oy&<>feny&))

        ox&=fenx&
        oy&=feny&
        x2& = fenx&-170+x1&
        y2& = feny&-170+y1&
        CenX& = (x2& - x1&) / 2
        CenY& = (y2& - y1&) / 2
        mx2& = fenx&-110+mx1&
        my2& = feny&-110+my1&
        mCenX& = (mx2& - mx1&) / 2
        mCenY& = (my2& - my1&) / 2
        hx2& = fenx&-50+hx1&
        hy2& = feny&-50+hy1&
        hCenX& = (hx2& - hx1&) / 2
        hCenY& = (hy2& - hy1&) / 2
        glob&=1
        Cls 0

    Endif

Wend

End
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
03.06.2018  ▲
 




Jörg
Sellmeyer
In diesem Zusammenhang me está veces en Wikipedia una Binäruhr  [...]  untergekommen y yo pensamiento me: el voluntad Yo haben.
Et voilá...
KompilierenMarcaSeparación
 $H windows.ph
Selección aleatoria
Declarar Hours%,Minutes%,Seconds%
Declarar x%,y%,bottom%
Declarar SecOn&[],SecOff&[],MaxIndexSec%
Declarar MinOn&[],MinOff&[],MaxIndexMin%
Declarar HoursOn&[],HoursOff&[],MaxIndexHours%
Mensajes del usuario $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%,&bucle))

    Wend

    WhileLoop 0,MaxIndexMin%

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

    Wend

    WhileLoop 0,MaxIndexHours%

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

    Wend

ENDPROC

Ventana de Estilo %11010
Título de la ventana "Binäruhr para Personas el %10 Augen haben."
Ventana 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 para Sekunden:

WhileLoop 0,6

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

    If &Loop = 3

        y% = bottom%
        Dec x%,36

    Más

        Dec y% ,34

    EndIf

    ShowWindow(SecOn&[&Loop],0)

Wend

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

WhileLoop 0,6

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

    If &Loop = 3

        y% = bottom%
        Dec x%,36

    Más

        Dec y% ,34

    EndIf

    ShowWindow(SecOn&[&Loop],0)

Wend

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

WhileLoop 0,5

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

    If &Loop = 3

        y% = bottom%
        Dec x%,36

    Más

        Dec y% ,34

    EndIf

    ShowWindow(SecOn&[&Loop],0)

Wend

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

Mientras que 1

    WaitInput 1000
    Case %umessage = $10:Romper
    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 es ahora genau " + Hex$(dt("gethour",!now)) + ":" + Hex$(dt("getmin",!now)) + ":" + Hex$(dt("getsec",!now)) + " Uhr " + Espacio$(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  ▲
 



12
►

Zum Quelltext


Título del Tema, max. 100 Signo.
 

Systemprofile:

Kein Systemprofil creado. [anlegen]

XProfan:

 Contribución  Font  Smilies  ▼ 

Bitte registro en una Contribución a verfassen.
 

Tema opciones

Unreaded
subscribe
Remember-List
Notes
guests
Delete
Constantemente
Hecho

17.717 Views

Untitledvor 0 min.
RudiB.15.03.2021
ByteAttack21.01.2021
Langer30.12.2020
Michael W.29.12.2020
Más...

Themeninformationen

Dieses Thema ha 6 subscriber:

Jörg Sellmeyer (10x)
p.specht (6x)
Frank Abbing (4x)
iF (2x)
Sebastian Sprenger (1x)
Hubert Binnewies (1x)


Admins  |  AGB  |  Applications  |  Autores  |  Chat  |  Política de Privacidad  |  Descargar  |  Entrance  |  Ayuda  |  Merchantportal  |  Pie de imprenta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Juegos  |  Búsqueda  |  Support

Ein Projekt aller XProfan, el lo son!


Mi XProfan
Privado Noticias
Eigenes Ablageforum
Temas-Merkliste
Eigene Beiträge
Eigene Temas
Zwischenablage
Cancelar
 Deutsch English Français Español Italia
Traducciones

Política de Privacidad


Wir uso Cookies sólo como Session-Cookies wegen el technischen Notwendigkeit y en uns hay no Cookies de Drittanbietern.

Wenn du hier en unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung de Informationen en unseren Cookies en XProfan.Net a.

Weitere Informationen a unseren Cookies y dazu, como du el Kontrolle darüber behältst, findest du en unserer nachfolgenden Datenschutzerklärung.

einverstandenDatenschutzerklärung
Yo möchte no Cookie