TimePicker Control

netmaestro · Post by **netmaestro** » Wed Sep 20, 2006 4:17 pm

I set out with the idea of using a simple spinner to select time values, and the further I got into it the more I realized what a huge task it is. After a great deal of work I believe I pretty much have it beat now, here's my TimePicker gadget. If you can make suggestions for improvement, please do!

Code: Select all

;***************************************************** 
;   Program:          TimePickerGadget 
;   Author:           netmaestro 
;   Date:             September 19, 2006 
;   Target OS:        Windows All 
;   Target Compiler:  PureBasic 4.0 + 
;   License:          Free, Use any way you wish, 
;                     credit appreciated but not 
;                     required. 
;****************************************************** 
; 
Global _lastgadget, _shour, _smin, _ssec, _sampm, _oldupdown, _oldampm, _oldproc, _updown 

Procedure SetClock() 
  ; // TODO 
EndProcedure 

ProcedureDLL TimePicker_GetHours() 
  If GetGadgetText(_sampm) = "PM" 
   ProcedureReturn Val(GetGadgetText(_shour)) + 12
  Else 
    ProcedureReturn Val(GetGadgetText(_shour)) 
  EndIf 
EndProcedure 

ProcedureDLL TimePicker_GetMinutes() 
  ProcedureReturn Val(GetGadgetText(_smin)) 
EndProcedure 

ProcedureDLL TimePicker_GetSeconds() 
  ProcedureReturn Val(GetGadgetText(_ssec)) 
EndProcedure 

