Source / code snippets | | | | | 
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 ▲ |
| | |
| | 
Frank
Abbing | moreover can you whom Regulars table Yes benefit. 
Have your Thread there moved.
hey, The watch is really calm! Dürfte but heavy umzusetzen his. |
| | | | | | |
| |
Jörg
Sellmeyer | is correct - whom Regulars table I had none on the screen. I thought, there ought to too only profanes stuff mere.
particularly calm on the watch find I this sanfte Andocken on The next Zeiteineinheit. means no simples Klack - klack - klack separate More son SSSSSSsscht  |
| | | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 05/16/07 ▲ |
| | |
| |
Frank
Abbing | Have time a beginning made. The Sekundenzeiger functions Schonmal. who likes, can whom code gladly moreover ausbauen... 
CompileMarkSeparationDeclare 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='./../../Function-References/XProfan/end/'>End
|
| | | | | | |
| | 
Sebastian
Sprenger | Hm, tja, I yourself already time started Have , only the Vollständigkeit halber another Code me. SSSSSSsscht missing but unfortunately. 
CompileMarkSeparationdeclare 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
./../../Function-References/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 | 05/17/07 ▲ |
| | |
| |
Frank
Abbing | Have my code yet moreover spun. me gefällt it so already.
CompileMarkSeparationDeclare 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
|
| | | | | | |
| | 
Hubert
Binnewies | sees Real class from... and if to the Set(CharSet, 0) weglässt then runs it even under 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!" | 05/18/07 ▲ |
| | |
| |
Jörg
Sellmeyer | | Wow! Real beeindruckend! comes utterly well. |
| | | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 05/18/07 ▲ |
| | |
| |
Frank
Abbing | Have the window still in the Size veränderbar made and something Antialiasing installed:
CompileMarkSeparationDeclare 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
|
| | | | | | |
| |
Jörg
Sellmeyer | its so bedauerlich, that The Forumssoftware The Codes any so zerschossen has 
alone this Thread contains so nice value.
here time the reparierter Code Sebastian:
$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!)
'report and 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 mins(2) if(&(1)<=&(2),&(1),&(2))
window 0,0-%maxx,%maxy
a%=mins(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
|
| | | | | | |
| |
Jörg
Sellmeyer | [OFFTOPIC]Very bedauerlich, iF. Wieviele data entrapments because with so Ner Komplettsicherung on? nowadys game it still well hardly another strain, How long is a Sicherung aufhebt. with whom gigantischen Plattengrößen and nevertheless very niedrigen Preisen. If at next time so a Umstellung comes, say message what about me schick you ne Festplatte  [/OFFTOPIC]
too Franks watch runs again. though skin with the whom colours not there.
probably could one itself much the Rechnerei save, there Yes The Uhrzeit really already The perfect Gradzahlen supply. one should The 0-59 always only on 0-360° converting. Perhaps trau I there soon too time ran.
but The Funktionsungetüme are already ne strength!
$I profalt.inc
Declare sx&,sy&,Text$,x&,y&,area#,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 @Deg2wheel(1) (@Pi() * (@!(1)-90)) / 180
Def @Deg2wheel2(1) (@Pi() * (@!(1)-98+((fenx&+feny&)/2)/180)) / 180
'SETTRUECOLOR 1
sx&=496-%cyCaption
sy&=496
Windowstyle 31+512
Windowtitle "Futuristische watch, https://frabbing.de"
Window %maxx,0-x&,y&
SendMessage(%hwnd,$80,1,LoadIcon(0,32517))' WM_SetIcon Application Icon settle
Cls 0
SetWindowPos %hwnd=(%maxx/2-(sx&/2)),(%maxy/2-(sy&/2))-sx&,sy&
Text Color 0, -1
'here Have I time ne others Textfarbe taken. Frank having irgenwie the principle ostfriesische Landesflagge uses:
'weißer eagle on weißem reason...
Text Color 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))
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(@Deg2wheel(-StopAngle!)))),\
Int(y1& + CenY& + (CenY& * @Sin(@Deg2wheel(-StopAngle!)))), Int(x1& + CenX& + (CenX& * @Cos(@Deg2wheel(-StartAngle!)))), Int(y1& + CenY& + (CenY& * @Sin(@Deg2wheel(-StartAngle!)))))
USEP 0,23,RGB(180-(StopAngle!/2),0,StopAngle!/2)
ArcAPI(%hdc2,x1&, y1&, x2&, y2&, Int(x1& + CenX& + (CenX& * @Cos(@Deg2wheel(-StopAngle!)))), Int(y1& + CenY& + (CenY& * @Sin(@Deg2wheel(-StopAngle!)))),\
Int(x1& + CenX& + (CenX& * @Cos(@Deg2wheel(-StartAngle!)))), Int(y1& + CenY& + (CenY& * @Sin(@Deg2wheel(-StartAngle!)))))
'any Text Color 0,-1 Have I ex here auskommentiert and then sees one at least, what occur should
'Text Color 0, -1
Orientation StopAngle!*10
UseFont "ARIAL",20, 0, 1, 0, 0
x&=seconds&
DrawText Int(x1& + CenX& +(((x2& - x1&+24) / 2)*@Cos(@Deg2wheel2(-StopAngle!)))), Int(y1& + CenY& +(((y2& - y1&+24) / 2) *@Sin(@Deg2wheel2(-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(@Deg2wheel(-mStopAngle!)))), Int(my1& + mCenY& + (mCenY& * @Sin(@Deg2wheel(-mStopAngle!)))), Int(mx1& + mCenX& + (mCenX& * @Cos(@Deg2wheel(-mStartAngle!)))), Int(my1& + mCenY& + (mCenY& * @Sin(@Deg2wheel(-mStartAngle!)))))
USEP 0,23,@RGB(180-(mStopAngle!/2),0,mStopAngle!/2)
ArcAPI(%hdc2,mx1&, my1&, mx2&, my2&, Int(mx1& + mCenX& + (mCenX& * @Cos(@Deg2wheel(-mStopAngle!)))), Int(my1& + mCenY& + (mCenY& * @Sin(@Deg2wheel(-mStopAngle!)))), Int(mx1& + mCenX& + (mCenX& * @Cos(@Deg2wheel(-mStartAngle!)))), Int(my1& + mCenY& + (mCenY& * @Sin(@Deg2wheel(-mStartAngle!)))))
'Text Color 0, -1
Orientation mStopAngle!*10
UseFont "ARIAL",20, 0, 1, 0, 0
x&=minutes&
DrawText Int(mx1& + mCenX& + (((mx2& - mx1&+24) / 2) *@Cos(@Deg2wheel2(-mStopAngle!)))), Int(my1& + mCenY& + (((my2& - my1&+24) / 2) * @Sin(@Deg2wheel2(-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(@Deg2wheel(-hStopAngle!)))), Int(hy1& + hCenY& + (hCenY& * @Sin(@Deg2wheel(-hStopAngle!)))), Int(hx1& + hCenX& + (hCenX& * @Cos(@Deg2wheel(-hStartAngle!)))), Int(hy1& + hCenY& + (hCenY& * @Sin(@Deg2wheel(-hStartAngle!)))))
USEP 0,23,@RGB(180-(hStopAngle!/2),0,hStopAngle!/2)
ArcAPI(%hdc2,hx1&, hy1&, hx2&, hy2&, Int(hx1& + hCenX& + (hCenX& * @Cos(@Deg2wheel(-hStopAngle!)))), Int(hy1& + hCenY& + (hCenY& * @Sin(@Deg2wheel(-hStopAngle!)))), Int(hx1& + hCenX& + (hCenX& * @Cos(@Deg2wheel(-hStartAngle!)))), Int(hy1& + hCenY& + (hCenY& * @Sin(@Deg2wheel(-hStartAngle!)))))
'Text Color 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(@Deg2wheel2(-hStopAngle!)))), Int(hy1& + hCenY& + (((hy2& - hy1&+24) / 2) * @Sin(@Deg2wheel2(-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 ... | 06/03/18 ▲ |
| | |
| |
Jörg
Sellmeyer | in this Context is me time with Wikipedia a Binäruhr [...] untergekommen what about me thought me: the I will having.
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%
User Messages $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
Window Style %11010
Window Title "Binäruhr for people The %10 eyes having."
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 for sec:
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 for minutes:
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 for hours:
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 is now very " + Hex$(dt("gethour",!now)) + ":" + Hex$(dt("getmin",!now)) + ":" + Hex$(dt("getsec",!now)) + " watch :-)"),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 is now very " + Hex$(dt("gethour",!now)) + ":" + Hex$(dt("getmin",!now)) + ":" + Hex$(dt("getsec",!now)) + " watch " + Space$(seconds% \ 10) + " :-)"
EndIf
ShowTime
Wend
DeleteObject hFont&
|
| | | | | | |
|
Zum QuelltextTopic-Options | 17.899 Views |
Themeninformationenthis Topic has 6 subscriber: |
(2.606)
Deutsch
English
Français
Español
Italia