Source / code snippets | | | | - Page 1 - |
| Jörg Sellmeyer | [...]
P.s. Perhaps ought to one still whom Trashcan time rename in this & the or so. the Delete can Yes gladly moreover How yet gehandhabt go but its still something strange, a Posting, whom one whom others not vorenthalten would like in the Trashcan To place. |
| | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 05/16/07 ▲ |
| |
| | | | - Page 2 - |
| | p.specht
| | | | XProfan 11Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'... | 06/04/18 ▲ |
| |
| | Jörg Sellmeyer | somehow having me The watches straight gepackt. The stops I personally for very well. Probiert please times from, whether differences in the Interpreter and in the finished Compilat To notice are.
$H windows.ph
Def AppHeight(0) %WinBottom - %WinTop
Def AppWidth(0) %WinRight - %WinLeft
User Messages $10
Var hFont& = ~GetStockObject(11)
SetDialogFont hFont&
Declare hStunden&[],hMinuten&[],hSekunden&[],MaxIndexSek%,MaxIndexMin%,MaxIndexStn%
Declare hStartIcon&[]
Declare hTimeTxt&[]
Declare hours%,minutes%,sec%
Declare Done%
Var xx% = 2
Var yy% = 16 + ~GetSystemMetrics(~SM_CYCAPTION)
Window Title "Push Me - The Dezimaluhr"
Window Style %11010 | 1024
Window %maxx +10,0 - (60 * 18 -30),(3*22+~GetSystemMetrics(~SM_CYSMCAPTION)+1)
'Mainwindow cache create
Proc MakeTimeLine
Parameters hParent&,AnzX%,AnzY%,Left%,Top%,Br%,H%,AbstX%,AbstY%,Icon1$,Icon2$,txt%
Declare Arr&[],hdl&,x%,y%
x% = Left%
y% = Top%
WhileLoop AnzY%
WhileLoop 0,AnzX% -1
If %pcount = 12
'that here sees one in the momentum not. was To Testzwecken.
Create("Text",hParent&,Str $((59-&Loop) mod 10),x%,y%,Br%,H%)
Inc x%,Br% + AbstX%
Continue
EndIf
hdl& = Create("Icon",%hwnd,Icon1$,x%,y%)
SetWindowPos hdl& = (x%),(y%) - 16,16
'Kästchen produce
Arr&[&Loop] = Create("Icon",hdl&,Icon2$,0,0)
ShowWindow(Arr&[&Loop],0)
'Icons for Zeitanzeige Show and same hide
Inc x%,Br% + AbstX%
Wend
hStartIcon&[Sizeof(hStartIcon&[])] = Create("Icon",hdl&,"Weg",0,0)
'test& = Sizeof(hStartIcon&[])
ShowWindow(hStartIcon&[Sizeof(hStartIcon&[])-1],0)
Inc y%,H% + AbstY%
x% = Left%
Wend
Return Arr&[]
ENDPROC
Proc GetTimeValues
sec% = dt("getsec",!now)
minutes% = dt("getmin",!now)
hours% = dt("gethour",!now)
ENDPROC
Proc TF$
Parameters t%
Return stature$("00",t%)
ENDPROC
Proc tPrev
Parameters t%
Return If(t% = 59,0,t% - 1)
ENDPROC
Proc tNext
Parameters t%
Return If(t% = 0,59,t% - 1)
ENDPROC
Proc ShowTimeDec
Parameters Arr&[],time%,appeal%
Var mxi% = SizeOf(Arr&[])-1
Var Sleep% = 40 - time%\4
Var tPrev% = tPrev(time%)-1
Var tNext% = tNext(time%)-1
WhileLoop 0,mxi%
ShowWindow( Arr&[mxi% - &Loop],1)
$IFDEF COMPILER
'sees by me at least rather from, as if I
'Sleep in compilierten Program take.
WaitInput Sleep%
If %umessage = $10
'here on discontinue checken, so the Click aufs Cross directly works
Break
EndIf
$ELSE
Sleep Sleep%
$ENDIF
ShowWindow( Arr&[mxi% - &Loop],&Loop = time%)
SetText hTimeTxt&[appeal%-1],TF$(&Loop)
Dec Sleep%,1
Case Sleep% < 0:Sleep% = 1
If &Loop > time%
ShowWindow(Arr&[0],0)
Break
EndIf
Wend
var Icon& = SizeOf(hStartIcon&[])
If appeal% = 1
WhileLoop SizeOf(hStartIcon&[])-1,0,-1
Icon& = hStartIcon&[&Loop]
ShowWindow(Icon&,1)
WaitInput 10
ShowWindow(Icon&,0)
Waitinput 10
Case %umessage = $10:Break
Wend
ShowWindow(Arr&[mxi%],1)
EndIf
SetText hTimeTxt&[appeal%-1],TF$(time%)
ENDPROC
GetTimeValues' watch Initialisieren
'MakeTimeLine(%hwnd,60,1,18,130,16,16,1,-4,"","",1)
hSekunden&[]=MakeTimeLine(%hwnd,60,1,xx%,yy%,16,16,1,-4,"Knopf2","Weg")
hTimeTxt&[0] = Create("Text",%hwnd,TF$(sec%),AppWidth() - 26,yy%,20,12)
'Kästchen for display produce
Dec yy%,20
hMinuten&[]=MakeTimeLine(%hwnd,60,1,xx%,yy%,16,16,1,-4,"Knopf2","Wasser")
hTimeTxt&[1] = Create("Text",%hwnd,TF$(minutes%),AppWidth() - 26,yy%,20,12)
Dec yy%,20
Inc xx%,612
hStunden&[]=MakeTimeLine(%hwnd,24,1,xx%,yy%,16,16,1,-4,"Knopf2","Muenze")
hTimeTxt&[2] = Create("Text",%hwnd,TF$(hours%),AppWidth() - 26,yy%,20,12)
MaxIndexSek% = SizeOf(hSekunden&[]) - 1
'one could here too directly 59 prompt, but so remaining it for further developments flexibler
MaxIndexMin% = SizeOf(hMinuten&[]) - 1
MaxIndexStn% = SizeOf(hStunden&[]) - 1
GetTimeValues' watch Initialisieren
Cls ~GetSysColor(~COLOR_3DFACE)
SetWindowPos %hwnd = 0,0 - (60 * 18 -30),(3*22+~GetSystemMetrics(~SM_CYSMCAPTION)+1);-1
'window Show
ShowTimeDec(hSekunden&[],sec%,1)
SetText hTimeTxt&[0],TF$(sec%)
ShowTimeDec(hMinuten&[],minutes%,2)
SetText hTimeTxt&[0],TF$(sec%)
ShowTimeDec(hStunden&[],hours%,3)
SetText hTimeTxt&[0],TF$(sec%)
'sec update
While 1
WaitInput 1
GetTimeValues' Uhrzeit update
If %Umessage = $10
Break
ElseIf Val(Right$(dt("getTime",1),3)) > 500
'Time Show. The Animation begins ca 1/2 second before
If Done% <> sec%
Done% = sec%
' sec Show.
ShowTimeDec(hSekunden&[],sec%,1)
Case sec% = MaxIndexSek%:ShowTimeDec(hMinuten&[],minutes%,2)
' minutes Show
Case hours% = MaxIndexStn%:ShowTimeDec(hStunden&[],hours%,3)
' hours Show
EndIf
EndIf
Wend
|
| | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 06/05/18 ▲ |
| |
| | p.specht
| "Potthässliche Uhr"
Windowtitle "POTTHÄSSLICHE UHR":Window Style 16 | 64
'Window (%maxx-%maxy)/2,0 - %maxy,%maxy-41:Cls
Window 0,0 - %maxx,%maxy
'(CL)CopyLeft 2017-11 by P.woodpecker, Wien; No however geartete Gewähr!
var xx&=width(%hwnd):var yy&=height(%hwnd):var xh!=xx&/2:var yh!=yy&/2
declare t!,r0&,r1&,r2&,r3&,b0&,b1&,b2&,b3&,b9& ,pi2!
r0&=300 : r1&=130 : r2&=210 : r3&=260: pi2!=2*pi()
b0&=7 : b1&=28 : b2&=20 : b3&=8 : b9&=3
MCls xx&,yy&:REPEAT
t!=(val(mid$(time$(0),1,2))*60+val(mid$(time$(0),4,2))+val(mid$(time$(1),1,2))/60)*pi2!
StartPaint -1:ClS if(between(t!,2260,6785),$F0F0F0,$707070)':locate 1,1:print t!;" ";
usebrush 1,$E0E0E0:usepen 0,2*b0&,$000000:ellipsis xh!+r0&+2,yh!+r0&+2 - xh!-r0&+2,yh!-r0&+2
usebrush 0,$E0E0E0:usepen 0,b0&,$A0A000:ellipsis xh!+r0&,yh!+r0& - xh!-r0&,yh!-r0&
usepen 0,b9&,0:line xh!,0 - xh!,yy& : line 0,yh! - xx&,yh!
usepen 0,b1&,$A00000:line xh!,yh! - xh!+r1&*sin(t!/720),yh!-r1&*cos(t!/720)
usepen 0,b2&,0:line xh!,yh! - xh!+r2&*sin(t!/60),yh!-r2&*cos(t!/60)
usepen 0,b3&,200:line xh!,yh! - xh!+r3&*sin(t!),yh!-r3&*cos(t!)
EndPaint:MCopyBMP 0,0-xx&,yy& > 0,0;0
waitinput 1000:UNTIL (%key>0) or %mousepressed
end
|
| | | XProfan 11Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'... | 06/05/18 ▲ |
| |
| | | [OFFTOPIC]6 itself in a Sanduhr drehenden Sanduhren: [...] [/OFFTOPIC] |
| | | | |
| | p.specht
| | | | XProfan 11Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'... | 06/07/18 ▲ |
| |
| | Jörg Sellmeyer | your "Potthässliche Uhr" would I but sooner in "Schön adjust Uhr" rename. Gefällt me very well. |
| | | | |
| | p.specht
| only so to that comparison: Online-Flash-watches (hope, The Site is sure): [...] this is hold already something other ... greeting |
| | | XProfan 11Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'... | 06/07/18 ▲ |
| |
| | Jörg Sellmeyer | well Yes - are so simply unterschiediche Grafinken with (probably) the same "Mechanik". is you noticed, that they not any The same Time Show? |
| | | | |
| | p.specht
| | | | XProfan 11Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'... | 06/07/18 ▲ |
| |
| | Jörg Sellmeyer | Nö - only Sekundenbereich. |
| | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 06/07/18 ▲ |
| |
| | p.specht
| 'Simple Eieruhr'
|
| | | XProfan 11Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'... | 10/06/19 ▲ |
| |
| | | | | | | |
|
Zum QuelltextTopic-Options | 16.840 Views |
Themeninformationenthis Topic has 6 subscriber: |