PureBoard

Code: Alles auswählen

; /*
;  *
;  *  Copyright (c) 2002-2005 by Danilo Krahn
;  *
;  *    This library is free software; you can redistribute it and/or
;  *    modify it under the terms of the GNU Lesser General Public
;  *    License As published by the Free Software Foundation; either
;  *    version 2.1 of the License, Or (at your option) any later version.
;  *
;  *    This library is distributed in the hope that it will be useful,
;  *    but WITHOUT ANY WARRANTY; without even the implied warranty of
;  *    MERCHANTABILITY Or FITNESS For A PARTICULAR PURPOSE.  See the GNU
;  *    Lesser General Public License For more details.
;  *
;  */

; changed from C to PB by ts-soft

; Diese Include enthält alle Funktionen der PBOSL_Timer Lib von Danilo Krahn
; Die Funktionsnamen wurden angepaßt, um konflikte mit der UserLib zu vermeiden
; Desweiteren ist vor Verwendung der Funktionen Timer_Init() aufzurufen
; Am Ende dann Timer_End()

; StartTimer() = TimerStart()
; EndTimer() = TimerStop()
; GetMinTimerResolution() = TimerGetMinRes()
; GetMaxTimerResolution() = TimerGetMaxRes()

Define TimerResolution.TIMECAPS
Global Dim TimerHandles(15)
Global Dim TimerProcedures(15)

Procedure Timer_Init()
  Shared TimerResolution

  If timeGetDevCaps_(@TimerResolution, SizeOf(TIMECAPS)) = #TIMERR_NOERROR
    If timeBeginPeriod_(TimerResolution\wPeriodMin) = #TIMERR_NOERROR
      ProcedureReturn #True
    EndIf
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure Timer_End()
  Protected I
  Shared TimerResolution

  timeEndPeriod_(TimerResolution\wPeriodMin)
  For I = 0 To 15
    If TimerHandles(I)
      timeKillEvent_(TimerHandles(I))
    EndIf
  Next
EndProcedure

Procedure Timer_Callback(TimerHandle, Message, TimerID, wParam, lParam)
  If TimerProcedures(TimerID)
    CallFunctionFast(TimerProcedures(TimerID))
  EndIf
EndProcedure