Procedure ampmproc(hwnd,msg,wparam,lparam) 
  result = CallWindowProc_(_oldampm,hwnd,msg,wparam,lparam) 
  Select msg 
    Case #WM_LBUTTONDOWN 
      GetWindowRect_(hwnd,@_editpos.RECT) 
      SetCursorPos_(_editpos\right,_editpos\top) 
      SendMessage_(hwnd,#EM_SETSEL,0,-1) 
      _lastgadget = hwnd 
    Case #WM_SETFOCUS 
      SendMessage_(hwnd,#EM_SETSEL,0,-1) 
      _lastgadget = hwnd 
    Case #WM_KILLFOCUS 
      SendMessage_(hwnd,#EM_SETSEL,0,0) 
      _lastgadget = 0 
    Case #WM_KEYDOWN 
      If GetGadgetText(GetDlgCtrlID_(hwnd)) = "AM" 
        SetGadgetText(GetDlgCtrlID_(hwnd),"PM") 
        SendMessage_(hwnd,#EM_SETSEL,0,-1) 
      Else 
        SetGadgetText(GetDlgCtrlID_(hwnd),"AM") 
        SendMessage_(hwnd,#EM_SETSEL,0,-1) 
      EndIf 
  EndSelect 
  ProcedureReturn result 
EndProcedure 

Procedure timeproc(hwnd,msg,wparam,lparam) 
  result = CallWindowProc_(_oldproc,hwnd,msg,wparam,lparam) 
  Protected upperlimit, _hourgadget 
  If GetDlgCtrlID_(hwnd) = _shour 
    lowerlimit = 1 
    _hourgadget = #True 
    upperlimit = 12 
    firstcharlimit = '1' 
    lastcharlimit = '2' 
  Else 
    lowerlimit = 0 
    _hourgadget = #False 
    firstcharlimit = '5' 
    lastcharlimit = '9' 
    upperlimit = 59 
  EndIf 
  Select msg 
    Case #WM_LBUTTONDOWN 
      GetWindowRect_(hwnd,@_editpos.RECT) 
      SetCursorPos_(_editpos\right,_editpos\top) 
      SendMessage_(hwnd,#EM_SETSEL,0,-1) 
      _lastgadget = hwnd 
    Case #WM_SETFOCUS 
      SendMessage_(hwnd,#EM_SETSEL,0,-1) 
      _lastgadget = hwnd 
    Case #WM_KILLFOCUS 
      SetGadgetText(GetDlgCtrlID_(hwnd),RSet(GetGadgetText(GetDlgCtrlID_(hwnd)), 2,"0")) 
      SendMessage_(hwnd,#EM_SETSEL,0,0) 
      _lastgadget = 0 
    Case #WM_CHAR 
      pos = SendMessage_(hwnd,#EM_GETSEL,0,0) & $FFFF 
      Select pos 
        Case 1 
          If wparam < '0' Or wparam > firstcharlimit 
            If wparam <> 8 
              SendMessage_(hwnd,#EM_UNDO,0,0) 
              SendMessage_(hwnd,#EM_SETSEL,0,-1)    
            EndIf 
          EndIf 
        Case 2 
          If _hourgadget 
            tmp = Val(Left(GetGadgetText(_shour),1)) 
            If tmp > 0 
              lastcharlimit = '2' 
            Else 
              lastcharlimit = '9' 
            EndIf 
          EndIf 
          If wparam < '0' Or wparam > lastcharlimit 
            If wparam <> 8 
              SendMessage_(hwnd,#EM_UNDO,0,0) 
              SendMessage_(hwnd,#EM_SETSEL,0,-1)    
             EndIf 
          Else 
            SendMessage_(hwnd,#EM_SETSEL,0,-1)      
            SetClock() 
          EndIf 
      EndSelect    
    Case #WM_KEYDOWN 
      Select wparam 
        Case #VK_UP 
          _valtxt = Val(GetGadgetText(GetDlgCtrlID_(hwnd))) 
          _valtxt+1 
          If _hourgadget And _valtxt = 12 
            If GetGadgetText(_sampm) = "AM" 
              SetGadgetText(_sampm, "PM") 
            Else 
              SetGadgetText(_sampm, "AM") 
            EndIf 
          EndIf 
          If _valtxt > upperlimit 
            _valtxt = lowerlimit 
            SetGadgetText(GetDlgCtrlID_(hwnd),RSet(Str(_valtxt),2,"0")) 
            If GetDlgCtrlID_(hwnd) = _ssec 
              SendMessage_(GadgetID(_smin),#WM_KEYDOWN,#VK_UP,0) 
            ElseIf GetDlgCtrlID_(hwnd) = _smin 
              SendMessage_(GadgetID(_shour),#WM_KEYDOWN,#VK_UP,0) 
            EndIf 
          EndIf 
          SetGadgetText(GetDlgCtrlID_(hwnd),RSet(Str(_valtxt),2,"0")) 
          SendMessage_(hwnd,#EM_SETSEL,0,-1) 
          SetClock() 
        Case #VK_DOWN 
          _valtxt = Val(GetGadgetText(GetDlgCtrlID_(hwnd))) 
          _valtxt-1 
          If _hourgadget And _valtxt = 11 
            If GetGadgetText(_sampm) = "AM" 
              SetGadgetText(_sampm, "PM") 
            Else 
              SetGadgetText(_sampm, "AM") 
            EndIf 
          EndIf 
          If _valtxt < lowerlimit 
            _valtxt = upperlimit  
            SetGadgetText(GetDlgCtrlID_(hwnd),RSet(Str(_valtxt),2,"0")) 
            If GetDlgCtrlID_(hwnd) = _ssec 
              SendMessage_(GadgetID(_smin),#WM_KEYDOWN,#VK_DOWN,0) 
            ElseIf GetDlgCtrlID_(hwnd) = _smin 
              SendMessage_(GadgetID(_shour),#WM_KEYDOWN,#VK_DOWN,0) 
            EndIf 
          EndIf 
          SetGadgetText(GetDlgCtrlID_(hwnd),RSet(Str(_valtxt),2,"0")) 
          SendMessage_(hwnd,#EM_SETSEL,0,-1)      
          SetClock() 
      EndSelect 
  EndSelect 
  ProcedureReturn result 
EndProcedure 

Procedure updownproc(hwnd,msg,wparam,lparam) 
  result = CallWindowProc_(_oldupdown,hwnd,msg,wparam,lparam) 
  If _lastgadget 
    _target = _lastgadget 
  Else 
    _target = GadgetID(_sampm) 
  EndIf 
  Select msg 
    Case #WM_KILLFOCUS 
      If GetAsyncKeyState_(#VK_TAB) & 32768 
        SetFocus_(GadgetID(_shour)) 
      EndIf 
    Case #WM_LBUTTONDOWN 
      If _target 
        If lparam >> 16 > 13 
          SendMessage_(_target,#WM_KEYDOWN,#VK_DOWN,0) 
        Else 
          SendMessage_(_target,#WM_KEYDOWN,#VK_UP,0) 
        EndIf 
      EndIf 
    Case #WM_TIMER 
      GetCursorPos_(@cp.POINT) 
      MapWindowPoints_(0,hwnd,@cp,1) 
      If cp\y > 13 
        SendMessage_(_target,#WM_KEYDOWN,#VK_DOWN,0) 
      Else 
       SendMessage_(_target,#WM_KEYDOWN,#VK_UP,0) 
      EndIf 
  EndSelect 
  ProcedureReturn result 
EndProcedure 

ProcedureDLL TimePickerGadget(gadget, x, y) 

  *unpacked = AllocateMemory(5376) 
  UnpackMemory(?PicPak, *unpacked) 
  _img1 = CatchImage(#PB_Any, *unpacked, 5376) 
  
  DataSection 
    PicPak: 
    Data.b $4A,$43,$00,$15,$00,$00,$3C,$EE,$28,$70,$A4,$A9,$D0,$20,$A6,$51,$A4,$62,$4A,$28 
    Data.b $23,$C0,$28,$4D,$94,$BA,$31,$C0,$18,$09,$44,$88,$A2,$F2,$30,$08,$6C,$A1,$5D,$D1 
    Data.b $7F,$0A,$F5,$87,$41,$F1,$8C,$09,$EA,$56,$A1,$48,$00,$AF,$8F,$64,$2F,$10,$75,$63 
    Data.b $50,$FC,$DE,$75,$80,$51,$F5,$FF,$78,$54,$79,$D7,$01,$46,$58,$7D,$85,$41,$00,$00 
    Data.b $10,$89 
    PicPakend: 
  EndDataSection 

  _cont = ContainerGadget(gadget, x,y,115,26) 
    _updownCtrlID = 7000+Random(1000) ; Choose a unique #gadget for the updown control 
    While IsGadget(_updownCtrlID) 
      _updownCtrlID = 7000+Random(1000) 
    Wend 
    _updown = CreateWindowEx_(0,"msctls_updown32","",#WS_CHILD|#WS_VISIBLE,96,0,20,22,GadgetID(_cont),_updownCtrlID,GetModuleHandle_(0),0) 
    _cont2 = ContainerGadget(#PB_Any,0,1,95,21,#PB_Container_Flat) 
      _imgg1 = ImageGadget(#PB_Any,0,0,0,0,ImageID(_img1)) 
      DisableGadget(_imgg1, 1) 
      _shour = StringGadget(#PB_Any,8,3,16,14,"",#PB_String_BorderLess) 
      _smin = StringGadget(#PB_Any,32,3,16,14,"",#PB_String_BorderLess) 
      _ssec = StringGadget(#PB_Any,55,3,16,14,"",#PB_String_BorderLess) 
      _sampm = StringGadget(#PB_Any,71,3,16,14,"",#PB_String_BorderLess|#PB_String_ReadOnly) 
    CloseGadgetList() 
  CloseGadgetList() 
  SendMessage_(GadgetID(_shour),#EM_LIMITTEXT,2,0) 
  SendMessage_(GadgetID(_smin),#EM_LIMITTEXT,2,0) 
  SendMessage_(GadgetID(_ssec),#EM_LIMITTEXT,2,0) 
  _oldupdown = SetWindowLong_(_updown,#GWL_WNDPROC,@updownproc())  
  _oldampm = SetWindowLong_(GadgetID(_sampm),#GWL_WNDPROC,@ampmproc()) 
  _oldproc = SetWindowLong_(GadgetID(_shour),#GWL_WNDPROC,@timeproc()) 
  _oldproc = SetWindowLong_(GadgetID(_smin),#GWL_WNDPROC,@timeproc()) 
  _oldproc = SetWindowLong_(GadgetID(_ssec),#GWL_WNDPROC,@timeproc()) 
  SetGadgetColor(_sampm,#PB_Gadget_BackColor,#White) 
  ShowWindow_(GadgetID(_cont),#SW_SHOW) 
  SetGadgetText(_smin, RSet(Str(Minute(Date())),2,"0")) 
  SetGadgetText(_ssec, RSet(Str(Second(Date())),2,"0")) 
  If Hour(Date()) >= 12 
    SetGadgetText(_shour, RSet(Str(Hour(Date())-12),2,"0")) 
    SetGadgetText(_sampm, "PM") 
  Else 
    SetGadgetText(_shour, RSet(Str(Hour(Date())),2,"0")) 
    SetGadgetText(_sampm, "AM") 
  EndIf 
  ProcedureReturn _cont 
EndProcedure

And here's a little test prog:

Code: Select all

IncludeFile "TimePicker.pb"

OpenWindow(0,0,0,320,240,"",$CF0001)
CreateGadgetList(WindowID(0))
gadget = TimePickerGadget(#PB_Any, 90, 100)
ButtonGadget(0,90,130,100,20,"Get Time Values")

Repeat
  ev = WaitWindowEvent()
  If ev=#PB_Event_Gadget
    If EventGadget()=0
      Debug TimePicker_GetHours()
      Debug TimePicker_GetMinutes()
      Debug TimePicker_GetSeconds()
    EndIf
  EndIf  
Until ev=#WM_CLOSE

If somebody posts in that there's already a premade control that does this, I'm going to have a litter of kittens...

srod · Post by **srod** » Wed Sep 20, 2006 5:00 pm

Nice one.

I like the way you've used multiple string gadgets there. Makes it very 'steady'.

I tried validating multiple 'field' input in a single string gadget once and it was bloody awful. Wish I'd thought of doing it this way! doh!

I'll remember this.

Thanks.

NoahPhense · Post by **NoahPhense** » Wed Sep 20, 2006 5:11 pm

Very nice..

- np

netmaestro · Post by **netmaestro** » Wed Sep 20, 2006 5:16 pm

Thanks, I had a lot of fun writing it. How I came up with the idea really can be traced back to how I learned most of my meager API skills, which is tips from Sparkie. He put me on to Greatis' Windowse, a truly indispensable tool for sleuthing window details. I ran that and hovered the mouse over the Control Panel applet's time picker and with fingers crossed, hoped for something like "sysctl_timepick32" or similar. NO SUCH LUCK. Every field showed "Edit" class with a different window handle. Uh oh... danger.. hard work ahead...

srod · Post by **srod** » Wed Sep 20, 2006 5:21 pm

Where do I lay my grubby hands on this tool?

netmaestro · Post by **netmaestro** » Wed Sep 20, 2006 5:26 pm

http://www.greatis.com/delphicb/windowse/

srod · Post by **srod** » Wed Sep 20, 2006 5:34 pm

Thanks.

What a great little tool.

Joakim Christiansen · Post by **Joakim Christiansen** » Wed Sep 20, 2006 5:37 pm

srod wrote:Thanks.

What a great little tool.

Indeed, I was looking for something like this!

Flype · Post by **Flype** » Wed Sep 20, 2006 9:41 pm

ohh, just like Scout on amigaos.
really useful app. thank you for the link.

netmaestro · Post by **netmaestro** » Sun Oct 01, 2006 3:37 am

Aw for crying out loud!! :roll: :roll: :roll:

Code: Select all

#DTS_TIMEFORMAT = $9
OpenWindow(0,0,0,320,240,"Somebody Just Shoot Me...",$CF0001)
InitCommonControls_()
dtp = CreateWindowEx_(0,"SysDateTimePick32","",#WS_CHILD|#WS_VISIBLE|#DTS_TIMEFORMAT,100,100,100,22,WindowID(0),99,GetModuleHandle_(0),0)
Repeat:Until WaitWindowEvent()=#WM_CLOSE

That's a whole day's hard work wasted. Why didn't MS just use one of these for their control panel applet? It would have saved me a lot of trouble.

rsts · Post by **rsts** » Sun Oct 01, 2006 5:56 am

rotflol

who was it said "what goes around comes around"?

Musta been talking about a spinnergadget.

Anyway, it sure was some nice code

cheers

Psychophanta · Post by **Psychophanta** » Sun Oct 01, 2006 10:44 am

netmaestro wrote:If you can make suggestions for improvement, please do!

You could add a button to allow to automatically synchronize your PC date and time to the world time (Universal Time Coordinated).
This is my program to do that:

Code: Select all

;**********************************************
;*   Program:          GetUTCTime             *
;*   Author:           Albert (Psychophanta)  *
;*   Date:             July, 2006             *
;**********************************************
;
Structure UTCSafe
  connectionID.l
  port.w
  UTCServer.s
EndStructure
Procedure MyOpenNetworkConnection(*conn.UTCSafe)
  *conn\connectionID=OpenNetworkConnection(*conn\UTCServer,*conn\port)
EndProcedure
Procedure.b GetUTCTime(port.w=13);<- Default TCP/IP port to do this task is 13
  Static Networkinitialized.b=0
  If Networkinitialized.b=0
    If InitNetwork():Networkinitialized.b=1
    Else:MessageRequester("Error", "Can't initialize network !",0):ProcedureReturn 0
    EndIf
  EndIf
  Protected t.l,Thread.l,date.l,Datebuffer.s=Space(1000),UTCServers.l=14,Dim UTC.s(UTCServers-1),Connection.UTCSafe,systime.SYSTEMTIME
  UTC(0)="208.184.49.9"; "nist1.ny.glassey.com", "Abovenet, New York City"
  UTC(1)="129.6.15.28"; "time-a.nist.gov", "NIST, Gaithersburg, Maryland"
  UTC(2)="129.6.15.29"; "time-b.nist.gov", "NIST, Gaithersburg, Maryland"
  UTC(3)="132.163.4.101"; "time-a.timefreq.bldrdoc.gov", "NIST, Boulder, Colorado"
  UTC(4)="132.163.4.102"; "time-b.timefreq.bldrdoc.gov", "NIST, Boulder, Colorado"
  UTC(5)="132.163.4.103"; "time-c.timefreq.bldrdoc.gov", "NIST, Boulder, Colorado"
  UTC(6)="128.138.140.44"; "utcnist.colorado.edu", "University of Colorado, Boulder"
  UTC(7)="192.43.244.18"; "time.nist.gov", "NCAR, Boulder, Colorado"
  UTC(8)="131.107.1.10"; "time-nw.nist.gov", "Microsoft, Redmond, Washington"
  UTC(9)="63.149.208.50"; "nist1.datum.com", "Datum, San Jose, California"
  UTC(10)="216.200.93.8"; "nist1.dc.glassey.com", "Abovenet, Virginia"
  UTC(11)="207.126.103.204"; "nist1.sj.glassey.com", "Abovenet, San Jose, California"
  UTC(12)="207.200.81.113"; "nist1.aol-ca.truetime.com", "TrueTime, AOL facility, Sunnyvale, California"
  UTC(13)="205.188.185.33"; "nist1.aol-va.truetime.com", "TrueTime, AOL facility, Virginia"
  For t=0 To UTCServers-1
    Connection.UTCSafe\UTCServer=UTC(t):Connection\port=port.w
    Thread.l=CreateThread(@MyOpenNetworkConnection(),@Connection.UTCSafe)
    If WaitThread(Thread,2000)=0:KillThread(Thread):Connection\connectionID=0:EndIf
    If Connection\connectionID
      ReceiveNetworkData(Connection\connectionID,@DateBuffer,1000)
      date.l=ParseDate("%yy/%mm/%dd/%hh/%ii/%ss",Mid(DateBuffer,8,2)+"/"+Mid(DateBuffer,11,2)+"/"+Mid(DateBuffer,14,2)+"/"+Mid(DateBuffer,17,2)+"/"+Mid(DateBuffer,20,2)+"/"+Mid(DateBuffer,23,2))
      systime\wYear=Year(date)
      systime\wMonth=Month(date)
      systime\wDayOfWeek=DayOfWeek(date)
      systime\wDay=Day(date)
      systime\wHour=Hour(date)
      systime\wMinute=Minute(date)
      systime\wSecond=Second(date)
      systime\wMilliseconds=0
      SetSystemTime_(@systime)
      CloseNetworkConnection(Connection\connectionID)
      MessageRequester("SUCCESS!","DATE and TIME was successful updated via UTC Server !",0)
      ProcedureReturn 1
    ElseIf t>=UTCServers-1
      MessageRequester("Error","Can't connect to UTC Servers !",0):ProcedureReturn 0
    EndIf
  Next
EndProcedure

;DO IT:
GetUTCTime()

Nice avatar you have got

techjunkie · Post by **techjunkie** » Fri Feb 02, 2007 8:54 pm

netmaestro wrote:That's a whole day's hard work wasted. Why didn't MS just use one of these for their control panel applet? It would have saved me a lot of trouble.

Hehe... so much work! (but I think your's where much better looking)

r_hyde · Post by **r_hyde** » Sat Feb 17, 2007 5:15 am

If you can make suggestions for improvement, please do!

How 'bout the ability to use more than one of these at the same time?

(you can have more than one, but the functions to get hour/min/sec don't take a #gadget parameter so you can really only use one)

r_hyde · Post by **r_hyde** » Sat Feb 17, 2007 3:42 pm

I managed to get multiple TimePickers running in the same project, and made some minor cosmetic tweaks to make the gadget suit my personal taste a bit better. Figured I'd share the results here (please forgive the poor formatting due to long lines

)

Code: Select all

;***************************************************** 
;   Program:          TimePickerGadget 
;   Author:           netmaestro 
;   Date:             September 19, 2006 
;   Target OS:        Windows All 
;   Target Compiler:  PureBasic 4.0 + 
;   License:          Free, Use any way you wish, 
;                     credit appreciated but not 
;                     required. 
;*****************************************************
;   Tweaked by:       Roger Hyde
;   Date:             February 16, 2007
;   Changes:
;     Modified to allow the use of more than one
;     TimePickerGadget per project, plus some
;     minor cosmetic stuff;)
;*****************************************************

Global _oldupdown.l, _oldampm.l, _oldproc.l;, _lastgadget.l

Structure TimePicker
  _cont.l
  _cont2.l
  _updownCtrlID.l
  _imgg1.l
  _img1.l
  _shour.l
  _smin.l
  _ssec.l
  _sampm.l
  _updown.l
  _hilitecolor.l
  _lastgadget.l
EndStructure

Global NewList tp_gadget.TimePicker()

Procedure SetClock(gadgetnum.l) 
  ; // TODO 
EndProcedure 

ProcedureDLL TimePicker_GetHours(gadgetnum.l)
  result.l = -1
  ForEach tp_gadget()
    If gadgetnum = tp_gadget()\_cont
      If GetGadgetText(tp_gadget()\_sampm) = "PM" 
       result = Val(GetGadgetText(tp_gadget()\_shour)) + 12 
      Else 
        result = Val(GetGadgetText(tp_gadget()\_shour)) 
      EndIf
      Break
    EndIf
  Next
  ProcedureReturn result
EndProcedure 

ProcedureDLL TimePicker_GetMinutes(gadgetnum.l) 
  result.l = -1
  ForEach tp_gadget()
    If gadgetnum = tp_gadget()\_cont
      result = Val(GetGadgetText(tp_gadget()\_smin))
      Break
    EndIf
  Next
  ProcedureReturn result
EndProcedure 

ProcedureDLL TimePicker_GetSeconds(gadgetnum.l)
  result.l = -1
  ForEach tp_gadget()
    If gadgetnum = tp_gadget()\_cont
      result = Val(GetGadgetText(tp_gadget()\_ssec)) 
      Break
    EndIf
  Next
  ProcedureReturn result
EndProcedure 

Procedure ampmproc(hwnd,msg,wparam,lparam)
  HideCaret_(hwnd)
  If msg = #WM_LBUTTONDOWN Or msg = #WM_SETFOCUS Or msg = #WM_KILLFOCUS Or msg = #WM_KEYDOWN 
    debugme.l = GetDlgCtrlID_(hwnd)
    ForEach tp_gadget()
      If GetDlgCtrlID_(hwnd) = tp_gadget()\_sampm
        Select msg 
          Case #WM_LBUTTONDOWN 
            GetWindowRect_(hwnd,@_editpos.RECT) 
            SendMessage_(hwnd,#EM_SETSEL,0,0) 
            tp_gadget()\_lastgadget = hwnd 
          Case #WM_SETFOCUS 
            SendMessage_(hwnd,#EM_SETSEL,0,0)
            SetGadgetColor(GetDlgCtrlID_(hwnd), #PB_Gadget_BackColor, tp_gadget()\_hilitecolor) 
            tp_gadget()\_lastgadget = hwnd 
          Case #WM_KILLFOCUS 
            SendMessage_(hwnd,#EM_SETSEL,0,0)
            SetGadgetColor(GetDlgCtrlID_(hwnd), #PB_Gadget_BackColor, #White) 
            tp_gadget()\_lastgadget = 0 
          Case #WM_KEYDOWN 
            If GetGadgetText(GetDlgCtrlID_(hwnd)) = "AM" 
              SetGadgetText(GetDlgCtrlID_(hwnd),"PM") 
              SendMessage_(hwnd,#EM_SETSEL,0,0) 
            Else 
              SetGadgetText(GetDlgCtrlID_(hwnd),"AM") 
              SendMessage_(hwnd,#EM_SETSEL,0,0) 
            EndIf 
        EndSelect
        Break
      EndIf
    Next
  EndIf
  result = CallWindowProc_(_oldampm,hwnd,msg,wparam,lparam) 
  ProcedureReturn result
EndProcedure 

Procedure timeproc(hwnd,msg,wparam,lparam)
  HideCaret_(hwnd)
  If msg = #WM_LBUTTONDOWN Or msg = #WM_SETFOCUS Or msg = #WM_KILLFOCUS Or msg = #WM_CHAR Or msg = #WM_KEYDOWN
    debugme.l = GetDlgCtrlID_(hwnd)
    ForEach tp_gadget()
      If (GetDlgCtrlID_(hwnd) = tp_gadget()\_shour) Or (GetDlgCtrlID_(hwnd) = tp_gadget()\_smin) Or (GetDlgCtrlID_(hwnd) = tp_gadget()\_ssec)
        Protected upperlimit, _hourgadget 
        If GetDlgCtrlID_(hwnd) = tp_gadget()\_shour 
          lowerlimit = 1 
          _hourgadget = #True 
          upperlimit = 12 
          firstcharlimit = '1' 
          lastcharlimit = '2' 
        Else 
          lowerlimit = 0 
          _hourgadget = #False 
          firstcharlimit = '5' 
          lastcharlimit = '9' 
          upperlimit = 59 
        EndIf 
        Select msg 
          Case #WM_LBUTTONDOWN 
            GetWindowRect_(hwnd,@_editpos.RECT) 
            SendMessage_(hwnd,#EM_SETSEL,0,0) 
            tp_gadget()\_lastgadget = hwnd 
          Case #WM_SETFOCUS 
            SendMessage_(hwnd,#EM_SETSEL,0,0)
            SetGadgetColor(GetDlgCtrlID_(hwnd), #PB_Gadget_BackColor, tp_gadget()\_hilitecolor)
            tp_gadget()\_lastgadget = hwnd 
          Case #WM_KILLFOCUS 
            SetGadgetText(GetDlgCtrlID_(hwnd),RSet(GetGadgetText(GetDlgCtrlID_(hwnd)), 2,"0")) 
            SendMessage_(hwnd,#EM_SETSEL,0,0)
            SetGadgetColor(GetDlgCtrlID_(hwnd), #PB_Gadget_BackColor, #White) 
            tp_gadget()\_lastgadget = 0 
          Case #WM_CHAR 
            pos = SendMessage_(hwnd,#EM_GETSEL,0,0) & $FFFF 
            Select pos 
              Case 1 
                If wparam < '0' Or wparam > firstcharlimit 
                  If wparam <> 8 
                    SendMessage_(hwnd,#EM_UNDO,0,0) 
                    SendMessage_(hwnd,#EM_SETSEL,0,0)    
                  EndIf 
                EndIf 
              Case 2 
                If _hourgadget 
                  tmp = Val(Left(GetGadgetText(tp_gadget()\_shour),1)) 
                  If tmp > 0 
                    lastcharlimit = '2' 
                  Else 
                    lastcharlimit = '9' 
                  EndIf 
                EndIf 
                If wparam < '0' Or wparam > lastcharlimit 
                  If wparam <> 8 
                    SendMessage_(hwnd,#EM_UNDO,0,0) 
                    SendMessage_(hwnd,#EM_SETSEL,0,-1)    
                   EndIf 
                Else 
                  SendMessage_(hwnd,#EM_SETSEL,0,-1)      
                  SetClock(tp_gadget()\_cont) 
                EndIf 
            EndSelect    
          Case #WM_KEYDOWN 
            Select wparam 
              Case #VK_UP 
                _valtxt = Val(GetGadgetText(GetDlgCtrlID_(hwnd))) 
                _valtxt+1 
                If _hourgadget And _valtxt = 12 
                  If GetGadgetText(tp_gadget()\_sampm) = "AM" 
                    SetGadgetText(tp_gadget()\_sampm, "PM") 
                  Else 
                    SetGadgetText(tp_gadget()\_sampm, "AM") 
                  EndIf 
                EndIf 
                If _valtxt > upperlimit 
                  _valtxt = lowerlimit 
                  SetGadgetText(GetDlgCtrlID_(hwnd),RSet(Str(_valtxt),2,"0")) 
                  If GetDlgCtrlID_(hwnd) = tp_gadget()\_ssec 
                    SendMessage_(GadgetID(tp_gadget()\_smin),#WM_KEYDOWN,#VK_UP,0) 
                  ElseIf GetDlgCtrlID_(hwnd) = _smin 
                    SendMessage_(GadgetID(tp_gadget()\_shour),#WM_KEYDOWN,#VK_UP,0) 
                  EndIf 
                EndIf 
                SetGadgetText(GetDlgCtrlID_(hwnd),RSet(Str(_valtxt),2,"0")) 
                SendMessage_(hwnd,#EM_SETSEL,0,-1) 
                SetClock(tp_gadget()\_cont) 
              Case #VK_DOWN 
                _valtxt = Val(GetGadgetText(GetDlgCtrlID_(hwnd))) 
                _valtxt-1 
                If _hourgadget And _valtxt = 11 
                  If GetGadgetText(tp_gadget()\_sampm) = "AM" 
                    SetGadgetText(tp_gadget()\_sampm, "PM") 
                  Else 
                    SetGadgetText(tp_gadget()\_sampm, "AM") 
                  EndIf 
                EndIf 
                If _valtxt < lowerlimit 
                  _valtxt = upperlimit  
                  SetGadgetText(GetDlgCtrlID_(hwnd),RSet(Str(_valtxt),2,"0")) 
                  If GetDlgCtrlID_(hwnd) = tp_gadget()\_ssec 
                    SendMessage_(GadgetID(tp_gadget()\_smin),#WM_KEYDOWN,#VK_DOWN,0) 
                  ElseIf GetDlgCtrlID_(hwnd) = tp_gadget()\_smin 
                    SendMessage_(GadgetID(tp_gadget()\_shour),#WM_KEYDOWN,#VK_DOWN,0) 
                  EndIf 
                EndIf 
                SetGadgetText(GetDlgCtrlID_(hwnd),RSet(Str(_valtxt),2,"0")) 
                SendMessage_(hwnd,#EM_SETSEL,0,-1)      
                SetClock(tp_gadget()\_cont) 
            EndSelect 
        EndSelect
        Break
      EndIf
    Next
  EndIf
  result = CallWindowProc_(_oldproc,hwnd,msg,wparam,lparam) 
  ProcedureReturn result 
EndProcedure 

Procedure updownproc(hwnd,msg,wparam,lparam)
  If msg = #WM_KILLFOCUS Or msg = #WM_LBUTTONDOWN Or msg = #WM_TIMER
    debugme.l = GetDlgCtrlID_(hwnd)
    ForEach tp_gadget()
      If GetDlgCtrlID_(hwnd) = tp_gadget()\_updownCtrlID
        If tp_gadget()\_lastgadget 
          _target = tp_gadget()\_lastgadget 
        Else 
          _target = GadgetID(tp_gadget()\_sampm) 
        EndIf 
        Select msg 
          Case #WM_KILLFOCUS 
            If GetAsyncKeyState_(#VK_TAB) & 32768 
              SetFocus_(GadgetID(tp_gadget()\_shour)) 
            EndIf 
          Case #WM_LBUTTONDOWN 
            If _target 
              If lparam >> 16 > 13 
                SendMessage_(_target,#WM_KEYDOWN,#VK_DOWN,0) 
              Else 
                SendMessage_(_target,#WM_KEYDOWN,#VK_UP,0) 
              EndIf 
            EndIf 
          Case #WM_TIMER 
            GetCursorPos_(@cp.POINT) 
            MapWindowPoints_(0,hwnd,@cp,1) 
            If cp\y > 13 
              SendMessage_(_target,#WM_KEYDOWN,#VK_DOWN,0) 
            Else 
             SendMessage_(_target,#WM_KEYDOWN,#VK_UP,0) 
            EndIf 
        EndSelect
        Break
      EndIf
    Next
  EndIf
  result = CallWindowProc_(_oldupdown,hwnd,msg,wparam,lparam)
  ProcedureReturn result
EndProcedure 

ProcedureDLL TimePickerGadget(gadget, x, y, hilitecolor=16769472) 

  AddElement(tp_gadget())
  tp_gadget()\_hilitecolor = hilitecolor

  *unpacked = AllocateMemory(5376) 
  UnpackMemory(?PicPak, *unpacked) 
  tp_gadget()\_img1 = CatchImage(#PB_Any, *unpacked, 5376)
  
  DataSection 
    PicPak:
    Data.b $4A,$43,$00,$15,$00,$00,$3C,$EE,$28,$70,$A4,$A9,$D0,$20,$A6,$51,$A4,$62,$4A,$28 
    Data.b $23,$C0,$28,$4D,$94,$BA,$31,$C0,$18,$09,$44,$88,$A2,$F2,$30,$08,$6C,$A1,$5D,$D1 
    Data.b $7F,$0A,$F5,$87,$41,$F1,$8C,$09,$EA,$56,$A1,$48,$00,$AF,$8F,$64,$2F,$10,$75,$63 
    Data.b $50,$FC,$DE,$75,$80,$51,$F5,$FF,$78,$54,$79,$D7,$01,$46,$58,$7D,$85,$41,$00,$00 
    Data.b $10,$89 
    PicPakend: 
  EndDataSection
  
  tp_gadget()\_updownCtrlID = 7000+Random(1000) ; Choose a unique #gadget for the updown control 
  While IsGadget(tp_gadget()\_updownCtrlID) 
    tp_gadget()\_updownCtrlID = 7000+Random(1000) 
  Wend
    
  If gadget = #PB_Any
    tp_gadget()\_cont = ContainerGadget(gadget,x,y,115,26) 
  Else
    tp_gadget()\_cont = gadget
    ContainerGadget(tp_gadget()\_cont, x, y, 100, 26)
  EndIf
    tp_gadget()\_updown = CreateWindowEx_(0,"msctls_updown32","",#WS_CHILD|#WS_VISIBLE,96,0,20,22,GadgetID(tp_gadget()\_cont),tp_gadget()\_updownCtrlID,GetModuleHandle_(0),0) 
    tp_gadget()\_cont2 = ContainerGadget(#PB_Any,0,1,96,21,#PB_Container_Flat) 
      tp_gadget()\_imgg1 = ImageGadget(#PB_Any,0,0,0,0,ImageID(tp_gadget()\_img1)) 
      DisableGadget(tp_gadget()\_imgg1, 1) 
      tp_gadget()\_shour = StringGadget(#PB_Any,8,3,16,14,"",#PB_String_BorderLess) 
      tp_gadget()\_smin = StringGadget(#PB_Any,32,3,16,14,"",#PB_String_BorderLess) 
      tp_gadget()\_ssec = StringGadget(#PB_Any,55,3,16,14,"",#PB_String_BorderLess) 
      tp_gadget()\_sampm = StringGadget(#PB_Any,71,3,16,14,"",#PB_String_BorderLess|#PB_String_ReadOnly) 
    CloseGadgetList()
  CloseGadgetList()

  SendMessage_(GadgetID(tp_gadget()\_shour),#EM_LIMITTEXT,2,0) 
  SendMessage_(GadgetID(tp_gadget()\_smin),#EM_LIMITTEXT,2,0) 
  SendMessage_(GadgetID(tp_gadget()\_ssec),#EM_LIMITTEXT,2,0) 
  _oldupdown = GetWindowLong_(tp_gadget()\_updown,#GWL_WNDPROC)
  SetWindowLong_(tp_gadget()\_updown,#GWL_WNDPROC,@updownproc())  
  _oldampm = SetWindowLong_(GadgetID(tp_gadget()\_sampm),#GWL_WNDPROC,@ampmproc()) 
  _oldproc = SetWindowLong_(GadgetID(tp_gadget()\_shour),#GWL_WNDPROC,@timeproc()) 
  _oldproc = SetWindowLong_(GadgetID(tp_gadget()\_smin),#GWL_WNDPROC,@timeproc()) 
  _oldproc = SetWindowLong_(GadgetID(tp_gadget()\_ssec),#GWL_WNDPROC,@timeproc())
  SetGadgetColor(tp_gadget()\_shour,#PB_Gadget_BackColor,#White)
  SetGadgetColor(tp_gadget()\_smin,#PB_Gadget_BackColor,#White)
  SetGadgetColor(tp_gadget()\_ssec,#PB_Gadget_BackColor,#White) 
  SetGadgetColor(tp_gadget()\_sampm,#PB_Gadget_BackColor,#White) 
  ShowWindow_(GadgetID(tp_gadget()\_cont),#SW_SHOW) 
  SetGadgetText(tp_gadget()\_smin, RSet(Str(Minute(Date())),2,"0")) 
  SetGadgetText(tp_gadget()\_ssec, RSet(Str(Second(Date())),2,"0")) 
  If Hour(Date()) >= 12 
    SetGadgetText(tp_gadget()\_shour, RSet(Str(Hour(Date())-12),2,"0")) 
    SetGadgetText(tp_gadget()\_sampm, "PM") 
  Else 
    SetGadgetText(tp_gadget()\_shour, RSet(Str(Hour(Date())),2,"0")) 
    SetGadgetText(tp_gadget()\_sampm, "AM") 
  EndIf 
  tp_gadget()\_lastgadget = GadgetID(tp_gadget()\_sampm)
  ProcedureReturn tp_gadget()\_cont 
EndProcedure

And the obligatory test suite:

Code: Select all

OpenWindow(0,0,0,320,240,"TimePicker Test", #PB_Window_ScreenCentered|#PB_Window_SystemMenu) 
CreateGadgetList(WindowID(0)) 
gadget1 = TimePickerGadget(#PB_Any, 90, 30) 
ButtonGadget(0,90,60,100,20,"Get Time Values 1")
gadget2 = TimePickerGadget(#PB_Any, 90, 110, RGB(255, 127, 0))
ButtonGadget(1,90,140,100,20,"Get Time Values 2")

Repeat 
  ev = WaitWindowEvent() 
  If ev=#PB_Event_Gadget 
    Select EventGadget()
      Case 0
        Debug TimePicker_GetHours(gadget1) 
        Debug TimePicker_GetMinutes(gadget1) 
        Debug TimePicker_GetSeconds(gadget1) 
      Case 1
        Debug TimePicker_GetHours(gadget2) 
        Debug TimePicker_GetMinutes(gadget2) 
        Debug TimePicker_GetSeconds(gadget2)
    EndSelect
  EndIf  
Until ev=#WM_CLOSE

Not sure if LinkedList is the proper way to do something like this, but it seems to be working pretty good so far in a project I've worked it into. By the way, netmaestro - since I didn't mention it before, I want to thank you for this wonderful contribution. I learned a couple things going through your code, and I appreciate what you do for this community on a daily basis

PureBasic Forums - English

TimePicker Control

TimePicker Control

Re: TimePicker Control

nevermind;)