ganze Menge User gibt, die keine UserLibraries mögen, hab ich den
C-Source von Danilo mal nach PureBasic übersetzt.
Functionsnamen wurden angepaßt, um Konflikte mit der Lib zu vermeiden.
"Timer_Include.pbi"
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
"Timer-TEST 1.pb"
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()
Dieser Source befindet sich jetzt auch im IncludePack
http://www.purebasic.fr/german/viewtopic.php?t=9190
Gruß
Thomas
