Verfasst: 26.02.2009 23:03
				
				Zum Thema Uhren, wie findet ihr eigendlich meine DesktopUhr:

Farbe mit Rechtsklick änderbar, jedoch immer nur "ins schwarz gehend"
			
Farbe mit Rechtsklick änderbar, jedoch immer nur "ins schwarz gehend"
Code: Alles auswählen
Procedure Real255(Wert)
 If Wert < 0
  ProcedureReturn 0
 ElseIf Wert > 255
  ProcedureReturn 255
 Else
  ProcedureReturn Wert
 EndIf
EndProcedure
Procedure ColorBrightness(Color, Brightness.f)
 Protected R, G, B, RGB
 R = Real255(   Red(Color) + Brightness*255 )
 G = Real255( Green(Color) + Brightness*255 )
 B = Real255(  Blue(Color) + Brightness*255 )
 ProcedureReturn RGB(R,G,B)
EndProcedure
Procedure.f Wisch(Radius)
 ProcedureReturn Pow(2,-Pow((200-Radius)/20,2))
EndProcedure
Global Color = $F0E0D0
Global Leer
LoadFont(1, "Arial", 24,#PB_Font_Bold)
CreateImage(1, 400, 400)
Procedure CreateClock()
Leer = ColorBrightness(Color, Wisch(200)*0.4111-1.0)
StartDrawing(ImageOutput(1))
 DrawingMode(1)
 DrawingFont(FontID(1))
 Box(0,0,400,400,Leer)
 For n = 200 To 100 Step -1
  Circle(200,200,n,ColorBrightness(Color, Wisch(n)*0.4-1.0))
 Next
 For w = -84 To 270 Step 6
  x = 190*Cos(w*#PI/180)+200
  y = 190*Sin(w*#PI/180)+200
  Circle(x,y,3,ColorBrightness(Color, -0.5))
 Next
 For w = -60 To 270 Step 30
  For n = 190 To 170 Step -1
   x = n*Cos(w*#PI/180)+200
   y = n*Sin(w*#PI/180)+200
   Circle(x,y,3,ColorBrightness(Color, Wisch(n)*0.4-0.6))
  Next
  x = 140*Cos(w*#PI/180)+200
  y = 140*Sin(w*#PI/180)+200
  T+1
  DrawText(x-TextWidth(Str(T))/2,y-TextHeight(Str(T))/2, Str(T), ColorBrightness(Color, -0.6))
 Next
StopDrawing()
EndProcedure
CreateClock()
CreateImage(0, 400, 400)
Procedure UpdateImage(Time)
 ResizeImage(0, 400, 400, #PB_Image_Smooth)
 StartDrawing(ImageOutput(0))
  DrawImage(ImageID(1),0,0)
  For r = 6 To 4 Step -1
   For n = 80 To 0 Step -1
    q.f = Hour(Time)*5+Minute(Time)/60*5
    x = Sin(q/30*#PI)*n+200
    y = -Cos(q/30*#PI)*n+200
    Circle(x,y,r,ColorBrightness(Color, -r*0.1-0.1))
   Next
  Next
  For r = 4 To 2 Step -1
   For n = 130 To 0 Step -1
    q.f = Minute(Time)
    x = Sin(q/30*#PI)*n+200
    y = -Cos(q/30*#PI)*n+200
    Circle(x,y,r,ColorBrightness(Color, -r*0.1-0.3))
   Next
  Next
  For r = 3 To 1 Step -1
   For n = 170 To 0 Step -1
    q.f = Second(Time)
    x = Sin(q/30*#PI)*n+200
    y = -Cos(q/30*#PI)*n+200
    Circle(x,y,r,ColorBrightness(Color, -r*0.1-0.2))
   Next
  Next
 StopDrawing()
 ResizeImage(0, 200, 200, #PB_Image_Smooth)
 SetGadgetState(0, ImageID(0))
EndProcedure
OpenWindow(1, 0, 0, 200, 200, "Desktop Uhr", #PB_Window_Invisible)
OpenWindow(0, 780, 540, 200, 200, "Desktop Uhr", #PB_Window_BorderLess|#PB_Window_ScreenCentered, WindowID(1))
 ImageGadget(0,0,0, 200, 200, ImageID(0))
StickyWindow(0, 1) 
CreatePopupMenu(1)
 MenuItem(1, "Farbe")
 MenuBar()
 MenuItem(10, "Beenden")
SetWindowLong_(WindowID(0), #GWL_EXSTYLE, GetWindowLong_(WindowID(0),#GWL_EXSTYLE)|#WS_EX_LAYERED) 
SetLayeredWindowAttributes_(WindowID(0), Leer, 255, #LWA_ALPHA|1)
WindowX = WindowX(0)
WindowY = WindowY(0)
Time = Date()
Mouse.POINT 
LastMouse.POINT 
Repeat
 LastMouse\x = Mouse\x 
 LastMouse\y = Mouse\y 
 Mouse\x = DesktopMouseX()
 Mouse\y = DesktopMouseY()
 MoveX = LastMouse\x-Mouse\x 
 MoveY = LastMouse\y-Mouse\y 
 If GetAsyncKeyState_(#VK_LBUTTON) 
  MouseL+1 
 Else 
  MouseL=0 
  Scroll=0 
 EndIf 
 If Mouse\X>WindowX And Mouse\X<WindowX+200 And Mouse\Y>WindowY And Mouse\Y<WindowY+200 And MouseL=1 
  Scroll=1 
 EndIf 
 If Scroll 
  WindowX-MoveX 
  WindowY-MoveY 
 EndIf 
 ResizeWindow(0,WindowX,WindowY,#PB_Ignore,#PB_Ignore) 
 If Time <> Date()
  Time = Date()
  UpdateImage(Time)
 EndIf
 Event = WaitWindowEvent(100)
 Select Event
  Case #PB_Event_Gadget         
   Select EventGadget()
    Case 0
     Select EventType()
      Case #PB_EventType_RightClick
       DisplayPopupMenu(1, WindowID(0))
     EndSelect
   EndSelect
  Case #PB_Event_Menu        
   Select EventMenu()
    Case 1
     Color = ColorRequester(Color)
     CreateClock()
     SetLayeredWindowAttributes_(WindowID(0), Leer, 255, #LWA_ALPHA|1)
   Case 10
     End
   EndSelect
 EndSelect
ForEver