Procedure TimerStart(TimerID, Delay, ProcAddr)
  If TimerID > 15 Or TimerID < 0 : ProcedureReturn #False : EndIf

  If TimerHandles(TimerID)
    timeKillEvent_(TimerHandles(TimerID))
  EndIf

  TimerProcedures(TimerID) = ProcAddr
  TimerHandles(TimerID) = timeSetEvent_(Delay, 0, @Timer_Callback(), TimerID, #TIME_PERIODIC)

  ProcedureReturn TimerHandles(TimerID)
EndProcedure

Procedure TimerStop(TimerID)
  If TimerID > 15 Or TimerID < 0 : ProcedureReturn #False : EndIf

  If TimerHandles(TimerID)
    timeKillEvent_(TimerHandles(TimerID))

    ProcedureReturn #True
  EndIf

  ProcedureReturn #False
EndProcedure

Procedure TimerGetMaxRes()
  Shared TimerResolution
  ProcedureReturn TimerResolution\wPeriodMax
EndProcedure

Procedure TimerGetMinRes()
  Shared TimerResolution
  ProcedureReturn TimerResolution\wPeriodMin
EndProcedure

Code: Alles auswählen

XIncludeFile "Timer_Include.pbi"

Procedure mytimer1()
  Shared hoehe
  If hoehe = 1000: hoehe = 100: EndIf
     Beep_(hoehe,100)
  hoehe+100
EndProcedure

Procedure mytimer2()
   Beep_(1800,5)
EndProcedure

Procedure mytimer3()
   Beep_(1800,100)
EndProcedure

Procedure mytimer4()
   Beep_(800,100)
EndProcedure

Timer_Init()

hWnd = OpenWindow(0, (GetSystemMetrics_(#SM_CXSCREEN)-200)/2,(GetSystemMetrics_(#SM_CYSCREEN)-277)/2, 400, 360, "High Resolution Timer by Danilo", #PB_Window_SystemMenu|#PB_Window_SizeGadget)

TimerStart(0, 1000, @mytimer1())
TimerStart(1,  200, @mytimer2())
TimerStart(2, 2000, @mytimer3())
TimerStart(3,  600, @mytimer4())

Repeat
  EventID.l=WaitWindowEvent()

  ; IF LeftMouseButton pressed...
  If EventID = #WM_LBUTTONDOWN
    TimerStop(1): TimerStop(2): TimerStop(3)
  EndIf
  ; pressed CloseButton or ALT+F4 ??
  If EventID = #PB_Event_CloseWindow
     Quit = 1
  EndIf
Until Quit = 1

Timer_End()

Code: Alles auswählen

XIncludeFile "Timer_Include.pbi"

Timer_Init()

Global myText$
Global hWnd.l
Global TextLength.l
#ScrollSpeed_in_Milliseconds = 70

myText$ = "     This is a little Scroller-Test with the Timer by Danilo     "
TextLength = Len(myText$)



Procedure Scroller()
  ;Shared Scroller_a
  Shared Scroller_Position
  Shared Scroller_Direction

  If Scroller_Position < TextLength + 1 And Scroller_Direction = 0
      TEMP$ = Right(myText$,Scroller_Position)
      SetWindowText_(hWnd, TEMP$)
      Scroller_Position+1
  Else
      Scroller_Direction = 1
      TEMP$ = Right(myText$,Scroller_Position)
      SetWindowText_(hWnd, TEMP$)
      Scroller_Position-1
      If Scroller_Position = 0 : Scroller_Direction = 0 : EndIf
  EndIf
EndProcedure

Procedure mybeep()
  Beep_(500,1000)
  TimerStop(0)
  DisableGadget(1,0)
  TimerStart(1, #ScrollSpeed_in_Milliseconds, @Scroller())
EndProcedure

Procedure Alarm()
  Beep_(500,60)
EndProcedure

MessageRequester("Minimal Timer Resolution",Str(TimerGetMinRes()),0)
MessageRequester("Maximal Timer Resolution",Str(TimerGetMaxRes()),0)


hWnd = OpenWindow(0, (GetSystemMetrics_(#SM_CXSCREEN)-400)/2,(GetSystemMetrics_(#SM_CYSCREEN)-100)/2, 400, 100,"", #PB_Window_SystemMenu)


If CreateGadgetList(WindowID(0))
  ButtonGadget(0,  10, 10, 100, 25, "Quit Scroller")
  DisableGadget(0,1)
  ButtonGadget(1, 120, 10, 250, 25, "Change Timer from Scroller to Beep")
  DisableGadget(1,1)
EndIf

SetForegroundWindow_(hWnd)

TimerStart(0,1000, @mybeep())
Repeat
  EventID.l=WaitWindowEvent()

  ; IF LeftMouseButton pressed...
  If EventID = #WM_LBUTTONDOWN
    SendMessage_(hWnd.l,#WM_NCLBUTTONDOWN, #HTCAPTION,0)
  EndIf
  If EventID = #PB_Event_Gadget
    Select EventGadget()
      Case 0 ; End the Timer
        A$ = GetGadgetText(0)
        If A$ = "Quit Alarm"
         SetGadgetText(0,"Exit Program")
         DisableGadget(1,1)
        EndIf
        If A$ = "Exit Program"
         Quit = 1
        EndIf
        TimerStop(1)
      Case 1
        SetGadgetText(0,"Quit Alarm")
        DisableGadget(0,0)
        TimerStart(1, 100, @Alarm())
    EndSelect
  EndIf
  ; pressed CloseButton or ALT+F4 ??
  If EventID = #PB_Event_CloseWindow
    Quit = 1
  EndIf
Until Quit = 1

Timer_End()