Here it is...
Code: Select all
#SecondsMinute=60
#SecondsHour=60*#SecondsMinute
#SecondsDay=24*#SecondsHour
#MaxTime=14*#SecondsDay
Procedure.i FindChar(s.s,chars.s,start=1)
Protected stop
stop=Len(s)
If start<1
start=2
EndIf
While start<=stop
If FindString(chars,Mid(s,start,1))
ProcedureReturn start
EndIf
start+1
Wend
ProcedureReturn #Null
EndProcedure
Procedure.s GetTimeString(time)
Protected n
Protected s.s
If time<0
time=-time
s="-"
EndIf
If time>=#SecondsDay
n=time/#SecondsDay
s+Str(n)+" day"+Left("s",Bool(n-1))+" "
time-n*#SecondsDay
EndIf
If time>=#SecondsHour
n=time/#SecondsHour
s+Str(n)+" hour"+Left("s",Bool(n-1))+" "
time-n*#SecondsHour
EndIf
If time>=#SecondsMinute
n=time/#SecondsMinute
s+Str(n)+" minute"+Left("s",Bool(n-1))+" "
time-n*#SecondsMinute
EndIf
If time Or s=""
s+Str(time)+" second"+Left("s",Bool(time-1))+" "
EndIf
ProcedureReturn s
EndProcedure
Procedure GetTimeSeconds(s.s)
Protected time.i
Protected val.i
Protected n,c
Protected flag
Protected sign
s=LCase(Trim(s))+"s"
If Left(s,1)="-"
s=Mid(s,2)
sign=-1
Else
sign=1
EndIf
While s
val=Val(s)
If val<0 And sign=-1
val=-val
EndIf
n=1
Repeat
flag=FindString("smhd",Mid(s,n,1))
n+1
Until flag
; Debug Str(val)+" - "+StringField("day.hour.min.sec",flag,".")
Select flag
Case 1
time+val
Case 2
time+val*#SecondsMinute
Case 3
time+val*#SecondsHour
Case 4
time+val*#SecondsDay
EndSelect
n=FindChar(s,"-0123456789",n)
If n
s=Mid(s,n)
Else
s=""
EndIf
Wend
ProcedureReturn sign*time
EndProcedure
Procedure Test()
a=GetTimeSeconds("-3 days 4hours 2mins 6s")
Debug GetTimeString(a)
b=GetTimeSeconds("1d -10m")
Debug GetTimeString(b)
Debug GetTimeString(0)
Debug GetTimeString(-2)
Debug GetTimeString(#SecondsDay+#SecondsHour+90)
EndProcedure
; --- Demo ---
Procedure CustomStringCenter_LeftAlign(gadget)
Protected hwndEdit
Protected hdc
Protected fsz.SIZE
Protected erect.RECT
Protected height
#StringGadgetSpace=2
height=GadgetHeight(gadget)
hwndEdit=GadgetID(gadget)
hdc=GetDC_(hwndEdit)
SelectObject_(hdc,GetGadgetFont(Gadget))
GetTextExtentPoint32_(hdc,"ABC",3,fsz)
ReleaseDC_(hwndEdit,hdc)
GetClientRect_(hwndEdit,eRect)
eRect\left=#StringGadgetSpace; kann auch wegfallen (für Testzwecke erhöhen)
eRect\top=height>>1-fsz\cy<<4/20; cy*16/20 (Text eher weiter oben) bis cy*16/22 (eher weiter unten)
eRect\bottom=height+fsz\cy>>1
SendMessage_(hwndEdit,#EM_SETRECT,0,eRect)
EndProcedure
Procedure CustomStringCenter_RightAlign(gadget)
Protected hdc
Protected hwndEdit
Protected fsz.Size
Protected erect.Rect
Protected s.s
Protected height,width
hwndEdit=GadgetID(gadget)
hdc=GetDC_(hwndEdit)
SelectObject_(hdc,GetGadgetFont(Gadget))
s=GetGadgetText(gadget)
If s=""
s="|"
GetTextExtentPoint32_(hdc,s,Len(s),fsz)
fsz\cx=0
Else
GetTextExtentPoint32_(hdc,s,Len(s),fsz)
EndIf
ReleaseDC_(hwndEdit,hdc)
height=GadgetHeight(gadget)
width=GadgetWidth(gadget)-#StringGadgetSpace<<1
GetClientRect_(hwndEdit,eRect)
height=eRect\bottom-eRect\top
eRect\left=width-fsz\cx
eRect\top=height>>1-fsz\cy<<4/21
eRect\bottom=height+fsz\cy>>1
eRect\right=width
SendMessage_(hwndEdit,#EM_SETRECT,0,eRect)
EndProcedure
Procedure Demo(mode)
Dim Time(4)
Time(1)=666666
OpenWindow(0,0,0,400,260,"")
For i=1 To 4
StringGadget(i,20,i*60-40,360,40,"",#ES_MULTILINE*mode)
SetGadgetText(i,GetTimeString(Time(i)))
CustomStringCenter_RightAlign(i); /!\ mode
Next i
SetActiveGadget(1)
Repeat
Event=WaitWindowEvent()
Select Event
Case #PB_Event_Gadget,#PB_Event_Menu
Gadget=EventGadget()
If Gadget>#Null
Select EventType()
Case #PB_EventType_Focus
If GadgetType(Gadget)=#PB_GadgetType_String
CustomStringCenter_LeftAlign(Gadget); /!\ mode
SendMessage_(GadgetID(Gadget),#EM_SETSEL,0,-1)
EndIf
Case #PB_EventType_Change
n=GetTimeSeconds(GetGadgetText(Gadget))
If Abs(n)<=#MaxTime
Time(Gadget)=n
EndIf
Case #PB_EventType_LostFocus
SetGadgetText(Gadget,GetTimeString(Time(Gadget)))
CustomStringCenter_RightAlign(Gadget); /!\ mode
EndSelect
EndIf
Case #PB_Event_CloseWindow
End
EndSelect
ForEver
EndProcedure
Demo(1)