(1.022)  Anmelden

Deutsch
Quelltexte/ Codesnippets

Interessantes Konzept Uhr

 

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  ▲
 




Frank
Abbing
Dazu kannst du den Stammtisch ja nutzen.
Hab deinen Thread dorthin verschoben.

He, die Uhr ist wirklich cool! Dürfte aber schwer umzusetzen sein.
 
16.05.2007  ▲
 




Jörg
Sellmeyer
Stimmt - den Stammtisch hatte ich gar nicht auf dem Schirm. Ich dachte, da sollte auch nur profanes Zeug rein.

Besonders cool an der Uhr finde ich dieses sanfte Andocken an die nächste Zeiteineinheit. Also kein simples Klack - klack - klack sondern mehr son SSSSSSsscht
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
16.05.2007  ▲
 




Frank
Abbing
Hab mal einen Anfang gemacht. Der Sekundenzeiger funktioniert schonmal. Wer mag, kann den Code gerne weiter ausbauen...
KompilierenMarkierenSeparieren
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

End
 
17.05.2007  ▲
 




Sebastian
Sprenger
Hm, tja, da ich selber auch schon mal angefangen hab , nur der Vollständigkeit halber noch ein Code von mir. SSSSSSsscht fehlt aber leider.
KompilierenMarkierenSeparieren
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

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 meinen Code noch weiter gesponnen. Mir gefällt er so schon.
KompilierenMarkierenSeparieren
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 aus... und wenn man das Set(CharSet, 0) weglässt dann läuft es sogar unter 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! Echt beeindruckend! Kommt total gut.
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
18.05.2007  ▲
 




Frank
Abbing
Hab das Fenster noch in der Grösse veränderbar gemacht und etwas Antialiasing eingebaut:
KompilierenMarkierenSeparieren
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 0

    Endif

Wend

End
 
18.05.2007  ▲
 




Jörg
Sellmeyer
Es ist so bedauerlich, dass die Forumssoftware die Codes alle so zerschossen hat

Allein dieser Thread enthält so schöne Schätze.

Hier mal der reparierter Code von Sebastian:
KompilierenMarkierenSeparieren
 $I profalt.inc
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

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 denn bei so ner Komplettsicherung an? Heutzutage spielt es doch wohl kaum noch eine Rolle, wie lange man eine Sicherung aufhebt. Bei den gigantischen Plattengrößen und trotzdem sehr niedrigen Preisen. Wenn beim nächsten Mal so eine Umstellung kommt, sag Bescheid und ich schick dir ne Festplatte [/OFFTOPIC]


Auch Franks Uhr läuft wieder. Allerdings haut das mit den Farben nicht hin.
Wahrscheinlich könnte man sich vieles der Rechnerei sparen, da ja die Uhrzeit eigentlich schon die perfekten Gradzahlen liefert. Man müsste die 0-59 immer nur auf 0-360° umrechnen. Vielleicht trau ich mich da demnächst auch mal ran.

Aber die Funktionsungetüme sind schon ne Wucht!
KompilierenMarkierenSeparieren
 $I profalt.inc
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, https://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
'hier hab ich mal ne andere Textfarbe genommen. Frank hatte irgenwie das Prinzip ostfriesische Landesflagge verwendet:
'weißer Adler auf weißem Grund...
TextColor RGB($FF,0,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!)))))
            'Alle TextColor 0,-1 hab ich ab hier auskommentiert und dann sieht man zumindest, was passieren soll
            '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 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 ist mir mal bei Wikipedia eine Binäruhr  [...]  untergekommen und ich dachte mir: das will ich haben.
Et voilá...
KompilierenMarkierenSeparieren
 $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  ▲
 



12
►

Zum Quelltext


Thementitel, max. 100 Zeichen.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Beitrag  Schrift  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Themenoptionen

Ungelesen
Abonnieren
Merkliste
Hinweise
Gäste
Löschen
Ständig
Erledigt

16.859 Betrachtungen

Unbenanntvor 0 min.
RudiB.15.03.2021
ByteAttack21.01.2021
Langer30.12.2020
Michael W.29.12.2020
Mehr...

Themeninformationen

Dieses Thema hat 6 Teilnehmer:

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


Admins  |  AGB  |  Anwendungen  |  Autoren  |  Chat  |  Datenschutz  |  Download  |  Eingangshalle  |  Hilfe  |  Händlerportal  |  Impressum  |  Mart  |  Schnittstellen  |  SDK  |  Services  |  Spiele  |  Suche  |  Support

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