PureBasic Forums - English

Posted: **Tue Feb 21, 2006 7:33 pm**

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

Posted: **Tue Feb 21, 2006 8:50 pm**

Sorry, but....

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

Posted: **Tue Feb 21, 2006 8:55 pm**

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

Posted: **Tue Feb 21, 2006 8:57 pm**

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

Posted: **Tue Feb 21, 2006 9:18 pm**

Just a joke

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

Posted: **Tue Feb 21, 2006 9:23 pm**

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

Posted: **Tue Feb 21, 2006 9:24 pm**

Ooh! .. naughty person ..

Graham

Posted: **Tue Feb 21, 2006 9:30 pm**

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

PureBasic Forums - English

Desktop Clock

Desktop Clock