PureBasic Forums - English

Code: Select all

;***** Windows Multimedia Timer *****
;***** by Psychophanta April 2006 *****
;***************************************
Global m_hWnd.l,m_timerId.l,m_timerRes.l
Procedure.l minUnsigned(a.l,b.l)
  If a<0
    If b>=0 Or a>b:ProcedureReturn b:EndIf
  ElseIf b>=0 And a>b:ProcedureReturn b
  EndIf
  ProcedureReturn a
EndProcedure
Procedure.l maxUnsigned(a.l,b.l)
  If a<0
    If b>=0 Or a>b:ProcedureReturn a:EndIf
  ElseIf b>=0 And a>b:ProcedureReturn a
  EndIf
  ProcedureReturn b
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////////////////
;// mmTimer CALLBACK handler
;// From the trace Data, I think mmTimer Callback is driven by Semaphore With counting.
;// And it won't overrun. In other words, the Callback function won't be re-entried.
;/////////////////////////////////////////////////////////////////////////////////////////////
Global myDD.IDirectDraw ; Create a DirectDraw object
Global ScanLine.l
DirectDrawCreate_(0,@myDD,0) 
Procedure CALLBACK_mmTimerProc(id.l,msg.l,dwUser.l,dw1.l,dw2.l)
  Protected message.l=myDD\GetScanLine(@ScanLine)
;   If Scanline<100:Beep_(300,2):EndIf
  Beep_(300,5)
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////////////////
;// start mmTimer
;/////////////////////////////////////////////////////////////////////////////////////////////
Procedure.b StartTimer(period.l,oneShot.b=0,resolution.l=0)
  Protected tc.TIMECAPS
  If timeGetDevCaps_(@tc,SizeOf(TIMECAPS))=#TIMERR_NOERROR
    m_timerRes.l=minUnsigned(maxUnsigned(tc\wPeriodMin,resolution),tc\wPeriodMax)
    If timeBeginPeriod_(m_timerRes)<>#TIMERR_NOERROR:ProcedureReturn 0:EndIf
  Else 
    ProcedureReturn 0
  EndIf
  If oneShot:oneShot=#TIME_ONESHOT:Else:oneShot=#TIME_PERIODIC:EndIf
  result.l=timeSetEvent_(period,m_timerRes,@CALLBACK_mmTimerProc(),0,oneShot);CALLBACK_EVENT_SET
  If result.l
    m_timerId=result.l
    ProcedureReturn 1
  EndIf
  ProcedureReturn 0
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////////////////
;// stop mmTimer
;// could be modified in XP with TIME_KILL_SYNCHRONOUS
;/////////////////////////////////////////////////////////////////////////////////////////////
Procedure.b StopTimer(bEndTime.b=0)
  result.l=timeKillEvent_(m_timerId)
  If result.l=#TIMERR_NOERROR
    m_timerId=0
    If bEndTime
      For i.b=0 To 9
        Sleep_(10);                          //TIME_KILL_SYNCHRONOUS
      Next
    EndIf
  EndIf
  If m_timerRes
    timeEndPeriod_(m_timerRes)
    m_timerRes=0
  EndIf
  If result.l=#TIMERR_NOERROR:ProcedureReturn 1:EndIf
  ProcedureReturn 0
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////////////////
;// Resume mmTimer
;/////////////////////////////////////////////////////////////////////////////////////////////
Procedure.b SafeStartTimer(period.l=2,oneShot.b=0,resolution.l=0)
  If StartTimer(period,oneShot,resolution)=0
   ; PostMessage_(m_hWnd,#WM_CLOSE,0,0)
    ProcedureReturn 0
  EndIf
  ProcedureReturn 1
EndProcedure
;-MAIN:
Enumeration
#window0=0
#Button_Start=0
#OneShot
#PeriodText
#PeriodBar
EndEnumeration
Procedure.l Open_window0()
  res.l=OpenWindow(#window0,0,0,155,100,"MM timer test",#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
  ButtonGadget(#Button_Start,5,5,145,50,"Start timer",#PB_Button_Toggle)
  CheckBoxGadget(#OneShot,5,60,150,15,"One shot")
  TrackBarGadget(#PeriodBar,60,76,100,30,0,1000):SetGadgetState(#PeriodBar,20)
  TextGadget(#PeriodText,2,80,58,15,"Period "+Str(GetGadgetState(#PeriodBar)))
  ProcedureReturn res
EndProcedure
Macro Interact
  Select EventID.l
  Case #PB_Event_Gadget
    Select EventGadget()
    Case #Button_Start
      If GetGadgetText(#Button_Start)="Start timer"
        If SafeStartTimer(GetGadgetState(#PeriodBar),GetGadgetState(#OneShot))
          SetGadgetText(#Button_Start,"Stop timer")
        Else
          SetGadgetState(#Button_Start,0):SetGadgetText(#Button_Start,"Start timer")
        EndIf
      Else
        SetGadgetText(#Button_Start,"Start timer")
        StopTimer()
      EndIf
    Case #PeriodBar
      period.l=GetGadgetState(#PeriodBar)
      SetGadgetText(#PeriodText,"Period "+Str(period))
      If GetGadgetText(#Button_Start)="Stop timer"
        StopTimer():Delay(1)
        If SafeStartTimer(period,GetGadgetState(#OneShot))=0
          SetGadgetState(#Button_Start,0):SetGadgetText(#Button_Start,"Start timer")
        EndIf
      EndIf
    Case #OneShot
      If GetGadgetText(#Button_Start)="Stop timer"
        StopTimer():Delay(1)
        If SafeStartTimer(period,GetGadgetState(#OneShot))=0
          SetGadgetState(#Button_Start,0):SetGadgetText(#Button_Start,"Start timer")
        EndIf
      EndIf
    EndSelect
  EndSelect
EndMacro
m_hWnd=Open_window0()
If m_hWnd=0:End:EndIf
Repeat
  EventID.l=WaitWindowEvent()
  Interact
  Delay(1)
Until EventID=#PB_Event_CloseWindow
StopTimer()
End