4K - Uhr mit Schlagwerk

    Diese Seite verwendet Cookies. Durch die Nutzung unserer Seite erklären Sie sich damit einverstanden, dass wir Cookies setzen. Weitere Informationen

    Unsere Datenschutzerklärung wurde aktualisiert. Mit der Nutzung unseres Forums akzeptierst Du unsere Datenschutzerklärung. Du bestätigst zudem, dass Du mindestens 16 Jahre alt bist.

    • 4K - Uhr mit Schlagwerk

      Hier noch eine kleine Analoguhr mit Schlagwerk. Beenden über das Optionsmenü (rechte Maustaste). Dort kann auch das Schlagwerk ein- und ausgeschalten und zwei verschiedene Töne ausgewählt werden. Zum Verschieben wird die Uhr am "Aufhänger" gezogen.

      [Blockierte Grafik: http://s15.postimage.org/th1y05efb/Screen_08_03_2013_13_Uhr_56_09_Sek.jpg]

      Quellcode

      1. ' 4k-Wettbewerb @Volkmar 2013
      2. $H WINDOWS.PH
      3. $H MESSAGES.PH
      4. Def DR(1) (Pi()*!(1))/180
      5. Def ZW1(2) %(1)*Cos(DR(!(2)))
      6. Def ZW2(2) %(1)*Sin(DR(!(2)))
      7. Declare String Zeit,Anz,Dat,Tag,PM,AL
      8. Declare Int Std,Min,Sek,K,WK,RF,R3,Ky
      9. Declare Double SWk,MWk,SEWk
      10. Var Int UR=200
      11. Var Int UU=200
      12. Var Int MX=(UR\2)
      13. Var Int MY=(UU\2)
      14. Var Int Bk=RGB(0,196,195)
      15. Var Int CXB=~GetSystemMetrics(~sm_CXFixedFrame)
      16. Var Int CYB=~GetSystemMetrics(~sm_CYFixedFRame)
      17. Var Int CYC=~GetSystemMetrics(~sm_CYCaption)
      18. Var Int T=1
      19. Var Int SM=1
      20. WindowTitle "Uhr"
      21. WindowStyle 16
      22. Window UR+(2*CXB),UU+CYC+(2*CXB)
      23. MCLS 2*UR,UU,Bk
      24. SWR
      25. SetTimer 300
      26. While 1
      27. WaitInput
      28. If GetActiveWindow()=%HWnd
      29. Ky=%MouseKey
      30. If Ky=2
      31. Case Menu()=1:Break
      32. EndIf
      33. EndIf
      34. Zeit=dt("GetTime",0)+":"+SubStr$(dt("GetTime",1),1,".")
      35. Dat=dt("GetDate",2)
      36. Tag=SubStr$(Dat,1,",")
      37. Dat=Trim$(SubStr$(Dat,2,"der"))
      38. If Zeit<>Anz
      39. Anz=Zeit
      40. Case Al=Zeit:WK=120
      41. Std=Val(SubStr$(Anz,1,":"))
      42. CaseNot Std:Std=24
      43. If Std>12
      44. PM="PM"
      45. Std=Std-12
      46. Else
      47. PM="AM"
      48. EndIf
      49. Min=Val(SubStr$(Anz,2,":"))
      50. Sek=Val(SubStr$(Anz,3,":"))
      51. SeWk= 6*Sek
      52. MWk=(6*Min)+(SeWk/60)
      53. SWk=30*Std+(MWk/12)
      54. StartPaint -1
      55. UsePen 0,1,Bk
      56. UseBrush 1,Bk
      57. Rectangle 0,0-2*UR,UU
      58. UsePen 0,1,0
      59. ZBl
      60. TextColor RGB(0,0,192), -1
      61. UseFont "ARIAL",20,0,0,0,0
      62. DrawText UR,MY+4,2*UR,MY+28,Dat,1
      63. Case Tag="Sonntag":TextColor RGB(240,0,0),-1
      64. DrawText UR,MY+29,2*UR,MY+48,Tag,1
      65. UseBrush 0,0
      66. UsePen 0,3,0
      67. Zeig 48,SWk
      68. UsePen 0,2,0
      69. Zeig 10,MWk
      70. UsePen 0,1,RGB(255,0,0)
      71. Zeig 2,SeWk
      72. TextColor RGB(0,0,64),-1
      73. UseFont "ARIAL",18,0,1,0,0
      74. DrawText UR,MY-48,2*UR,MY-32,PM,1
      75. CopyBMP 0,0,UR,UU>UR,0;-1
      76. EndPaint
      77. MCopyBMP UR,0-(UR*2),UU>0,0;0
      78. If WK
      79. If (Sek & 3)=0
      80. PExec("|WKSch")
      81. Dec WK
      82. EndIf
      83. Else
      84. If Sek=0
      85. If Min=0
      86. Case T:PExec("|SSch",Str$(Std),Str$(K))
      87. ElseIf Min = 15
      88. Case T:PExec("|VSch","1",Str$(K))
      89. ElseIf Min = 30
      90. Case T:PExec("|VSch","2",Str$(K))
      91. ElseIf Min = 45
      92. Case T:PExec("|VSch","3",Str$(K))
      93. EndIf
      94. EndIf
      95. EndIf
      96. EndIf
      97. EndWhile
      98. Case R3:DeleteObject R3
      99. Proc Menu
      100. Declare Int M
      101. CreateMenu
      102. AppendMenu 1,"Minimieren"
      103. AppendMenu 2,"Immer im Vordergrund"
      104. AppendMenu 3,"Ton"
      105. Case SM:CheckMenu 2,1
      106. Case T:CheckMenu 3,1
      107. If T
      108. If K
      109. AppendMenu 4,"Gong"
      110. Else
      111. AppendMenu 4,"Kuckuck"
      112. EndIf
      113. EndIf
      114. AppendMenu 5,"Wecker"
      115. AppendMenu 6, "Fensteransicht"
      116. Separator
      117. AppendMenu 10,"Ende"
      118. TrackMenu 16,16
      119. If MenuItem(1)
      120. ShowWindow(%HWnd,6)
      121. ElseIf MenuItem(2)
      122. SM=Not(SM)
      123. SWP
      124. ElseIf MenuItem(3)
      125. T=Not(T)
      126. ElseIf MenuItem(4)
      127. K=Not(K)
      128. ElseIf MenuItem(5)
      129. If WK
      130. WK=0
      131. Else
      132. AL=Input$("Weckzeit im 24-Stundenformat","Wecker",Left$(AL,5))
      133. If AL<>""
      134. Case Mid$(AL,2,1)=":":AL="0"+AL
      135. AL=Left$(AL,5)+":00"
      136. EndIf
      137. EndIf
      138. ElseIf MenuItem(6)
      139. RF=Not(RF)
      140. SWR
      141. ElseIf MenuItem(10)
      142. M=1
      143. EndIf
      144. Return M
      145. EndProc
      146. Proc SWP
      147. ~SetWindowPos(%HWnd,SM-2,0,0,0,0,$203)
      148. EndProc
      149. Proc SWR
      150. If RF
      151. DeleteObject R3
      152. R3=0
      153. Else
      154. Var Int R1=~CreateEllipticRgn(CXB,CYB+CYC,UR+CXB,UU+CYB+CYC)
      155. Var Int R2=~CreateEllipticRgn(MX+CYB-8,4,MX+12,CYB+CYC+3)
      156. R3=~CreateRectRgn(0,0,UR+(2*CYB),UU+CYB+CYC)
      157. ~CombineRgn(R3,R1,R2,~rgn_xor)
      158. DeleteObject R1
      159. DeleteObject R2
      160. EndIf
      161. ~SetWindowRgn(%HWnd,R3,0)
      162. SWP
      163. EndProc
      164. Proc ZBl
      165. Declare Int PX,PY,Z
      166. WhileLoop 0,11
      167. Case &Loop=11:UsePen 1,3,0
      168. Z=(&Loop*30)-60
      169. PX=ZW1(MY,Z)
      170. PY=ZW2(MX,Z)
      171. Line MX+UR,MY-MX+UR+PX,MY+PY
      172. EndWhile
      173. UsePen 0,1,Bk\2
      174. UseBrush 1,RGB(188,250,250)
      175. Ellipse UR+6,6-UR*2-6,UU-6
      176. EndProc
      177. Proc Zeig
      178. Parameters Int L,Double W
      179. Declare Int PX,PY
      180. W=W+90
      181. Case W>359:W=W-360
      182. PX=ZW1(MX-L,W)*-1
      183. PY=ZW2(MY-L,W)*-1
      184. Line MX,MY-(MX+PX),MY+PY
      185. EndProc
      186. Proc VS
      187. Parameters Int V,K
      188. WhileLoop V
      189. If K
      190. Sound 800,100
      191. Sound 680,130
      192. Sleep 320
      193. Else
      194. Play 44;48,2,1
      195. Sleep 200
      196. EndIf
      197. EndWhile
      198. Sleep 160
      199. EndProc
      200. Proc SSch
      201. Declare Int Z,K
      202. Z=Val(Par$(2))
      203. K=Val(Par$(3))
      204. VS 4,K
      205. WhileLoop Z
      206. If K
      207. Sound 540,140
      208. Sound 420,160
      209. Sleep 320
      210. Else
      211. Play 30;34;38,1,1
      212. Sleep 300
      213. EndIf
      214. EndWhile
      215. EndProc
      216. Proc VSch
      217. Declare Int Z,K
      218. Z=Val(Par$(2))
      219. K=Val(Par$(3))
      220. VS Z,K
      221. EndProc
      222. Proc WKSch
      223. Play 38;42;46,2,1
      224. Play 44;48;52,2,1
      225. EndProc
      Alles anzeigen
      Gruß Volkmar
    • Ja, einen Titel hatte ich nicht drin, weil von der Titelleiste ja nur der Aufhänger übrig bleibt. Und in W7 steht ja an den Symbolen in der Taskleiste nichts mehr dran, da geht nur noch die Vorschau auf, wenn ich die Maus drauf habe. Da stört das nicht. Jetzt sollte aber "Uhr" da stehen.
      Und die Weckfunktion hat auch noch rein gepaßt. Im Optionsmenü "Wecker" die Uhrzeit im 24-Stunden-Format eingeben, nur Stunden und Minuten. Der Wecker dudelt 8 Minuten oder bis zum Ausschalten, wieder über den gleichen Menüpunkt, jetzt ohne Eingabe. Die eingestellte Zeit bleibt dabei erhalten bis das Programm beendet wird. Wecker total abschalten mit Leereingabe.

      Quellcode

      1. ' 4k-Wettbewerb @Volkmar 2013
      2. $H WINDOWS.PH
      3. $H MESSAGES.PH
      4. Def DegRad(1) (Pi()*!(1))/180
      5. Def ZW1(2) %(1)*Cos(DegRad(!(2)))
      6. Def ZW2(2) %(1)*Sin(DegRad(!(2)))
      7. Struct TPoint=X&,Y&
      8. Struct TRect=X&,Y&,W&,H&
      9. Declare String Zeit,Anz,Dat,Tag,PM,AL
      10. Declare Int Std,Min,Sek,Kuck,WK
      11. Declare Double SWink,MWink,SEWink
      12. Var Int URe=200
      13. Var Int UUn=200
      14. Var Int MX=(URe\2)
      15. Var Int MY=(UUn\2)
      16. Var Int Back=RGB(0,196,195)
      17. Var Int CXB=~GetSystemMetrics(~sm_CXFixedFrame)
      18. Var Int CYB=~GetSystemMetrics(~sm_CYFixedFRame)
      19. Var Int CYC=~GetSystemMetrics(~sm_CYCaption)
      20. Var Int Rgn1=~CreateEllipticRgn(CXB,CYB+CYC,URe+CXB,UUn+CYB+CYC)
      21. Var Int Rgn2=~CreateEllipticRgn(MX+CYB-8,4,MX+12,CYB+CYC+3)
      22. Var Int Rgn3=~CreateRectRgn(0,0,URe+(2*CYB),UUn+CYB+CYC)
      23. ~CombineRgn(Rgn3,Rgn1,Rgn2,~rgn_xor)
      24. DeleteObject Rgn1
      25. DeleteObject Rgn2
      26. Var Int Ton=1
      27. Var Int SM=1
      28. WindowTitle "Uhr"
      29. WindowStyle 16
      30. Window URe+(2*CXB),UUn+CYC+(2*CXB)
      31. ~SetWindowRgn(%HWnd,Rgn3,0)
      32. ~SetWindowPos(%HWnd,SM-2,0,0,0,0,$203)
      33. SetTimer 300
      34. While 1
      35. WaitInput
      36. If IsKey(2) And (GetActiveWindow()=%HWnd)
      37. Case Menu() = 1 : Break
      38. EndIf
      39. Zeit=dt("GetTime",0)+":"+SubStr$(dt("GetTime",1),1,".")
      40. Dat=dt("GetDate",2)
      41. Tag=SubStr$(Dat, 1, ",")
      42. Dat=Trim$(SubStr$(Dat,2,"der"))
      43. If Zeit<>Anz
      44. Anz=Zeit
      45. Case Al=Zeit:WK=120
      46. Std=Val(SubStr$(Anz,1,":"))
      47. CaseNot Std:Std=24
      48. If Std>12
      49. PM="PM"
      50. Std=Std-12
      51. Else
      52. PM="AM"
      53. EndIf
      54. Min=Val(SubStr$(Anz,2,":"))
      55. Sek=Val(SubStr$(Anz,3,":"))
      56. SWink=Std
      57. SWink=30*SWink
      58. MWink=6*Min
      59. SWink=SWink+(MWink/12)
      60. SeWink= 6*Sek
      61. MCLS 2*URe,UUn,Back
      62. StartPaint -1
      63. ZBlatt
      64. TextColor RGB(0,0,192), -1
      65. UseFont "ARIAL",20,0,0,0,0
      66. DrawText URe,MY+4,2*URe,MY+28,Dat,1
      67. Case Tag="Sonntag":TextColor RGB(240 0,0),-1
      68. DrawText URe,MY+29,2*URe,MY+48,Tag,1
      69. UseBrush 0,0
      70. UsePen 0,3,0
      71. Zeiger 48,SWink
      72. UsePen 0,2,0
      73. Zeiger 10,MWink
      74. UsePen 0,1,RGB(255,0,0)
      75. Zeiger 2, SeWink
      76. TextColor RGB(0,0,64),-1
      77. UseFont "ARIAL",18,0,1,0,0
      78. DrawText URe,MY-48,2*URe,MY-32,PM,1
      79. CopyBMP 0,0,URe,UUn>URe,0;-1
      80. EndPaint
      81. MCopyBMP URe,0-(URe*2),UUn>0,0;0
      82. If WK
      83. If (Sek & 3)=0
      84. PExec("|WKSchlag")
      85. Dec WK
      86. EndIf
      87. Else
      88. If Sek=0
      89. If Min=0
      90. Case Ton:PExec("|SSchlag",Str$(Std),Str$(Kuck))
      91. ElseIf Min = 15
      92. Case Ton:PExec("|VSchlag","1",Str$(Kuck))
      93. ElseIf Min = 30
      94. Case Ton:PExec("|VSchlag","2",Str$(Kuck))
      95. ElseIf Min = 45
      96. Case Ton:PExec("|VSchlag","3",Str$(Kuck))
      97. EndIf
      98. EndIf
      99. EndIf
      100. EndIf
      101. EndWhile
      102. Proc Menu
      103. Declare Int M
      104. While IsKey(2)
      105. Sleep 20
      106. EndWhile
      107. Sleep 40
      108. CreateMenu
      109. AppendMenu 1,"Minimieren"
      110. AppendMenu 2,"Immer im Vordergrund"
      111. AppendMenu 3,"Ton"
      112. Case SM:CheckMenu 2,1
      113. Case Ton:CheckMenu 3,1
      114. If Ton
      115. If Kuck
      116. AppendMenu 4,"Gong"
      117. Else
      118. AppendMenu 4,"Kuckuck"
      119. EndIf
      120. EndIf
      121. AppendMenu 5,"Wecker"
      122. Separator
      123. AppendMenu 10,"Ende"
      124. TrackMenu 16,16
      125. If MenuItem(1)
      126. ShowWindow(%HWnd,6)
      127. ElseIf MenuItem(2)
      128. SM=Not(SM)
      129. ~SetWindowPos(%HWnd,SM-2,0,0,0,0,$203)
      130. ElseIf MenuItem(3)
      131. Ton=Not(Ton)
      132. ElseIf MenuItem(4)
      133. Kuck=Not(Kuck)
      134. ElseIf MenuItem(5)
      135. If WK
      136. WK=0
      137. Else
      138. AL=Input$("Zeit eingeben","Wecker",Left$(AL,5))
      139. If AL<>""
      140. Case Mid$(AL,2,1)=":":AL="0"+AL
      141. AL=Left$(AL,5)+":00"
      142. EndIf
      143. EndIf
      144. ElseIf MenuItem(10)
      145. M=1
      146. EndIf
      147. Return M
      148. EndProc
      149. Proc ZBlatt
      150. Declare Int PX, PY, Z
      151. WhileLoop 0,11
      152. Case &Loop=11:UsePen 1,3,0
      153. Z=(&Loop*30)-60
      154. PX=ZW1(MY,Z)
      155. PY=ZW2(MX,Z)
      156. Line MX+URe,MY-MX+URe+PX,MY+PY
      157. EndWhile
      158. UsePen 0,1,Back \ 2
      159. UseBrush 1,RGB(188,250,250)
      160. Ellipse URe+6,6-URe*2-6,UUn-6
      161. EndProc
      162. Proc Zeiger
      163. Parameters Int L, Double W
      164. Declare Int PX,PY
      165. W=W+90
      166. Case W > 359:W=W-360
      167. PX=ZW1(MX-L,W)*-1
      168. PY=ZW2(MY-L,W)*-1
      169. Line MX,MY-(MX+PX),MY+PY
      170. EndProc
      171. Proc VS
      172. Parameters Int V,K
      173. WhileLoop V
      174. If K
      175. Sound 800,100
      176. Sound 680,130
      177. sleep 320
      178. Else
      179. Play 44;48,2,1
      180. Sleep 200
      181. EndIf
      182. EndWhile
      183. Sleep 160
      184. EndProc
      185. Proc SSchlag
      186. Declare Int Z,K
      187. Z=Val(Par$(2))
      188. K=Val(Par$(3))
      189. VS 4,K
      190. WhileLoop Z
      191. If K
      192. Sound 540,140
      193. Sound 420,160
      194. Sleep 320
      195. Else
      196. Play 30;34;38,1,1
      197. Sleep 300
      198. EndIf
      199. EndWhile
      200. EndProc
      201. Proc VSchlag
      202. Declare Int Z,K
      203. Z=Val(Par$(2))
      204. K=Val(Par$(3))
      205. VS Z,K
      206. EndProc
      207. Proc WKSchlag
      208. Play 38;42;46,2,1
      209. Play 44;48;52,2,1
      210. EndProc
      Alles anzeigen
      Gruß Volkmar
    • Ich habe noch ein bißchen gequetscht und unnötige Variablen gefunden, nun ist auch noch Platz für eine andere Ansicht.

      Quellcode

      1. ' 4k-Wettbewerb @Volkmar 2013
      2. $H WINDOWS.PH
      3. $H MESSAGES.PH
      4. Def DR(1) (Pi()*!(1))/180
      5. Def ZW1(2) %(1)*Cos(DR(!(2)))
      6. Def ZW2(2) %(1)*Sin(DR(!(2)))
      7. Declare String Zeit,Anz,Dat,Tag,PM,AL
      8. Declare Int Std,Min,Sek,Kuck,WK,RF,R3
      9. Declare Double SWk,MWk,SEWk
      10. Var Int URe=200
      11. Var Int UUn=200
      12. Var Int MX=(URe\2)
      13. Var Int MY=(UUn\2)
      14. Var Int Back=RGB(0,196,195)
      15. Var Int CXB=~GetSystemMetrics(~sm_CXFixedFrame)
      16. Var Int CYB=~GetSystemMetrics(~sm_CYFixedFRame)
      17. Var Int CYC=~GetSystemMetrics(~sm_CYCaption)
      18. Var Int Ton=1
      19. Var Int SM=1
      20. WindowTitle "Uhr"
      21. WindowStyle 16
      22. Window URe+(2*CXB),UUn+CYC+(2*CXB)
      23. SWR
      24. SetTimer 300
      25. While 1
      26. WaitInput
      27. If IsKey(2) And (GetActiveWindow()=%HWnd)
      28. Case Menu()=1:Break
      29. EndIf
      30. Zeit=dt("GetTime",0)+":"+SubStr$(dt("GetTime",1),1,".")
      31. Dat=dt("GetDate",2)
      32. Tag=SubStr$(Dat, 1, ",")
      33. Dat=Trim$(SubStr$(Dat,2,"der"))
      34. If Zeit<>Anz
      35. Anz=Zeit
      36. Case Al=Zeit:WK=120
      37. Std=Val(SubStr$(Anz,1,":"))
      38. CaseNot Std:Std=24
      39. If Std>12
      40. PM="PM"
      41. Std=Std-12
      42. Else
      43. PM="AM"
      44. EndIf
      45. Min=Val(SubStr$(Anz,2,":"))
      46. Sek=Val(SubStr$(Anz,3,":"))
      47. SWk=Std
      48. SWk=30*SWk
      49. MWk=6*Min
      50. SWk=SWk+(MWk/12)
      51. SeWk= 6*Sek
      52. MCLS 2*URe,UUn,Back
      53. StartPaint -1
      54. ZBl
      55. TextColor RGB(0,0,192), -1
      56. UseFont "ARIAL",20,0,0,0,0
      57. DrawText URe,MY+4,2*URe,MY+28,Dat,1
      58. Case Tag="Sonntag":TextColor RGB(240,0,0),-1
      59. DrawText URe,MY+29,2*URe,MY+48,Tag,1
      60. UseBrush 0,0
      61. UsePen 0,3,0
      62. Zeig 48,SWk
      63. UsePen 0,2,0
      64. Zeig 10,MWk
      65. UsePen 0,1,RGB(255,0,0)
      66. Zeig 2, SeWk
      67. TextColor RGB(0,0,64),-1
      68. UseFont "ARIAL",18,0,1,0,0
      69. DrawText URe,MY-48,2*URe,MY-32,PM,1
      70. CopyBMP 0,0,URe,UUn>URe,0;-1
      71. EndPaint
      72. MCopyBMP URe,0-(URe*2),UUn>0,0;0
      73. If WK
      74. If (Sek & 3)=0
      75. PExec("|WKSch")
      76. Dec WK
      77. EndIf
      78. Else
      79. If Sek=0
      80. If Min=0
      81. Case Ton:PExec("|SSch",Str$(Std),Str$(Kuck))
      82. ElseIf Min = 15
      83. Case Ton:PExec("|VSch","1",Str$(Kuck))
      84. ElseIf Min = 30
      85. Case Ton:PExec("|VSch","2",Str$(Kuck))
      86. ElseIf Min = 45
      87. Case Ton:PExec("|VSch","3",Str$(Kuck))
      88. EndIf
      89. EndIf
      90. EndIf
      91. EndIf
      92. EndWhile
      93. Case R3:DeleteObject R3
      94. Proc Menu
      95. Declare Int M
      96. While IsKey(2)
      97. Sleep 20
      98. EndWhile
      99. Sleep 40
      100. CreateMenu
      101. AppendMenu 1,"Minimieren"
      102. AppendMenu 2,"Immer im Vordergrund"
      103. AppendMenu 3,"Ton"
      104. Case SM:CheckMenu 2,1
      105. Case Ton:CheckMenu 3,1
      106. If Ton
      107. If Kuck
      108. AppendMenu 4,"Gong"
      109. Else
      110. AppendMenu 4,"Kuckuck"
      111. EndIf
      112. EndIf
      113. AppendMenu 5,"Wecker"
      114. AppendMenu 6, "Fensteransicht"
      115. Separator
      116. AppendMenu 10,"Ende"
      117. TrackMenu 16,16
      118. If MenuItem(1)
      119. ShowWindow(%HWnd,6)
      120. ElseIf MenuItem(2)
      121. SM=Not(SM)
      122. SWP
      123. ElseIf MenuItem(3)
      124. Ton=Not(Ton)
      125. ElseIf MenuItem(4)
      126. Kuck=Not(Kuck)
      127. ElseIf MenuItem(5)
      128. If WK
      129. WK=0
      130. Else
      131. AL=Input$("Weckzeit im 24-Stundenformat","Wecker",Left$(AL,5))
      132. If AL<>""
      133. Case Mid$(AL,2,1)=":":AL="0"+AL
      134. AL=Left$(AL,5)+":00"
      135. EndIf
      136. EndIf
      137. ElseIf MenuItem(6)
      138. RF=Not(RF)
      139. SWR
      140. ElseIf MenuItem(10)
      141. M=1
      142. EndIf
      143. Return M
      144. EndProc
      145. Proc SWP
      146. ~SetWindowPos(%HWnd,SM-2,0,0,0,0,$203)
      147. EndProc
      148. Proc SWR
      149. If RF
      150. DeleteObject R3
      151. R3=0
      152. Else
      153. Var Int R1=~CreateEllipticRgn(CXB,CYB+CYC,URe+CXB,UUn+CYB+CYC)
      154. Var Int R2=~CreateEllipticRgn(MX+CYB-8,4,MX+12,CYB+CYC+3)
      155. R3=~CreateRectRgn(0,0,URe+(2*CYB),UUn+CYB+CYC)
      156. ~CombineRgn(R3,R1,R2,~rgn_xor)
      157. DeleteObject R1
      158. DeleteObject R2
      159. EndIf
      160. ~SetWindowRgn(%HWnd,R3,0)
      161. SWP
      162. EndProc
      163. Proc ZBl
      164. Declare Int PX,PY,Z
      165. WhileLoop 0,11
      166. Case &Loop=11:UsePen 1,3,0
      167. Z=(&Loop*30)-60
      168. PX=ZW1(MY,Z)
      169. PY=ZW2(MX,Z)
      170. Line MX+URe,MY-MX+URe+PX,MY+PY
      171. EndWhile
      172. UsePen 0,1,Back\2
      173. UseBrush 1,RGB(188,250,250)
      174. Ellipse URe+6,6-URe*2-6,UUn-6
      175. EndProc
      176. Proc Zeig
      177. Parameters Int L, Double W
      178. Declare Int PX,PY
      179. W=W+90
      180. Case W>359:W=W-360
      181. PX=ZW1(MX-L,W)*-1
      182. PY=ZW2(MY-L,W)*-1
      183. Line MX,MY-(MX+PX),MY+PY
      184. EndProc
      185. Proc VS
      186. Parameters Int V,K
      187. WhileLoop V
      188. If K
      189. Sound 800,100
      190. Sound 680,130
      191. sleep 320
      192. Else
      193. Play 44;48,2,1
      194. Sleep 200
      195. EndIf
      196. EndWhile
      197. Sleep 160
      198. EndProc
      199. Proc SSch
      200. Declare Int Z,K
      201. Z=Val(Par$(2))
      202. K=Val(Par$(3))
      203. VS 4,K
      204. WhileLoop Z
      205. If K
      206. Sound 540,140
      207. Sound 420,160
      208. Sleep 320
      209. Else
      210. Play 30;34;38,1,1
      211. Sleep 300
      212. EndIf
      213. EndWhile
      214. EndProc
      215. Proc VSch
      216. Declare Int Z,K
      217. Z=Val(Par$(2))
      218. K=Val(Par$(3))
      219. VS Z,K
      220. EndProc
      221. Proc WKSch
      222. Play 38;42;46,2,1
      223. Play 44;48;52,2,1
      224. EndProc
      Alles anzeigen
      Gruß Volkmar
    • Ich muß nochmal korrigieren. Da war ein böses Speicherleck drin. Häufiger MCLS-Aufruf geht eben nicht, irgendwann läuft das gegen die Wand. Beim Umbau ließen sich sogar noch ein paar Byte sparen :lol:

      Quellcode

      1. ' 4k-Wettbewerb @Volkmar 2013
      2. $H WINDOWS.PH
      3. $H MESSAGES.PH
      4. Def DR(1) (Pi()*!(1))/180
      5. Def ZW1(2) %(1)*Cos(DR(!(2)))
      6. Def ZW2(2) %(1)*Sin(DR(!(2)))
      7. Declare String Zeit,Anz,Dat,Tag,PM,AL
      8. Declare Int Std,Min,Sek,K,WK,RF,R3,Ky
      9. Declare Double SWk,MWk,SEWk
      10. Var Int UR=200
      11. Var Int UU=200
      12. Var Int MX=(UR\2)
      13. Var Int MY=(UU\2)
      14. Var Int Bk=RGB(0,196,195)
      15. Var Int CXB=~GetSystemMetrics(~sm_CXFixedFrame)
      16. Var Int CYB=~GetSystemMetrics(~sm_CYFixedFRame)
      17. Var Int CYC=~GetSystemMetrics(~sm_CYCaption)
      18. Var Int T=1
      19. Var Int SM=1
      20. WindowTitle "Uhr"
      21. WindowStyle 16
      22. Window UR+(2*CXB),UU+CYC+(2*CXB)
      23. MCLS 2*UR,UU,Bk
      24. SWR
      25. SetTimer 300
      26. While 1
      27. WaitInput
      28. If GetActiveWindow()=%HWnd
      29. Ky=%MouseKey
      30. If Ky=2
      31. Case Menu()=1:Break
      32. EndIf
      33. EndIf
      34. Zeit=dt("GetTime",0)+":"+SubStr$(dt("GetTime",1),1,".")
      35. Dat=dt("GetDate",2)
      36. Tag=SubStr$(Dat,1,",")
      37. Dat=Trim$(SubStr$(Dat,2,"der"))
      38. If Zeit<>Anz
      39. Anz=Zeit
      40. Case Al=Zeit:WK=120
      41. Std=Val(SubStr$(Anz,1,":"))
      42. CaseNot Std:Std=24
      43. If Std>12
      44. PM="PM"
      45. Std=Std-12
      46. Else
      47. PM="AM"
      48. EndIf
      49. Min=Val(SubStr$(Anz,2,":"))
      50. Sek=Val(SubStr$(Anz,3,":"))
      51. SeWk= 6*Sek
      52. MWk=(6*Min)+(SeWk/60)
      53. SWk=30*Std+(MWk/12)
      54. StartPaint -1
      55. UsePen 0,1,Bk
      56. UseBrush 1,Bk
      57. Rectangle 0,0-2*UR,UU
      58. UsePen 0,1,0
      59. ZBl
      60. TextColor RGB(0,0,192), -1
      61. UseFont "ARIAL",20,0,0,0,0
      62. DrawText UR,MY+4,2*UR,MY+28,Dat,1
      63. Case Tag="Sonntag":TextColor RGB(240,0,0),-1
      64. DrawText UR,MY+29,2*UR,MY+48,Tag,1
      65. UseBrush 0,0
      66. UsePen 0,3,0
      67. Zeig 48,SWk
      68. UsePen 0,2,0
      69. Zeig 10,MWk
      70. UsePen 0,1,RGB(255,0,0)
      71. Zeig 2,SeWk
      72. TextColor RGB(0,0,64),-1
      73. UseFont "ARIAL",18,0,1,0,0
      74. DrawText UR,MY-48,2*UR,MY-32,PM,1
      75. CopyBMP 0,0,UR,UU>UR,0;-1
      76. EndPaint
      77. MCopyBMP UR,0-(UR*2),UU>0,0;0
      78. If WK
      79. If (Sek & 3)=0
      80. PExec("|WKSch")
      81. Dec WK
      82. EndIf
      83. Else
      84. If Sek=0
      85. If Min=0
      86. Case T:PExec("|SSch",Str$(Std),Str$(K))
      87. ElseIf Min = 15
      88. Case T:PExec("|VSch","1",Str$(K))
      89. ElseIf Min = 30
      90. Case T:PExec("|VSch","2",Str$(K))
      91. ElseIf Min = 45
      92. Case T:PExec("|VSch","3",Str$(K))
      93. EndIf
      94. EndIf
      95. EndIf
      96. EndIf
      97. EndWhile
      98. Case R3:DeleteObject R3
      99. Proc Menu
      100. Declare Int M
      101. CreateMenu
      102. AppendMenu 1,"Minimieren"
      103. AppendMenu 2,"Immer im Vordergrund"
      104. AppendMenu 3,"Ton"
      105. Case SM:CheckMenu 2,1
      106. Case T:CheckMenu 3,1
      107. If T
      108. If K
      109. AppendMenu 4,"Gong"
      110. Else
      111. AppendMenu 4,"Kuckuck"
      112. EndIf
      113. EndIf
      114. AppendMenu 5,"Wecker"
      115. AppendMenu 6, "Fensteransicht"
      116. Separator
      117. AppendMenu 10,"Ende"
      118. TrackMenu 16,16
      119. If MenuItem(1)
      120. ShowWindow(%HWnd,6)
      121. ElseIf MenuItem(2)
      122. SM=Not(SM)
      123. SWP
      124. ElseIf MenuItem(3)
      125. T=Not(T)
      126. ElseIf MenuItem(4)
      127. K=Not(K)
      128. ElseIf MenuItem(5)
      129. If WK
      130. WK=0
      131. Else
      132. AL=Input$("Weckzeit im 24-Stundenformat","Wecker",Left$(AL,5))
      133. If AL<>""
      134. Case Mid$(AL,2,1)=":":AL="0"+AL
      135. AL=Left$(AL,5)+":00"
      136. EndIf
      137. EndIf
      138. ElseIf MenuItem(6)
      139. RF=Not(RF)
      140. SWR
      141. ElseIf MenuItem(10)
      142. M=1
      143. EndIf
      144. Return M
      145. EndProc
      146. Proc SWP
      147. ~SetWindowPos(%HWnd,SM-2,0,0,0,0,$203)
      148. EndProc
      149. Proc SWR
      150. If RF
      151. DeleteObject R3
      152. R3=0
      153. Else
      154. Var Int R1=~CreateEllipticRgn(CXB,CYB+CYC,UR+CXB,UU+CYB+CYC)
      155. Var Int R2=~CreateEllipticRgn(MX+CYB-8,4,MX+12,CYB+CYC+3)
      156. R3=~CreateRectRgn(0,0,UR+(2*CYB),UU+CYB+CYC)
      157. ~CombineRgn(R3,R1,R2,~rgn_xor)
      158. DeleteObject R1
      159. DeleteObject R2
      160. EndIf
      161. ~SetWindowRgn(%HWnd,R3,0)
      162. SWP
      163. EndProc
      164. Proc ZBl
      165. Declare Int PX,PY,Z
      166. WhileLoop 0,11
      167. Case &Loop=11:UsePen 1,3,0
      168. Z=(&Loop*30)-60
      169. PX=ZW1(MY,Z)
      170. PY=ZW2(MX,Z)
      171. Line MX+UR,MY-MX+UR+PX,MY+PY
      172. EndWhile
      173. UsePen 0,1,Bk\2
      174. UseBrush 1,RGB(188,250,250)
      175. Ellipse UR+6,6-UR*2-6,UU-6
      176. EndProc
      177. Proc Zeig
      178. Parameters Int L,Double W
      179. Declare Int PX,PY
      180. W=W+90
      181. Case W>359:W=W-360
      182. PX=ZW1(MX-L,W)*-1
      183. PY=ZW2(MY-L,W)*-1
      184. Line MX,MY-(MX+PX),MY+PY
      185. EndProc
      186. Proc VS
      187. Parameters Int V,K
      188. WhileLoop V
      189. If K
      190. Sound 800,100
      191. Sound 680,130
      192. Sleep 320
      193. Else
      194. Play 44;48,2,1
      195. Sleep 200
      196. EndIf
      197. EndWhile
      198. Sleep 160
      199. EndProc
      200. Proc SSch
      201. Declare Int Z,K
      202. Z=Val(Par$(2))
      203. K=Val(Par$(3))
      204. VS 4,K
      205. WhileLoop Z
      206. If K
      207. Sound 540,140
      208. Sound 420,160
      209. Sleep 320
      210. Else
      211. Play 30;34;38,1,1
      212. Sleep 300
      213. EndIf
      214. EndWhile
      215. EndProc
      216. Proc VSch
      217. Declare Int Z,K
      218. Z=Val(Par$(2))
      219. K=Val(Par$(3))
      220. VS Z,K
      221. EndProc
      222. Proc WKSch
      223. Play 38;42;46,2,1
      224. Play 44;48;52,2,1
      225. EndProc
      Alles anzeigen


      Gruß Volkmar