Update pour executer une routine ou procédure à intervalle régulier

[ProVideo]

J'ai déjà posté la question suivante dans le forum, et je vous demande s'il ne serait pas opportun d'updater le QB

Le très ancien Quick Basic compilé de Microsoft avait une instruction très utile qui permet d'interrompre un programme en cour d'exécution à des intervalles réguliers afin d'exécuter une sous routine ou une procedure. Voici un exemple simple d'utilisation (en supposant que votre PC soit très lent et mette un temps considérable pour effectuer la boucle For Next):

On Timer(1000) gosub MaRoutine ;1000 est le nombre de millisecondes

For i=0 to 100
if i<=50 then TimerON else TimerOFF: Endif ;Le timer est activé si i<=50 sinon il est désactivé
Print i
Next
End

MaRoutine: Beep: Return

Un beep sera émis toutes les 1 secondes si le le PC est occupé d'afficher un nombre entre 0 et 50 et il n'y aura pas de beep pendant l'affichage des
nombres entre 50 et 100

L'instruction On Timer est très puissante. Elle permet par exemple dans un programme d'alarme de retourner à intervalle régulier l'état des détecteurs au programme principal qui prendra alors la décision qui s'impose. Autre exemple: faire clignoter automatiquement à intervalle régulier des instructions à l'écran, les possibilités sont infinies.

Je n'ai pas trouvé une manière aussi simple d'implémenter cela en QB.

[falsam]

Ca existe déja avec la fonctionnalité AddWindowTimer(#Fenetre, Minuteur, Temps)

Lien : https://www.purebasic.com/french/docume ... timer.html

[ProVideo]

Merci pour ta réponse, mais il y a un hic. Mon programme est en mode Console pour piloter des machines branchées sur une carte PCI I/O industrielle. Dans certaines parties de mon programme, je dois à intervalles réguliers envoyer des commandes sur certains de ses ports pour faire des Reset du hardware qui y est branché puis immédiatement lire sur d'autres ports l'état de la machine que je dois stocker dans un buffer à lire plus tard, tout cela alors que le programme principal doit continuer à tourner. J'entrevois une solution avec des Threads et des Delay() puisque le AddWindowTimer() ne fonctionne qu'avec des fenêtres . Y aurait-il une autre solution moins compliquée? Cela fonctionnait si bien avec la simple instruction On Timer(millisecond) gosub: routine à executer: Return de mon vieux QuickBasic.

[Marc56]

Pourquoi ne pas utiliser les capacités graphiques du système d'exploitation ? C'est bien plus simple et rapide.
Créer une fenêtre en mode invisible (#PB_Window_Invisible)
La gérer avec une SysTrayIcon (afficher / cacher / Changer l'icône pour indiquer l'état / Utiliser tooltip pour afficher données, etc
Créer Un menu pour piloter ou afficher /cacher une fenêtre qui affiche un monitoring des données IO

sinon, il y a ElapsedMilliseconds() mais ça va utiliser du CPU.

Si c'est trop de travail de tout réécrire, il existe QB64

[Mesa]

Code : Tout sélectionner

EnableExplicit

Enumeration #PB_Event_FirstCustomValue
	#Serial_Event_StringForUs
	#Serial_Event_StringForOthers
	#Serial_Event_Exit
EndEnumeration



Structure ThreadParameterStructure
	Port$
	Semaphore.i
	Port.i
	nx$
	Exit.i
EndStructure


Procedure serial_rd(*Parameter.ThreadParameterStructure)
	
	Protected.i position, size, reslen, i, State
	Protected Port$, Rx$, l$
	Protected Byte.a
	
	
	
	If IsSerialPort(*Parameter\Port)
		
		position = 0
		Repeat
			;  receive serial data
			size = AvailableSerialPortInput(*Parameter\Port)
			If size > 0     ; only if someting to read
				
				If ReadSerialPortData(*Parameter\Port, @Byte, 1)
					
					Select State
						Case 0
							If Byte = #LF
								State = 1
							EndIf
							
						Case 1
							If Byte <> #LF
								Rx$ + Chr(Byte)
								Debug Rx$
							Else
								*Parameter\nx$ = Rx$
								If Left(*Parameter\nx$, 3) = "sfs"
									PostEvent(#Serial_Event_StringForUs)
								Else
									PostEvent(#Serial_Event_StringForOthers)
								EndIf
								WaitSemaphore(*Parameter\Semaphore)
								Rx$ = ""
							EndIf
							
					EndSelect
					
				EndIf
			Else
				Delay(1)    ; to avoid a high CPU load if nothing to receive
			EndIf
		Until *Parameter\Exit
		
	EndIf
	
	PostEvent(#Serial_Event_Exit)
	
EndProcedure


Define.i Exit, Event, Thread
Define ThreadParameter.ThreadParameterStructure


CompilerIf Not #PB_Compiler_Thread
	MessageRequester("PureBasic Info", "COCHEZ Menu 'Compilateur/Options du compilateur.../Activer la gestion des Threads'.")
	End
CompilerEndIf



If OpenWindow(0, 0, 0, 400, 500, "Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
	
	ListIconGadget(0, 10, 10, 380, 200, "For Us", 270)
	ListIconGadget(1, 10, 220, 380, 200, "For Other", 270)
	
	
	ThreadParameter\Port$ = "COM4"
	ThreadParameter\Semaphore = CreateSemaphore()
	
	ThreadParameter\Port = OpenSerialPort(#PB_Any, ThreadParameter\Port$, 230400, #PB_SerialPort_NoParity, 8, 1, #PB_SerialPort_NoHandshake, 1024, 1024)
	If ThreadParameter\Port
		
		Thread = CreateThread(@serial_rd(), @ThreadParameter)
		
		Repeat
			
			Event = WaitWindowEvent()
			
			Select Event
					
				Case #Serial_Event_StringForUs
					AddGadgetItem(0, -1, ThreadParameter\nx$)
					SignalSemaphore(ThreadParameter\Semaphore)
					
				Case #Serial_Event_StringForOthers
					AddGadgetItem(1, -1, ThreadParameter\nx$)
					SignalSemaphore(ThreadParameter\Semaphore)
					
				Case #Serial_Event_Exit
					; do something or not
					Exit = #True
					
				Case #PB_Event_CloseWindow
					Exit = #True
					
			EndSelect
			
		Until Exit
		
		If IsThread(Thread)
			ThreadParameter\Exit = #True
			SignalSemaphore(ThreadParameter\Semaphore)  ; to be sure it is not waiting
			If WaitThread(Thread, 1000) = 0
				KillThread(Thread)
			EndIf
		EndIf
		
		CloseSerialPort(ThreadParameter\Port)
		
	Else
		
		MessageRequester("Error", "Was not able to open " + ThreadParameter\Port$)
		
	EndIf
	
EndIf

M.