Desktop Clock

[GWS]

Code updated For 5.20+

Hi,

This is my first PB program, so if anyone can see any way of improving the code, I'd be interested ..

I find it a useful tool to remind me how fast time is passing while coding. You can drag it around with the mouse ..

Code: Select all

;   PureBasic - Window clock
;   GWS - Feb 2006

screenwidth = GetSystemMetrics_(0)
screenheight = GetSystemMetrics_(1)

Style = #PB_Window_BorderLess

; open a window and make it topmost ..
hWnd1 = OpenWindow(1, (screenwidth-60)/2, 0, 60, 18, "", style)
SetWindowPos_(WindowID(1), #HWND_TOPMOST, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE)

;_______________________________________________

; subroutines ..
Procedure Timer(tnum,time)
  ; create a Windows timer ..
  SetTimer_(WindowID(1),tnum,time,0)
EndProcedure

Procedure settime()
  
  ; display the time ..
  StartDrawing(WindowOutput(1))           
  DrawingMode(1)                         
  FrontColor(RGB(0, 250, 250))
  DrawingFont(FontID(0))
  
  m$=Str(Minute(Date()))
  If Len(m$) = 1
    m$ = "0" + m$
  EndIf
  
  h$=Str(Hour(Date()))
  If Len(h$) = 1
    h$ = "0" + h$
  EndIf
  
  t$ = h$ + ":" + m$
  ; clear the previous text ..         
  Box(8, 0, 35, 16 ,RGB(80, 80, 80) )
  DrawText(12, 2,t$)
  ;       (     
  StopDrawing()
  
EndProcedure

;_______________________________________________

; set the window background color ..
hBrush = CreateSolidBrush_(RGB(80, 80, 80))
SetClassLong_(hWnd1, #GCL_HBRBACKGROUND, hBrush)
InvalidateRect_(hWnd1, #Null, #True)

; create an Exit button ..

ButtonGadget(1, 50, 0, 10, 18, "")

; set the drawing font and size ..
LoadFont(0,"Times New Roman",8)

; first time display ..
settime()

; start a 5 second timer ..
Timer(1,5000)


; window message loop ...
;_______________________________________________

Repeat
  
  Event = WaitWindowEvent()
  
  
  Select Event
      
    Case #PB_Event_CloseWindow
      Quit = 1
      
    Case #PB_Event_Gadget
      Select EventGadget()
          ; exit button pressed ..
        Case 1
          Quit = 1       
      EndSelect
      
      ; mouse left button down message, so the window can be dragged if required ..
    Case #WM_LBUTTONDOWN
      SendMessage_(WindowID(1), #WM_SYSCOMMAND, #SC_MOVE + #HTCAPTION, 0)
      
    Case #WM_TIMER
      ; timer routine - update the clock every 5 seconds ..
      Select EventwParam()
        Case 1
          settime()
      EndSelect
  EndSelect
  
  
Until Quit = 1

; clean up ..

DeleteObject_(hBrush)
KillTimer_(WindowID(1),1)
CloseWindow(1)


End


  

Watch out for line wrapping ..

all the best,

Graham

[Hroudtwolf]

Sorry, but....

..errors in following lines 11, 18, 26,56, 27,24....

[Num3]

For PB4

Code: Select all

;   PureBasic - Window clock
;   GWS - Feb 2006

screenwidth = GetSystemMetrics_(0)
screenheight = GetSystemMetrics_(1)

Style = #PB_Window_BorderLess

; open a window and make it topmost ..
hWnd1 = OpenWindow(1, (screenwidth-60)/2, 0, 60, 18, style, "")
SetWindowPos_(WindowID(1), #HWND_TOPMOST, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE)

;_______________________________________________

; subroutines ..
Procedure Timer(tnum,time)
; create a Windows timer ..
  SetTimer_(WindowID(1),tnum,time,0)
EndProcedure

Procedure settime()

; display the time ..
  StartDrawing(WindowOutput(1))           
  DrawingMode(1)                         
  FrontColor(RGB(0, 250, 250))
  DrawingFont(FontID(0))
 
  m$=Str(Minute(Date()))
  If Len(m$) = 1
    m$ = "0" + m$
  EndIf
 
  h$=Str(Hour(Date()))
  If Len(h$) = 1
    h$ = "0" + h$
  EndIf
 
  t$ = h$ + ":" + m$
; clear the previous text ..         
  Box(8, 0, 35, 16 ,RGB(80, 80, 80) )
  ;Locate(12, 2)
  DrawText(12,2,t$)     
  StopDrawing()

EndProcedure

;_______________________________________________

; set the window background color ..
hBrush = CreateSolidBrush_(RGB(80, 80, 80))
SetClassLong_(hWnd1, #GCL_HBRBACKGROUND, hBrush)
InvalidateRect_(hWnd1, #Null, #True)
 
; create an Exit button ..
CreateGadgetList(WindowID(1))
ButtonGadget(1, 50, 0, 10, 18, "")

; set the drawing font and size ..
LoadFont(0,"Times New Roman",8)

; first time display ..
settime()

; start a 5 second timer ..
Timer(1,5000)

 
; window message loop ...
;_______________________________________________
 
Repeat

  Event = WaitWindowEvent()
 
 
  Select Event
 
    Case #PB_Event_CloseWindow
      Quit = 1
     
    Case #PB_Event_Gadget
      Select EventGadget()
; exit button pressed ..
        Case 1
          Quit = 1       
      EndSelect
     
; mouse left button down message, so the window can be dragged if required ..
    Case #WM_LBUTTONDOWN
      SendMessage_(WindowID(1), #WM_SYSCOMMAND, #SC_MOVE + #HTCAPTION, 0)
     
    Case #WM_TIMER
; timer routine - update the clock every 5 seconds ..
      Select EventwParam()
        Case 1
          settime()
      EndSelect
  EndSelect
 

Until Quit = 1

; clean up ..

DeleteObject_(hBrush)
KillTimer_(WindowID(1),1)
CloseWindow(1)

 
End

[GWS]

Hello Hr .. .. working perfectly here in 3.94 ..
What version are you using ?

Just realised, I've probably posted this in the wrong place ..

Hey, Ho!

Graham

[Hroudtwolf]

Just a joke

I use PB 4.00. I just wanted to annoy you.

[Joakim Christiansen]

Nice clock you got!
I made a smaller version of it for PB 4:

Code: Select all

OpenWindow(0,GetSystemMetrics_(0)/2-25,0,50,18,#PB_Window_BorderLess,"Clock")
SetWindowPos_(WindowID(0),#HWND_TOPMOST,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE)
CreateGadgetList(WindowID(0))
ButtonGadget(0,40,0,10,18,"")

Repeat
  Select WaitWindowEvent(1000)
    Case #WM_LBUTTONDOWN
      SendMessage_(WindowID(0),#WM_SYSCOMMAND,#SC_MOVE+#HTCAPTION,0)
    Case #PB_Event_Gadget
      End
  EndSelect
  StartDrawing(WindowOutput(0))
    DrawingMode(1)
    Box(0,0,40,18,#Black)
    DrawText(2,1,RSet(Str(Hour(Date())),2,"0")+":"+RSet(Str(Minute(Date())),2,"0"),#Green)
  StopDrawing()
ForEver

[GWS]

Ooh! .. naughty person ..

Graham

[GWS]

Wow Joakim .. that's very compact

I can see I'm going to have to try V4, since most folk seem to have moved to it .. I'll try to follow what you've done ..

all the best,

Graham