PureBasic Forums - English

Code: Select all

;Game date/time Example - Dayname, DayOfWeek, DayOfYear and time (hh:ss).
;By DK_PETER
DeclareModule _Time
  Structure _DateData
    day.i
    hour.i
    mins.i
    sday.s
    sHour.s
    sMins.s
    sDaynum.i
    sDayName.s
  EndStructure
  
  Global hs._DateData
  Declare.i SetStartTime(*hs._DateData)
  Declare.i StartTime()
  Declare.i GetTime(*hs._DateData)
  Declare.i StopTime()
  Declare.i PauseTime()
  Declare.i ChangeSpeedTime(ms.i = 1000)
  Declare.i DayNames(DayList.s = "Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday")
EndDeclareModule

Module _Time
  
  Declare.i Begin(v.i)
  Global  thr.i, BaseSec.i = 1000, PauseTime.i = #False, StopThread.i = #False
  Global Dim Days.s(0)
  
  Procedure.i SetStartTime(*hs._DateData)
    hs\day = *hs\day
    hs\hour = *hs\hour
    hs\mins = *hs\mins
    hs\sday = *hs\sday
    hs\sHour = *hs\sHour
    hs\sMins = *hs\sMins
    hs\sHour = RSet(Str(*hs\Hour), 2,"0")
    hs\sMins = RSet(Str(*hs\mins), 2, "0")
  EndProcedure
  
  Procedure.i ChangeSpeedTime(ms.i = 1000)
    BaseSec = ms
  EndProcedure
  
  Procedure.i DayNames(DayList.s = "Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday")
    Protected x.i, num.i = CountString(DayList,",")
    ReDim Days(num)
    For x = 0 To num
      Days(x) = StringField(DayList, x+1, ",")
    Next x
  EndProcedure
  
  Procedure.i IncTime()
    If hs\mins + 1 > 59
      hs\mins = 0
      If hs\hour + 1 > 23
        hs\hour = 0
        If hs\day + 1 > 365
          hs\day = 1
          If hs\sDaynum + 1 > ArraySize(Days()) : hs\sDaynum = 0 : Else : hs\sDaynum + 1 : EndIf
        Else
          hs\day + 1
          If hs\sDaynum + 1 > ArraySize(Days()) : hs\sDaynum = 0 : Else : hs\sDaynum + 1 : EndIf
        EndIf
      Else
        hs\hour + 1
      EndIf
    Else
      hs\mins + 1
    EndIf
    
    hs\sHour = RSet(Str(hs\Hour), 2,"0")
    hs\sMins = RSet(Str(hs\mins), 2, "0")
  EndProcedure
  
  Procedure.i GetTime(*hs._DateData)
    *hs\day = hs\day
    *hs\hour = hs\hour
    *hs\mins = hs\mins
    *hs\sday = hs\sday
    *hs\sHour = hs\sHour
    *hs\sMins = hs\sMins
    *hs\sDaynum = hs\sDaynum
    *hs\sDayName = Days(hs\sDaynum)
    ProcedureReturn #True
  EndProcedure
  
  Procedure.i StartTime() 
    StopThread = #False
    thr = CreateThread(@Begin(), #False)
  EndProcedure
  
  Procedure.i PauseTime()
    PauseTime ! 1
  EndProcedure
  
  Procedure.i Begin(v.i)
    Protected elap.q = ElapsedMilliseconds()
    StopThread = v
    Repeat
      If PauseTime = #False
        If ElapsedMilliseconds()-elap >= BaseSec
          IncTime()
          elap = ElapsedMilliseconds()
        EndIf
      EndIf
      Delay(1) ;edit...
    Until StopThread = #True
  EndProcedure
  
  Procedure.i StopTime()
    StopThread = #True
  EndProcedure
EndModule

;------Example-------

CompilerIf #PB_Compiler_Thread = 0
  MessageRequester("Threading is off", "Threadsafe must checked!")
  End
CompilerEndIf

Declare.i Pausing()
Declare.i Change()
Global slide, pause, hs._Time::_DateData

OpenWindow(0, 0, 0, 400, 60, "Time simulation", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
CanvasGadget(0, 0, 0, 300, 35)
pause = ButtonGadget(#PB_Any, 301, 0, 99, 60, "Pause")
slide = TrackBarGadget(#PB_Any, 0, 40, 300, 20, 25, 1000)
GadgetToolTip(slide, "Slide to shange date/time speed")
BindGadgetEvent(pause, @Pausing())
BindGadgetEvent(slide, @Change())

hs\day = 100 ; Day of year
hs\hour = 23 ; 
hs\mins = 52
hs\sDaynum = 2 ;Day of week - set as second day (Tuesday)
_Time::DayNames("Elenya,Anarya,Isilya,Aldúya,Menelya,Valanya,Selenia") ;Elvish... :-)
_Time::ChangeSpeedTime(50) ;How fast it runs in ms.
_Time::SetStartTime(hs)
_Time::StartTime()

Repeat
  ev = WindowEvent()
  _Time::GetTime(hs)
  StartDrawing(CanvasOutput(0))
  Box(0, 0, 300, 35, $FFFFFF)
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(5, 1, "Day name: " + hs\sDayName + " - Day of year: " + hs\day , $000000)
  DrawText(5, 20, "Day Of Week: " + hs\sDaynum + " - Time " + hs\shour + ":" + hs\sMins, $000000)
  StopDrawing()
Until ev = #PB_Event_CloseWindow

Procedure.i Pausing()
  _Time::PauseTime()  
EndProcedure

Procedure.i Change()
  _Time::ChangeSpeedTime(GetGadgetState(slide))
EndProcedure

Code: Select all

DeclareModule _Time
  #Time_TickEvent = #PB_Event_FirstCustomValue
  [...]
EndDeclareModule

Code: Select all

Procedure.i IncTime()
  [...]
  PostEvent(#Time_TickEvent)
EndProcedure

Code: Select all

Repeat
  ev = WaitWindowEvent()
  If ev = _Time::#Time_TickEvent
    _Time::GetTime(hs)
    StartDrawing(CanvasOutput(0))
    [...]
    StopDrawing()
  EndIf
Until ev = #PB_Event_CloseWindow