: Cette méthode n'existe pas.

⇧ Bac à sable - 23/07/2026 09:43:09

      //******************
//$commande
// bit 0 : 
// bit  6 : test génération mobile
// bit  7 : test JLOG
// bit  8 : test open DS
// bit  9 : maintenance mobile
// bit 10 : test serveurs web
// bit 11 : test requete HTTP
// bit 12 : maintenance album
// bit 13 : création webStatic
// bit 14 : créer la documentation
// bit 15 : modification datastore
// bit 16 : lire journal Web
// bit 17 : test AG
// bit 18 : test recherche
// bit 19 : test sonorisation
// bit 20 : test pack
// bit 21 : lire Notes
// bit 23 : test console
// bit 24 : 
// bit 25 : 
// bit 26 : 
// bit 27 : init session
// bit 30 : afficher console
// bit 31 : traduction
//******************

var $x; $y; $z; $stdIn : Text
var $numProc; $Error; $commande : Integer
var $i; $j; $k : Integer
var $pict : Picture
var $docRef : Time
var $bool : Boolean
var $blob : Blob
var $data; $o; $oo; $sélectionEntités; $environnement; $params : Object
var $c; $cc : Collection
var $v : Variant



Case of 
	: (Macintosh option down)
		
	: (Count parameters=0)
		SET ASSERT ENABLED(True)
		WEB SET OPTION(Web inactive process timeout; 1)
		WEB SET OPTION(Web inactive session timeout; 1)
		$numproc:=New process(Current method name; 0; "tester_"+String(Random); Current process; *)
		
		
	Else 
		InitProcessCooperative
		ON ERR CALL(Formula(traceHandler).source; ek local)
		
		SHOW MENU BAR
		SET BLOB SIZE($blob; 0)
		ARRAY LONGINT($tabEL; 0)
		ARRAY TEXT($tabTxt; 0)
		$x:=""
		$y:=""
		$z:=""
		$i:=0
		$j:=0
		$k:=0
		$o:=New object
		$oo:=New object
		$data:=New object
		$c:=New collection
		$environnement:=cs.xSDK.EnvironnementALV.new()
		
		$c:=[30]
		$c.push(10)
		//$c.push(4)
		//$c:=[2; 16]
		//$c:=[2; 24; 25]
		//$c:=[2; 24]
		//$c:=[2; 30; 25]
		//$c:=[31]
		//$c:=[2; 7]
		
		If (Application type=4D Remote mode)
			$x:="2"
			CALL WORKER("WK_Services"; Formula(InitProcessThreadSafe).source)
			//$x:=Request("Commandes : Console = 2 lire journal Web = 16"; "0"; "Exécuter"; "annuler")
			$c:=[Num($x)]
		End if 
		
		$commande:=0x0000
		For each ($i; $c)
			$commande:=$commande ?+ $i
		End for each 
		
		
		
		
		
		//$LogIn:=$o.userName
		//$nomGroupe:="saisie"
		//$result:=False
		//// renvoie vrai si l'utilisateur de LogIn (ou alias) $2 appartient au groupe de nom $3
		//$sélection:=ds.UtilisateursALV.query("LogIn = :1"; $LogIn).lesGroupes.leGroupe
		//Case of 
		//: ($sélection.query("nom = :1"; $nomGroupe).length>0)
		//$result:=True
		
		//: ($sélection.lesSurGroupes=Null)
		//// $2 n'appartient pas à un sur groupe
		
		//: ($sélection.lesSurGroupes.leGroupe.query("nom = :1"; $nomGroupe).length>0)
		//$result:=True
		
		//Else 
		//// rien trouvé
		//End case 
		
		//$data:=New object
		//$data.Libellé:="Ouverture"
		//$data.Source:=Current method name
		//$data.Description:="Connexion de l'utilisateur <"+cs.$session.me.userName+">"
		//cs._main.new().PosterMessageSurServeur($data)
		
		
		
		
		
		//MARK:01 test SauvegarderAPP
		If ($commande ?? 1)
			// lancer ma sauvegarde de la BDD complète
			$params:=New object()
			$params.initProcess:=Formula(InitProcessThreadSafe)
			$params.numProcessAppelant:=-1
			$params.nomTache:="SauvegarderAPP"
			cs.$process.new().NouveauProcess(cs.$sauvegarde; "SauvegarderAPP"; $params)
		End if 
		
		//MARK:02 Init storage
		If ($commande ?? 2)
			Use (Storage)
				cs._main.new().InitVariablesSystème()
				InitProcessCooperative
			End use 
			
			Use (cs.$processData.me)
				//cs.$processData.me.processes:=New shared collection
			End use 
			
		End if 
		
		
		//MARK:03 SVGTool_Display_colors
		If ($commande ?? 3)
			SVGTool_Display_colors
		End if 
		
		//MARK:04 test téléchargement FTP
		If ($commande ?? 4)
			$o:=cs.$process.new()
			$x:=Folder(fk home folder).folder("tempo_ALV/FTP").platformPath
			ALERT("test téléchargement dans "+$x)
			
			
			//$params:=Créer objet
			$data:=New object("cheminDestination"; $x; "Options"; 0)
			$data.initProcess:=Formula(InitProcessThreadSafe)
			$data.CallBack:="CallBackTéléchargement"
			
			$data.IDnomFichier:="3110"
			$data.nomTache:="$application_TelechargerFichierMedia_test"+$data.IDnomFichier
			$o.NouveauProcess(cs.$application; "TelechargerFichierMedia"; $data)
			$data.IDnomFichier:="1339"
			$data.nomTache:="$application_TelechargerFichierMedia_test"+$data.IDnomFichier
			$o.NouveauProcess(cs.$application; "TelechargerFichierMedia"; $data)
			$data.IDnomFichier:="723"
			$data.nomTache:="$application_TelechargerFichierMedia_test"+$data.IDnomFichier
			$o.NouveauProcess(cs.$application; "TelechargerFichierMedia"; $data)
			$data.IDnomFichier:="1258"
			$data.nomTache:="$application_TelechargerFichierMedia_test"+$data.IDnomFichier
			$o.NouveauProcess(cs.$application; "TelechargerFichierMedia"; $data)
			
			//ABORT
			
			$data.IDnomFichier:="3109"
			$data.Options:=4
			$data.nomTache:="$application_TelechargerFichierMedia_test"+$data.IDnomFichier
			$o.NouveauProcess(cs.$application; "TelechargerFichierMedia"; $data)
		End if 
		
		//MARK:05 test génération licence ALV
		If ($commande ?? 5)
			var $xml : cs.xSDK.XML
			$xml:=cs.xSDK.XML.me
			
			$stdIn:=""
			$x:="philippe"
			$y:="phil"
			//$Error:=HTTP MiseAjourALV("EnregistrementApplication"; $stdIn; ->$x; ->$y)
			
			$o:=Folder(fk documents folder).folder("tempo_ALV").file("Hebergement.xml")
			$x:=""
			If ($o.exists)
				// lire le fichier XML
				$xml.LireFichier($o; ->$stdIn)
				// lire la clé publique reçue
				If ($xml.LireLeChemin(->$stdIn; "Chemins/RacineHOST"; ->$x).success)
					// lire l'identifiant
					If ($xml.LireLeChemin(->$stdIn; "Connexion/Identifiant"; ->$y).success)
					End if 
					
					// lire le mot de passe
					If ($xml.LireLeChemin(->$stdIn; "Connexion/MotDePasse"; ->$z).success)
					End if 
					
					
				End if 
			End if 
		End if 
		
		//MARK:06 test génération mobile
		If ($commande ?? 6)
			Use (cs.$session.me.prefs)
				cs.$session.me.prefs.Session_Etat:=cs.$session.me.prefs.Session_Etat ?+ 17
			End use 
			$o:=ds.Personnes.get(952)
			$x:=$o.biographie
			
			$o:=ds.Sites.get(164)
			$o:=ds.Communes.get(44)
			$x:=$o.etatCivil
			
		End if 
		
		//MARK:07 ImporterLogs
		If ($commande ?? 7)
			Use (cs.$session.me.prefs)
				cs.$session.me.prefs.Session_Etat:=cs.$session.me.prefs.Session_Etat ?+ 18  // BDD mère
			End use 
			cs.xJLOG.$LogsAppImport.new().ImporterLogs()
		End if 
		
		//MARK:08 open datastore
		If ($commande ?? 8)
			$x:="auteur"
			$y:="philippe"
			$o:=New object("type"; "4D Server"; "hostname"; "127.0.0.1:8081"; "user"; $x; "password"; $y; "idleTimeout"; 70; "tls"; False)
			//$o:=Créer objet("type";"4D Server";"hostname";"10.0.1.99:8080";"user";$x;"password";$y;"idleTimeout";70;"tls";Faux)
			//$connectTo:=Créer objet("type";"4D Server";"hostname";"10.0.1.99:8080";"user";"philippe";"password";$pwd;"idleTimeout";70;"tls";Faux)
			//$connectTo:=Créer objet("type";"4D Server";"hostname";"serveurainsilavie.local:8080";"user";"auteur";"password";"philippe";"idleTimeout";70;"tls";Faux)
			$oo:=Open datastore($o; "ID")
		End if 
		
		//MARK:09 maintenance xMOB
		If ($commande ?? 9)
			// maintenance mobile
			Use (Storage)
				cs.$session.me.prefs:=New shared object
				Use (cs.$session.me.prefs)
					cs.$session.me.prefs.Session_Etat:=0x0000 ?+ 6
				End use 
			End use 
			cs.xMOB.$maintenance.new().Démarrer()
		End if 
		
		//MARK:10 démarrer les serveurs WEB
		If ($commande ?? 10)
			//Utiliser (cs.$session.me.prefs)
			//cs.$session.me.prefs.Session_Etat:=cs.$session.me.prefs.Session_Etat ?+ 6
			//Fin utiliser 
			//cs.$documentation.new().CréerPageConnexionServeurWeb()
			//Utiliser (cs.$session.me.prefs)
			//cs.$session.me.prefs.Session_Etat:=cs.$session.me.prefs.Session_Etat ?- 6
			//Fin utiliser 
			
			
			cs.$serveurWEB.new().Installer()
			cs.xWEB.$serveur.new().Demarrer()
			cs.xWEBMO.$serveur.new().Demarrer()
			
			
			//cs.$certificatSSL.new().Activer()
			
			//$o:=Créer objet("params"; Créer objet("URL"; "/LancerServeur"))
			//EXÉCUTER MÉTHODE("Connexion Web"; *; $o)
			ok:=0
			CONFIRM("Exporter les paramètres Web via 'messageApplication[msgk_debug]'"; "Non"; "Oui")
			If (ok=0)
				$c:=WEB Server list
				TEXT TO DOCUMENT(cs.$trace.me.GetGarbageDossier("_APPdebug/"+Current method name).file(Timestamp+"Ainsi La Vie.json").platformPath; JSON Stringify($c.query("name =:1"; "Ainsi La Vie")[0]; *))
				TEXT TO DOCUMENT(cs.$trace.me.GetGarbageDossier("_APPdebug/"+Current method name).file(Timestamp+"ALV Serveur Web.json").platformPath; JSON Stringify($c.query("name =:1"; "ALV Serveur Web")[0]; *))
				TEXT TO DOCUMENT(cs.$trace.me.GetGarbageDossier("_APPdebug/"+Current method name).file(Timestamp+"ALV Serveur Web Mobile.json").platformPath; JSON Stringify($c.query("name =:1"; "ALV Serveur Web Mobile")[0]; *))
			End if 
			
			//$o:=cs.xWEB.$serveur.new().LireInformationsServeur()
			//$o:=JSON Parse($o.resultat; Is object)
			$o:=New object("userName"; "philippe")
			cs.$serveurAPP.me.Executer(cs.$session.name; "FixerSessionUser"; $o)
			
		End if 
		
		//MARK:11 $requeteHTTP
		If ($commande ?? 11)
			
			Use (cs.$session.me.prefs)
				//cs.$session.me.prefs.Session_Etat:=cs.$session.me.prefs.Session_Etat ?+ 17
				
				//cs.$session.me.prefs.Session_Etat:=cs.$session.me.prefs.Session_Etat ?- 16  // nomade
				cs.$session.me.prefs.Session_Etat:=cs.$session.me.prefs.Session_Etat ?+ 18  // BDD mère
			End use 
			
			$data:=Données Hôte Partagées
			//$data.RequeteHTTP.call(Null).Requeter("/4DHTTP/APP/$serveurWEB/test"; "Get"; $o; "blob")
			
			
			cs.$requeteHTTP.new().Requeter("/4DHTTP/APP/$serveurWEB/test"; "Get"; $o; "blob")
			//cs.$requeteHTTP.new().Requeter("/4DHTTP/APP/test_text"; "GET"; $o; "blob")
			cs.$requeteHTTP.new().Requeter("/4DHTTP/xSDK/EvenementsALV/GetEvenementsServeur"; "Get"; $o; "blob")
			$o.params:=New object("x"; "toto")
			//cs.$requeteHTTP.new().Requeter("/4DHTTP/APP/$journalALV/ListerLesUtilisateurs"; "Get"; $o; "blob")
			$oo:=$o.reqRetour
			
			
			
			//var $host : Object:=New object
			//EXECUTE METHOD(Lire Données Hôte Partagées; $host)
			//$data:=New object
			//$host.RequeteHTTP.call(Null).Requeter("/4DHTTP/xSDK/EvenementsALV/GetEvenementsServeur"; "GET"; $data; "blob")
			
			//cs.CommandesEditeur.new().OuvrirConsoleSRV()
			//cs.CommandesEditeur.new().OuvrirConsoleAPP()
			
		End if 
		
		
		//MARK:12 $serveurAPP
		If ($commande ?? 12)
			$params:=New object()
			//cs.$formulaire_0123.new().getCheminBDD($params)
			cs.$serveurAPP.me.Executer(cs.$formulaire_0123.name; "getCheminBDD"; $params)
		End if 
		
		//MARK:13 $maintenance WEB
		If ($commande ?? 13)
			SET ASSERT ENABLED(True)
			Use (Storage)
				cs.$session.me.prefs:=New shared object
				Use (cs.$session.me.prefs)
					cs.$session.me.prefs.Session_Etat:=0x0000 ?+ 6
				End use 
			End use 
			
			cs.xWEB.$maintenance.new().Démarrer()
		End if 
		
		//MARK:14 Documentation ALV
		If ($commande ?? 14)
			$params:=New object
			$params.nomProcess:="$ALV_Creer_DOC"
			$params.initProcess:=Formula(InitProcessThreadSafe)
			$params.tache:=cs.xSDK.RegistreTaches.me.Inscrire(New object("nomProcess"; Current process name; "nomTache"; "toto"; "numProcessAppelant"; Current process))
			// s'il existe, on le laisse terminer
			cs.$process.new().NouveauProcess(cs.$documentation; "CreerDocumentation"; $params)
			
			//$params:=New object
			//$params.functionID:="CreerDocumentation"
			//$params.nomTache:="ALV_Creer_DOC"
			//$params.numProcessAppelant:=-1
			//// s'il existe, on le laisse terminer
			//$numProc:=Exécuter Function Préemptive(cs.$documentation; $params)
		End if 
		
		
		//MARK:15 test ORDA
		If ($commande ?? 15)
			//FIXER PARAMÈTRE BASE([Commandes]; Numéro automatique table; 0)
			
			ds.startTransaction()
			//$o.LogIn:="tom"
			//$o.Name:="galaxyA40"
			//$o.First_Name:="android 11"
			//$o.Password:="Gm@il07011980"
			//$o.Adresse_eMail:="tom.atlas1980@gmail.com"
			//$o.Groupe:=1
			//$o.save()
			
			//$o.save()
			
			
			//Pour chaque ($o; ds.DicoDesNoms.all())
			////$o.IDunique:=Generer UUID
			////$o.save()
			
			////Pour chaque ($ooo; $oo)
			////$ooo.Commande:=$o.ID
			////$ooo.save()
			////Fin de chaque 
			//Fin de chaque 
			//ds.cancelTransaction()
			//ds.validateTransaction()
		End if 
		
		//MARK:16 console
		If ($commande ?? 16)
			// obsolete Connexion servicesHTTP("FixerURLserveur")
			cs.CommandesEditeur.new().OuvrirConsoleAPP()
			
			$data:=New object("commande"; "3123")
			cs.CommandesEditeur.new().ExécuterMenu($data)
		End if 
		
		//MARK:17 AG
		If ($commande ?? 17)
			// voir "Arbre Généalogique" pour le détail des options
			var $EtatProcessus : Object
			$params:=New object
			$i:=953
			$i:=2048
			OB SET($params; "IDarbre"; $i)
			OB SET($params; "IDpersonne"; CodeEnreg($i; [1]))
			OB SET($params; "NmaxAscendance"; 0)
			OB SET($params; "NmaxDescendance"; 3)
			// la génération du site statique "WEBStatic" crée une forêt d'arbres => la BDD_AG grossit et les commandes SELECT prennent des plombes
			// dans ce cas, on réduit la taille de la BDD_AG en créant des BDD_AG alphabétiques
			$o:=Folder(fk documents folder).folder("tempo_ALV").folder("_ARBdebug")
			$o.delete(Delete with contents)
			$o.create()
			OB SET($params; "CheminDossierBDD_AG"; $o.platformPath)
			
			OB SET($params; "nomBDD"; "session")
			$y:="serveur HTML portrait.xml"
			$y:="Editeur clair.xml"
			OB SET($params; "Modele"; $y)
			OB SET($params; "functionID"; "Construire_AG")
			// nom et collections des éléments Webables
			//OB FIXER($params; "EntitésWebables"; Créer objet)
			//OB FIXER($params; "PersonnesAffichables"; "HTTP_Personnes")
			//OB FIXER TABLEAU($params.EntitésWebables; "HTTP_Personnes"; HTTP_Personnes)
			//OB FIXER($params; "EventsAffichables"; "HTTP_Events")
			//OB FIXER TABLEAU($params.EntitésWebables; "HTTP_Events"; HTTP_Events)
			
			OB SET($params; "AlertesHôte"; 0x0004)
			OB SET($params; "Session_Etat"; cs.$session.me.prefs.Session_Etat)
			OB SET($params; "optionsMsg"; [msgk_event])
			// options : on veut les cadres des personnes absentes (=> largeur image SVG fixe)
			OB SET($params; "Options"; 1)  //0x0007)  // liens dynamiques
			// initialiser l'état
			OB SET($EtatProcessus; "Params"; 0x0000)
			//OB FIXER($EtatProcessus; "Params"; 0x0000 ?? 25)  // afficher viewer
			OB SET($EtatProcessus; "SaisieAutorisée"; True)
			OB SET($params; "EtatProcessus"; $EtatProcessus)
			
			Use (cs.$session.me.prefs)
				//cs.$session.me.prefs.Session_Etat:=(cs.$session.me.prefs.Session_Etat ?+ 6) ?+ 8
			End use 
			
			// on lance (le résultat sera reçu dans arbreXML)
			cs.xARB.$arbre.new().Imager_AG($params)  //Executer("Imager_AG"; ->dataTexte)
			$x:=$params.arb
			
			
			//$bool:=Arbre Généalogique(Imager AG; $params; ->dataTexte)
			TEXT TO DOCUMENT($o.platformPath+"arbre.xml"; $x)
			BEEP
		End if 
		
		//MARK:18 $rechercheBDD
		If ($commande ?? 18)
			If (True)
				$o:=New object
				$o.Nom:=""
				$o.Prenom:=""
				$o.Events:=New object
				$o.Events.Naissances:=New object("date"; New object("Start"; ""; "Stop"; ""))
				//$o.Events.Naissances:=Créer objet("date"; Créer objet("Start"; "01/01/2022"; "Stop"; ""))  //1 janvier 2022"))
				//$o.Critères.Events.Naissances:=Créer objet("date"; Créer objet("Start"; "1 janvier 2022"; "Stop"; "1 février 2022"))
				//$o.Critères.Events.Mariages:=Créer objet("date"; Créer objet("Start"; "1 janvier 2022"; "Stop"; "31 décembre 2023"))
				//$o.Critères.Events.Deces:=Créer objet("date"; Créer objet("Start"; "1 janvier 2022"; "Stop"; "31 décembre 2023"))
				//$o.nom:="hamon@"
				//$o.Events.Deces:=Créer objet("lieu"; Créer objet("nom"; "Plouigneau"); "date"; Créer objet("Start"; "1 janvier 2022"; "Stop"; "31 décembre 2023"))
				
				cs.$rechercheBDD.new().RechercherPersonnes($o; ->$c)
			End if 
			
			If (False)
				$o:=New object
				$o.nom:="plou@"
				cs.$rechercheBDD.new().RechercherCommunes($o; ->$c)
			End if 
			
			TRACE
		End if 
		
		//MARK:19 $canalAudio
		If ($commande ?? 19)
			//Lire Fichier Son (15001;"Ouverture")  // son ouverture sur le canal application
			//JOUER SON("Submarine.aiff")
			
			var $canal : cs.$canalAudio
			
			$canal:=cs.$canalAudio.new("SyntheLecture")
			$x:="Bonjour à tous et bonne journée"
			$canal.LireTexte($x)
			
			$o:=Folder(fk documents folder).file("test.aiff")
			$canal.EnregistrerTexte($x; $o)
			
			$o:=Folder(fk resources folder).folder("Sons").file("Ouverture_OSX.mp3")
			$canal.IDnomCanal:="Ambiance"
			$canal.FixerFichier($o)
			$canal.FixerLecturePause(1)
			$canal.LireNiveau()
			
			//$x:="Bonjour à tous et bonne journée"
			////$x:="Bonjour"
			//$y:=Documents systeme("buildFilePath"; System folder(Documents folder); ["test.aiff"])
			//$o:=New object("IDnomCanal"; "SyntheLecture"; "Texte"; $x; "CheminFichier"; $y)
			//$i:=Wrapper ALV_Pack(VOIX Lire Texte; ->$o)
			
			//$o.IDnomCanal:="Enregistrement"
			//$i:=Wrapper ALV_Pack(VOIX Enregistrer Texte; ->$o)
			
			//$y:=Documents systeme("buildFilePath"; Get 4D folder(Current resources folder); ["Sons"; "Ouverture_OSX.mp3"])
			//$o.IDnomCanal:="Ambiance"
			//$o.chemin:=$y
			//$o.CheminFichier:=$y
			//$o.Propriété:=AV LecturePause
			//$o.ValeurPropriété:=1
			//$i:=Wrapper ALV_Pack(AUDIO Ouvrir Canal; ->$o)
			//$i:=Wrapper ALV_Pack(AUDIO Fixer Propriété Canal; ->$o)
			
			//$o.Propriété:=AV Niveau
			//$i:=Wrapper ALV_Pack(AUDIO Lire Propriété Canal; ->$o)
		End if 
		
		//MARK:20 $wrapperPlugIn
		If ($commande ?? 20)
			$o:=ds.Medias.get(3109)
			$x:=$o.LeFichier().platformPath
			
			$i:=1
			$j:=cs.$wrapperPlugIn.me.ConvertirPageDansImage($x; $i; 1; ->$pict)
			ALERT(String($j))
			
			$y:=cs.xSDK.Traces.new().GetGarbageDossier().file("test.png").platformPath
			$j:=cs.$wrapperPlugIn.me.ConvertirPageDansFichier($x; $i; 1; $y)
			ALERT(String($j))
		End if 
		
		//MARK:21 EditerNotesMobile
		If ($commande ?? 21)
			Use (cs.$session.me.prefs)
				cs.$session.me.prefs.Session_Etat:=cs.$session.me.prefs.Session_Etat ?+ 18
			End use 
			cs.CommandesEditeur.new().EditerNotesMobile()
		End if 
		
		//MARK:22 vide
		If ($commande ?? 22)
			
		End if 
		
		//MARK:23 test console
		If ($commande ?? 23)
			// afficher la console de l'application
			InitProcessCooperative
			ON ERR CALL(Formula(traceHandler).source)
			
			$params:=New object
			$params.Commande:="Afficher"
			$params.sourceLogs:=ALV Client APP
			$params.wndTitre:="Logs application ALV"
			cs.xSDK.ResourceALV.me.SetObjet(Est Ressource APP; "Ressources_Communes/nbrMaxLogs"; Is longint; $params; "nbrMaxLogs")
			
			cs.xSDK.EvenementsALV.me.AfficherEditeur($params)
			Waiting(60)
			
			var $trace:=cs.$trace.me
			Use (cs.$session.me.prefs)
				cs.$session.me.prefs.Session_Etat:=((0x0000 ?+ 6) ?+ 8) ?+ 3
			End use 
			$trace.DebugerMethode("debug libellé"; Current method name; "Le process "+String(Current process)+" n'a pas de fenêtre")
			$trace.DebugerVariables("debug var"; Current method name; New object("largeur Media_Pict1"; 1000; "titre"; "kh ;h j j"; "bool"; True))
			$trace.DebugerEventForm("debug eventForm"; Current method name; New object("numEvent"; FORM Event.code; "numTable"; Table(->[Medias])))
			
			Use (cs.$session.me.prefs)
				cs.$session.me.prefs.Session_Etat:=((0x0000 ?- 6) ?- 8) ?- 3
			End use 
			
			$trace.EnvoyerMessages([msgk_event; msgk_log]; "Direct test libellé"; Current method name; "Direct test description")
			
			cs.xSDK.Traces.new().EnvoyerMessages([msgk_event; msgk_log]; "SDK"; "test SDK"; Current method name; "test SDK message")
			cs.xALB._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "test ALB"; Current method name; "test ALB message")
			cs.xARB._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "test ARB"; Current method name; "test ARB message")
			
			$trace.Créer(-15003; Current method name; "5059").LeverException([msgk_event; msgk_log])
			$trace.Créer(15104; Current method name; "5102").LeverException([msgk_event; msgk_log])
			
			CALL WORKER(Worker Services; Formula from string("cs.$trace.me.EnvoyerMessages($1;$2;$3;$4)"); [msgk_event; msgk_log]; "WK formule directe test libellé"; Current method name; "WK formule directe test description")
			CALL WORKER(Worker Services; Formula from string(Importer Les Journaux); [msgk_event; msgk_log]; "WK cste formule directe test libellé"; Current method name; "WK cste formule directe test description"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
			$docRef:=Create document(Folder(fk documents folder).folder("tempo_ALV").file("test").platformPath)
			
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "WK service libellé"; Current method name; "test sous WK"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
			$trace.EnvoyerMessages([msgk_debug]; Current method name; "test_msg_debug"; "vekz mezmzorvmzjv z:lq rvoavn z:ljre nb=qsee"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_debug]; Current method name; "test_msg_debug"; "by WK vekz mezmzorvmzjv z:lq rvoavn z:ljre nb=qsee"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		End if 
		
		//MARK:24 xWEBMO.$serveur
		If ($commande ?? 24)
			cs.xWEBMO._composant.new().InstallerServeur()
			cs.xWEBMO.$serveur.new().Demarrer()
			BEEP
			Waiting(60)
		End if 
		
		//MARK:25 maintenance xWEBMO
		If ($commande ?? 25)
			Use (cs.$session.me.prefs)
				cs.$session.me.prefs.Session_Etat:=cs.$session.me.prefs.Session_Etat ?+ 6
			End use 
			cs.xWEBMO._maintenance.new().Démarrer()
			//cs.xALB._maintenance.new().Démarrer()
			BEEP
			//$o:=cs.xSDK.RegistreTaches.me.Inscrire(New object("nomProcess"; Current process name; "nomTache"; "CréerMediaMobile"; "numProcessAppelant"; Current process))
			//cs.xWEBMO._maintenance.new().CréerMediaMobile($o)
		End if 
		
		//MARK:26 WEB FixerEtatConnexion
		If ($commande ?? 26)
			If (WEB Is server running)
				WEB STOP SERVER
				Use (Storage.System)
					Storage.System.estClientAPP:=False
				End use 
				
			Else 
				Use (cs.$session.me.prefs)
					cs.$session.me.prefs.Session_Etat:=cs.$session.me.prefs.Session_Etat ?+ 6
					cs.$session.me.prefs.Session_Etat:=cs.$session.me.prefs.Session_Etat ?+ 18
				End use 
				WEB START SERVER
				Waiting(10)
				Use (Storage.System)
					Storage.System.estClientAPP:=True
				End use 
				CALL WORKER("WK_EtatConnexionHTTP"; Formula(cs.$requeteHTTP.me.FixerEtatConnexion()))
				
			End if 
		End if 
		
		
		//MARK:27 ActiverApplication
		If ($commande ?? 27)
			
			var $session : cs.$session
			$session:=cs.$session.me
			Use ($session)
				$session.userName:="Auteur"
			End use 
			$session.ActiverApplication()
		End if 
		
		//MARK:30 console
		If ($commande ?? 30)
			cs.CommandesEditeur.new().OuvrirConsoleAPP()
		End if 
		
		//MARK:31 traduc
		If ($commande ?? 31)
			cs.xSDK.TraductionsEditeur.new().ModifierTraductions()
		End if 
		
End case

⇧ Afficher Progression Process - 12/05/2026 09:38:30

      #DECLARE($data : Object; $process : Object)->$result : Integer
// gérer les indicateurs progression (userMessage, thermomètre et curseur horaire)
// $data = bits 24-31 : type curseur 
//      bits 00-23 : paramètre
C_LONGINT($gauche; $haut; $droite; $bas)
C_TEXT($VarName)
C_OBJECT($params)
C_COLLECTION($listeTâches)

// ne sert qu'en cas d'appel par un 'au cas ou'
$result:=0

Case of 
	: (Count parameters=0)
		// lire les progressions
		
		If (False)
			// init
			$params:=New object("State"; False; "Etat"; ""; "Time"; 0)
			
			// données d'un process APP lancé par le process courant
			// attention : à partir de v16, si "ProcInProgressNum" est un worker, on ne peut pas savoir ici s'il a fini notre tâche (le process peut continuer à vivre)
			// dans ce cas, l'effacement du thermomètre est déclenché par le Worker
			
			// lire la progression du process
			$params.Commande:="LireProgression"
			$params.numProcess:=Storage.Processes[Current process name].ProcInProgress.numProcess
			Case of 
				: (Storage.Processes[Current process name].ProcInProgress.numProcess=0)
					// pas de proc lancé par le process courant
				: (Afficher Progression Process($params; Storage.Processes[Storage.Processes[Current process name].ProcInProgress.name])#0)
					// on a les données
				: ($params.State)
					// process en progression
				Else 
					// il est terminé, nettoyer
					Use (Storage.Processes[Current process name].ProcInProgress)
						Storage.Processes[Current process name].ProcInProgress.numProcess:=0
					End use 
			End case 
			
			// données d'un process Composant lancé par le process courant
			// remarque : ce process est inscrit dans le storage du composant
			// lire la progression du process
			Case of 
				: ($params.State=True)
					// priorité au process courant
				: (Not(OB Is defined(Form)))
				: (Not(OB Is defined(Form; "sousFormulaire")))
				: (Not(OB Is defined(Form.sousFormulaire; "ProcInProgress")))
				: (Form.sousFormulaire.ProcInProgress.numProcess<0)
					// dans cette version, seule façon de savoir si on doit afficher la progression d'un process de composant
				Else 
					// process de composant
					$params.numProcess:=Form.sousFormulaire.ProcInProgress.numProcess
					Afficher Progression Process($params; Form.sousFormulaire.ProcInProgress)
			End case 
			
			// finalement, afficher l'état résultant
			$params.Commande:="AfficherAvancement"
			Afficher Progression Process($params)
			
			$params.Commande:="AfficherCurseurHoraire"
			Afficher Progression Process($params)
		End if 
		
	: ($data.Commande="LireProgression")
		// de $process
		Case of 
			: ($data.numProcess=0)
				// rien en cours
			: (Process state($data.numProcess)<Executing)
				// le process a fini
			Else 
				// on a un process en progression
				$data.State:=True
				$data.Etat:=$process.Status.Etat
				// .Time est fixé
				
				// calcul de l'avancement (cas où un début / fin de tâche existent)
				If (OB Is defined($process.Status; "avancement"))
					Progression Fixer Avancement($process.Status.avancement*100; $process.Status)
					// .Time est calculé
				End if 
				// fixer l'avancement 
				$data.Time:=$process.Status.Time
		End case 
		
		
	: ($data.Commande="AfficherAvancement")
		// fixer l'état de l'avancement
		// * un thermomètre existe dans le formulaire courant?
		OBJECT GET COORDINATES(*; "avancement"; $gauche; $haut; $droite; $bas)
		Case of 
			: (Not(($droite-$gauche>0) & ($bas-$haut>0)))
				// pas de thermometre ici
			: ($data.Etat="")
				// pas de message thermomixé
				Waiting(30)
				OBJECT SET VISIBLE(*; "avancement"; False)
				
			Else 
				// on a un thermomètres mettre à jour
				OBJECT Get pointer(Object named; "avancement")->:=$data.Time
				OBJECT SET VISIBLE(*; "avancement"; $data.State)
				// * message utilisateur
				Form.AfficherMessageUtilisateur(New object("libelle"; $data.Etat))
		End case 
		
		
	: ($data.Commande="AfficherCurseurHoraire")
		// * il existe un curseur horaire dans le formulaire courant?
		ARRAY TEXT($tabObjets; 0)
		ARRAY POINTER($tabVariables; 0)
		FORM GET OBJECTS($tabObjets; $tabVariables; Form current page+Form inherited)
		$VarName:="AsynchroProgress"
		$listeTâches:=cs.xSDK.RegistreTaches.me.LireInscriptions()
		
		Case of 
			: (Find in array($tabObjets; $VarName)=-1)
				// pas de curseur horaire dans le formulaire
			: ($listeTâches.length=0)
				// pas de tâches créées
				OBJECT SET VISIBLE(*; $VarName; False)
				
			: ($listeTâches.query("data.numProcessAppelant = :1"; Current process).length=0)
				// plus rien en cours
				OBJECT SET VISIBLE(*; $VarName; False)
				
			Else 
				// on (ré)allume
				$tabVariables{Find in array($tabObjets; $VarName)}->:=1  // activer la roue (utile?)
				OBJECT SET VISIBLE(*; $VarName; True)
		End case 
		
	Else 
		
End case

⇧ Liens HyperText - 24/03/2026 15:01:13

      #DECLARE($Commande : Text; $ptrText : Pointer; $ptrLien : Pointer)
C_LONGINT($début; $fin; $typeLien)
C_TEXT($motClé; $texte; $lienHyperTextID; $texteTrouvé)
C_OBJECT($params)


Case of 
	: ($Commande="Modifier")
		// Rechercher des mot clés dans le texte brut de $1 et les HTMLiser
		$texte:=ST Get plain text($ptrText->)
		// $ptrText peut être une variable texte ou ZoneWritePro
		COPY NAMED SELECTION([Encyclopedia]; "sLiensHTML")
		If (Records in selection([Encyclopedia])=1)  // NE PAS HTMLiser le mot-clé sélectionné
			ALL RECORDS([Encyclopedia])
			CREATE SET([Encyclopedia]; "liensHTML")
			USE NAMED SELECTION("sLiensHTML")
			REMOVE FROM SET([Encyclopedia]; "liensHTML")
			USE SET("liensHTML")
			CLEAR SET("liensHTML")
		Else 
			ALL RECORDS([Encyclopedia])
		End if 
		ORDER BY FORMULA([Encyclopedia]; Length([Encyclopedia]MotCle); <)
		
		// les liens doivent être un mot-clé de l'encyclopédie et un mot entier du texte
		// lister les mots du texte
		GET TEXT KEYWORDS($texte; $Mots; *)
		FIRST RECORD([Encyclopedia])
		Repeat 
			$lienHyperTextID:=String(CodeEnreg(Record number([Encyclopedia]); [Table(->[Encyclopedia])]))
			
			// utiliser la forme plurielle du mot
			$motClé:=[Encyclopedia]formePlurielle
			$début:=1
			Repeat 
				// rechercher $motClé avec ou sans majuscule
				$début:=Position($motClé; ST Get plain text($ptrText->); $début)
				If ($début>0)
					$fin:=$début+Length($motClé)
					$texteTrouvé:=ST Get text($ptrText->; $début; $fin)
					// ce doit être un mot entier ou une expression
					If ((Find in array($Mots; $texteTrouvé)>0) | ($motClé="@ @") | ($motClé="@-@"))  // regex?
						// on a un mot entier qui fait partie de la BDD
						// utiliser le texte d'origine pour le lien (on ne sait pas s'il y a des majuscules)
						ST SET TEXT($ptrText->; "<span style=\"-d4-ref-user:'"+$lienHyperTextID+"'\">"+$texteTrouvé+"</span>"; $début; $fin)
					End if 
					$début:=$fin
				End if 
			Until ($début=0)
			
			//utiliser la forme singulière du mot
			$motClé:=[Encyclopedia]MotCle
			$début:=0
			Repeat 
				// rechercher $motClé avec ou sans majuscule
				$début:=Position($motClé; ST Get plain text($ptrText->); $début)
				If ($début>0)
					$fin:=$début+Length($motClé)
					$texteTrouvé:=ST Get text($ptrText->; $début; $fin)
					// ce doit être un mot entier ou une expression
					If ((Find in array($Mots; $texteTrouvé)>0) | ($motClé="@ @") | ($motClé="@-@"))  // regex?
						// on a un mot entier qui fait partie de la BDD
						ST SET ATTRIBUTES($ptrText->; $début; $fin; Attribute text color; "red")  // pb
						// utiliser le texte d'origine pour le lien (on ne sait pas s'il y a des majuscules)
						ST SET TEXT($ptrText->; "<span style=\"-d4-ref-user:'"+$lienHyperTextID+"'\">"+$texteTrouvé+"</span>"; $début; $fin)
					End if 
					$début:=$fin
				End if 
			Until ($début=0)
			
			NEXT RECORD([Encyclopedia])
		Until (End selection([Encyclopedia]))
		USE NAMED SELECTION("sLiensHTML")
		CLEAR NAMED SELECTION("sLiensHTML")
		
	: ($Commande="Activer")
		// clic dans un champ / variable texte / zoneWritePro $ptrText
		// récupérer les données du lien
		GET HIGHLIGHT($ptrText->; $début; $fin)
		If ($début<$fin)  // ATTENTION il faut un champ / une variable saisissable
			// lire la balise <span>
			$motClé:=ST Get text($ptrText->; $début; $fin)
			// lire le type de lien
			$typeLien:=ST Get content type($motClé)  // ST Début sélection; ST Fin sélection  pas utile
			Case of   // traitement des différents types
				: ($typeLien=ST Url type)
					
				: ($typeLien=ST Expression type)
					
				: ($typeLien=ST User type)
					// récupérer le code de l'information du lien
					$lienHyperTextID:=ST Get plain text($motClé; ST User links as links)
					// récupérer le mot-clé cliqué
					$motClé:=ST Get plain text($motClé; ST User links as labels)
					Liens HyperText("Exécuter"; ->$motClé; ->$lienHyperTextID)
			End case 
		Else 
			// pas de contenu sélectionné
		End if 
		
	: ($Commande="Exécuter")
		// exécuter le lien
		$motClé:=$ptrText->
		$typeLien:=Num($ptrLien->)
		Case of 
			: (CodeEnreg($typeLien; [Table(->[Encyclopedia])])=1)
				// le traitement dépend du process courant => faire remonter
				$params:=New object("texte"; $motClé)
				Appeler_Le_Formulaire(Current form window; "AfficherMotClé"; $params)
				
			: (CodeEnreg($typeLien; [Table(->[Events]); Table(->[Lieux]); Table(->[Medias]); Table(->[Personnes])])=1)
				// changer de sélection
				cs.$editeur.new().EditerSélection($typeLien; 0)  // pas testé
				
			: (CodeEnreg($typeLien; [213])=1)
				// ouvrir une page d'aide
				$params:=cs.$formulaire.new()
				$params.menu.params:=New object("type"; "Palette"; "DataClassNom"; ""; "nomClass"; "$documentation"; "Commande"; "3106"; "IDpage"; $typeLien & 0x00FFFFFF)
				$params.menu.Exécuter()  //AfficherFormulaire()
		End case 
		
	Else 
		// erreur non gérée
		
End case

⇧ Installer_LesServeurs - 26/02/2026 08:16:42

Partagée entre composants et base hôte

Disponible via les balises HTML et les URLs 4D (4DACTION...)

Capable de process préemptif

      #DECLARE($commande : Text)->$result : Text
var $URL : Text:=""
var $adresseServeur : Text:=""
var $dataTexte : Text:=""
var $i : Integer
var $data : Object
var $rsc : cs.xSDK.ResourceALV

$rsc:=cs.xSDK.ResourceALV.me

Case of 
		//*****************
		// documentation
		//*****************
	: ($commande="/getLienSiteAide")
		// renvoyer le lien d'ouverture du site documentation
		$rsc.SetVariable(Est Ressource APP; "Serveur_Web/nomDossier_Documentation"; Is text; ->$URL)
		$result:="/"+$URL+"/index.html"
		
		
	: ($commande="getURLsiteAide")
		// calculer l'URL du site Aide
		$adresseServeur:=Installer_LesServeurs("getAdresseServeur")
		$URL:=""
		$data:=cs.$certificatSSL.new().getCertInformations(cs.xSDK.EnvironnementALV.new().infosApplication(102).nomLong)
		// remarque : pour les tests, utiliser l'adresse IP
		Case of 
			: (Not($rsc.SetVariable(Est Ressource APP; "Serveur_Web/nomDossier_Documentation"; Is text; ->$URL)))
				
				// serveur sécurisé ? on ne sait pas si le serveur est lancé; aller à la source de l'information
			: ($data.Production.exists)
				// le site est sécurisé
				WEB GET OPTION(Web HTTPS port ID; $i)
				$URL:="https://"+$adresseServeur+":"+String($i)+"/"+$URL+"/index.shtml"
				
			Else 
				WEB GET OPTION(Web port ID; $i)
				$URL:="http://"+$adresseServeur+":"+String($i)+"/"+$URL+"/index.shtml"
		End case 
		$result:=$URL
		
		
	: ($commande="getAdresseServeur")
		// par défaut renvoyer le nom du domaine ALV
		// remarque : au cas où changement d'IP entre 2 lancements du serveur Web, on utilise le nom de domaine au lieu l'adresse IP du site
		$rsc.SetVariable(Est Ressource APP; "serveur_URL/Nom_sousDomaine"; Is text; ->$adresseServeur)
		// pour les tests, renvoyer l'IP du serveur
		$dataTexte:=""
		Case of 
			: (Not($rsc.SetVariable(Est Ressource APP; "Serveurs_ALV/nom_Machine"; Is text; ->$dataTexte)))
				// pas normal 
			: (System info.machineName=$dataTexte)
				// on est sur la machine host, on garde le nom de domaine
			Else 
				// on est en test sur une autre machine
				// utiliser l'adresse IP
				$rsc.SetVariable(Est Ressource WEB; "Serveur_web/Web_Adresse_IP_ecoute"; Is text; ->$adresseServeur)
		End case 
		$result:=$adresseServeur
		
		
	: ($commande="getURLserveurAPP")
		// par défaut renvoyer le nom du domaine ALV
		$result:="http://"+Installer_LesServeurs("getIPserveurAPP")
		
		
	: ($commande="getIPserveurAPP")
		// remarque : on fait l'hypothèse que le serveur n'est pas forcément démarré !
		// pour les tests, renvoyer l'IP du serveur
		$dataTexte:=""
		Case of 
			: (Not($rsc.SetVariable(Est Ressource APP; "Serveurs_test/nom_Machine"; Is text; ->$dataTexte)))
			: (System info.machineName=$dataTexte)
				// machine de test
				$rsc.SetVariable(Est Ressource APP; "Serveurs_test/IP_Serveur"; Is text; ->$adresseServeur)
				
			: (Storage.System.typeApplication=ALV BDD mère)
				$rsc.SetVariable(Est Ressource APP; "Serveurs_BDDmere/IP_Serveur"; Is text; ->$adresseServeur)
				
			Else 
				// renvoyer le nom du domaine ALV
				// remarque : au cas où changement d'IP entre 2 lancements du serveur Web, on utilise le nom de domaine au lieu l'adresse IP du site
				$rsc.SetVariable(Est Ressource APP; "Serveurs_ALV/IP_Serveur"; Is text; ->$adresseServeur)
		End case 
		$result:=$adresseServeur
		
End case

⇧ Créer Liste Hiérarchique - 18/05/2026 12:48:15

      #DECLARE($params : Object)->$result : Object
// ici on est COOPERATIF
// ----------------------------------------------------
// Nom créateur (OS) : Bernard Vaché
// Date et heure : 13/01/23
// ----------------------------------------------------
// Méthode : Créer LHdeCollection
// Description
//
// Paramètres
// ----------------------------------------------------
// Modifié par : Philippe (18/02/2023)
// Modifié par : Philippe (21/03/2023)
//
var $c : Collection
var $i; $listeH; $hSousListe; $type; $style : Integer
var $deployed; $saisissable; $addedElement : Boolean
var $element; $data; $paramètre; $subParams : Object
var $blob : Blob
var $pict : Picture

Case of 
	: ($params=Null)
		cs.$trace.me.Créer(-15068; Current method name; "'$params est est null").LeverException([msgk_event; msgk_log])
	: (Not(OB Is defined($params; "liste")))
		cs.$trace.me.Créer(-15068; Current method name; "'liste' n'est pas défini dans $params").LeverException([msgk_event; msgk_log])
		
	: (Not(OB Is defined($params; "LH")))
		// initialisation de la récursivité
		
		Case of 
			: (Not(OB Is defined($params; "nomProcessAppelant")))
			: ($params.nomProcessAppelant=Current process name)
			Else 
				// démarrage d'un process
				InitProcessCooperative
		End case 
		
		$params.débutTache:=0
		$params.duréeTache:=10000
		
		// lancer le traitement
		$params.LH:=New list
		$result:=Créer Liste Hiérarchique($params)
		
		$params.tache.FixerTime(10000)
		Waiting(10)
		
		// suite du traitement
		Case of 
			: (Not(OB Is defined($params; "nomProcessAppelant")))
			: (Not(OB Is defined($params; "CallBack")))
			Else 
				// transmettre au process demandeur le résultat
				cs.$process.new().AppelerFormulaire($params.nomProcessAppelant; $params.CallBack; $params)
		End case 
		$params.tache.DésInscrire()
		
	Else 
		// on est dans la récursivité
		
		$listeH:=$params.LH
		$c:=$params.liste
		
		$deployed:=False
		If (OB Is defined($params; "déployée"))
			$deployed:=$params.déployée
		End if 
		
		$result:=New object
		
		For ($i; 0; $c.length-1)
			
			$type:=Value type($c[$i])
			$addedElement:=False
			
			Case of 
				: ($params.tache.Tuer.signaled)
					// arreter
					
				: ($type=Is text)
					// ici on a un objet encodé avec les données de la liste
					BASE64 DECODE($c[$i]; $blob)
					BLOB TO VARIABLE($blob; $data)
					$result.list:=$data
					
				: ($type=Is object)
					// ici on a les info d'un élément de la liste
					$element:=$c[$i]
					Case of 
						: (Not(OB Is defined($element; "itemText")))
						: (Not(OB Is defined($element; "itemRef")))
							// le minimum syndical n'est pas requis
						Else 
							APPEND TO LIST($listeH; $element.itemText; $element.itemRef)
							// demander l'habillage de l'élément ajouté
							$addedElement:=True
					End case 
					
				: ($type=Is collection)
					// ici on a une sous liste
					$hSousListe:=New list
					$subParams:=OB Copy($params)
					$subParams.liste:=$c[$i]
					$subParams.LH:=$hSousListe
					$subParams.débutTache:=$params.tache.Time
					$subParams.duréeTache:=$params.duréeTache/$c.length
					$element:=Créer Liste Hiérarchique($subParams)
					$params.tache.FixerTime($subParams.tache.Time)
					
					Case of 
						: (Not(OB Is defined($element; "nombreEléments")))
							//: ($element.nombreEléments=0)
						: (Not(OB Is defined($element; "list")))
							// il faut les données de la list
						: (Not(OB Is defined($element.list; "itemText")))
						: (Not(OB Is defined($element.list; "itemRef")))
						Else 
							// ok on a tout
							APPEND TO LIST($listeH; $element.list.itemText; $element.list.itemRef; $hSousListe; $deployed)
							// demander l'habillage de l'élément ajouté
							$element:=$element.list
							$addedElement:=True
					End case 
					
			End case 
			
			// habiller un élément ajouté
			If ($addedElement)
				
				If (OB Is defined($element; "iconePict"))
					SET BLOB SIZE($blob; 0)
					BASE64 DECODE($element.iconePict; $blob)
					BLOB TO VARIABLE($blob; $pict)
					SET LIST ITEM ICON($listeH; 0; $pict)
				End if 
				
				// un blob 'data' contient les paramètres et propriétés de l'élément
				If (OB Is defined($element; "data"))
					$data:=CoDecBase64_Objet($element.data)
					
					// properties : contient les propriétés de l'élément
					$saisissable:=False
					$style:=Plain
					If (OB Is defined($data; "properties"))
						If (OB Is defined($data.properties; "saisissable"))
							$saisissable:=$data.properties.saisissable
						End if 
						If (OB Is defined($data.properties; "style"))
							$style:=$data.properties.style
						End if 
					End if 
				End if 
				// fixer les propriétés lues
				SET LIST ITEM PROPERTIES($listeH; 0; $saisissable; $style)
				
				// parameters : contient les paramètres de l'élément
				If (OB Is defined($data; "parameters"))
					For each ($paramètre; $data.parameters)
						Case of 
							: (Not(OB Is defined($paramètre; "sélecteur")))
							: (Not(OB Is defined($paramètre; "valeur")))
							Else 
								SET LIST ITEM PARAMETER($listeH; 0; $paramètre.sélecteur; $paramètre.valeur)
						End case 
					End for each 
				End if 
			End if 
			
			// avancement
			$params.tache.FixerTime($params.débutTache+(($i+1)/$c.length*$params.duréeTache))
		End for 
		
		$result.nombreEléments:=Count list items($listeH; *)
End case

⇧ [class]PersonnagesEntity - 30/04/2026 14:28:08

      Class extends Entity

Function LeLien()->$result : Object
	// renvoie la personne liée
	$result:=This.laPersonne
	
Function Libellé($userFormats : Object)->$libellé : Text
	// renvoie le nom formaté suivant les options $1
	var $formats : Object
	
	$libellé:=""
	$formats:=New object("Options"; 3)
	Case of 
		: (Count parameters=0)
		: (OB Is defined($userFormats; "Options"))
			$formats:=$userFormats
	End case 
	
	$libellé:=This.LeLien().Libellé($formats)
	
	
	// ----------------------
	//MARK:Modification DataStore
	// -----------------------
	
Function _FixerDonnées($quoi : Integer; $params : Object)->$result : Object
	Case of 
		: (Not(OB Is defined($params; "deQui")))
			$result:=ds.initResult(-15068; ".deQui non renseignés dans $params"; False)
		Else 
			This.personne:=$params.deQui.ID
			$result:=ds.initResult()
	End case 
	This.save()
	
	
	// ----------------------
	//MARK:APP mobile
	// -----------------------
	
	// cette entité est associée à un media ; décrire le contenu du media
exposed Function get vignetteMedia()->$result : Picture
	$result:=This.laZone.leMedia.vignetteMedia
	
	
exposed Function get dateChaineMedia()->$result : Text
	$result:=This.laZone.leMedia.dateChaine
	
	
exposed Function get titreMedia()->$result : Text
	$result:="Titre du media"
	
	If (estAppelMobile)
		$result:=This.laZone.leMedia.titre
	End if 
	
	
exposed Function get commentaireMedia()->$result : Text
	// attention : si la function est utilisée dans un formulaire, le nom de la function est le libellé du champ
	$result:="Le commentaire..."
	
	If (estAppelMobile)
		$result:=This.laZone.leMedia.commentaire
	End if 
	
	
exposed Function get descriptionMedia()->$result : Text
	// décrire les zones accrochées à this
	var $sélection : Object
	var $texte : Text
	var $c : Collection
	var $ID : Integer
	
	If (estAppelMobile)
		$sélection:=This.laZone.leMedia.lesZones
		Case of 
			: ($sélection.lesInstantanes.length=1)
				// lié à un event
				$texte:=$sélection.lesInstantanes.leEvent[0].Libellé(New object("Options"; 0x0103DF00))
				$result:="Photo prise lors "+$texte
				
			: ($sélection.lesPaysages.length=1)
				// un lieu
				$texte:=$sélection.lesPaysages.leLieu[0].Libellé(New object("Options"; 0x00030000))
				$result:="Photo prise à "+$texte
		End case 
		
		// récupérer les zones personnages
		If ($sélection.lesPersonnages.length>0)
			// attention : éviter de mettre le bazar dans les sélections utilisées
			// ici, on n'utilise pas les liens pour remonter aux personnes ; cela perturbe les autres fonctions (tri par la date en particulier)
			$c:=$sélection.lesPersonnages.orderBy("laZone.gauche asc").extract("personne")
			$texte:=""
			For each ($ID; $c)
				$texte:=$texte+", "+ds.Personnes.get($ID).Libellé(New object("Options"; 0x0003))
			End for each 
			// nettoyer
			$texte:=Substring($texte; 3)
			
			$texte:=Choose($c.length=1; "Personne présente : "; "Personnes présentes (de gauche à droite) : ")+$texte
			$result:=$result+(". "*Num(Length($result)>0))+$texte
		End if 
		
	Else 
		$result:="La description..."
	End if 
	
	
exposed Function get photoMedia($event : Object)->$result : Picture
	var $entité : Object
	var $path; $nomFichier : Text
	var $pict : Picture
	
	If (estAppelMobile)
		$entité:=This.laZone.leMedia
		$path:=cs.$document.new().GetMobileMediaFolder().platformPath
		
		$nomFichier:="media_"+String($entité.ID)+".jpg"
		READ PICTURE FILE($path+$nomFichier; $pict)
		
		$result:=$pict
	End if 
	
	
	// pour les tris
exposed Function get dateMedia()->$result : Text
	var $entité : Object
	
	$entité:=This.laZone.leMedia
	$result:=String($entité.dateNum; ISO date GMT; $entité.heure)

⇧ [class]$sauvegarde - 21/05/2026 10:55:07

      property environnement : cs.xSDK.EnvironnementALV
property xml : cs.xSDK.XML
property fichierParamsSauvegarde : 4D.File
property session : Object

Class constructor()
	
	// fixer le chemin du fichier XML des informations de sauvegarde
	This.fichierParamsSauvegarde:=Folder(Get 4D folder(Current resources folder; *); fk platform path).file("SauvegardesBDD.xml")
	
	This.environnement:=cs.xSDK.EnvironnementALV.new()
	This.xml:=cs.xSDK.XML.me
	This.session:=cs.$session.me
	
	
	// -----------------------------
	// MARK:Sauvegardes ALV
	// -----------------------------
	
Function ProgrammerSauvegardeALV($data : Object)
	// renvoyer la méthode à faire exécuter par le planificateur de tâches
	var $params : Object:=New object()
	
	Case of 
		: (Storage.System.typeApplication#4D BDD mère)
			// BDD mère uniquement
		Else 
			// c'est ok, renvoyer les données
			
			// données de programmation de la tâche
			$params:=New object("nomClass"; "$sauvegarde"; "functionID"; "SauvegarderALV"; "params"; New object)
			// dans 5 mn
			$params.params.dateTache:=String(Current date; ISO date GMT; (Current time+?00:05:00?)%?24:00:00?)
			// toutes les heures
			$params.params.période:=New object("jour"; 0; "seconde"; 60*60)
			// pas urgence
			$params.params.initialiser:=False
			
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Programmation"; Current method name; "tâche programmée (voir détails dans Logs)"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_log]; "Donnée"; Current method name; JSON Stringify($params))
	End case 
	// finalement
	$data.params:=$params
	
	
Function SauvegarderALV()
	InitProcessThreadSafe
	ON ERR CALL(Formula(Intercepter Erreur SAVE).source; ek local)
	
	CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Début de la sauvegarde ALV"; Current method name; ""; New object("nomProcess"; Current process name; "numProcess"; Current process))
	
	BACKUP
	// dans un process nommé "backupProcess"
	// lance aussi les méthodes base "sur ouverture", puis "fermeture sauvegarde" => SauvegarderAPP()
	
	
	// -----------------------------
	// MARK:Post Sauvegarde
	// -----------------------------
	
Function SauvegarderAPP($process : Object)
	// sauvegarder toutes les fichiers de la BDD mère sur les disques désignés dans les préférences
	// le process exécute une tâche ; tuer la t$ache tue le process
	var $params; $data : Object
	var $dateModificationDest : Date
	var $pict : Picture
	var $numProc; $numProgress : Integer
	var $tache : cs.xSDK.Tache
	
	ON ERR CALL(Formula(Intercepter Erreur SAVE).source; ek local)
	
	$tache:=cs.xSDK.RegistreTaches.me.Inscrire(New object("nomProcess"; Current process; "nomTache"; $process.nomTache; "numProcessAppelant"; -1))
	
	$params:=New object
	
	Case of 
		: (This.LireParamètres($params)#0)
		: (Not(OB Is defined($params; "chemins")))
		: ($params.chemins.length=0)
		Else 
			// ok, le user a programmé des chemins
			
			// fixer les paramètres de la session
			For each ($data; $params.chemins)
				// attendre que le disque soit monté
				$data.relancer:=True
				// un message alerte en cas de sauvegarde trop ancienne
				$data.relancerAlerte:=True
			End for each 
			
			Repeat 
				// lancer périodiquement la surveillance des disques, la tuerie et la sauvegarde
				
				// c'est parti pour une sauvegarde
				For each ($data; $params.chemins)
					Case of 
						: (Not(OB Is defined($data; "chemin")))
							// il faut un chemin de disque !
						: (Not(Folder($data.chemin; fk platform path).exists))
							// disque de sauvegarde non monté, deux cas :
							
							If ($data.relancerAlerte=True)
								CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "disque de sauvegarde"; Current method name; Localized string("5127")+" <"+$data.chemin+">"; New object("nomProcess"; Current process name; "numProcess"; Current process))
								// lire la date de dernière sauvegarde
								$dateModificationDest:=Date($data.miseAjour)
								// si la dernière sauvegarde date est de plus de 30 jours, secouer le user
								If ((Current date-$dateModificationDest)>30)
									cs.$process.new().AppelerFormulaire(Frontmost process(*); "AfficherMessageUtilisateur"; New object("libelle"; Localized string("5127")+" <"+$data.chemin+">"))
								End if 
								
								// ne pas relancer l'alerte
								$data.relancerAlerte:=False
								// remarque va rester à faux pendant TOUTE la session
								
							Else 
								// une première alerte a été faite
								// si le disque apparait, la sauvegarde va se déclencher automatiquement
							End if 
							
						: (Not($data.relancer))
							
							//: (Chaîne(Date($data.miseAjour); ISO date GMT; Heure(Heure($data.miseAjour)+(30*60)))>Chaîne(Date du jour; ISO date GMT; Heure courante))
							// la date de dernière mise à jour + 30 mn est supérieure à la date courante
							// attendre pour la prochaine sauvegarde
							
						Else 
							// c'est ok, on a un dossier accessible
							
							// interdire les user modifications
							Use (Storage.System)
								Storage.System.Status:=Storage.System.Status ?- 1
							End use 
							
							$numProgress:=Progress New
							Progress SET WINDOW VISIBLE(False; 40; Screen height-200)
							$pict:=cs._rsc.me.image(16208)
							Progress SET ICON($numProgress; $pict)
							Progress SET TITLE($numProgress; Localized string("5116")+"'"+$data.chemin+"'"; 0; ""; False)
							Progress SET WINDOW VISIBLE(True; -1; -1; True)
							
							Progress SET PROGRESS($numProgress; 100/10000; Localized string("5138"); False)
							This.CopierDossierDéveloppement($data)
							
							Progress SET PROGRESS($numProgress; 1000/10000; Localized string("5132"); False)
							This.CopierDossierBDD($data)
							
							Progress SET PROGRESS($numProgress; 2000/10000; Localized string("5147"); False)
							$data.nomTache:="CopierMedias"
							$data.numProcessAppelant:=-1
							$data.initProcess:=Formula(InitProcessThreadSafe)
							$data.tache:=cs.xSDK.RegistreTaches.me.Inscrire(New object("nomProcess"; Current process name; "nomTache"; $data.nomTache; "numProcessAppelant"; Current process))
							
							$numProc:=cs.$process.new().NouveauProcess(cs.$sauvegarde; "CopierMedias"; $data)
							cs.$processData.me.SuivreProgressionProgress($data.tache; 2000; 5000; $numProgress)  // fin de tâche 7000
							
							// remettre les données
							Use (Storage.System)
								Storage.System.Status:=Storage.System.Status ?+ 1
							End use 
							
							Progress SET PROGRESS($numProgress; 7000/10000; Localized string("5148"); False)
							$data.nomTache:="CopierDocumentsAutres"
							$data.numProcessAppelant:=-1
							$data.initProcess:=Formula(InitProcessThreadSafe)
							$data.tache:=cs.xSDK.RegistreTaches.me.Inscrire(New object("nomProcess"; Current process name; "nomTache"; $data.nomTache; "numProcessAppelant"; Current process))
							
							$numProc:=cs.$process.new().NouveauProcess(cs.$sauvegarde; "CopierDocumentsAutres"; $data)
							cs.$processData.me.SuivreProgressionProgress($data.tache; 7000; 1000; $numProgress)  // fin de tâche 8000
							
							Progress SET PROGRESS($numProgress; 8000/10000; Localized string("5148"); False)
							$data.nomTache:="CopierDossierRessourcesDEV"
							$data.numProcessAppelant:=-1
							$data.initProcess:=Formula(InitProcessThreadSafe)
							$data.tache:=cs.xSDK.RegistreTaches.me.Inscrire(New object("nomProcess"; Current process name; "nomTache"; $data.nomTache; "numProcessAppelant"; Current process))
							
							$numProc:=cs.$process.new().NouveauProcess(cs.$sauvegarde; "CopierDossierRessourcesDEV"; $data)
							cs.$processData.me.SuivreProgressionProgress($data.tache; 8000; 2000; $numProgress)  // fin de tâche 10000
							
							Progress SET PROGRESS($numProgress; 1)
							
							// passer la main aux albums
							// l'appel se fait ici, mise à jour dans le process courant
							// le composant n'existe pas forcément
							Case of 
								: (cs.xALB=Null)
								: (Not(OB Is defined(cs.xALB; "$albums")))
								Else 
									$params.chemin:=$data.chemin
									cs.xALB.$albums.new().DémarrerSauvegarde($params)
							End case 
							
							Progress SET PROGRESS($numProgress; 1; ""; False)
							Waiting(60)
							
							// c'est fini pour ce disque dans cette session
							$data.relancer:=False
							
							//*** mémoriser la nouvelle date de mise à jour
							$data.miseAjour:=String(Current date; ISO date GMT; Current time)
							// mémoriser le résultat final
							This.EcrireParamètres($params)
							
							Waiting(30)
							Progress QUIT($numProgress)
					End case 
				End for each 
				
				// attendre $params.cadenceRelance secondes (si aucune mise a jour, c'est la cadence de scrutation de la tuerie et de la prochaine mise à jour)
				DELAY PROCESS(Current process; 60*$params.cadenceRecherche)
			Until ($tache.Tuer.signaled)
			
			cs.$trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Sauvegarde"; Current method name; "Sauvegarde terminée")
	End case 
	
	
Function CopierDossierDéveloppement($params : Object)
	// sauvegarder les dossier de la structure courante
	// v8.1.18 : zipper le fichier structure (copie plus rapide)
	var $dossier; $fichier; $data : Object
	var $pathDossierDest : Text
	
	If (This.session.user.estMembreDe_Developpement)
		
		// aller au dossier complet du développement
		$dossier:=Folder(Get 4D folder(Database folder); fk platform path).parent
		// zip temporaire
		$fichier:=Folder(fk documents folder).file("tempo"+String(Random)+".zip")
		$data:=ZIP Create archive($dossier; $fichier)
		$dossier:=Folder($params.chemin; fk platform path).folder("Structures")
		If (Not($dossier.exists))
			$dossier.create()
		End if 
		$pathDossierDest:="DEV_"+String(Current date; ISO date GMT; Current time)+"_"+This.environnement.LireVersionAPP()+".zip"
		$pathDossierDest:=Replace string($pathDossierDest; ":"; ".")  // attention : est le séparateur de l'heure et des dossiers !
		
		// transférer
		$data:=$fichier.copyTo($dossier; $pathDossierDest; fk overwrite)
		$fichier.delete()
		
		CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Fin de la sauvegarde"; Current method name; "dans le dossier "+$pathDossierDest; New object("nomProcess"; Current process name; "numProcess"; Current process))
	End if 
	
	
Function CopierDossierRessourcesDEV($params : Object)
	// sauvegarder les autres documents
	var $source; $destination : 4D.Folder
	
	// en production uniquement (pas en développement, administration, invité...)
	If (This.session.user.estMembreDe_Developpement)
		// copier les dossiers non gérés par la BDD
		// cablé EN DUR :  remonter de 3 niveaux où se trouve le dossier documents autres
		
		$source:=Folder(Get 4D folder(Database folder); fk platform path).parent.parent.parent.parent.folder("For_Developers")
		$destination:=Folder($params.chemin; fk platform path).folder("For_Developers")
		
		This.CopierDossier($source; $destination; 0x0001)
		CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Fin de la sauvegarde"; Current method name; "dans le dossier "+$destination.platformPath; New object("nomProcess"; Current process name; "numProcess"; Current process))
		
	Else 
		CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Sauvegarde impossible"; Current method name; Current user+" n'appartient pas au groupe 'Archivage'"; New object("nomProcess"; Current process name; "numProcess"; Current process))
	End if 
	
	
Function CopierDossierBDD($params : Object)
	// sauvegarder la base de données courante et les données annexes
	var $source; $destination : 4D.Folder
	
	// en production uniquement (pas en développement, administration, invité...)
	If (This.session.user.estMembreDe_Archivage)
		$source:=Folder(Get 4D folder(Data folder); fk platform path)
		$destination:=Folder($params.chemin; fk platform path).folder("Base de données")
		
		This.CopierDossier($source; $destination; 0x0001)
		CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Fin de la sauvegarde"; Current method name; "dans le dossier "+$destination.platformPath; New object("nomProcess"; Current process name; "numProcess"; Current process))
		
	Else 
		CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Sauvegarde impossible"; Current method name; Current user+" n'appartient pas au groupe 'Archivage'"; New object("nomProcess"; Current process name; "numProcess"; Current process))
	End if 
	
	
Function CopierMedias($params : Object)
	// sauvegarder les dossiers Medias courants
	// copier les medias de la BDD mère dans le dossier $3
	var $source; $destination; $dossierDestination : 4D.Folder
	var $c : Collection
	
	// en production uniquement (pas en développement, administration, invité...)
	Case of 
		: (This.session.user.estMembreDe_Archivage)
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Sauvegarde impossible"; Current method name; Current user+" n'appartient pas au groupe 'Archivage'"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		: (Not(OB Is defined($params; "tache")))
		Else 
			// collecter tous les dossiers medias gérés par la BDD
			$c:=ds.Dossiers.ListerDossiersMedia()
			
			$dossierDestination:=Folder($params.chemin; fk platform path).folder("Medias")
			
			For each ($source; $c)
				$destination:=$dossierDestination.folder($source.fullName)
				$destination.create()
				This.CopierDossier($source; $destination; 0x0005)
				
				$params.tache.FixerAvancement(0.1+($c.indexOf($source)/$c.length))
				$params.tache.FixerEtat("Fin de la copie du dossier '"+$source.name+"'")
			End for each 
			
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Fin de la sauvegarde"; Current method name; "dans le dossier "+$destination.platformPath; New object("nomProcess"; Current process name; "numProcess"; Current process))
	End case 
	$params.tache.DésInscrire()
	
	
Function CopierDocumentsAutres($params : Object)
	// sauvegarder les autres documents
	var $source; $destination : 4D.Folder
	
	// en production uniquement (pas en développement, administration, invité...)
	Case of 
		: (This.session.user.estMembreDe_Archivage)
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Sauvegarde impossible"; Current method name; Current user+" n'appartient pas au groupe 'Archivage'"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		: (Not(OB Is defined($params; "tache")))
		Else 
			// copier les dossiers non gérés par la BDD
			// cablé EN DUR :  remonter de 3 niveaux où se trouve le dossier documents autres
			$params.tache.FixerAvancement(0)
			$params.tache.FixerEtat("Copie des autres documents")
			
			$source:=Folder(Get 4D folder(Data folder); fk platform path).parent.parent.folder("Documents")
			$destination:=Folder($params.chemin; fk platform path).folder("Documents")
			
			This.CopierDossier($source; $destination; 0x0005)
			$params.tache.FixerAvancement(1)
			
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Fin de la sauvegarde"; Current method name; "dans le dossier "+$destination.platformPath; New object("nomProcess"; Current process name; "numProcess"; Current process))
	End case 
	$params.tache.DésInscrire()
	
	
	// -----------------------------
	// MARK:Paramètres
	// -----------------------------
	
Function LireParamètres($params : Object)->$result : Integer
	var $fichier : Object
	
	// fixer le chemin du fichier XML des informations
	$fichier:=This.fichierParamsSauvegarde
	$params.fichier:=$fichier
	
	// lire la liste existante dans les ressources
	$result:=0
	ARRAY OBJECT($tabChemins; 0)
	
	Case of 
		: (Not(This.xml.LireLeChemin(->$fichier; "Sauvegarde/ListeChemins"; ->$tabChemins).success))
			$result:=-15077
		Else 
			// on a trouvé des chemins de sauvegarde
			SORT ARRAY($tabChemins; >)
			$params.chemins:=New collection
			ARRAY TO COLLECTION($params.chemins; $tabChemins)
	End case 
	
	// valeur fixe, en seconde
	$params.cadenceRecherche:=1
	
	
Function EcrireParamètres($params : Object)->$result : Integer
	// fixer le chemin du fichier XML des informations
	var $fichier : Object
	var $structureDeDonnées : Text
	
	$fichier:=This.fichierParamsSauvegarde
	
	// lire la liste existante dans les ressources
	$structureDeDonnées:=""
	ARRAY OBJECT($tabChemins; 0)
	
	$result:=-15068
	Case of 
		: (Not(OB Is defined($params; "chemins")))
		: (Value type($params.chemins)#Is collection)
		Else 
			// on a des données
			ARRAY OBJECT($tabChemins; 0)
			COLLECTION TO ARRAY($params.chemins; $tabChemins)
			
			$result:=This.xml.EcrireLeChemin(->$fichier; "Sauvegarde/ListeChemins"; ->$tabChemins).Error
	End case 
	
	CLEAR VARIABLE($fichier)
	
	
	// -----------------------------
	// MARK:Utilitaires
	// -----------------------------
	
Function CopierDossier($source : 4D.Folder; $destination : 4D.Folder; $options : Integer)
	var $dossierSource; $dossierDestination : 4D.Folder
	var $poubelle : Collection
	
	// copier les fichier
	This.CopierContenuDeDossier($source; $destination; $options)
	
	// copier chaque sous dossier
	For each ($dossierSource; $source.folders(fk ignore invisible))
		$dossierDestination:=$destination.folder($dossierSource.name)
		// peut ne pas exister
		$dossierDestination.create()
		
		// on boucle
		This.CopierDossier($dossierSource; $dossierDestination; $options)
	End for each 
	
	If ($options ?? 2)
		// collecter et détruire les dossiers de $dossierDestination qui ne sont pas dans $dossierSource
		$poubelle:=New collection
		For each ($dossierDestination; $destination.folders(fk ignore invisible))
			If ($source.folders(fk ignore invisible).query("fullName = :1"; $dossierDestination.fullName).length=0)
				$poubelle.push($dossierDestination)
			End if 
		End for each 
		
		If ($poubelle.length>0)
			For each ($dossierDestination; $poubelle)
				$dossierDestination.delete(Delete with contents)
			End for each 
		End if 
	End if 
	
	
Function CopierContenuDeDossier($source : 4D.Folder; $destination : 4D.Folder; $options : Integer)
	// options : bit 0 = remplacer un existant si plus ancien, bit 2 = supprimer dans destination les fichier / dossiers orphelin
	var $fichier : 4D.File
	var $aFaire : Boolean
	var $poubelle : Collection
	
	For each ($fichier; $source.files(fk ignore invisible))
		$aFaire:=($destination.files(fk ignore invisible).query("fullName = :1"; $fichier.fullName).length=0)
		// vrai si fichier nouveau
		If (Not($aFaire) & ($options ?? 0))
			// on remplace si fichier plus agé
			$aFaire:=($fichier.modificationDate>$destination.files(fk ignore invisible).query("fullName = :1"; $fichier.fullName)[0].modificationDate)
		End if 
		
		If ($aFaire)
			$fichier.copyTo($destination; fk overwrite)
		End if 
	End for each 
	
	If ($options ?? 2)
		// collecter et détruire les fichiers de $destination qui ne sont pas dans $sources
		$poubelle:=New collection
		For each ($fichier; $destination.files(fk ignore invisible))
			If ($source.files(fk ignore invisible).query("fullName = :1"; $fichier.fullName).length=0)
				$poubelle.push($fichier)
			End if 
		End for each 
		
		If ($poubelle.length>0)
			For each ($fichier; $poubelle)
				$fichier.delete()
			End for each 
		End if 
	End if

⇧ [class]$application - 08/06/2026 09:54:38

      property environnement : cs.xSDK.EnvironnementALV
property registreTaches : cs.xSDK.RegistreTaches
property trace : cs.$trace
property ftp : cs.xSDK.ServicesFTP
property fct : cs.xSDK.Outils
property rsc : cs.xSDK.ResourceALV
property progress : Object
property session : Object

Class constructor()
	
	// avancement des tâches
	This.progress:=Storage.Processes[Current process name]
	
	This.environnement:=cs.xSDK.EnvironnementALV.new()
	This.registreTaches:=cs.xSDK.RegistreTaches.me
	This.trace:=cs.$trace.me
	This.ftp:=cs.xSDK.ServicesFTP.new()
	
	This.fct:=cs.xSDK.Outils.me
	This.rsc:=cs.xSDK.ResourceALV.me
	
	// session utilisateur
	This.session:=cs.$session.me
	
	var ErrorNum : Integer
	var ErrorDescription : Text
	
	
	
Function getDataClassInfos($nomClass : Text)->$result : Object
	
	$result:=New object("name"; ""; "tableNumber"; 0)
	Case of 
		: (OB Is defined(ds; $nomClass))
			// on a une dataclass
			$result:=ds[$nomClass].new().getDataClass().getInfo()
			
		: (Not(OB Is defined(cs; $nomClass)))
			// pb
		: ($nomClass="$@")
			// classe non concernée (et ça peut boucler !!!)
			
		Else 
			// voir si la classe peut fournir l'info
			If (cs[$nomClass]["getDataClassInfos"]#Null)
				$result:=cs[$nomClass].new().getDataClassInfos()
			End if 
	End case 
	
	
	// -----------------------------
	// MARK:FTP
	// -----------------------------
	
Function TelechargerFichierMedia($params : Object)->$result : Object
	// ici on est thread-safe
	var $FichierTéléchargé : 4D.File
	var $dossier : 4D.Folder
	var $entity : cs.MediasEntity
	var $texte : Text:=""
	var $dossierTravail; $data : Object
	var $cheminFichierPath; $path; $fichier : Text
	var $i; $position : Integer
	
	$result:=ds.initResult()
	
	$result.Error:=-15068
	Case of 
		: (Not(OB Is defined($params; "IDnomFichier")))
			$result.ErrorDescription:="$1.IDnomFichier n'est pas défini"
		: (Not(OB Is defined($params; "cheminDestination")))
			$result.ErrorDescription:="$1.cheminDestination n'est pas défini"
		: (Not(OB Is defined($params; "Options")))
			$result.ErrorDescription:="$1.Options n'est pas défini"
		Else 
			$result.Error:=0
			$dossierTravail:=cs.$document.new().GetAppWorkSpace().folder("tempo_"+String(Random))
			
			// demander l'url du dossier du media
			$data:=New object("ID"; Num($params.IDnomFichier))
			If (This.ftp.FixerAccessBDDduMedia($data).success)
				// on a tout
				
				// fixer le nom du fichier
				// utiliser la sélection courante de medias
				// ici on reçoit un fichier media IDnomFichier = IDmedia
				$entity:=ds.Medias.get(Num($params.IDnomFichier))
				// nom sur le serveur FTP du fichier demandé
				$data.nomFichier:=String($entity.ID; "00000")+(".alvprv"*Num($entity.private#0))+".xfam.b64"
				// récupérer urlDossier
				//$data.urlDossier:=$data.dossier
				// télécharger le fichier
				$result:=This.ftp.TelechargerFichier($data; $dossierTravail.platformPath)
				// le chemin du fichier est dans $result.fichier
				
			Else 
				$result.Error:=-15080
				$result.ErrorDescription:="paramètres FTP non reçus"
			End if 
			
			// appliquer les options
			If ($result.Error=0)
				// recopier le fichier à l'endroit demandé
				$FichierTéléchargé:=$result.fichier.copyTo(Folder($params.cheminDestination; fk platform path); fk overwrite)
				$cheminFichierPath:=$FichierTéléchargé.platformPath
				
				// appliquer les traitements sur des fichiers medias
				
				// *** compresser le media
				If ($params.Options ?? 0)
					Case of 
						: ($entity.type=1)  // image
							$path:=$dossierTravail.folder("tempo_compression").file("Compressed_"+$entity.leFichier.nom).platformPath  // garder la même extension de fichier
							CREATE FOLDER($path; *)  // créer le dossier s'il n'existe pas
							$result.Error:=cs.$media.new().CompresserImage(->$cheminFichierPath; $path)  // $fichierPath = chemin image compressée
							
						: ($entity.type=2)  // PDF
							$path:=$dossierTravail.folder("tempo_compression").platformPath
							CREATE FOLDER($path; *)  // créer le dossier s'il n'existe pas
							//$result.Error:=Compresser PDF(->$cheminFichierPath; ->$path)  // $cheminFichierPath = PDF compressé
							
						Else 
							// non géré (vidéo)
							$result.Error:=0
					End case 
				End if 
				
				// *** filigraner le media
				If (($params.Options ?? 1) & ($result.Error=0))
					$result.Error:=This.ftp.Filigraner(New object("fichier"; $FichierTéléchargé; "type"; 1); $entity.Credits; 40; 20; 0; "blue").Error
				End if 
				
				// *** extraire les pages du document PDF et les enregistrer
				If ($params.Options ?? 2)
					If (($FichierTéléchargé.extension=".pdf") & (Storage.System.Status ?? 21))  // nécessite le PlugIn
						
						// chercher le dossier où enregistrer les pages
						// dossier des pages extraites (suffixe au nom du dossier)
						This.rsc.SetVariable(Est Ressource APP; "Ressources_Communes/Suffixe_Dossier_ImagesPDF"; Is text; ->$texte)
						// sélectionner le dossier
						$dossier:=cs.$document.new().GetMediaFolder($entity.LeVolume().volume).folder($entity.LeVolume().nom+$texte)
						
						If ($dossier.exists)
							// créer un sous dossier pour y mettre les pages du PDF
							If ($entity.NombreDePages>1)
								$dossier:=$dossier.folder(String($entity.ID))
								$dossier.delete(Delete with contents)
								$dossier.create()
							End if 
							
							For ($i; 1; $entity.NombreDePages)
								// fixer le nom du fichier de la page (IDmedia_N°page.png)
								$fichier:=$FichierTéléchargé.fullName
								$position:=Position("."; $fichier; *)
								$fichier:=Replace string($fichier; Substring($fichier; $position); "_"+String($i)+".png"; *)  //nom fichier  = IDmedia_NumPage.png"
								// fixer le chemin du document
								$fichier:=$dossier.file($fichier).platformPath
								// extraire la page $i
								$result.Error:=cs.$wrapperPlugIn.me.ConvertirPageDansFichier($cheminFichierPath; $i; 1; $fichier)
								
								If ($result.Error#0)
									$i:=1+$entity.NombreDePages  // arrêter les frais
									cs.$trace.me.Créer(-15055; Current method name; Localized string("5102")).LeverException([msgk_log])
								End if 
							End for 
						End if 
					End if 
				End if 
				
				// finalement
				$result.fichier:=File($cheminFichierPath; fk platform path)
			End if 
			$result.success:=($result.Error=0)
			
			$dossierTravail.delete(Delete with contents)
			cs.$trace.me.Créer($result.Error; Current method name; "Contexte BDDmedia : "+$result.ErrorDescription).LeverException([msgk_event; msgk_log])
			
			// pour un éventuel CallBack
			$params.Error:=$result.Error
			$params.ErrorDescription:=$result.ErrorDescription
	End case 
	
	
Function TelechargerFichierAPP($params : Object)->$result : Object
	var $dossierTravail : Object
	
	$result:=ds.initResult()
	
	$result.Error:=-15068
	Case of 
		: (Not(OB Is defined($params; "typeAPP")))
			$result.ErrorDescription:="$1.typeAPP n'est pas défini"
		: (Not(OB Is defined($params; "version")))
			$result.ErrorDescription:="$1.version n'est pas défini"
		: (Not(OB Is defined($params; "IDnomFichier")))
			$result.ErrorDescription:="$1.IDnomFichier n'est pas défini"
		: (Not(OB Is defined($params; "cheminDestination")))
			$result.ErrorDescription:="$1.cheminDestination n'est pas défini"
		Else 
			$result.Error:=0
			
			If (Not(OB Is defined($params; "numProcessAppelant")))
				// créer le process externe
				$params.nomTache:="ALV_Telecharger_Fichier_APP_"+$params.IDnomFichier
				$params.initProcess:=Formula(InitProcessThreadSafe)
				// retourner numProc (utilisable par le process appelant pour lancer le thermomètre)
				$params.numProc:=cs.$process.new().NouveauProcess(cs.$application; "TelechargerFichierAPP"; $params)
				
				If ($params.numProc>0)
					// renvoyer "fichier en cours de téléchargement"
					$result.Error:=Fichier en téléchargement
					
				Else 
					// process non lancé, renvoyer une erreur
					$result.Error:=-15002
				End if 
				
			Else 
				// on est dans le process de téléchargement
				$dossierTravail:=cs.$document.new().GetAppWorkSpace().folder("tempo_"+String(Random))
				$dossierTravail.create()
				
				// demander l'url du dossier du fichier demandé
				If (This.ftp.FixerAccessMisesAjour($params).success)
					// on a tout
					
					// récupérer urlDossier
					$params.urlDossier:=$params.urlDossier+$params.version+"/"
					$params.nomFichier:=$params.IDnomFichier
					// télécharger le fichier
					$result:=This.ftp.TelechargerFichier($params; $dossierTravail.platformPath)
					// le chemin du fichier est dans $result.fichier
				End if 
				
				// appliquer les options
				If ($result.Error=0)
					// recopier le fichier à l'endroit demandé
					$result.fichier:=$result.fichier.copyTo(Folder($params.cheminDestination; fk platform path); fk overwrite)
					This.trace.EnvoyerMessages([msgk_event]; "fichier "+String($params.IDnomFichier); Current method name; " téléchargé")
				End if 
				$result.success:=($result.Error=0)
				
				// la suite
				$params.Error:=$result.Error
				$params.ErrorDescription:=String($params.IDnomFichier)
				
				$dossierTravail.delete(Delete with contents)
				cs.$trace.me.Créer($result.Error; Current method name; "Contexte BDDmedia : "+$result.ErrorDescription).LeverException([msgk_event; msgk_log])
			End if 
	End case 
	
	
Function TeleverserDossier($params : Object)
	// envoyer vers l'hébergeur le contenu du dossier $data
	var $dataTexte : Text:=""
	var $data; $tache : Object
	
	$params.Contexte:="MiseAjourBddMedia"
	Case of 
			// dossier à transférer
		: (Not(OB Is defined($params; "dossier")))
			// chemin sur l'hébergeur
		: (Not(This.ftp.FixerAccessMisesAjour($params).success))
			// ajouter la version
		: (Not(This.rsc.SetVariable(Est Ressource APP; "Versionnage/Data/Format_Fichier"; Is text; ->$dataTexte)))
		Else 
			// on a tout, on continue
			// transférer avec les options demandées
			
			$data:=New object
			$data.dossier:=$params.dossier
			$data.Options:=$params.Options
			// versionner
			$dataTexte:=This.fct.FormaterHTML($dataTexte)
			$data.cheminFTP:=$params.urlDossier+$dataTexte+"/"
			$data.tache:=This.registreTaches.Inscrire(New object("nomProcess"; Current process name; "nomTache"; "MiseAjourBdd"; "numProcessAppelant"; $params.numProcessAppelant))
			$data.debutTache:=0
			$data.finTache:=10000
			
			// lancer la tâche
			$tache:=cs.xSDK.ServicesFTP.new(New object)
			$data.result:=$tache.MettreAjourDossier($data)
	End case 
	
	
	// -----------------------------
	// MARK:BDD media
	// -----------------------------
	
Function VérifierBDDmedia($params : Object)
	// La base de données des chemins de medias est intègre si :
	//. tous les chemins de volume sont valides
	//. tous les chemins de fichier sont valides(volume+[Dossiers]+[Fichiers])
	//. tous les chemins sont liés à un seul média
	//. tous les media sont liés à un seul fichier
	// Le premier point est testé dans le formulaire "options d'installation" (?)."Vérifier BDDMedia" teste les derniers points.
	
	// Les cas d'erreur sont :
	//. 15001/5080 : chemin de volume non valide
	//. 15001/5081 : chemin de fichier invalide
	//. 15100/5073 : fichier non lié à un media
	//. 15101/5074 : media sans fichier
	//. 15102/5075 : plusieurs fichiers pour un media
	
	var $tache : cs.xSDK.Tache
	var $sélection : Object
	
	If (OB Is empty($params))
		$params.nomTache:="VérifierBDDmedia"
		$params.initProcess:=Formula(InitProcessThreadSafe)
		cs.$process.new().NouveauProcess(cs.$application; "VérifierBDDmedia"; $params)
		
	Else 
		// c'est parti
		// le process exécute une seule tache ; si elle est tuée, le process meurt dans la foulée
		$tache:=This.registreTaches.Inscrire(New object("nomProcess"; Current process name; "nomTache"; $params.nomTache; "numProcessAppelant"; $params.numProcessAppelant))
		If ($tache#Null)
			cs.$processData.me.FixerTache(Current process name; New object("nomTache"; $tache.nomTache; "activerThermometre"; True))
			
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Début traitement"; Current method name; ""; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
			// tester Présence des fichiers Medias
			$tache.FixerEtat(Localized string("5069"))
			// tout les medias de la BDD
			$sélection:=ds.Medias.query("type < :1"; 200)
			$sélection.TesterCheminFichiers($tache)
			
			// vérifier que tous les fichiers adressent un media
			$tache.FixerTime(2000)
			$sélection:=ds.Fichiers.query("media > :1"; 0)
			$sélection.TesterPrésenceMedias($tache)
			
			// vérifier que tous les medias ont un seul fichier
			$tache.FixerTime(3000)
			$sélection:=ds.Medias.all()
			$sélection.TesterFichier($tache)
			
			// vérifier que tous les medias PDF ont leurs pages dans un dossier "xxxPDF_Images"
			$tache.FixerTime(4000)
			$sélection:=ds.Medias.query("type = :1"; 2)
			$sélection.TesterPagesPDF($tache)
			
			// vérifier que toutes les images sont lisibles
			$tache.FixerTime(6000)
			$sélection:=ds.Medias.query("type = :1"; 1).orderBy("ID asc")
			$sélection.TesterLecture($tache)
			
			// vérifier que tous les medias sont compressés
			$tache.FixerTime(8000)
			//Compresser Image(->[Medias])// pas clair à faire ici !!!
			
			// c'est fini
			$tache.FixerTime(10000)
			
			// renvoyer le nombre d'erreurs (le process a pu être tué)
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Fin traitement"; Current method name; String($tache.State)+" Erreur"+(Num($tache.State>0)*"s")+" (Afficher la console)"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			// désinscrire la tâche "Nom du process courant" du process appelant
			$tache.DésInscrire()
		End if 
	End if 
	
	
Function programmerVérifierBDDmedia($data : Object)
	// renvoyer la méthode à faire exécuter par le planificateur de tâches
	var $params : Object:=New object()
	
	Case of 
		: (Storage.System.typeApplication#4D BDD mère)
			// BDD mère uniquement
		: (Not(This.session.user.estMembreDe_Archivage))
			// en production uniquement (pas en développement, administration, invité...)
		Else 
			// c'est ok, renvoyer les données
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Programmation"; Current method name; "tâche programmée"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
			// données de programmation de la tâche
			$params:=New object("nomClass"; "$application"; "functionID"; "VérifierBDDmedia"; "params"; New object)
			// dans 2 minutes
			$params.params.dateTache:=String(Current date; ISO date GMT; (Current time+?00:02:00?)%?24:00:00?)
			// une seule fois par session
			$params.params.période:=New object("jour"; 8; "seconde"; 0)
			// pas urgence
			$params.params.initialiser:=False
			
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event]; "Programmation"; Current method name; "tâche programmée"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_log]; "Donnée"; Current method name; JSON Stringify($params))
	End case 
	// finalement
	$data.params:=$params
	
	
	// -----------------------------
	// Mark:Utilitaires
	// -----------------------------
	
Function _nettoyerResult($result : Object)
	$result.success:=($result.Error=0)
	$result.ErrorDescription:=$result.ErrorDescription*Num(Not($result.success))
	
	
Function estDebugAPP()->$result : Boolean
	$result:=This.session.prefs.Session_Etat ?? 6
	
	
Function OuvrirDeveloppement()->$result : Boolean
	// afficher le process "Développement"
	// $0 nécessaire quand la fonction est dans une structure 'au cas ou' 
	var $c : Collection
	
	$result:=False
	
	Case of 
		: (Is compiled mode)
		: (Not(This.session.user.estMembreDe_Developpement))
			cs.$trace.me.EnvoyerMessages([msgk_event; msgk_log]; Current process name; Current method name; "l'utilisateur '"+Current user+"' n'est pas autorisé")
			
		Else 
			// * rechercher le process "developpement"
			$c:=Process activity(Processes only).processes.query("type = :1"; -2)
			
			// * process trouvé : l'afficher
			If ($c.length=1)
				SHOW PROCESS($c[0].number)
				BRING TO FRONT($c[0].number)
				//$refMenu:=Storage.BarresMenus["Standard?Developpement"]
				//FIXER BARRE MENUS($refMenu;$numProc)  // ré init de la barre menus (active les cmd clavier)  ex barre n°2
				SHOW MENU BAR
				cs.$trace.me.EnvoyerMessages([msgk_event]; Current process name; Current method name; "process développement trouvé et affiché")
				// déjà ouvert ; on renvoit faux (sinon on ne peut pas relancer l'APP depuis le mode développement)
				
			Else 
				cs.$trace.me.EnvoyerMessages([msgk_event; msgk_log]; Current process name; Current method name; "process développement non trouvé, passage en mode utilisation")
				// * passer en mode utilisation
				
				// * rechercher le process "principal"
				$c:=Process activity(Processes only).processes.query("type = :1"; -1)
				If ($c.length=1)
					SHOW PROCESS($c[0].number)
					BRING TO FRONT($c[0].number)
					cs.$trace.me.EnvoyerMessages([msgk_event; msgk_log]; Current process name; Current method name; "process principal affiché")
					$result:=True
					
				Else 
					cs.$trace.me.EnvoyerMessages([msgk_event; msgk_log]; Current process name; Current method name; "process principal non trouvé")
				End if 
			End if 
	End case

⇧ [class]$formulaire - 18/05/2026 10:08:39

      property process : cs.$processUser
property nav : cs.$navigation
property menu : cs.$menu
property menuContextuel : cs.$menuContextuel
property zoneSensible : cs.$zoneSensible
property sonorisation : cs.$sonorisation
property document : cs.$document
property glisserDeposer : cs.$glisserDeposer
property params; informations; entité; sousFormulaire : Object
property userMessageTime : Integer
property userMessageText : Text
property thermometre; curseurHoraire : Integer
property grandEcran; mémoTaille : Boolean

// pour FORM Event
property functionID; nomOBJ : Text
property cadenceRafraichissement : Integer:=0


Class extends $application

Class constructor($params : Object)
	
	Super()
	
	// gestion du process
	This.process:=cs.$processUser.new()
	
	// formulaire de projet par défaut
	This.params:=New object
	This.informations:=New object
	This.informations.numTable:=This.getDataClassInfos(OB Class(This).name).tableNumber  // toto
	This.informations.DataClassInfos:=OB Copy(This.getDataClassInfos(OB Class(This).name))
	
	// pilote la navigation
	This.nav:=cs.$navigation.new()
	// gestion des menus 
	This.menu:=cs.$menu.new()
	// gestion des menus contextuels
	This.menuContextuel:=cs.$menuContextuel.new()
	// gestion des glisser / déposer
	This.glisserDeposer:=cs.$glisserDeposer.me
	// gestion des ZS
	This.zoneSensible:=cs.$zoneSensible.new()
	
	// gestion d'un user message, à disposition d'un Form
	// (réellement affiché si un objet FORM a pour variable Form.userMessageText)
	This.userMessageText:=""
	This.userMessageTime:=0
	// gestion de la progression d'une tache
	This.thermometre:=0
	This.curseurHoraire:=0
	
	
	// gestion de la sonorisation
	This.sonorisation:=cs.$sonorisation.new()
	// tout formulaire a un canal audio pour les messages sonores APP
	// attention les Storage.UserPref ne sont pas toujours présentes
	This.sonorisation.AjouterCanal("MessageAPP"; Est Ressource Système; "Submarine.aiff"; New object("Niveau"; 1000; "Son"; "Submarine.aiff"))
	
	// gestion des documents
	This.document:=cs.$document.new()
	
	// données standard pour tout formulaire
	This.grandEcran:=False
	This.mémoTaille:=True
	This.rsc.SetObjet(Est Ressource APP; "Ressources_Communes/RefreshTime"; Is longint; This; "cadenceRafraichissement")
	
	// paramètres reçus, peuvent écraser les init standard
	Case of 
		: (Count parameters=0)
		: ($params=Null)
		Else 
			// recopier les données reçues
			This.InitParams($params)
	End case 
	
	
Function InitParams($params : Object)
	// recopier les attributs de $params
	var $i; $entierLong : Integer
	var $texte : Text
	var $bool : Boolean
	
	ARRAY TEXT($tabNoms; 0)
	ARRAY LONGINT($tabTypes; 0)
	OB GET PROPERTY NAMES($params; $tabNoms; $tabTypes)
	If (Size of array($tabNoms)>0)
		For ($i; 1; Size of array($tabNoms))
			// garder le typage des données
			Case of 
				: ($tabTypes{$i}=Is boolean)
					$bool:=$params[$tabNoms{$i}]
					This[$tabNoms{$i}]:=$bool
					
				: ($tabTypes{$i}=Is real)
					$entierLong:=$params[$tabNoms{$i}]
					This[$tabNoms{$i}]:=$entierLong
					
				: ($tabTypes{$i}=Is text)
					$texte:=$params[$tabNoms{$i}]
					This[$tabNoms{$i}]:=$texte
					
				: ($tabTypes{$i}=Is object)
					This[$tabNoms{$i}]:=$params[$tabNoms{$i}]
					
				: ($tabTypes{$i}=Is collection)
					This[$tabNoms{$i}]:=$params[$tabNoms{$i}]
					
				: ($tabTypes{$i}=Is null)
					This[$tabNoms{$i}]:=Null
					
				Else 
					BEEP
					TRACE
			End case 
		End for 
	End if 
	
	
	// ----------------------
	//MARK:IHM
	// -----------------------
	
Function ActionUtilisateur($action : Text)->$result : Boolean
	Case of 
		: ($action="[option]")
			// option (ou alt sur Windows)
			$result:=Macintosh option down
			
		: ($action="[commande]")
			// commande (ou xx sur Windows)
			$result:=Macintosh command down
			
		: ($action="[ModificationAutorisée]")
			// modification autorisée ?
			$result:=This.ActionUtilisateur("[SaisieAutorisée]")
			If ($result)
				$result:=$result & This.ActionUtilisateur("[ToucheValidation]")
			Else 
				//  non autorisée
				This.AfficherMessageUtilisateur(New object("ID"; 5042))
			End if 
			
		: ($action="[SaisieAutorisée]")
			// l'utilisateur doit être autorisé, ou mode Debug
			If ([UtilisateursALV]droits ?? 0)
				// utilisateur Web connu
				$result:=True
			Else 
				$result:=(This.session.user.estMembreDe_Saisie | (This.session.prefs.Session_Etat ?? 6))
			End if 
			
		: ($action="[ToucheValidation]")
			// touche de validation d'une modification
			$result:=Macintosh option down
			If (Not($result))  // non valide
				This.AfficherMessageUtilisateur(New object("ID"; 5056))
			End if 
			
		: ($action="[ContrastePlus]")
			$result:=((Macintosh option down) & (Macintosh command down) & (Shift down))
			
		: ($action="[ContrasteMoins]")
			$result:=((Macintosh option down) & (Macintosh command down))
			
		: ($action="[ZoomPlus]")
			$result:=((Macintosh option down) & (Shift down))
			
		: ($action="[ZoomMoins]")
			$result:=(Macintosh option down)
	End case 
	
	
Function AfficherMessageUtilisateur($params : Object)
	// fixe le contenu Form.userMessageText à partir de $params :
	// - ID, ID d'une chaine localisée
	// - libellé, texte du message
	// - userMessageTime, optionnel, fixe la durée d'affichage du message (10 s par défaut)
	var $durée : Integer
	
	// time-out du message = dans 10 secondes
	$durée:=(10*60)
	If ($params.userMessageTime#Null)
		$durée:=$params.userMessageTime
	End if 
	$durée:=$durée+Tickcount
	
	Case of 
		: (Count parameters=0)
			// gèrer l'extinction automatique du message
			Case of 
				: (This.userMessageTime>Tickcount)
					// attendre
				: (This.userMessageText#"")
					// il y a un message affiché et la durée max est atteinte
					// appeler le process pour l'extinction
					// attention le process courant n'est peut être plus au premier plan : passer par là
					Appeler_Le_Formulaire(Current process; "MettreAjourPage"; New object("ActionID"; "EffacerMessageUtilisateur"))
			End case 
			
			// afficher un message
		: (OB Is defined($params; "ID"))
			This.userMessageText:=cs._cfct.me.LireLocatedSTR($params.ID; $params)
			This.userMessageTime:=$durée
			
		: (OB Is defined($params; "libelle"))
			This.userMessageText:=$params.libelle
			This.userMessageTime:=$durée
	End case 
	
	
Function EffacerMessageUtilisateur()
	This.userMessageText:=""
	This.userMessageTime:=0
	
	
Function MettreAjourBarreMenus()
	// mettre à jour la barre de menus lorsque le pointeur passe dessus
	var $result : Boolean
	var $sourisX; $sourisY; $SourisBtn : Integer
	
	$result:=False
	
	MOUSE POSITION($sourisX; $sourisY; $SourisBtn; *)
	$result:=$result | ($sourisY<20)
	$result:=$result | ($sourisY>(Screen height-60))
	$result:=$result | ($sourisX<60)
	
	If ($result)
		// mettre à jour le menu des fenetres
		This.menu.CréerMenuFenetres()
		
		// mettre à jour les menus dynamiques
		This.menu.Configurer(This)
		
		SHOW MENU BAR
	End if 
	
	
	// ----------------------
	//MARK:Sélection
	// -----------------------
	
Function FixerSélectionVisualisable($params : Object)
	// on a reçu un deQui pas forcément affichable
	// créer à partir de .deQui une sélection affichable par $params.DataClassNom
	
	// lancer la création dans la DataClass appropriée
	cs.$serveurAPP.me.Executer($params.DataClassNom; "CréerSélection"; $params)
	// la sélection est dans $params.reqRetour
	$params.sélectionEntités:=$params.reqRetour.sélectionEntités
	OB REMOVE($params; "reqRetour")
	
	// 2026-02-09
	// dans le cas d'un visualisateur, un callback va appeler le formulaire : attendre un peu qu'il s'affiche
	Waiting(10)
	
	Case of 
		: (Storage.System.typeApplication=ALV Serveur APP)
			// rien de plus
		: (Not(OB Is defined($params; "nomProcessAppelant")))
		: (Not(OB Is defined($params; "CallBack")))
		Else 
			// retour par callBack, transmettre au process demandeur le résultat
			// attention ici on peut être dans un WK ; 
			This.process.AppelerFormulaire($params.nomProcessAppelant; $params.CallBack; $params)
	End case 
	
	
Function FixerParamètresSélectionVisualisable()->$result : Object
	// paramètres par défaut
	$result:=New object
	
	
Function FixerParamètres($params : Object)
	// mémoriser les paramètres par défaut du menu
	This.menu.params:=$params
	This.informations.Contexte:=This.menu.params.commande
	
	
	// ----------------------
	//MARK:Demande actions
	// -----------------------
	
Function CallBack($params : Object)
	// appel extérieur : callback générique tout formulaire d'une méthode externe
	Case of 
		: (Not(OB Is defined($params; "Error")))
			// passer
			
		: ($params.Error=-15066)
			// erreur FTP
			This.AfficherMessageUtilisateur(New object("ID"; 5053))
			
		: (Not(OB Is defined($params; "CallBack")))
			// pourquoi pas
			
		: (This[$params.CallBack]=Null)
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "CallBack"; Current method name; $params.CallBack+" n'est pas une function de la classe du process "+Current process name; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		Else 
			This[$params.CallBack]($params)
	End case 
	
	
Function MettreAjourPage($params : Object)
	Case of 
		: ($params.ActionID="AfficherMessageUtilisateur")
			This.AfficherMessageUtilisateur($params)
			
		: ($params.ActionID="EffacerMessageUtilisateur")
			This.EffacerMessageUtilisateur()
			
		: (This.sonorisation.MettreAJour($params).success)
			// action traitée
	End case 
	
	
Function APP_PassePremierPlan()
	// pour les sousformulaires de Form.export ; pas sûr que ca fonctionne partout !
	This.sousFormulaire:=This.sousFormulaire
	
	
Function FixerVisibilitéPalettes($visible : Boolean)
	var $process : Object
	
	For each ($process; Process activity(Processes only)["processes"])
		Case of 
			: ($process.name#"U_Palette@")
			: ($visible)
				SHOW PROCESS($process.number)
			Else 
				HIDE PROCESS($process.number)
		End case 
	End for each 
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// -----------------------
	
Function TraiterFORMevent()
	// dans l'ordre !
	Case of 
		: (OB Is defined(FORM Event; "columnName"))
			// event d'une colonne de listBox
			This.functionID:=New collection("_FORM"; FORM Event.objectName; FORM Event.columnName).join("_")
			This.nomOBJ:=FORM Event.objectName
			
		: (OB Is defined(FORM Event; "objectName"))
			// event d'un objet formulaire
			This.functionID:="_FORM_"+FORM Event.objectName
			This.nomOBJ:=FORM Event.objectName
			
		Else 
			// event du formulaire
			This.functionID:="_FORM"
			This.nomOBJ:=""
	End case 
	
	If (OB Is defined(This; This.functionID))
		// faire traiter l'event par la function du formulaire ou de l'objet
		This[This.functionID]()
	Else 
		// cas où l'objet délègue au formulaire (traitement générique)
		This["_FORM"]()
	End if 
	
	
Function onEndEventForm($c : Collection)
	// appel, après le onload du formulaire, du onload des objets de $c
	var $nomOBJ : Text
	
	// lancer l'event 'onLoad'
	For each ($nomOBJ; $c)
		If (OB Is defined(This; "_FORM_"+$nomOBJ))
			This.nomOBJ:=$nomOBJ
			This["_FORM_"+$nomOBJ]()
		End if 
	End for each 
	
	
	// ----------------------
	//MARK:FORMevents
	// -----------------------
	
Function surEvenementFormulaire()
	
	Case of 
			// active l'évènement formulaire "sur Minuteur" (effectif si coché dans le formulaire)
			// appel une seule fois dans le process, ou quand la wnd revient au premier plan
		: (FORM Event.code=On Load)
			cs.$processData.me.FixerNumFenetre(Current process name)
			
			SET TIMER(This.cadenceRafraichissement)
			OBJECT SET VISIBLE(*; "GrpID@"; False)
			
		: (FORM Event.code=On Activate)
			SET TIMER(This.cadenceRafraichissement)
			
		: (FORM Event.code=On Clicked)
			This.ActionMenuContextuel()
			
		: (FORM Event.code=On Timer)
			// actions minutées d'un formulaire
			This.FixerNavigationClavier()
			This.AfficherMessageUtilisateur()
			This.MettreAjourBarreMenus()
			
			// fixer état technique
			OBJECT SET VISIBLE(*; "GrpID@"; This.session.prefs.Session_Etat ?? 5)
			
		: (FORM Event.code=On Getting Focus)
			This.nav.saisieEnCours:=OBJECT Get enterable(*; This.nomOBJ)
			
		: (FORM Event.code=On Losing Focus)
			This.nav.saisieEnCours:=False
			
		: (FORM Event.code=On Deactivate)
			Use (Storage.System.Navigation.ZS)
				Storage.System.Navigation.ZS.ZoneSurvolée:=-1
				Storage.System.Navigation.ZS.EnregistrementLié:=-1
			End use 
			SET TIMER(0)
			
		: (FORM Event.code=On Unload)
			cs.$processData.me.RazNumFenetre(Current process name)
	End case 
	
	
Function SurvolZSimage()->$result : Boolean
	var $data : Object
	var $itemText : Text
	
	$result:=True
	If ((Storage.System.Navigation.ZS.ZoneSurvolée=-1))
		// pas de ZS survolée
		// dans l'ordre :
		Case of 
			: (This.ActionUtilisateur("[ContrastePlus]"))
				// indiquer la modification du contraste
				SET CURSOR(351)
				
			: (This.ActionUtilisateur("[ContrasteMoins]"))
				// indiquer la modification du contraste
				SET CURSOR(9021)
				
			: (This.ActionUtilisateur("[ZoomPlus]"))
				// indiquer le zoom du media
				SET CURSOR(560)
				
			: (This.ActionUtilisateur("[ZoomMoins]"))
				// indiquer le dézoom du media
				SET CURSOR(559)
				
			Else 
				$result:=False
				// circuler
		End case 
		
	Else 
		// le curseur est sur une zone sensible
		$data:=New object("IDobjetCodé"; Storage.System.Navigation.ZS.EnregistrementLié; "action"; This.ActionUtilisateur("[option]"))
		This.zoneSensible.LireParamètresZS(Current process name; $data)
		// libellé de l'action liée au clic seul, ou clic + option
		$itemText:=Storage.System.Navigation.ZS.EnregistrementLiéLibellé
		This.AfficherMessageUtilisateur(New object("ID"; This.zoneSensible.params.message; "param_1"; $itemText; "userMessageTime"; 3*60))
		
		If (Macintosh option down)
			SET CURSOR(9015)
		Else 
			SET CURSOR(9000)
		End if 
	End if 
	
	
Function ActionMenuContextuel()->$result : Boolean
	// renvoie Vrai si une commande a été exécutée
	var $nom : Text
	
	Case of 
		: (Not(Contextual click | Right click))
			$result:=False
			
		: (This.nav.saisieEnCours)
		: (Storage.System.Navigation.ZS.ZoneSurvolée>0)
			// filtrer
		Else 
			// clic droit sur un fond de formulaire
			$nom:=OB Class(This).name
			// exécuter le menu contextuel
			$result:=This.zoneSensible.MontrerPopUpMenu("MC_"+$nom)
	End case 
	
	
	// ----------------------
	//MARK:FORM actions
	// -----------------------
	
Function EditerPropriétéObjet($typePropriété : Integer; $storage : Object; $attributStorage : Text; $valeurStorage : Integer; $params : Object)  //$attribut : Text; $valeur : Integer)
	// lire / Ecrire la propriété $attributStorage de l'objet partagé $storage en fonction de l'évènement formulaire
	// $typePropriété = une valeur, un bit, un booleen) {, $valeurStorage = la valeur}
	var $trace : cs.$trace
	
	$trace:=cs.$trace.me.Créer(-15086; Current method name; "")
	
	If ($storage=Null)
		$trace.ErrorDescription:="$storage est nul"
	Else 
		
		Use ($storage)
			Case of 
				: (This.EditerOptionBooléenne($typePropriété; $storage; $attributStorage; $valeurStorage; $trace))
				: (This.EditerOptionBooléenneRadio($typePropriété; $storage; $attributStorage; $valeurStorage; $params; $trace))
				: (This.EditerOptionSaisieRadio($typePropriété; $storage; $attributStorage; $valeurStorage; $params; $trace))
				: (This.EditerOptionSaisie($typePropriété; $storage; $attributStorage; $trace))
				: (This.EditerOptionSélectionnée($typePropriété; $storage; $attributStorage; $valeurStorage; $trace))
				: (This.EditerOptionBinaire($typePropriété; $storage; $attributStorage; $valeurStorage; $trace))
			End case 
		End use 
	End if 
	
	$trace.LeverException([msgk_event; msgk_log])
	
	
Function EditerOptionBooléenne($typePropriété : Integer; $storage : Object; $attributStorage : Text; $valeurStorage : Integer; $trace : cs.$trace)->$result : Boolean
	
	$result:=($typePropriété=Est une Option booléenne)
	Case of 
		: (Not($result))
		: ($attributStorage="")
			$trace.ErrorDescription:="Il manque le paramètre $attributStorage"
		Else 
			// c'est ok
			// option = choix entre $valeurStorage (valeur = 0) et -> $valeurStorage+1 (valeur = 1)
			// rappel : ces options booléennes sont également modifiables par popUpMenu, via un ID menu : on utilise un ID et non un booléen
			$trace.Error:=0
			Case of 
				: (FORM Event.code=On Load)
					Form[This.nomOBJ]:=($storage[$attributStorage]=($valeurStorage+1))
					
				: (FORM Event.code=On Clicked)
					$storage[$attributStorage]:=$valeurStorage+Num(Form[This.nomOBJ])
			End case 
	End case 
	
	
Function EditerOptionSaisieRadio($typePropriété : Integer; $storage : Object; $attributRadio1 : Text; $valeurRadio1 : Integer; $params : Object; $trace : cs.$trace)->$result : Boolean
	
	$result:=($typePropriété=Est une Option saisie radio)
	Case of 
		: (Not($result))
		: (Not(OB Is defined($params; "attribut")))
			$trace.ErrorDescription:="Il manque le paramètre attribut"
		: (Not(OB Is defined($params; "valeur")))
			$trace.ErrorDescription:="Il manque le paramètre valeur"
		Else 
			// c'est ok
			// option = choix entre $valeurRadio1 (valeur = 0) (=> $attribut = $valeur+1) et $valeurRadio2 (valeur = 1) (=> $attribut = $valeur)
			// rappel : ces options booléennes sont également modifiables par popUpMenu, via un ID menu : on utilise un ID et non un booléen
			$trace.Error:=0
			Case of 
				: (FORM Event.code=On Load)
					Form[This.nomOBJ]:=Num($storage[$attributRadio1]=($valeurRadio1+1))
					
				: (FORM Event.code=On Clicked)
					$storage[$attributRadio1]:=$valeurRadio1+Form[This.nomOBJ]
					// faire la bascule
					Form[$params.attribut]:=Num(Form[This.nomOBJ]=0)  // afficher
					$storage[$params.attribut]:=$params.valeur+Form[$params.attribut]  // mémoriser
			End case 
	End case 
	
	
Function EditerOptionBooléenneRadio($typePropriété : Integer; $storage : Object; $attributStorage : Text; $indiceStorage : Integer; $params : Object; $trace : cs.$trace)->$result : Boolean
	var $i : Integer
	
	$result:=($typePropriété=Est une Option booléenne radio)
	Case of 
		: (Not($result))
		: (Not(OB Is defined($params; "radioGroup")))
		: ($params.radioGroup.length=0)
			$trace.ErrorDescription:="Il manque un groupe de boutons"
		Else 
			// c'est ok
			// option = choix entre $valeurRadio1 (valeur = 0) (=> $attribut = $valeur+1) et $valeurRadio2 (valeur = 1) (=> $attribut = $valeur)
			$trace.Error:=0
			Case of 
				: (FORM Event.code=On Load)
					Form[This.nomOBJ]:=($storage[$attributStorage] ?? $indiceStorage)
					
				: (FORM Event.code=On Clicked)
					// recopier la bascule dans $storage
					For each ($i; $params.radioGroup)
						If ($i=$indiceStorage)
							// c'est le btn radio sélectionné
							$storage[$attributStorage]:=($storage[$attributStorage] ?+ $indiceStorage)
						Else 
							// btn non sélectionné
							$storage[$attributStorage]:=($storage[$attributStorage] ?- $i)  // mémoriser
						End if 
					End for each 
			End case 
	End case 
	
	
Function EditerOptionSaisie($typePropriété : Integer; $storage : Object; $attributStorage : Text; $trace : cs.$trace)->$result : Boolean
	
	$result:=($typePropriété=Est une Option saisie)
	Case of 
		: (Not($result))
		: ($attributStorage="")
			$trace.ErrorDescription:="Il manque le paramètre $attributStorage"
		Else 
			// c'est ok
			// option = texte saisie (valeur = texte)
			// remarque : ce cas peut être remplacé :
			//    en nommant l'objet Form par le nom de la propriété de $storage
			//    en affectant la propriété à la variable de l'objet Form 
			$trace.Error:=0
			Case of 
				: (FORM Event.code=On Load)
					Form[This.nomOBJ]:=$storage[$attributStorage]
					
				: ((FORM Event.code=On Data Change) | (FORM Event.code=On Clicked))
					// Sur données modifiées pour les champs saisis, Sur clic pour les règles
					$storage[$attributStorage]:=Form[This.nomOBJ]
			End case 
	End case 
	
	
Function EditerOptionSélectionnée($typePropriété : Integer; $storage : Object; $attributStorage : Text; $valeurStorage : Integer; $trace : cs.$trace)->$result : Boolean
	var $i : Integer
	
	$result:=(($typePropriété=Est une Option sélectionDate) | ($typePropriété=Est une Option sélectionHeure) | ($typePropriété=Est une Option sélectionLatLong))
	Case of 
		: (Not($result))
		: ($attributStorage="")
			$trace.ErrorDescription:="Il manque le paramètre $attributStorage"
		Else 
			// c'est ok
			// option = choix dans une liste H (valeur = itemPos dans la liste)
			$trace.Error:=0
			
			Case of 
				: (FORM Event.code=On Load)
					// créer la collection
					Form[This.nomOBJ]:=New object("values"; New collection; "codes"; New collection)
					
					Case of 
						: ($typePropriété=Est une Option sélectionDate)
							For ($i; 1; 7)
								Form[This.nomOBJ].codes.push($i)
								Form[This.nomOBJ].values.push(String(Current date; $i))
							End for 
							
						: ($typePropriété=Est une Option sélectionHeure)
							For ($i; 1; 5)
								Form[This.nomOBJ].codes.push($i)
								Form[This.nomOBJ].values.push(String(Current time; $i))
							End for 
							
						: ($typePropriété=Est une Option sélectionLatLong)
							Form[This.nomOBJ].codes.push(1; 2)
							Form[This.nomOBJ].values.push("-12° 34' 56,7"+Char(Double quote))
							Form[This.nomOBJ].values.push("-12,34567°")
					End case 
					
					// sélection courante
					Form[This.nomOBJ].index:=Form[This.nomOBJ].codes.indexOf($storage[$attributStorage])
					
					
				: (FORM Event.code=On Data Change)
					$storage[$attributStorage]:=Form[This.nomOBJ].codes[Form[This.nomOBJ].index]
			End case 
	End case 
	
	
Function EditerOptionBinaire($typePropriété : Integer; $storage : Object; $attributStorage : Text; $valeurStorage : Integer; $trace : cs.$trace)->$result : Boolean
	var $i : Integer
	
	$result:=($typePropriété=Est une Option binaire)
	Case of 
		: (Not($result))
		: ($attributStorage="")
			$trace.ErrorDescription:="Il manque le paramètre $attributStorage"
		Else 
			// c'est ok
			// option = un bit (n° bit = $valeurStorage)
			$trace.Error:=0
			// lire le mot courant
			$i:=$storage[$attributStorage]
			
			Case of 
				: (FORM Event.code=On Load)
					Form[This.nomOBJ]:=($i ?? $valeurStorage)
					
				: (FORM Event.code=On Clicked)
					If (Form[This.nomOBJ])
						$storage[$attributStorage]:=$i ?+ $valeurStorage
					Else 
						$storage[$attributStorage]:=$i ?- $valeurStorage
					End if 
					
				: (FORM Event.code=On Unload)
					// RAZ du bit
					$i:=$i ?- $valeurStorage
					$storage[$attributStorage]:=($i ?? $valeurStorage)
			End case 
	End case 
	
	
	// ----------------------
	//MARK:Utilitaires
	// -----------------------
	
Function SélectionnerUnDossier($titre : Text; $répertoire : Integer; $unlocked : Boolean)->$result : Text
	// sélectionner un dossier sur le DD
	
	If (Count parameters<3)
		$unlocked:=False
	End if 
	
	$result:=Select folder($titre; $répertoire; Use sheet window)
	If (ok=1)
		// on a un chemin
		If ($unlocked)
			// et on veut que le dossier soit unlocked
			If (This.document.estDossierVerrouillé(Folder($result; fk platform path)))
				$result:=""
				This.AfficherMessageUtilisateur(New object("ID"; 5058))
			End if 
		End if 
		
	Else 
		$result:=""
	End if 
	
	
Function FixerNavigationClavier()
	If (This.nav.saisieEnCours)
		// invalider la navigation fléchée
		OBJECT SET SHORTCUT(*; "navPreviousItem"; "")
		OBJECT SET SHORTCUT(*; "navNextItem"; "")
		
	Else 
		// retablir la navigation fléchée
		OBJECT SET SHORTCUT(*; "navPreviousItem"; Shortcut with Up arrow)
		OBJECT SET SHORTCUT(*; "navNextItem"; Shortcut with Down arrow)
	End if 
	
	
Function FixerHTTPvars($data : Object)
	// initialiser dans HTTPvars les variables process
	var $path : Text
	// définir les constantes process (et en mode interprété les variables process)
	//COMPILER_WEB
	
	$data.HTTPvars:=New object
	$data.HTTPvars.wwwRacineRessources:=""
	
	If (OB Is defined($data; "SessionID"))
		$path:=$data.SessionID
		This.rsc.SetObjet(Est Ressource APP; $path+"/Carto_Opacity_OSM"; Is text; $data.HTTPvars; "wwwCarto_Opacity_OSM")
		This.rsc.SetObjet(Est Ressource APP; $path+"/Carto_Install_GP"; Is text; $data.HTTPvars; "wwwCarto_Install_GP")
		This.rsc.SetObjet(Est Ressource APP; $path+"/Carto_Opacity_GP"; Is text; $data.HTTPvars; "wwwCarto_Opacity_GP")
		This.rsc.SetObjet(Est Ressource APP; $path+"/Carto_Opacity_Cible"; Is text; $data.HTTPvars; "wwwCarto_Opacity_Cible")
		This.rsc.SetObjet(Est Ressource APP; $path+"/Carto_ZoomMin_OL"; Is text; $data.HTTPvars; "wwwZoneWeb_ZoomMin")
		This.rsc.SetObjet(Est Ressource APP; $path+"/Carto_ZoomMax_OL"; Is text; $data.HTTPvars; "wwwZoneWeb_ZoomMax")
	End if 
	// fixer le 4DBASE des pages .shtml
	$data.HTTPvars.wwwContexteWeb:=Choose(This.environnement.typeApplication()=ALV Client APP; "ALVclient"; "ALVserveur")
	
	
Function RestaurerHTTPvars($data : Object)
	// copier HTTPvars dans les variables process
	// ici COMPILER_WEB est appelé (les variables process sont définies)
	var $attribut : Text
	var $ptr : Pointer
	var wwwCarto_Opacity_OSM : Text:=""
	var wwwCarto_Install_GP : Text:=""
	var wwwCarto_Opacity_GP : Text:=""
	var wwwCarto_Opacity_Cible : Text:=""
	var wwwZoneWeb_ZoomMin : Text:=""
	var wwwZoneWeb_ZoomMax : Text:=""
	// composant CARTO
	var wwwRacineRessources : Text:=""
	var wwwContexteWeb : Text:=""
	var wwwCarto_LatitudeCentre : Text:=""
	var wwwCarto_LongitudeCentre : Text:=""
	var wwwZoneWeb_Zoom : Text:=""
	var ZoneWeb_Largeur : Text:=""
	var ZoneWeb_Hauteur : Text:=""
	var wwwMediaPath : Text:=""
	
	For each ($attribut; $data)
		$ptr:=Get pointer($attribut)
		Case of 
			: (Undefined($ptr->))
				// pas normal
				CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Variable indéfinie"; Current method name; "La variable '"+$attribut+"' n'a pas été initialisée dans COMPILER_WEB"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			Else 
				// une variable
				$ptr->:=$data[$attribut]
		End case 
	End for each

⇧ [class]$formulaire_SF_OptionsAG - 18/04/2026 18:35:48

      property choix; modeleAG; NmaxAscendance; NmaxDescendance : Object
property userPrefs : Object

Class extends $formulaire

Class constructor()
	
	Super()
	
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	Case of 
		: (FORM Event.code=On Load)
			
			This.onEndLoad()
	End case 
	
	
Function onEndLoad()
	var $c : Collection
	
	// dans l'ordre
	$c:=New collection("modeleAG"; "choix")  //; "nbreAscendance"; "nbreDescendance")
	Super.onEndEventForm($c)
	
	
Function _FORM_choix()
	var $nomModele : Text
	var $index : Integer
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=New object
			
			Form[This.nomOBJ].values:=New collection(Localized string("10611"); Localized string("10612"))
			Form.Pages:=New collection(1; 2)
			
			// ici la page courante est mémorisée par 4D
			Form[This.nomOBJ].index:=This.session.prefs.Apparence.AG.ChoixMode-10611
			FORM GOTO PAGE(Form.Pages[Form[This.nomOBJ].index]; *)
			
		: (FORM Event.code=On Clicked)
			Use (This.session.prefs.Apparence.AG)
				This.session.prefs.Apparence.AG.ChoixMode:=10611+Form[This.nomOBJ].index
			End use 
			
			FORM GOTO PAGE(Form.Pages[Form[This.nomOBJ].index])
	End case 
	
	If ((FORM Event.code=On Load) | (FORM Event.code=On Clicked))
		// initialiser les objets fonction de la valeur de this
		
		This.userPrefs:=This.session.prefs.Apparence.AG["Mode_"+String(10611+This.choix.index)]
		
		$nomModele:=This.userPrefs.Modele
		$nomModele:=Replace string($nomModele; ".xml"; "")
		
		$index:=Form.modeleAG.values.indexOf($nomModele)
		Form.modeleAG.index:=Choose($index=-1; 0; $index)
		
		This.getListeXscendance("NmaxAscendance")
		This.getListeXscendance("NmaxDescendance")
	End if 
	
	
	// ----------------------
	//MARK:FORMevents Page Fond
	// ----------------------
	
Function _FORM_modeleAG()
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=New object()
			Form[This.nomOBJ].values:=This.getListeModelesAG()
			
		: (FORM Event.code=On Data Change)
			Use (This.userPrefs)
				This.userPrefs.Modele:=Form[This.nomOBJ].values[Form[This.nomOBJ].index]
			End use 
	End case 
	
	
Function _FORM_NmaxAscendance()
	Case of 
		: (FORM Event.code=On Data Change)
			Use (This.userPrefs)
				This.userPrefs[This.nomOBJ]:=Form[This.nomOBJ].values[Form[This.nomOBJ].index]
			End use 
	End case 
	
	
Function _FORM_NmaxDescendance()
	Case of 
		: (FORM Event.code=On Data Change)
			Use (This.userPrefs)
				This.userPrefs[This.nomOBJ]:=Form[This.nomOBJ].values[Form[This.nomOBJ].index]
			End use 
	End case 
	
	
	// ----------------------
	//MARK:Utilitaires
	// ----------------------
	
Function getListeModelesAG()->$result : Collection
	// la function renvoie le nom des modèles AG en traitant le schemaCouleur
	var $dossier : 4D.Folder
	var $fichier : 4D.File
	var $nomModele : Text
	
	$result:=New collection
	$result.push(Localized string("141"))
	
	$dossier:=Folder(fk resources folder).folder("Modèles Arbre")
	For each ($fichier; $dossier.files().orderBy("name"))
		$nomModele:=$fichier.name
		Case of 
			: ($nomModele="@clair")
				$nomModele:=Replace string($nomModele; " clair"; "")
				
			: ($nomModele="@sombre")
				$nomModele:=Replace string($nomModele; " sombre"; "")
		End case 
		
		$result.push($nomModele)
	End for each 
	
	$result:=$result.distinct().sort(ck ascending)
	
	
Function getListeXscendance($nomOBJ : Text)
	var $c : Collection
	var $nbreMax : Integer
	var $i : Integer
	
	Form[$nomOBJ]:=New object()
	
	$nbreMax:=Choose(This.choix.index; 4; 25)
	
	$c:=New collection
	For ($i; 1; $nbreMax)
		$c.push($i)
	End for 
	Form[$nomOBJ].values:=$c
	
	Form[$nomOBJ].index:=Form[$nomOBJ].values.indexOf(This.userPrefs[$nomOBJ])

⇧ [class]$processData - 09/06/2026 09:33:34

      property processes : Collection
property data : Object
property taches : Collection
property spinner : Boolean

shared singleton Class constructor()
	
	This.processes:=New shared collection
	
	
	
	// ----------------------
	//MARK:Points d'entrée
	// -----------------------
	
Function InscrireProcess($nomProcess : Text)
	var $data : Object
	
	If (Not(This._getData($nomProcess)))
		$data:=New shared object("nomProcess"; $nomProcess)
		Use (This.processes)
			This.processes.push($data)
		End use 
	End if 
	
	This._FixerData($nomProcess; "numFenetre"; -1)
	This._FixerData($nomProcess; "taches"; New shared collection)
	
	
Function FixerNumFenetre($nomProcess : Text)
	This._FixerData($nomProcess; "numFenetre"; Current form window)
	
	
Function RazNumFenetre($nomProcess : Text)
	This._FixerData($nomProcess; "numFenetre"; -1)
	
	
Function LireNumFenetre($nomProcess : Text)->$result : Integer
	$result:=This._LireData($nomProcess; "numFenetre"; -1)
	
	
Function existeFenetre($nomProcess : Text)->$result : Boolean
	$result:=(This._LireData($nomProcess; "numFenetre"; -1)>-1)
	
	
Function LireBureau()->$result : Collection
	$result:=This.processes.query("not(numFenetre = -1)").extract("nomProcess")
	
	
Function DeInscrireProcess($nomProcess : Text)
	var $data : Object
	
	If (This._getData($nomProcess))
		Use (This.processes)
			This.processes.remove(This.processes.indexOf(This.data))
		End use 
	End if 
	
	
	// ----------------------
	//MARK:Data
	// -----------------------
	
Function _FixerData($nomProcess : Text; $attribut : Text; $valeur : Variant)
	
	If (This._getData($nomProcess))
		Use (This.data)
			Case of 
				: (Value type($valeur)=Is object)
					This.data[$attribut]:=OB Copy($valeur; ck shared; This.data)
					
				: (Value type($valeur)=Is collection)
					This.data[$attribut]:=$valeur
					
				Else 
					This.data[$attribut]:=$valeur
			End case 
		End use 
	End if 
	
	
Function _LireData($nomProcess : Text; $attribut : Text; $defaut : Variant)->$result : Variant
	
	$result:=$defaut
	If (This._getData($nomProcess))
		$result:=This.data[$attribut]
	End if 
	
	
Function _getData($nomProcess : Text)->$result : Boolean
	Use (This)
		This.data:=Null
	End use 
	
	Case of 
		: (This.processes.length=0)
		: (This.processes.query("nomProcess = :1"; $nomProcess).length=0)
		Else 
			
			Use (This)
				This.data:=This.processes.query("nomProcess = :1"; $nomProcess)[0]
			End use 
	End case 
	
	$result:=Not(This.data=Null)
	
	
	
	// ----------------------
	//MARK:Tache en Cours
	// -----------------------
	
Function FixerTache($nomProcess : Text; $tache : Object)
	// renseigner le nom d'une tache pour la suivre ; la tache a été alors ou pas encore
	
	Case of 
		: (Not(This._getData($nomProcess)))
		: (Not(OB Is defined($tache; "nomTache")))
		Else 
			// compléter au besoin
			If (Not(OB Is defined($tache; "activerCurseurHoraire")))
				$tache.activerCurseurHoraire:=False
			End if 
			
			If (Not(OB Is defined($tache; "activerThermometre")))
				$tache.activerThermometre:=False
			End if 
			
			// ajouter lla tache
			var $c : Collection
			$c:=This.data.taches
			cs._cfct.me.PartagerObjet($tache; $c)
	End case 
	
	
Function LireTaches($nomProcess : Text)->$result : Collection
	$result:=Null
	
	If (This._getData($nomProcess))
		$result:=This.data.taches
	End if 
	
	
Function existeTache($nomTache : Text)->$result : Boolean
	$result:=cs.xSDK.RegistreTaches.me.existeTache($nomTache)
	
	
	// ----------------------
	//MARK:Affichage
	// -----------------------
	
Function AfficherProgressionTache()
	var $taches : Collection
	var $tache : Object
	var $progression : Object:=New object
	
	$taches:=This.LireTaches(Current process name)
	If ($taches.length>0)
		This._FixerData(Current process name; "spinner"; False)
		
		For each ($tache; $taches)
			Case of 
				: ($tache.nomTache="")
					// pas de tache pour ce process
					
				: (This.LireProgressionTache($tache.nomTache; $progression))
					// erreur ou pas concerné
					
				: (This.AfficherThermometre($tache.activerThermometre; $progression))
				: (This.FixerCurseurHoraire($tache.activerCurseurHoraire; $progression))
					// ici plusieurs taches peuvent activer le spinner : le OU des activations est mémorisé dans this
			End case 
		End for each 
		
		// afficher l'état global du spinner
		This.AfficherCurseurHoraire()
	End if 
	
	
Function SuivreProgressionProgress($tache : cs.xSDK.Tache; $debutTache : Integer; $dureeTache : Integer; $numProgress : Integer)
	// calcule l'avancement de la tâche réalisée par le process "$numProc"
	// le début de l'avancement est $debutTache et la durée est $dureeTache (hypothèse : la tâche entretient son avancement entre 0 et 10000)
	// met jour l'état de l'avancement dans le 4Dprogress de ID $numProgress
	var $progression : Object:=New object
	
	// attendre un peu que le process soit bien démarré
	$tache.FixerParamsAvancement($debutTache; $dureeTache)
	
	While (This.existeTache($tache.nomTache))
		
		This.LireProgressionTache($tache.nomTache; $progression)
		
		If ($numProgress>0)
			// mettre à jour le libellé de l'état d'avancement
			If ($progression.Etat#"")
				Progress SET PROGRESS($numProgress; $progression.Time/10000; $progression.Etat; False)
			End if 
			// tuer le process à la demande de l'utilisateur
			Case of 
					// il n'y a peut-être pas de btn
				: (Not(Progress Get Button Enabled($numProgress)))
					// action?
				: (Not(Progress Stopped($numProgress)))
				Else 
					// purger le process
					cs.$process.new().TuerAvecNom($tache.nomProcess)
			End case 
		End if 
		
		Waiting(10)
	End while 
	
	
Function LireProgressionTache($nomTache : Text; $progression : Object)->$result : Boolean
	// renvoie vrai si existe tache
	var $tache : cs.xSDK.Tache
	$result:=False  // c'est comme ça !
	
	$tache:=cs.xSDK.RegistreTaches.me.LireTache($nomTache)
	$progression.enCours:=($tache#Null)
	
	If ($progression.enCours)
		$progression.Etat:=$tache.Etat
		$progression.State:=$tache.State
		$progression.Time:=$tache.Time
		$progression.Avancement:=$tache.Avancement
		
		Case of 
			: ($progression.Avancement<0)
			: (Not(OB Is defined($tache; "debut")))
			: (Not(OB Is defined($tache; "duree")))
			Else 
				// rappel : hypothèse : .Avancement est un réel dans [0 ; 1]
				$progression.Time:=$tache.debut+($progression.Avancement*$tache.duree)
		End case 
	End if 
	
	
Function AfficherThermometre($afficher : Boolean; $progression : Object)->$result : Boolean
	// fixer l'état de la progression dans un thermomètre
	$result:=False  // c'est comme ça !
	
	Case of 
		: (Not($afficher))
			// affichage non demnandé
			
		: (Not(OB Is defined(Form; "thermometre")))
			// pas de thermometre dans le formulaire courant
			
		: (Not($progression.enCours))
			// pas de message thermomixé
			OBJECT SET VISIBLE(*; "thermometre"; False)
			Form.userMessageText:=""
			
		Else 
			// on a un thermomètre avec une tâche en cours ; mettre à jour
			OBJECT SET VISIBLE(*; "thermometre"; $progression.enCours)
			
			Form.thermometre:=$progression.Time
			// * message utilisateur
			Form.AfficherMessageUtilisateur(New object("libelle"; $progression.Etat))
	End case 
	
	
Function FixerCurseurHoraire($afficher : Boolean; $progression : Object)->$result : Boolean
	// fixer l'état de la progression dans un curseur horaire
	$result:=False  // c'est comme ça !
	
	// * un spinner existe dans le formulaire courant?
	Case of 
		: (Not($afficher))
			// affichage non demnandé
			
		: (Not($progression.enCours))
			// pas de tâches créées
			This._FixerData(Current process name; "spinner"; This._LireData(Current process name; "spinner"; False) | False)
			
		Else 
			// on (ré)allume
			This._FixerData(Current process name; "spinner"; This._LireData(Current process name; "spinner"; False) | True)
	End case 
	
	
Function AfficherCurseurHoraire()
	// afficher l'état du curseur horaire
	
	// * un spinner existe dans le formulaire courant?
	If (OB Is defined(Form; "curseurHoraire"))
		Form.curseurHoraire:=Num(This._LireData(Current process name; "spinner"; False))
		OBJECT SET VISIBLE(*; "curseurHoraire"; This._LireData(Current process name; "spinner"; False))
	End if

⇧ [class]$pageWebDOC - 18/04/2026 18:34:15

      property rsc : cs.xSDK.ResourceALV
property result : Object
property paramsUrl; balisesUrl : Collection
property aideRacineXML; racineXML : Text
property _tagUrl : Text:="/4DCGI/"

Class extends $serveurWEB

Class constructor
	
	Super()
	
	This.result:=This.InitResult()
	This.rsc:=cs.xSDK.ResourceALV.me
	
	var $fichier : 4D.File
	var $structureDeDonnées : Text
	
	$fichier:=Folder(Get 4D folder(Current resources folder); fk platform path).file("DataPagesAide.xml")
	// lire la structure XML
	cs.xSDK.XML.me.LireFichier($fichier; ->$structureDeDonnées)
	This.aideRacineXML:=DOM Parse XML variable($structureDeDonnées)
	// racineXML est purgé ailleurs en fonction du contexte
	
	
	// -----------------------------
	// Mark:Serveur Web
	// -----------------------------
	
Function TraiterURL($url : Text)->$result : Object
	
	This.result.nomMethode:=Current method name
	This.result.resultat:=""
	
	// récupérer les paramètres
	This.LireParametresUrl($url)
	
	// normalement .balise[2] est le nom d'une function de $pageXXX
	Case of 
		: (This.balisesUrl.length<3)
			This.result.Error:=-15068
			This.result.ErrorDescription:="url incorrecte - il manque la paramètres .balise[2]"
			
		: (Not(OB Is defined(This; This.balisesUrl[2])))
			This.result.Error:=-15068
			This.result.ErrorDescription:="url incorrecte - .balise[2] '"+This.balisesUrl[2]+"' n'est pas une function de this "+OB Class(This).name
			
		Else 
			// on accepte la demande
			// le résultat, s'il y a, est dans this.result.resultat
			// exécuter la function, en cas d'erreur elle peut renseigner This.result
			This[This.balisesUrl[2]]()
	End case 
	$result:=This.result
	
	
Function Connecter()
	This.Envoyer(6000)
	
	
Function AfficherLaPage()
	Case of 
		: (This.paramsUrl.length=0)
		: (Num(This.paramsUrl[0])=0)
		Else 
			This.Envoyer(Num(This.paramsUrl[0]))
	End case 
	
	
Function Envoyer($IDpage : Integer)
	// fixer les paramètres de construction
	numPageForm:=$IDpage
	wwwEtatNavigation:="serveurWeb"
	wwwRacineRessources:="../../"  // depuis v5.2 les 4DURL sont de la forme /4Dxxx/xxx/yyy
	wwwSousDomaine:="documentation/"
	
	WEB SEND FILE("documentation/pageAide.shtml")
	
	
Function AfficherLaPageDansForm()
	// cas palette
	// ici on doit être thread-safe
	var $data : Object
	
	Case of 
		: (This.paramsUrl.length=0)
		: (Num(This.paramsUrl[0])=0)
		Else 
			$data:=New object("IDpage"; Num(This.paramsUrl[0]))
			CALL WORKER("WK_Services"; Formula(Appeler_Le_Formulaire); Current process; "AfficherLaPage"; $data)
	End case 
	
	
	// -----------------------------
	// Mark:Menus Liste Hierarchique
	// -----------------------------
	
Function getLHdesMenus()
	// renvoi un bloc contenant la LH des menus déroulée jusqu'à l'élément "numPageForm"
	var $ElémentXML; $EnfantXML; $petitEnfantXML; $AideElémentXML; $Xpath; $texte : Text
	var $i; $valeur : Integer
	
	ErrorNum:=0
	
	// créer la structure
	This.racineXML:=DOM Create XML Ref("nav")
	$ElémentXML:=This.racineXML
	
	// récupérer la hiérarchie (inverse) des menus jusqu'à "numPageForm", et la LHaide utilisée
	ARRAY LONGINT($IDélements; 0)
	This.getCheminDePage(->$IDélements)
	
	// pour l'accueil, pas de LH
	If (numPageForm=6000)
		ARRAY LONGINT($IDélements; 0)
	End if 
	
	// créer le début du menu
	If (Size of array($IDélements)>0)
		// rappel : la hiérarchie est lue à l'envers
		For ($i; Size of array($IDélements); 1; -1)
			// insérer un sous menu
			$ElémentXML:=DOM Create XML element($ElémentXML; "ul")
			$ElémentXML:=DOM Create XML element($ElémentXML; "li"; "class"; "Menus")
			$EnfantXML:=DOM Create XML element($ElémentXML; "a")
			This.FixerLienVersPage($EnfantXML; $IDélements{$i})
			
			DOM SET XML ELEMENT VALUE($EnfantXML; This.FormaterIDarticle($IDélements{$i})+cs._cfct.me.LireLocatedSTR($IDélements{$i}))
		End for 
	End if 
	
	// ajouter la liste des menus du même niveau que "numPageForm"
	// le parent de numPageForm est $IDélements{1}
	If (Size of array($IDélements)>0)
		$AideElémentXML:=DOM Find XML element by ID(This.aideRacineXML; String($IDélements{1}))
		// lister les éléments
		DOM GET XML ELEMENT NAME($AideElémentXML; $Xpath)  // récupérer la racine
		$Xpath:=$Xpath+"/menu"
		$EnfantXML:=DOM Get first child XML element($AideElémentXML; $Xpath; $texte)
		$petitEnfantXML:=$EnfantXML
		
		ARRAY LONGINT($IDélements; 0)
		While (ok=1)
			DOM GET XML ELEMENT VALUE($petitEnfantXML; $valeur)
			APPEND TO ARRAY($IDélements; $valeur)
			$petitEnfantXML:=DOM Get next sibling XML element($petitEnfantXML; $Xpath; $texte)
		End while 
		
		// écrire la liste des menus
		$ElémentXML:=DOM Create XML element($ElémentXML; "ul")
		For ($i; 1; Size of array($IDélements))
			// insérer un sous menu
			$EnfantXML:=DOM Create XML element($ElémentXML; "li"; "class"; "Menus")
			$EnfantXML:=DOM Create XML element($EnfantXML; "a")
			This.FixerLienVersPage($EnfantXML; $IDélements{$i})
			
			DOM SET XML ELEMENT VALUE($EnfantXML; This.FormaterIDarticle($IDélements{$i})+cs._cfct.me.LireLocatedSTR($IDélements{$i}))
		End for 
		
	End if 
	
	// c'est fini
	This.result.resultat:=Char(1)+This.getTexteElement()
	This.FermerDocDataXML()
	
	
Function getBarreDeMenus()
	// renvoi un bloc contenant la hiérarchie des menus depuis l'élément "numPageForm"
	var $ElémentXML; $EnfantXML : Text
	var $i : Integer
	
	ErrorNum:=0
	
	// récupérer la hiérarchie (inverse) des menus jusqu'à "numPageForm", et la LHaide utilisée
	ARRAY LONGINT($IDélements; 0)
	This.getCheminDePage(->$IDélements)
	
	Case of 
		: (numPageForm#6000)
			// ajouter "numPageForm" (rappel le chemin est inversé, avec 1 il est en dernier)
			INSERT IN ARRAY($IDélements; 1)
			$IDélements{1}:=numPageForm
	End case 
	
	// créer le menu
	This.racineXML:=DOM Create XML Ref("nav")
	$ElémentXML:=This.racineXML
	
	If (Size of array($IDélements)>0)
		
		// rappel : la hiérarchie est lue à l'envers
		$ElémentXML:=DOM Create XML element(This.racineXML; "ul"; "id"; "barreMenus")
		For ($i; Size of array($IDélements); 1; -1)
			// insérer un sous menu
			$EnfantXML:=DOM Create XML element($ElémentXML; "li")
			$EnfantXML:=DOM Create XML element($EnfantXML; "a")
			// le dernier élément n'a pas de lien
			If ($i>1)
				This.FixerLienVersPage($EnfantXML; $IDélements{$i})
			End if 
			DOM SET XML ELEMENT VALUE($EnfantXML; This.FormaterIDarticle($IDélements{$i})+cs._cfct.me.LireLocatedSTR($IDélements{$i}))
		End for 
	End if 
	
	// c'est fini
	This.result.resultat:=Char(1)+This.getTexteElement()
	This.FermerDocDataXML()
	
	
Function getCheminDePage($ptrTab : Pointer)
	// renvoi dans le tableau $2 le chemin du menu "numPageForm" depuis l'origine des menus de $3
	// pas simple avec la structure XML
	var $result : Collection
	var $AideElémentXML; $ElémentXML; $EnfantXML; $petitEnfantXML; $Xpath; $texte : Text
	var $valeur; $i : Integer
	
	$result:=New collection
	ErrorNum:=0
	
	// lire la définition des menus
	$AideElémentXML:=DOM Find XML element by ID(This.aideRacineXML; String(numPageForm))
	// lire tous les éléments de la hiérarchie des menus
	DOM GET XML ELEMENT NAME(This.aideRacineXML; $Xpath)  // récupérer la racine
	ARRAY TEXT($ElémentsXML; 0)
	$ElémentXML:=DOM Find XML element(This.aideRacineXML; $Xpath+"/AideMenus"; $ElémentsXML)
	
	ARRAY LONGINT($IDélements; 0)
	$valeur:=numPageForm
	Repeat 
		For ($i; 1; Size of array($ElémentsXML))
			// passer en revue tous les éléments de $ElémentsXML{$i} et chercher $valeur
			$EnfantXML:=DOM Get first child XML element($ElémentsXML{$i}; $Xpath; $texte)
			$petitEnfantXML:=$EnfantXML
			While (ok=1)
				If (Num($texte)=$valeur)
					// trouvé
					DOM GET XML ATTRIBUTE BY NAME($ElémentsXML{$i}; "id"; $valeur)
					APPEND TO ARRAY($IDélements; $valeur)
					
					// arrêter la boucle (le repeat va au bout, rappel $valeur ne peut apparaitre qu'une fois)
					$i:=Size of array($ElémentsXML)+2
					// remonter d'un niveau
				End if 
				$petitEnfantXML:=DOM Get next sibling XML element($petitEnfantXML; $Xpath; $texte)
			End while 
			
		End for 
		$valeur:=$valeur*Num($i>(Size of array($ElémentsXML)+1))
	Until ($valeur=0)
	// c'est bon
	//%W-518.1
	COPY ARRAY($IDélements; $ptrTab->)
	//%W+518.1
	
	
	// -----------------------------
	// Mark:Article de page
	// -----------------------------
	
Function getTitreDesArticles()
	// lire la définition du menu numPageForm
	var $AideElémentXML; $ElémentXML; $EnfantXML; $petitEnfantXML; $Xpath; $texte : Text
	var $i : Integer
	
	$AideElémentXML:=DOM Find XML element by ID(This.aideRacineXML; String(numPageForm))
	
	If (ok=1)
		// initialiser les propriétés du menu numPageForm
		ARRAY TEXT($Paramètres; 4)
		$Paramètres{1}:="icone"
		$Paramètres{2}:="application"
		$Paramètres{3}:="use"
		$Paramètres{4}:="specificOS"
		ARRAY TEXT($valeurs; 4)
		$valeurs{1}:="16322"
		$valeurs{2}:=""
		$valeurs{3}:="-1"
		$valeurs{4}:="none"
		
		// lire les propriétés du menu numPageForm
		// elles ne sont pas toujours toutes présentes
		For ($i; 1; DOM Count XML attributes($AideElémentXML))
			DOM GET XML ATTRIBUTE BY INDEX($AideElémentXML; $i; $Xpath; $texte)
			If (Find in array($Paramètres; $Xpath)>0)
				$valeurs{Find in array($Paramètres; $Xpath)}:=$texte
			End if 
		End for 
		
		// créer le titre
		This.racineXML:=DOM Create XML Ref("div")
		$ElémentXML:=DOM Create XML element(This.racineXML; "h2"; "id"; "pageTitre")
		// ajouter le nom du menu
		$petitEnfantXML:=DOM Create XML element($ElémentXML; "img"; "alt"; $valeurs{1}; "width"; "16"; "height"; "16"; "src"; wwwRacineRessources+wwwSousDomaine+"ressources/images/"+$valeurs{1}+".png")
		$EnfantXML:=DOM Create XML element($ElémentXML; "p")
		DOM SET XML ELEMENT VALUE($EnfantXML; cs._cfct.me.LireLocatedSTR(numPageForm))
		
		// ajouter les propriétés de la page
		$ElémentXML:=DOM Create XML element(This.racineXML; "h4"; "id"; "pageProprietes")
		
		// ajouter l'application concernée :
		// offset de la chaine : ALV = 0 , spécifique BDD mère = 1 , spécifique Serveur Web = 2 , spécifique Serveur APP = 3
		Case of 
			: ($valeurs{2}="ALV")
				$valeurs{2}:="0"
			: ($valeurs{2}="BDD")
				$valeurs{2}:="1"
			: ($valeurs{2}="WEB")
				$valeurs{2}:="2"
			: ($valeurs{2}="APP")
				$valeurs{2}:="3"
		End case 
		If ($valeurs{2}#"")
			$EnfantXML:=DOM Create XML element($ElémentXML; "p")
			DOM SET XML ELEMENT VALUE($EnfantXML; cs._cfct.me.LireLocatedSTR(5160+Num($valeurs{2})))
		End if 
		
		// ajouter l'utilisation concernée :
		// -1 (toutes utilisations), 0 (consultation), 1 (édition), 2 (admin), 3 (archive), 4 (dev)
		If ($valeurs{3}#"-1")
			$EnfantXML:=DOM Create XML element($ElémentXML; "p")
			DOM SET XML ELEMENT VALUE($EnfantXML; cs._cfct.me.LireLocatedSTR(5164+Num($valeurs{3})))
		End if 
		
		// ajouter la dépendance OS : none = aucune, OSX, Win, et les 2 OS
		If ($valeurs{4}#"none")
			$EnfantXML:=DOM Create XML element($ElémentXML; "p")
			If (($valeurs{4}="OSX") | ($valeurs{4}="ALL"))
				$petitEnfantXML:=DOM Create XML element($EnfantXML; "img"; "alt"; String(16319); "width"; "32"; "height"; "32"; "src"; wwwRacineRessources+wwwSousDomaine+"ressources/images/16319.png")
			End if 
			If (($valeurs{4}="WIN") | ($valeurs{4}="ALL"))
				$petitEnfantXML:=DOM Create XML element($EnfantXML; "img"; "alt"; String(16320); "width"; "32"; "height"; "32"; "src"; wwwRacineRessources+wwwSousDomaine+"ressources/images/16320.png")
			End if 
		End if 
		
		// c'est fini
		This.result.resultat:=Char(1)+This.getTexteElement()
		
	Else 
		This.result.resultat:=Char(1)+"err XML"
		cs.$trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Template aide"; Current method name; "La page "+String(numPageForm)+" n'existe pas dans la structure 'AideRacineXML'")
	End if 
	
	This.FermerDocDataXML()
	
	
Function ListerLesArticles()
	// renvoi un bloc contenant la liste des sous menus de "numPageForm", ou des articles si on est en fin de menu
	var $AideElémentXML; $ElémentXML; $EnfantXML; $petitEnfantXML; $arrièrePetitEnfantXML; $texte; $Xpath : Text
	var $i : Integer
	
	ErrorNum:=0
	
	$AideElémentXML:=DOM Find XML element by ID(This.aideRacineXML; String(numPageForm))
	
	If (ok=1)
		// lire la définition du menu numPageForm
		DOM GET XML ELEMENT NAME($AideElémentXML; $texte)  // racine de l'élément ("AideMenus" ou "Page" selon)
		$ElémentXML:=DOM Get first child XML element($AideElémentXML; $Xpath)  // ("menu" ou "article" selon)
		ARRAY TEXT($ElémentsXML; 0)
		$ElémentXML:=DOM Find XML element($AideElémentXML; "/"+$texte+"/"+$Xpath; $ElémentsXML)
		
		// créer la structure
		This.racineXML:=DOM Create XML Ref("section")
		$ElémentXML:=DOM Create XML element(This.racineXML; "div"; "class"; "aContenu")
		
		Case of 
			: (Size of array($ElémentsXML)=0)
				// pas normal (ou bien aide en chantier)
				
			: ($Xpath="menu")
				// récupérer les numPages associés
				ARRAY LONGINT($IDélements; Size of array($ElémentsXML))
				For ($i; 1; Size of array($ElémentsXML))
					DOM GET XML ELEMENT VALUE($ElémentsXML{$i}; $IDélements{$i})
				End for 
				// ajouter les $IDélements à l'article
				If (Size of array($IDélements)>0)
					// nouvelle liste
					$ElémentXML:=DOM Create XML element(This.racineXML; "ul")
					For ($i; 1; Size of array($IDélements))
						// insérer un sous menu
						$EnfantXML:=DOM Create XML element($ElémentXML; "li")
						$EnfantXML:=DOM Create XML element($EnfantXML; "a")
						This.FixerLienVersPage($EnfantXML; $IDélements{$i})
						DOM SET XML ELEMENT VALUE($EnfantXML; cs._cfct.me.LireLocatedSTR($IDélements{$i}))
					End for 
				End if 
				
			: ($Xpath="article")
				For ($i; 1; Size of array($ElémentsXML))
					// récupérer les données disponibles associés
					// un article doit avoir un élément "Aide_ID" et optionnellement un élément "libelle" ; lire en aveugle
					ARRAY TEXT($paramètres; 0)
					ARRAY TEXT($valeurs; 0)
					//Si (Taille tableau($Paramètres)>0)
					$EnfantXML:=DOM Get first child XML element($ElémentsXML{$i}; $Xpath; $texte)
					$petitEnfantXML:=$EnfantXML
					While (ok=1)
						APPEND TO ARRAY($Paramètres; $Xpath)
						APPEND TO ARRAY($valeurs; $texte)
						$petitEnfantXML:=DOM Get next sibling XML element($petitEnfantXML; $Xpath; $texte)
					End while 
					
					// on y va : créer l'article
					$EnfantXML:=DOM Create XML element($ElémentXML; "article")
					
					// écrire le titre de l'article
					If (Find in array($Paramètres; "libelle")>0)
						$petitEnfantXML:=DOM Create XML element($EnfantXML; "header")
						$arrièrePetitEnfantXML:=DOM Create XML element($petitEnfantXML; "h3"; "class"; "aTitre")
						$texte:="libelle"
						DOM SET XML ELEMENT VALUE($arrièrePetitEnfantXML; cs._cfct.me.LireLocatedSTR(Num($valeurs{Find in array($Paramètres; $texte)}))+This.EcrireIDarticle(->$valeurs; ->$texte; ->$Paramètres))
						$arrièrePetitEnfantXML:=DOM Create XML element($petitEnfantXML; "hr")
					End if 
					
					If (Find in array($Paramètres; "Aide_ID")>0)
						// écrire le contenu de l'article
						$petitEnfantXML:=DOM Create XML element($EnfantXML; "p")
						$texte:="Aide_ID"
						DOM SET XML ELEMENT VALUE($petitEnfantXML; This.EcrireIDarticle(->$valeurs; ->$texte; ->$Paramètres))
						This.LireLocatedSTR_HTML(->$EnfantXML; Num($valeurs{Find in array($Paramètres; "Aide_ID")}))
						//cs._cfct.me.LireLocatedSTR HTML(->$EnfantXML; Num($valeurs{Find in array($Paramètres; "Aide_ID")}))
					End if 
				End for 
		End case 
		
		// c'est fini
		$texte:=This.getTexteElement()
		$texte:=Replace string($texte; "@RC@"; "</br>")
		This.result.resultat:=Char(1)+$texte
		
	Else 
		This.result.resultat:=Char(1)+"err XML"
		cs.$trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Template aide"; Current method name; "La page "+String(numPageForm)+" n'existe pas dans la structure 'AideRacineXML'")
	End if 
	
	This.FermerDocDataXML()
	
	
Function LireLocatedSTR_HTML($ptrElement : Pointer; $ID : Integer)
	// lit une chaine localisée et la convertie en texte HTML; traite les balises du texte (xliff, ALVhtml, ALVresc ?)
	var $texte; $ElementXML; $séparateur : Text
	var $début; $fin; $i : Integer
	
	// lire le texte brut (rappel : lit et traite les balises xliff)
	$texte:=cs._cfct.me.LireLocatedSTR($ID)
	
	// les RC ne sont pas reconnus en HTML : récupérer les paragraphes pour les ajouter un par un
	$séparateur:="\n"
	ARRAY TEXT($paragraphes; 0)
	
	$début:=1
	Repeat 
		$fin:=Position($séparateur; $texte; $début; *)
		
		Case of 
			: ($fin=0)
				// dernier paragraphe
				APPEND TO ARRAY($paragraphes; Substring($texte; $début))
				
			: ($fin=$début)
				// un saut de ligne : on filtre
				$début:=$fin+1
				
			Else 
				// on a un paragraphe
				APPEND TO ARRAY($paragraphes; Substring($texte; $début; $fin-$début))
				$début:=$fin+1
				
		End case 
	Until (($fin=0) | (Size of array($paragraphes)>1000))
	
	// pour chaque paragraphe :
	For ($i; 1; Size of array($paragraphes))
		// créer le paragraphe
		$ElementXML:=DOM Create XML element($ptrElement->; "p")
		// le traitement doit être récursif pour gérer des balises ALV imbriquées
		This.TraiterBalisesALV(->$paragraphes{$i}; ->$ElementXML)
	End for 
	
	
Function TraiterBalisesALV($ptrTexte : Pointer; $ptrElement : Pointer)
	// Insérer les balises (ALVxxx) du texte $1 dans $ptrElement
	var $newTexte : Text:=""
	var $texte; $balise; $EnfantXML : Text
	var $début; $fin; $IDpage : Integer
	var $objet : Object
	var $c : Collection
	
	// principe : lire le texte et le découper en morceaux, ajoutés à $1 sous forme de <span>
	// remplacer les balises rencontrées par l'élément HTML demandé
	
	// lire le texte brut
	$texte:=$ptrTexte->
	// une expression calculée est encadrée par <ALVhtml et />
	$début:=1
	While ($début>0)
		// chercher une balise HTML type ALV
		$fin:=Position("<ALV"; $texte; $début; *)
		
		Case of 
			: ($début>Length($texte))
				// plus de texte : arréter la recherche
				$début:=-1
				
			: ($fin=0)
				// c'est fini : créer la fin du texte
				$EnfantXML:=DOM Create XML element($ptrElement->; "span")
				DOM SET XML ELEMENT VALUE($EnfantXML; Substring($texte; $début))
				// arréter la recherche
				$début:=-1
				
			Else 
				// créer le texte entre $début et $fin (s'il existe)
				If ($fin>$début)
					$EnfantXML:=DOM Create XML element($ptrElement->; "span")
					DOM SET XML ELEMENT VALUE($EnfantXML; Substring($texte; $début; $fin-$début))
				End if 
				
				// récupérer le nom de la balise
				$début:=$fin
				$balise:=Substring($texte; $début+1; Position("?"; $texte; $début; *)-1-$début)
				// récupérer la position de fermeture de balise
				Case of 
					: (Match regex("ALVul|ALVli"; $balise))
						// balise fermante, type '/balise>'
						$fin:=Position("/"+$balise+">"; $texte; $début+1; *)+Length($balise)+1
						$newTexte:=Substring($texte; $début+1; $fin-Length($balise)-1-$début-1)  // virer les marqueurs (plus propre)
						
					: (Match regex("ALVdiv|ALVp"; $balise))
						// balise fermante, type '/balise>'
						$fin:=Position("/"+$balise+">"; $texte; $début+1; *)+Length($balise)+1
						$newTexte:=Substring($texte; $début+1; $fin-Length($balise)-1-$début-1)  // virer les marqueurs (plus propre)
						
					Else 
						// balise autofermante, type '/>'
						$fin:=Position("/>"; $texte; $début+1; *)+1
						$newTexte:=Substring($texte; $début+1; $fin-$début+1-3)  // virer les marqueurs (plus propre)
				End case 
				If ($fin<$début)  // pb dans le texte
					$fin:=Length($texte)
				End if 
				
				// récupérer les paramètres de la balise
				$c:=Split string($newTexte; "?")
				
				// plusieurs cas
				Case of 
						// cas sans paramètres ($newTexte est une structure complexe, $c est incohérent)
					: (Match regex("ALVul|ALVli"; $balise))
						// écrire la balise (dans cette version, c'est toujours une balise standard HTML)
						$EnfantXML:=DOM Create XML element($ptrElement->; Replace string($balise; "ALV"; ""); "class"; $balise)
						// supprimer la balise et traiter '$newTexte'
						$newTexte:=Replace string($newTexte; $balise+"?"; "")
						This.TraiterBalisesALV(->$newTexte; ->$EnfantXML)
						
					: (Match regex("ALVdiv|ALVp"; $balise))
						// écrire la balise (dans cette version, c'est toujours une balise standard HTML)
						$EnfantXML:=DOM Create XML element($ptrElement->; Replace string($balise; "ALV"; ""); "class"; $balise)
						// supprimer la balise et traiter '$newTexte'
						$newTexte:=Replace string($newTexte; $balise+"?"; "")
						This.TraiterBalisesALV(->$newTexte; ->$EnfantXML)
						
						
						// une ressource utilisé ???
					: ($balise[[2]]="®")
						$newTexte:=Substring($texte; 3; $fin-$début+1-3)
						If (cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; $newTexte; Is text; ->$newTexte))
							$newTexte:=$Texte
						End if 
						
						// un chemin de dossier, remarque : les styles ne peuvent pas être saisis directement dans le texte
					: ($balise="ALVpath")
						$objet:=cs.$document.new()
						If (OB Is defined($objet; $c[1]))
							Case of 
								: ($c.length=2)
									$newTexte:=$objet[$c[1]]().platformPath
									
								: ($c.length=3)
									$newTexte:=$objet[$c[1]](Num($c[2])).platformPath
							End case 
							
						Else 
							// on a une constante 4D de dossier 
							$newTexte:=Get 4D folder(Num($c[1]))
						End if 
						
						$EnfantXML:=DOM Create XML element($ptrElement->; "span"; "class"; "aLabel")
						DOM SET XML ELEMENT VALUE($EnfantXML; $newTexte)
						
					: ($balise="ALV$doc")
						// on doit avoir un nom de function
						$objet:=cs.$document.new()
						If (OB Is defined($objet; $c[1]))
							$newTexte:=$objet[$c[1]]().platformPath
							$EnfantXML:=DOM Create XML element($ptrElement->; "span"; "class"; "aLabel")
							DOM SET XML ELEMENT VALUE($EnfantXML; $newTexte)
							
						Else 
							$newTexte:=""
						End if 
						
						
						// cas suivants : il faut au moins 2 éléments
					: ($c.length<3)
						// effacer la balise
						$newTexte:=""
						
						// un lien de l'aide
					: ($balise="ALVhref")
						$IDpage:=Num($c[2])
						$EnfantXML:=DOM Create XML element($ptrElement->; "a")
						This.FixerLienVersPage($EnfantXML; $IDpage)
						DOM SET XML ELEMENT VALUE($EnfantXML; $c[1])
						
						// une url vers une page WEB
					: ($balise="ALVurl")
						$EnfantXML:=DOM Create XML element($ptrElement->; "a")
						// supprimer la balise et traiter '$newTexte'
						$newTexte:=$c[2]
						This.TraiterBalisesALV(->$newTexte; ->$EnfantXML)
						$newTexte:="https://"+$newTexte
						DOM SET XML ATTRIBUTE($EnfantXML; "href"; $newTexte)
						DOM SET XML ELEMENT VALUE($EnfantXML; $c[1])
						
						// un style, remarque : les styles ne peuvent pas être saisis directement dans le texte
					: ($balise="ALVstyle")
						$EnfantXML:=DOM Create XML element($ptrElement->; "span"; "class"; $c[2])
						DOM SET XML ELEMENT VALUE($EnfantXML; $c[1])
						
						
						// cas suivants : il faut au moins 3 éléments
					: ($c.length<4)
						// effacer la balise
						$newTexte:=""
						
						// une image
					: ($balise="ALVimage")
						$EnfantXML:=DOM Create XML element($ptrElement->; "img")
						// $c[1] est le nom du fichier
						DOM SET XML ATTRIBUTE($EnfantXML; "src"; wwwRacineRessources+wwwSousDomaine+"ressources/images/"+$c[1]+".png"; "alt"; $c[1]; "width"; $c[2]; "height"; $c[3])
						
					Else 
						// on ne sait pas
						$newTexte:=""
				End case 
				
				// continuer
				$début:=$fin+1
		End case 
	End while 
	
	// c'est fini
	
	
	// -----------------------------
	// Mark:Elements HTML
	// -----------------------------
	// ici le resultat doit être dans .result.resultat
	
Function getTitreDeLaPage()
	This.result.resultat:=Char(1)+This.FormaterIDarticle(numPageForm)+cs._cfct.me.LireLocatedSTR(numPageForm)
	
	
Function getApplicationVersion()
	This.result.resultat:=cs.xSDK.EnvironnementALV.new().LireVersionAPP()
	
	
Function getCheminDocumentationALV()
	// hypothèse : un seul fichier téléchargeable (dernière version)
	// son nom est celui de la version du serveur en cours d'exécution
	// le CheminDocumentationALV est donc unique, cablé EN DUR dans la page HTML
	var $path : Text:=""
	var $url : Text:=""
	var $data : Object
	
	This.result.resultat:="#1"  // lien inactif
	$path:=""
	$url:=""
	Case of 
		: (Not(This.rsc.SetVariable(Est Ressource HOST; "Chemins/Documentation/URL"; Is text; ->$path)))
			// URL relative à la racine HTML :
		: (Not(This.rsc.SetVariable(Est Ressource WEB; "Hosting/URL"; Is text; ->$url)))
		Else 
			$data:=New object
			cs.$documentation.new().Versionner($data)
			This.result.resultat:=$url+$path+$data.nomDossierCompressé+".zip"
	End case 
	
	
Function getPiedDePage()
	This.result.resultat:="© 1998-"+String(Year of(Current date))+"   Ainsi La Vie. Tous droits réservés."
	This.result.resultat:=Char(1)+This.result.resultat
	
	
Function LireSTR()
	This.result.resultat:="#err LireSTR"
	If (This.paramsUrl.length>0)
		// il faut toujours au moins 2 éléments ; au cas où un seul élément, ajouter des options vides
		This.paramsUrl.push("")
		This.result.resultat:=cs._cfct.me.LireLocatedSTR(Num(This.paramsUrl[0]))
	End if 
	This.result.resultat:=Char(1)+This.result.resultat
	
	
	// -----------------------------
	// Mark:Utilitaires
	// -----------------------------
	
Function FermerDocDataXML()
	DOM CLOSE XML(This.aideRacineXML)
	
	
Function FormaterIDarticle($numPage : Variant)->$result : Text
	// renvoyer l'ID de l'article (mode debug)
	var $texte : Text
	
	$texte:=""
	Case of 
		: (Storage.System.typeApplication=ALV Serveur APP)
		: (Not(cs.$session.me.prefs.Session_Etat ?? 6))
			// filtrer
			
		: (Value type($numPage)=Is text)
			$texte:=$numPage
			
		: ((Value type($numPage)=Is longint) | (Value type($numPage)=Is real))
			$texte:=String($numPage)
			
		Else 
			$texte:="erreur type $1"
	End case 
	$result:=(" ["+$texte+"] ")*Num(Length($texte)>0)
	
	
Function FixerLienVersPage($ElémentXML : Text; $numPage : Integer)->$result : Text
	// construire le lien en fonction du contexte "wwwEtatNavigation"
	
	Case of 
		: (wwwEtatNavigation="ALV")
			// le lien à 4D se fait par l'intermédiaire de $4d avec 2 paramètres
			//DOM ÉCRIRE ATTRIBUT XML($ElémentXML; "onClick"; "$4d."+Formule(EcrireElementHTML).source+"("+Caractère(Guillemets)+"/4DHTML/WebDOC/AfficherLaPageDansForm?"+Chaîne($numPage)+Caractère(Guillemets)+")")
			DOM SET XML ATTRIBUTE($ElémentXML; "onClick"; "$4d."+Formula(EcrireElementHTML).source+"('/4DHTML/WebDOC/AfficherLaPageDansForm?"+String($numPage)+"')")
			
		: (wwwEtatNavigation="serveurWeb")
			// le lien au serveur se fait par une balise 4DXXX
			DOM SET XML ATTRIBUTE($ElémentXML; "href"; "/4DCGI/WebDOC/AfficherLaPage?"+String($numPage))
			
		: (wwwEtatNavigation="DOC")
			// le lien au serveur se fait par un chemin relatif à la page courante
			DOM SET XML ATTRIBUTE($ElémentXML; "href"; "page"+String($numPage)+".html")
			
		Else 
			// contexte inconnu
	End case 
	
	
Function EcrireIDarticle($ptrValeurs : Pointer; $ptrTexte : Pointer; $ptrParamètres : Pointer)->$result : Text
	// renvoyer " [IDarticle]" ; la valeur dans tableau $2 de nom $3 $2 dans tableau $4 des noms de paramètre
	var $texte : Text
	
	$texte:=$ptrValeurs->{Find in array($ptrParamètres->; $ptrTexte->)}
	$result:=This.FormaterIDarticle($texte)
	
	
Function getTexteElement()->$result : Text
	// passer le contenu de la DOM $1 en texte HTML
	var $texte : Text
	
	DOM EXPORT TO VAR(This.racineXML; $texte)
	DOM CLOSE XML(This.racineXML)
	
	$texte:=Substring($texte; Position("<"; $texte; 2; *))
	$result:=Replace string($texte; "\r"; "")

⇧ [class]$maintenance - 08/06/2026 10:22:13

      property Taches : Collection
property nomTache : Text:="MaintenanceALV"

Class extends $application

Class constructor()
	
	Super()
	
	
Function FixerListeTâches()
	// lister les tâches à exécuter
	var $data : Object
	
	This.Taches:=New collection
	$data:=New object
	
	// chaque tâche doit contenir :
	// .params nomClasse, functionID et paramètres de la function à exécuter
	// .dateMaintenance, date à laquelle lancer la tâche
	// .période (jour et heure) de lancement de la tâche
	// .initialiser, booléen, lancer la tâche immédiatement
	
	// Tester les medias de la BDD :
	This.ProgrammerTache(cs.$application; "programmerVérifierBDDmedia")
	// Mise à jour APP :
	This.ProgrammerTache(cs.$servicesEditeur; "ProgrammerMajAPP")
	// Mise à jour DATA :
	This.ProgrammerTache(cs.$servicesEditeur; "ProgrammerMajDATA")
	// Les sauvegardes :
	This.ProgrammerTache(cs.$sauvegarde; "ProgrammerSauvegardeALV")
	// Certificat SSL :
	This.ProgrammerTache(cs.$certificatSSL; "ProgrammerRenouvellementSSL")
	
	
Function ProgrammerTache($class : Object; $functionID : Text)
	var $data : Object
	
	$data:=New object()
	Case of 
		: (cs.$process.new().ExecuterDansProcess($class; $functionID; $data))
			// erreur gérée
		: (OB Is empty($data.params))
			// tâche non concernée par cet environnement
		Else 
			// toutes les données sont dans $data.params (peut être Null => pas programmée)
			This.Taches.push($data.params)
	End case 
	
	
	// ----------------------
	// MARK:Maintenance
	// ----------------------
	
Function Démarrer()
	// exécuter dans un process externe
	var $params : Object
	
	$params:=New object
	$params.nomProcess:="$SYS_PlanifierLesTaches"
	$params.initProcess:=Formula(InitProcessCooperative)
	
	cs.$process.new().ExecuterDansWorker(cs.$maintenance; "SuperviserLesTaches"; $params)
	// rappel : l'objet $data.tache a été créé
	
	
Function SuperviserLesTaches($data : Object)
	// gérer les tâches de la maintenance des serveurs Web
	var $tâche : Object
	var $nbre : Integer
	
	// attendre la fin du démarrage de l'hôte et composants
	Waiting(10*60)
	This.trace.EnvoyerMessages([msgk_event; msgk_log; msgk_mail]; "Maintenance"; Current method name; "Démarrage du monitoring")
	
	This.FixerListeTâches()
	
	// lancer le monitoring des tâches
	Repeat 
		For each ($tâche; This.Taches)
			
			Waiting(60*10)
			
			Case of 
				: (Not(OB Is defined($tâche; "nomClass")))
				: (Not(OB Is defined($tâche; "functionID")))
				: (Not(OB Is defined($tâche; "params")))
				: (Not(OB Is defined($tâche.params; "dateTache")))
				: (Not(OB Is defined($tâche.params; "période")))
				: (Not(OB Is defined($tâche.params; "initialiser")))
				: (Not(($tâche.params.initialiser) | (String(Current date; ISO date GMT; Current time)>$tâche.params.dateTache)))
					// attendre
				Else 
					// ok, on a tout pour cette tâche, la lancer
					cs[$tâche.nomClass].new()[$tâche.functionID]($tâche.params)
					
					// date du prochain lancement de cette tâche
					// nombre de jours
					// . on peut avoir rater des périodes ; combien?
					$nbre:=Current date-Date($tâche.params.dateTache)
					// . ajouter la période
					$nbre:=$nbre+$tâche.params.période.jour+((Time($tâche.params.dateTache)+$tâche.params.période.seconde)\(24*3600))
					// . nouvelle date (au cas où, on se resynchronise aussi sur l'heure)
					$tâche.params.dateTache:=String(Add to date(Date($tâche.params.dateTache); 0; 0; $nbre); ISO date GMT; Time(Current time+$tâche.params.période.seconde))
					$tâche.params.initialiser:=False
					
					This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "La tâche '"+$tâche.functionID+"' sera relancée le '"+$tâche.params.dateTache+"'")
			End case 
		End for each 
		
		// *** attendre un peu
		Waiting(60*10)
	Until (Storage.System.ArrêtAPP=True)
	This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "Fin du monitoring")
	
	
Function Arrêter()
	cs.xSDK.RegistreTaches.me.Tuer(This.nomTache)
	
	This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "Arrêt du monitoring")
	
	
	// ----------------------
	// MARK:Tâches
	// ----------------------
	
	//Function Verifier QUOI ???

⇧ [class]$editeur - 09/06/2026 09:12:09

      // classe de gestion d'un éditeur ALV
property menu : cs.$menu
property params; informations; entité : Object
property indexPageForm; numPageForm; numPageMedia : Integer
property navigation : cs.$navigation

Class extends $formulaire

Class constructor()
	
	Super()
	
	This.menu:=cs.$menu.new()
	
	This.params.numProcessAppelant:=-1
	This.informations.Contexte:="_editer_fiche_"
	This.informations.nomForm:="U_Nav?"+This.informations.DataClassInfos.name
	
	// on démarrage à la page 1 du formulaire
	This.indexPageForm:=0
	// on démarrage à la page 1 du media
	This.numPageMedia:=1
	
	// passer au SF la classe nav pour avoir accès au variable des objets
	This.navigation:=This.nav
	
	
	
Function surEvenementFormulaire()
	// traitement générique des évènements formulaire
	Super.surEvenementFormulaire()
	
	Case of 
		: (FORM Event.code=On Load)
			This.menu.entitéCourante:=This.entité
			
			// dans l'ordre
			Form.AfficherEntité()
			// ici il faut un Form.entité
			This.ChargerInformationPrivée()
			
		: (FORM Event.code=On Menu Selected)
			This.ExécuterMenu()
			
		: (FORM Event.code=On Close Box)
			CANCEL  // pour fermer la fenetre
			
		Else 
			// evenements génériques...
	End case 
	// après les éventuelles spécificités sont traités dans la méthode du formulaire
	
	
Function ExécuterMenu()
	This.menu.LireParamètresMenu(Get selected menu item parameter)
	// l'utilisateur appuie aussi sur la touche Option
	This.menu.params.actionOption:=This.ActionUtilisateur("[option]")
	Case of 
		: (This.menu.Exécuter())
			// c'est traité
			
		: (Not(Storage.System.Status ?? 1))
			This.AfficherMessageUtilisateur(New object("ID"; 5059))
			
		: (Not(This.ActionUtilisateur("[SaisieAutorisée]")))
			This.entité.reload()
			This.AfficherMessageUtilisateur(New object("ID"; 5042))
			
		: (cs._ds.me.$ajouter(Num(This.menu.params.commande)))
			// ajout fait
			
		: (This.ModifierDataInformation())
			// modification faite
			
	End case 
	This.menu.Initialiser()
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function TraiterFORMevent()
	Super.TraiterFORMevent()
	This.nav.TraiterFORMevent()
	
	
Function _FORM_listeIllustrations($params : Object)
	var $data : Object
	
	Case of 
		: (FORM Event.code=On Load)
			// données de la class / function à utiliser
			$params.DataClassNom:=This.informations.DataClassInfos.name
			$params.entitéID:=Form.entité.ID
			$params.typeZone:=1
			$params.IDgroupe:=This.session.user.IDfamille
			$params.attribut:="photo"
			
			// exécuter
			This.CréerLaListe(OB Class(This).name; "CréerLaListeDesIllustrations"; $params)
			
			// lire la photo
			For each ($data; $params.liste)
				Case of 
					: ($params.attribut="icone")
						$data.photo:=CoDecBase64_Objet($data.pict)
						
					: ($params.attribut="photo")
						// lire le media
						cs.$media.me.LireAvecIDmedia($data.ID; 1)
						$data.photo:=cs.$media.me.imagePageMedia
				End case 
			End for each 
			
			Form[This.nomOBJ]:=$params.liste
			OBJECT SET VISIBLE(*; This.nomOBJ; $params.liste.length>0)
	End case 
	
	
Function _FORM_listeIllustrations_photo()
	var $sélection : Object
	
	Case of 
		: (FORM Event.code=On Clicked)
			$sélection:=cs._ds.new().SelectionAvecID("Medias"; Form[This.nomOBJ].extract("ID"))
			This.EditerSélection($sélection; Form[This.nomOBJ+"ElementCourant"].itemRef)
	End case 
	
	
Function surActionFormulaire($classesGlissables : Collection)->$result : Integer
	var $itemRef : Integer
	var $itemText : Text
	
	Case of 
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserENTITE($classesGlissables)
			$itemText:=Num($result=0)*cs._cfct.me.LireLocatedSTR(5014; This.glisserDeposer.paramsMessage)
			This.AfficherMessageUtilisateur(New object("libelle"; $itemText; "userMessageTime"; 30))
			
		: (FORM Event.code=On Drop)
			// la présence de refItem est validée par "Sur glisser"
			cs.$trace.me.DebugerMethode(""; Current method name; "Appel sur deposer : "+String(Storage.System.GlisserDéposer.refItem))
			$itemRef:=Storage.System.GlisserDéposer.refItem
			This.EditerSélection($itemRef; 0)
			
		: (FORM Event.code=On Clicked)
			This.ActionMenuContextuel()
	End case 
	
	
	// ----------------------
	// MARK:Sélections 
	// -----------------------
	
Function ChargerMedias($membre : Object)
	// sélectionner les enregistrement de Medias de $membre  (rappel : type zone = 1)
	// ce sont les medias affichés dans le sous formulaire de l'éditeur -> besoin d'enregistrements
	var $sélection : Object
	
	$sélection:=$membre.LesMedias(New object("typeZone"; 1; "IDgroupe"; This.session.user.IDfamille))
	This.nav.sélectionMedias:=$sélection
	
	
Function ChargerInformationPrivée()
	// charger un champ privé associé à $1
	var $IDgroupe : Integer
	var $params : Object
	
	// récupérer le groupe familial de l'utilisateur
	$IDgroupe:=This.session.user.IDfamille
	Form.PrivateData:=Null
	Case of 
		: (Not(OB Is defined(Form; "entité")))
			// pas normal
		: (Not(OB Is defined(Form.entité; "laPrivateData")))
			// entité sans data privée
		: (This.session.prefs.Session_Etat ?? 6)
			// mode debug
			Form.PrivateData:=Form.entité.laPrivateData
			// ne pas filtrer le groupe
		: (Not(This.session.user.estMembreDe_Saisie))
			// en principe user appartient à "saisie"
		: ($IDgroupe=0)
			// il faut un groupe. Attention : les utilisateurs génériques 4D n'ont pas de groupe (donc l'archiviste !)
		: (Form.entité.laPrivateData.proprietaire#$IDgroupe)
			// pas le bon proprio
		Else 
			// c'est ok
			Form.PrivateData:=Form.entité.laPrivateData
	End case 
	OBJECT SET VISIBLE(*; "PrivateData@"; Form.PrivateData#Null)
	
	// une seule entité privée par entité de la DS courante => menu invalide si une existe
	$params:=New object("IDnomMenu"; "BM_01-01-0113")
	Chercher refMenu($params)
	Case of 
		: ($params.refMenu="")  // le menu existe dans la barre courante
		: (Form.PrivateData=Null)
			// autoriser la création
			ENABLE MENU ITEM($params.refMenu; $params.numLigne)
		Else 
			// une info existe déjà, pas de menu
			DISABLE MENU ITEM($params.refMenu; $params.numLigne)
	End case 
	
	
Function CréerLaListe($className : Text; $functionID : Text; $params : Object)
	// exécuter
	cs.$serveurAPP.me.Executer($className; $functionID; $params)
	
	// créer la LH
	Case of 
		: ($params.reqRetour=Null)
		: (Not(OB Is defined($params.reqRetour; "liste")))
			
		Else 
			// renvoyer la liste dans $params
			$params.liste:=$params.reqRetour.liste
	End case 
	
	
Function CréerHiérarchie($data : Object; $params : Object; $LH : Pointer)
	var listeDescendance; listeAscendance : Integer
	
	// exécuter
	cs.$serveurAPP.me.Executer($data.className; $data.functionID; $params)
	// le résultat est dans .reqRetour
	
	// créer la LH
	Case of 
		: ($params.reqRetour=Null)
		: (Not(OB Is defined($params.reqRetour; "liste")))
		: (Count parameters<3)
			// la listeH est créée ailleurs :  renvoyer la liste dans $params
			$params.liste:=$params.reqRetour.liste
	End case 
	
	
Function CréerLaListeDesIllustrations($params : Object)
	// ici on est toujours sur BDDmère ou ServeurAPP
	var $selection : cs.PersonnesSelection
	
	$selection:=ds[$params.DataClassNom].query("ID = :1"; $params.entitéID)
	// créer la collection hiérarchique des illustrations de $sélection
	$selection.CréerListBoxMedia($params)
	// le résultat est dans $params
	
	
	// ----------------------
	// MARK:Affichage
	// -----------------------
	
Function OuvrirFormulaire()
	// ouvrir le formulaire de this
	var $wndNum : Integer
	var $table : Pointer:=Table(This.informations.DataClassInfos.tableNumber)
	
	Case of 
		: (This.params=Null)
		: (This.params.deQui=Null)
			
		Else 
			This.menu.FixerBarreMenus()
			
			// initialiser l'affichage
			var numPageForm : Integer
			numPageForm:=1  // variable nécessaire pour mémoriser la page courante
			// 4Dv14 : les infos du formulaire ne sont mémorisés qu'à la fermeture de la fenêtre
			
			$wndNum:=Open form window($table->; This.informations.nomForm; Plain form window+Form has no menu bar; Horizontally centered; 42; *)
			
			Repeat 
				// afficher le formulaire
				Case of 
					: (This.nav.sélectionCourante=Null)
						cs.$trace.me.Créer(-15006; Current method name; "Pas de sélection courante définie dans la table "+This.informations.DataClassInfos.name).LeverException([msgk_event; msgk_log])
						ok:=0
					: (This.nav.sélectionCourante.length=0)
						cs.$trace.me.Créer(-15006; Current method name; "Sélection courante vide dans la table "+This.informations.DataClassInfos.name).LeverException([msgk_event; msgk_log])
						ok:=0
					Else 
						// c'est ok
						
						// le formulaire affiche les données d'une entité : fixer $data.entité
						This.entité:=ds[This.informations.DataClassInfos.name].get(This.nav.entitéCourante.ID)
						DIALOG($table->; This.informations.nomForm; This)
				End case 
				
				// ok = 1 on affiche la sélection demandée, = 0 on purge
			Until (ok=0)
			CLOSE WINDOW
			CLEAR VARIABLE($wndNum)
			
			This.session.EcrireSélectionTable(This.nav)
			ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "Fin du process"))
	End case 
	
	
Function EditerEntity($item : Variant; $nomTable : Text)->$result : Object
	var $sélection : Object
	
	Case of 
		: ((Value type($item)=Is text) & (Match regex("[0-9ABCDEF]{32}"; $item)))
			$sélection:=ds[$nomTable].query("IDunique = :1"; $item)
			This.EditerSélection($sélection; 0)
	End case 
	// v20R7 semble nécessaire si utilé par un .call()
	$result:=Null
	
	
Function EditerSélection($item : Variant; $index : Integer)
	// on reçoit la sélection $item, l'afficher dans un éditeur (exclusivement)
	var $params; $sélection; $class : Object
	var $nomProc; $dataClassNom; $nomClass : Text
	
	// fixer le deQui à éditer
	$params:=New object("Contexte"; "_editer_fiche_"; "deQui"; New object)
	$sélection:=Null
	Case of 
		: (Value type($item)=Is longint)
			$sélection:=ds[Table name($item >> 24)].query("ID = :1"; $item & 0x00FFFFFF)
			
		: (Value type($item)#Is object)
		: (OB Class($item).name="Object")
			// pas instance de classe
		: (Not(OB Is defined(ds; $item.getDataClass().getInfo().name)))
			// pas une classe ORDA
			
		: (OB Is defined($item; "length"))
			// une sélection
			$sélection:=$item
	End case 
	// rappel : ici on a une sélection pas forcément éditable ; créer sa sélection éditable
	$sélection:=cs._ds.me.SelectionEditable($sélection)
	
	If ($sélection#Null)
		$params.deQui.sélection:=$sélection.IDcodés()
		// index de sélection. ou un élement de la sélection
		$params.deQui.index:=Choose(CodeEnreg($index)=0; $index; $params.deQui.sélection.indexOf($index))
		
		$dataClassNom:=$sélection.getDataClass().getInfo().name
		
		$params.numTable:=$sélection.getDataClass().getInfo().tableNumber
		$params.nouveauProcess:=This.ActionUtilisateur("[option]")
		$nomProc:=This.process.FixerNomProcess("U_Nav"; $params)
		
		// chercher la fenetre du process WK
		If (Not(cs.$processData.me.existeFenetre($nomProc)))
			// le domaine n'existe pas : créer le process
			Case of 
				: ($params=Null)
				: ($params.deQui.sélection.length=0)
				Else 
					$nomClass:="Editeur"
					Case of 
						: ($dataClassNom="")
							// tant pis
							ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "la sélection .deQui n'a pas de DataClassNom "))
							
						: (Not(OB Is defined(ds; $dataClassNom)))
							// ce n'est pas un nom de table
							ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "la dataClass "+$dataClassNom+" est inconnue"))
							
						: (Not(OB Is defined(cs; $dataClassNom+$nomClass)))
							// la classe éditeur n'existe pas
							ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "la dataClass "+$dataClassNom+$nomClass+" est inconnue"))
							
						Else 
							$class:=cs[$dataClassNom+$nomClass].new()
							$class.params:=$params
							$class.informations.deQui:=$params.deQui
							This.process.LancerVisualisateur($class)
					End case 
			End case 
			
		Else 
			// le process existe, avec un appel possible
			$params.nomProcess:=$nomProc
			// lui envoyer la sélection à afficher
			This.process.FixerSélection($params)
			
			This.process.AppelerFormulaire($nomProc; "CallBackEditerSélection")
		End if 
	End if 
	
	
Function CallBackEditerSélection()
	// une nouvelle sélection est fournie dans l'objet storage du process courant
	var $params : Object
	
	// récupérer dans le storage ce qu'il faut afficher
	$params:=New object
	$params:=This.process.LireSélection()
	
	// fixer pour ce formulaire la sélection courante
	This.nav.FixerSélectionNavigation($params)
	
	// fermer le formulaire, ré-afficher en premier plan avec une nouvelle sélection
	This.MettreAjourSelection()
	BRING TO FRONT(Current process)
	
	
Function FixerSélectionVisualisable()
	// on a un .deQui en params, en faire une sélection affichable et la mémoriser dans le process du formulaire
	var $params : Object
	
	$params:=This.FixerParamètresSélectionVisualisable()
	$params.DataClassNom:=This.getDataClassInfos(OB Class(This).name).name
	$params.deQui:=This.params.deQui
	// on va passer sur le serveur; passer les userprefs
	$params.UserPrefs:=OB Copy(This.session.prefs)
	
	// c'est parti
	Super.FixerSélectionVisualisable($params)
	
	// mémoriser la sélection courante pour ce formulaire
	This.nav.FixerSélectionNavigation($params.sélectionEntités)
	
	
Function NouvelleSélection()
	// un process externe envoie une sélection à éditer
	// la lire
	This.params.deQui:=This.process.LireSélection()
	// la visualiser
	This.FixerSélectionVisualisable()
	This.MettreAjourSelection()
	
	
Function ModifierDataInformation()->$result : Boolean
	var $data : Object
	
	// refuser par défaut
	$result:=False
	
	Case of 
		: (This.menu.params.type#"InformationsAutres")
		: (Not(OB Is defined(This.menu.params; "DataClassNom")))
		: (Not(OB Is defined(This.menu.params; "nomClass")))
		: (Not(OB Is defined(cs; This.menu.params.DataClassNom+This.menu.params.nomClass)))
			
		Else 
			// modifier les informations autres : faire saisir les données
			// un formulaire nommé "InformationsAutres" doit exister pour la ds.entity de This.entité
			
			$data:=cs[This.menu.params.DataClassNom+This.menu.params.nomClass].new()
			// demander les infos de la classe (contexte d'affichage et collection des attributs modifiables)
			$data.autres:=This.entité.ModifierAutre()
			cs.$dialogue_3001.new().Ouvrir("InformationsAutres"; Sheet form window; ""; $data)
			// v11.5.12 les modification sont gérées par le FORM entité
	End case 
	
	
	// ----------------------
	// MARK:Demande actions 
	// -----------------------
	
Function MettreAjourSelection()
	// fermer le formulaire, ré-ouvrir avec une nouvelle sélection
	// La nouvelle sélection est fournie dans l'objet storage du process courant
	ACCEPT
	
	
Function MettreAjourPage($params : Object)
	// modifier l'affichage du formulaire en cours ; il reste ouvert
	Case of 
		: ($params.ActionID="AfficherURL")
			Form.AfficherURL()
			
		Else 
			// voir la classe du dessus 
			Super.MettreAjourPage($params)
	End case 
	
	
	// ----------------------
	// MARK:Utilitaires 
	// -----------------------
	
Function décoderEventValide($c : Collection)
	var $data : Object
	
	For each ($data; $c)
	End for each

⇧ [class]$serveurWEB - 18/06/2026 08:19:38

      // classe de gestion du serveur WEB hôte
property balisesUrl; paramsUrl : Collection
property params : Object

Class constructor()
	
	// ----------------------
	//MARK:Installation
	// -----------------------
	
Function Installer()
	// la function installe le serveur Web hôte.
	// ici on est toujours sur un serveur (APP ou HTTP) ou la BDDmère
	
	Case of 
		: (Storage.System.typeApplication=ALV Client APP)
		: (Storage.System.typeApplication=4D Remote mode)
			// filtrer
		Else 
			// installer les fichiers
			This.InstallerServeur()
			
			// démarrer le serveur en mode opérationnel
			This.Démarrer("ModeNominal")
	End case 
	
	
Function InstallerServeur()
	var $dataTexte : Text:=""
	var $DossierDestination; $DossierSource : Object
	var $texteIn; $texteOut : Text
	
	// copier les ressources documentation dans le dossier web
	// dossier d'installation
	$DossierDestination:=cs.$document.new().GetRacineHTMLFolder()
	
	// source
	$DossierSource:=Folder(Get 4D folder(Current resources folder; *); fk platform path).folder("TemplatesPagesWeb")
	// copier le dossier des ressources
	Dupliquer ContenuDeDossier($DossierSource; $DossierDestination)
	
	CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "TemplatesPagesWeb et Ressources copiés dans "; Current method name; "<"+$DossierDestination.platformPath+">"; New object("nomProcess"; Current process name; "numProcess"; Current process))
	
	
	Case of 
		: (Not(cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Serveur_Web/nomDossier_Documentation"; Is text; ->$dataTexte)))
		Else 
			// calculer les liens inter sites
			// ici mettre dans "index.html" l'URL du site de l'aide
			$DossierDestination:=$DossierDestination.folder($dataTexte)
			$texteIn:=Document to text($DossierDestination.file("index.html").platformPath; "UTF-8")
			$texteOut:=""
			$dataTexte:=Installer_LesServeurs("getURLsiteAide")
			PROCESS 4D TAGS($texteIn; $texteOut; $dataTexte)
			TEXT TO DOCUMENT($DossierDestination.file("index.html").platformPath; $texteOut; "UTF-8")
			
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "dossier documentation"; Current method name; "<"+$DossierDestination.platformPath+$dataTexte+">"; New object("nomProcess"; Current process name; "numProcess"; Current process))
	End case 
	
	// recopier les certificats SSL pour le serveur Web Hôte
	cs.$certificatSSL.new().InstallerCertificatServeurWeb()
	
	// rappel : le serveur APP utilise aussi des certificats SSL, situés dans le dossier 'Resources' de 'Contents' de l'APP (voir 'APP Services Serveur')
	
	
Function Démarrer($mode : Text)
	// ici on est sur un serveur (APP ou HTTP), un client ou la BDDmère
	// lancer le démarrage sur le serveur
	var $params : Object
	
	$params:=New object("mode"; $mode)
	ExecuterSurServeur(OB Class(This).name; "_Démarrer"; $params)
	
	
Function _Démarrer($params : Object)
	// démarrer le serveur WEB hôte
	var $webServer; $result : Object
	
	// on est sur le serveur (ou la BDD mère pour test)
	$webServer:=WEB Server(Web server database)
	
	Case of 
		: (WEB Is server running)
			// rien à faire
			$result:=New object("success"; True)
			
		: (Not(OB Is defined($params; "mode")))
		: (Not(OB Is defined(This; "FixerParametres"+$params.mode)))
		Else 
			// fixer les paramètres du serveur de la base hôte
			This["FixerParametres"+$params.mode]()
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "dossier racine Web"; Current method name; "<"+This.params.rootFolder.platformPath+">"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
			// log
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_log]; "Serveur Web hôte"; Current method name; "$webServer propriétés : "+JSON Stringify($webServer); New object("nomProcess"; Current process name; "numProcess"; Current process))
			
			// on démarre
			// pb avec cette commande (erreur 4D sur le serveur Web) ; utiliser les commandes
			//$result:=$webServer.start($data)
			
			WEB SET OPTION(Web IP address to listen; This.params.IPAddressToListen)
			WEB SET OPTION(Web port ID; This.params.HTTPPort)
			WEB SET OPTION(Web HTTPS port ID; This.params.HTTPSPort)
			WEB SET OPTION(Web HTTP enabled; Num(This.params.HTTPEnabled))
			WEB SET OPTION(Web HTTPS enabled; Num(This.params.HTTPSEnabled))
			WEB SET OPTION(Web HSTS enabled; Num(This.params.HSTSEnabled))
			WEB SET ROOT FOLDER(This.params.rootFolder.platformPath)
			
			WEB START SERVER
			
			// message ALV
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Démarrage"; Current method name; "Le serveur Web hôte "+Choose($webServer.HTTPSEnabled; "[HTTPS]"; "[HTTP]")+" est démarré "+Choose(WEB Is server running; "[OK]"; "[KO]")+", HSTS "+Choose($webServer.HSTSEnabled; "[OK]"; "[KO]"); New object("nomProcess"; Current process name; "numProcess"; Current process))
	End case 
	
	
Function Arrêter()
	// ici on est sur un serveur (APP ou HTTP), un client ou la BDDmère
	// lancer l'arrêt du serveur
	ExecuterSurServeur(OB Class(This).name; "_Arrêter")
	
	
Function _Arrêter()
	// arrêter le serveur WEB hôte
	
	//$webServer:=WEB Serveur(Web serveur de base de données hôte)
	//$webServer.stop()
	WEB STOP SERVER
	Waiting(20)
	
	// message ALV
	CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Arrêt"; Current method name; "Le serveur Web hôte est arrêté "+Choose(WEB Is server running; "[KO]"; "[OK]"); New object("nomProcess"; Current process name; "numProcess"; Current process))
	
	
Function FixerParametresModeNominal()
	// paramètres du fonctionnement opérationnel
	
	This.InitialiserParamètres()
	
	Case of 
		: (Not(This.params.SSL.Production.exists))
			// pas de certificat ou forcer une connexion non sécurisée => http
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Paramétrage Serveur Web hôte"; Current method name; "certificat SSL en production non trouvé"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		: (This.params.SSL.Production.Invalide)
			// on n'a pas de certificat SSL valide
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Paramétrage Serveur Web hôte"; Current method name; "certificat SSL en production trouvé, non valide, doit être renouvelé"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		Else 
			// cas normal en production (on ne teste pas si à renouveler)
			// options HTTPS nécessaire pour MobileApps
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Paramétrage Serveur Web hôte"; Current method name; "certificat SSL en production trouvé [OK]"+Choose(This.params.SSL.Production.aRenouveler; ", à renouveler"; ""); New object("nomProcess"; Current process name; "numProcess"; Current process))
			
			// age maximal d'activation du HSTS pour une session
			This.params.HSTSMaxAge:=7776000  //   7 776 000 = 3 * 30 * 24 * 3600, soit 3 mois.    31 536 000 = 365 * 86400 s = 365 days
			
			// Enable HSTS on the 4D Web server
			// rappel : HSTS activé permet au serveur web 4D de déclarer que les navigateurs ne doivent interagir avec lui que par des connexions HTTPS sécurisées
			// important : ici HTTP est aussi activé : le navigateur peut toujours basculer entre HTTPS et HTTP (par exemple, dans la zone URL du navigateur, l'utilisateur peut remplacer "https" par "http")
			// on pourra désactiver HTTP
			This.params.HSTSEnabled:=False  //21/12/2023 NON les url liées au composant MOB ne passent plus
			
			// Enable HTTP on your 4D Web server
			This.params.HTTPEnabled:=True
			
			// Enable HTTPS on your 4D Web server
			This.params.HTTPSEnabled:=True
	End case 
	
	CALL WORKER(Worker Services; Formula(traceHandler); [msgk_log]; "Serveur Web hôte"; Current method name; "data : "+JSON Stringify(OB Copy(This.params)); New object("nomProcess"; Current process name; "numProcess"; Current process))
	
	
Function FixerParametresModeCertbot()
	// paramètres pour le Certbot
	// l'utilisation de Certbot nécessite que les ports des services HTTP et HTTPS soient respectivement de 80 et 443
	
	This.InitialiserParamètres()
	
	This.params.HTTPPort:=80
	This.params.HTTPSPort:=443
	// HTTP non sécurisé (nécessaire pour ACME)
	This.params.HTTPEnabled:=True
	This.params.HTTPSEnabled:=False
	This.params.HSTSEnabled:=False
	
	
Function InitialiserParamètres()
	var $dataEntier : Integer
	
	This.params:=New object
	
	// l'adresse IP du serveur Web 4D
	This.params.IPAddressToListen:=cs.xSDK.EnvironnementALV.new().infosSystème().IPadresse
	
	// fixer les options Hôte
	//  lire les valeurs définies dans les propriétés de la base
	WEB GET OPTION(Web port ID; $dataEntier)
	This.params.HTTPPort:=$dataEntier
	
	WEB GET OPTION(Web HTTPS port ID; $dataEntier)
	This.params.HTTPSPort:=$dataEntier
	
	This.params.inactiveProcessTimeout:=480
	This.params.inactiveSessionTimeout:=480
	
	//$data.sessionCookieDomain:="/*.ainsilavie.fr"
	//$data.sessionCookieName:="doc.alv.fr"
	
	This.params.scalableSession:=True
	// sessionCookieName est fixé automatiquement. en scalableSession = "4DSID_AppName"
	//  "" rétablit la valeur par défaut (4DSID)
	
	// fixer le dossier racine
	This.params.rootFolder:=cs.$document.new().GetRacineHTMLFolder()
	
	// données SSL
	This.params.SSL:=cs.$certificatSSL.new().getCertInformations(cs.xSDK.EnvironnementALV.new().infosApplication(102).nomLong)
	
	// par défaut HTTP seul
	// Enable HTTP on your 4D Web server (no certificates)
	This.params.HTTPEnabled:=True
	
	// Disable HTTPS on your 4D Web server
	This.params.HTTPSEnabled:=False
	This.params.HSTSEnabled:=False
	
	
	// -----------------------------
	// MARK:Serveur HTTP
	// -----------------------------
	
Function AuthentificationWeb($url : Text; $entete : Text; $IPnavigateur : Text; $IPserveur : Text; $LogIn : Text; $motDePasse : Text)->$result : Boolean
	// réception de la réponse des composants
	
	$result:=True
	
	Case of 
		: (Not(This.estURLvalide($url; "AuthentificationWeb")))
			// ne pas traiter, mais 
			// accepter la requete (sinon une demande d'authentification est gérée)
			
			// commencer par une url du process ACME (génération de certificat SSL par let'sEncrypt)
		: (cs.$certificatSSL.new().OnACMEAuthentification($url))
			
			// les url de l'apps mobile
		: (cs.xMOB.$serveurWeb.new().AuthentificationWeb($url; $entete; $IPnavigateur; $IPserveur; $LogIn; $motDePasse))
			
		: ($url="@/WebDOC/@")
			// appel d'une page par un client APP
			wwwRacineRessources:=""
			wwwSousDomaine:=""
			
			// vs4D : prévenir le navigateur que le serveur est présent (à faire tout de suite)
			vs4D:="4D4Daide"
			
		: ($url="/4DHTTP/@")
			// commande pour s'authentifier
			$result:=ds.authentify($LogIn)
			
		Else 
			// le reste n'est pas concerné
	End case 
	
	
Function ConnexionWeb($url : Text; $entete : Text; $IPnavigateur : Text; $IPserveur : Text; $LogIn : Text; $motDePasse : Text)
	// renvoie vrai si l'url est traitée, ou si elle est invalide (erreur 404)
	// renvoie faux pour un traitement ailleurs
	This.InitProcessWeb()
	
	Case of 
		: (Not(This.estURLvalide($url; "ConnexionWeb")))
			// filtrage amont, tout domaine
			// ici une erreur 404 est générée
			
		: (This.TraiterURL($url).success)
			// commande filtrée ou traitée
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_log]; $url; Current method name; " traité par <$serveurs>"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
			// filtrer certaines erreurs
		: ($url="/ressources@")
			// ici une erreur 404 est générée
			cs.$trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Serveur Web"; Current method name; "L'url <"+$url+"> n'est pas traitée")
			
		: (cs.xMOB.$serveurWeb.new().ConnexionWeb($url; $entete; $IPnavigateur; $IPserveur; $LogIn; $motDePasse))
			// commande traitée par l'application Mobile
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_log]; $url; Current method name; " traité par <MobileApplication>"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		Else 
	End case 
	
	
Function estURLvalide($url : Text; $contexte : Text)->$result : Boolean
	// renvoie vrai (non filtrée) si l'URL est acceptable
	
	$result:=False
	// dans l'ordre
	Case of 
		: (($url="#4DSCRIPT/@") | ($url="/4DACTION/@") | ($url="/4DCGI/@") | ($url="/4DHTTP/@"))
			// construction des pages dynamiques, on teste
			Case of 
				: (This.FiltrerHeader("User-Agent"; ["AppleWebKit"; "Chrome"; "Gecko"; "Alamofire"; "4D/"; "AinsiLaVie/@"]))
					// navigateurs Web, desktop ou mobile, et AppMobile
				: (This.FiltrerHeader("X-METHOD"; ["GET"; "POST"]))
				Else 
					$result:=True
			End case 
			
		: (($url="/activation?token=@") | ($url="/mobileArbre@") | ($url="/mobileCarte@") | ($url="/mobileAlbums@"))
			// url de l'application ALV mobile
			Case of 
				: (This.FiltrerHeader("User-Agent"; ["AppleWebKit"; "Chrome"; "Gecko"]))
				: (This.FiltrerHeader("X-METHOD"; ["GET"; "POST"]))
				Else 
					$result:=True
			End case 
			
		: (($url="/mobileapp/@") | ($url="/4dwebtest") | ($url="/apple@"))
			// reçues lors de la mise à jour des data par le mobile
			$result:=True
			
		: ($url="/.well-know@")
			// accès "let'sEncrypt"
			$result:=True
			
		: (($url="/") | ($url="/.@"))
		: (($url="@gateway@") | ($url="@.php@") | ($url="@shell@"))
			// pas bon ça
			
		Else 
			// la poubelle ; pour test tracer ce qui n'est pas traité ou reconnu
			// on ne garde pas
			//$result:=True  // test
	End case 
	
	
Function FiltrerHeader($nom : Text; $c : Collection)->$result : Boolean
	var $rang : Integer
	var $valeur; $item : Text
	
	$result:=True
	
	ARRAY TEXT($noms; 0)
	ARRAY TEXT($valeurs; 0)
	WEB GET HTTP HEADER($noms; $valeurs)
	
	$rang:=Find in array($noms; $nom)
	Case of 
		: ($rang=-1)
			// il faut cette valeur
		Else 
			$valeur:=$valeurs{$rang}
			
			// initialiser le test
			For each ($item; $c)
				$result:=$result & ($valeur#("@"+$item+"@"))
			End for each 
			$result:=$result | ($valeur="")
	End case 
	
	
Function TraiterURL($url : Text)->$result : Object
	// traiter toutes les url envoyées par le client HTTP ou par un formulaire en construction
	// remarque : dans les 2 cas, les url ont le même format
	// transmettre l'url à la bonne classe $page pour traitement
	var $dataTexte : Text
	var $params; $class : Object
	
	// récupérer les params
	WEB GET HTTP BODY($dataTexte)
	Try
		$params:=JSON Parse($dataTexte; Is object)
	Catch
		// $dataTexte est null
		$params:=New object()
	End try
	
	$result:=This.InitResult(-15068; ""; True)  // success vrai 
	
	// analyser l'url
	This.LireParametresUrl($url)
	
	Case of 
		: (This.balisesUrl=Null)
			$result.ErrorDescription:="[KO] url incomplète - pas de balise à traiter dans : <"+$url+">"
			
			// *** les requêtes à des functions de l'application
			// le résultat est toujours dans $params
		: (This.balisesUrl[1]="APP")
			// à traiter ici
			$class:=Null
			Case of 
				: (This.balisesUrl.length<3)
					$result.ErrorDescription:="[KO] url incomplète - le nom de la classe, balisesUrl[2], est absent dans : <"+$url+">"
					
				: (OB Is defined(ds; This.balisesUrl[2]))
					$class:=ds[This.balisesUrl[2]]
					
					// BDDmère
				: (OB Is defined(cs; This.balisesUrl[2]))
					$class:=cs[This.balisesUrl[2]].new()
			End case 
			
			Case of 
				: ($class=Null)
					$result.ErrorDescription:="[KO] pas de classe du nom de : <"+This.balisesUrl[2]+">"
					
				: (Not(OB Is defined($class; This.balisesUrl[3])))
					// function inconnue
					$result.ErrorDescription:="[KO] la function '"+This.balisesUrl[3]+"' de la classe '"+This.balisesUrl[2]+"' est inconnue (url :"+$url+")"
					
				Else 
					// c'est OK
					$result.Error:=0
					
					$class[This.balisesUrl[3]]($params)
					// rappel le résultat est dans $params
			End case 
			// il faut toujours envoyer quelque chose
			This.EnvoyerReponseReqHTTP($params)
			
			cs.$trace.me.Créer($result.Error; Current method name; $result.ErrorDescription).LeverException([msgk_event; msgk_log])
			
			
			// *** les requêtes à des functions d'un composant
			// dans cette version les composants n'ont pas de paramètres ; le résultat est toujours dans $result
		: (OB Is defined(cs; This.balisesUrl[1]))
			// à traiter ici
			
			$result.data:=New object
			Case of 
				: (Not(OB Is defined(cs[This.balisesUrl[1]]; This.balisesUrl[2])))
					$result.ErrorDescription:="[KO] url incomplète - le composant '"+This.balisesUrl[1]+"' n'a pas de classe '"+This.balisesUrl[2]+"'"
					
				: (Not(OB Is defined(cs[This.balisesUrl[1]][This.balisesUrl[2]].new(); This.balisesUrl[3])))
					$result.ErrorDescription:="[KO] la classe '"+This.balisesUrl[2]+"' du composant '"+This.balisesUrl[1]+"' n'a pas de function '"+This.balisesUrl[3]+"' (url :"+$url+")"
					
				Else 
					// c'est OK
					$result.Error:=0
					cs[This.balisesUrl[1]][This.balisesUrl[2]].new()[This.balisesUrl[3]]($params)
					
					cs.$trace.me.EnvoyerMessages([msgk_log]; "URL traitée"; Current method name; "La function '"+This.balisesUrl[3]+"' de la classe '"+This.balisesUrl[2]+"' du composant '"+This.balisesUrl[1]+"' a traité l'url '"+$url+"'")
			End case 
			// il faut toujours envoyer quelque chose
			This.EnvoyerReponseReqHTTP($params)
			
			cs.$trace.me.Créer($result.Error; Current method name; $result.ErrorDescription).LeverException([msgk_event; msgk_log])
			
			
			// *** les url de site WEB
		: (OB Is defined(cs; "$page"+This.balisesUrl[1]))
			// créer la classe et traiter l'url
			// le résultat, s'il y a, est dans $result.resultat
			// en cas d'erreur elle peut renseigner $result
			$result:=cs["$page"+This.balisesUrl[1]].new().TraiterURL($url)
			
			cs.$trace.me.EnvoyerMessages([msgk_log]; "URL traitée"; Current method name; "cs.$page"+This.balisesUrl[1]+" a traité l'url '"+$url+"'")
			
		Else 
			// url non traitée ici
			$result.ErrorDescription:="url non traitée ici. <"+$url+">"
	End case 
	// renvoyer true si on a traité
	$result.success:=($result.Error=0)
	
	CALL WORKER(Worker Services; Formula(traceHandler); [msgk_log]; $url; Current method name; $result.ErrorDescription; New object("nomProcess"; Current process name; "numProcess"; Current process))
	
	
Function LireParametresUrl($url : Text)
	// $url est de la forme /4Dxxx/yyy/nomFunction {?param1 {+?param2...}}, avec xxx = CGI ou ACTION ou SCRIPT, yyy le contexte WEB, APP ...
	// lire les balises
	This.balisesUrl:=Split string($url; "/"; sk ignore empty strings)
	This.paramsUrl:=New collection
	
	If (This.balisesUrl.length>0)
		// analyser la function
		This.paramsUrl:=Split string(This.balisesUrl[This.balisesUrl.length-1]; "?")
		// virer function+params
		This.balisesUrl:=This.balisesUrl.slice(0; This.balisesUrl.length-1)
		// ajouter la function seule
		This.balisesUrl.push(This.paramsUrl[0])
		
		// lister les paramètres
		This.paramsUrl.shift()
		// nettoyer les paramètres
		Case of 
			: (This.paramsUrl.length<2)
				// rien à faire
			: (This.paramsUrl[0]="@+")
				// nettoyer les '+'
				This.paramsUrl:=Split string(This.paramsUrl.join(""); "+")
			: (This.paramsUrl[0]="@&")
				// l'url vient de javascript, le séparateur de params est '&' ('+' ne passe pas)
				This.paramsUrl:=Split string(This.paramsUrl.join(""); "&")
		End case 
	End if 
	
	
Function LireInformationsServeur()->$result : Object
	// informations du serveur Web
	var $dataTexte : Text:=""
	var $i : Integer:=0
	var $texte : Text
	var $rsc : cs.xSDK.ResourceALV
	
	$rsc:=cs.xSDK.ResourceALV.me
	
	// en principe : ALV Serveur APP est interrogé par ALV Client APP, et ALV Serveur HTTP par 4D mode distant
	$result:=New object
	
	// *** les paramètres
	$result.params:=New object
	// dossier racine
	$result.params.DossierRacineHTML:=Get 4D folder(HTML Root folder; *)  //Lire Ressource ALV(Est Ressource WEB; "Chemins/Serveur_web/Dossier_racine_web"; Est un texte)->
	$result.params.estDémarré:=WEB Is server running
	
	// paramètres
	WEB GET OPTION(Web port ID; $i)
	$result.params.webPortID:=$i
	WEB GET OPTION(Web HTTPS port ID; $i)
	$result.params.webHTTPSPortID:=$i
	WEB GET OPTION(Web HTTPS enabled; $i)
	$result.params.HTTPSEnabled:=($i=1)
	WEB GET OPTION(Web HSTS enabled; $i)
	$result.params.HSTSEnabled:=($i=1)
	
	// URL serveur
	$rsc.SetVariable(Est Ressource APP; "serveur_URL/Nom_sousDomaine"; Is text; ->$dataTexte)
	$texte:="://"+$dataTexte
	If ($result.params.HTTPSEnabled)
		$texte:="https"+$texte
		$rsc.SetVariable(Est Ressource WEB; "Serveur_web/portHTTPS_sousDomaine"; Is longint; ->$i)
		$texte:=$texte+":"+String($i)
	Else 
		$texte:="http"+$texte
		$rsc.SetVariable(Est Ressource WEB; "Serveur_web/portHTTP_sousDomaine"; Is longint; ->$i)
		$texte:=$texte+":"+String($i)
	End if 
	$result.params.URLserveurWEB:=$texte
	
	// *** info serveur 
	$result.serveurWeb:=WEB Server(Web server database)
	
	// au cas ou, passer en objet pur
	$dataTexte:=JSON Stringify($result)
	$result:=JSON Parse($dataTexte)
	
	
Function EnvoyerReponseReqHTTP($data : Object)
	var $rawData : Blob
	
	SET BLOB SIZE($rawData; 0)
	VARIABLE TO BLOB($data; $rawData)
	WEB SEND RAW DATA($rawData)
	
	
	// -----------------------------
	// MARK:Utilitaires
	// -----------------------------
	
Function InitProcessWeb()
	// pour la gestion des erreurs
	// déclaration des variable process
	
	// nécessaire à "sur Authentification WEB" (ici COMPILER_WEB pas encore appelé?)
	var wwwSousDomaine : Text
	
	ErrorNum:=0
	// gestion des erreurs
	ON ERR CALL(Formula(Intercepter Erreur WEB).source; ek local)
	
	
Function InitResult($Error : Integer; $ErrorDescription : Text; $success : Boolean)->$result : Object
	If (Count parameters=0)
		$result:=New object("Error"; 0; "ErrorDescription"; ""; "success"; True)
	Else 
		$result:=New object("Error"; $Error; "ErrorDescription"; $ErrorDescription; "success"; $success)
	End if 
	$result.nomMethode:=Current method name
	
	
Function EtatServeurAPP($params : Object)
	// renvoyer les infos du serveur
	
	$params.EstActif:=True
	
	$params.UserID:=New object
	$params.UserID.isGuest:=Session.isGuest()
	$params.UserID.userName:=Session.userName
	$params.UserID.isMobileALV:=Session.hasPrivilege("MobileALV")
	$params.UserID.isReadUsers:=Session.hasPrivilege("ReadRecords")
	$params.UserID.isnone:=Session.hasPrivilege("none")
	
	$params.session:=New object
	$params.session.id:=Session.id
	$params.session.idleTimeout:=Session.idleTimeout
	
	
Function test()->$result : Object
	var $entité : cs.PersonnesEntity
	
	$result:=New object
	
	$result.isGuest:=Session.isGuest()
	$result.isMobileALV:=Session.hasPrivilege("MobileALV")
	$result.isReadUsers:=Session.hasPrivilege("ReadRecords")
	$result.isnone:=Session.hasPrivilege("none")
	$result.id:=Session.id
	$result.idleTimeout:=Session.idleTimeout
	$result.estAppelMobile:=estAppelMobile
	$result.userName:=Session.userName
	$result.getPrivileges:=JSON Stringify(Session.getPrivileges(); *)
	$result.logPath:=Folder(fk logs folder).platformPath
	
	// pour test
	$result.msg:="coucou"
	
	$entité:=ds.Personnes.get(952)
	$result.bio:=$entité.biographie

⇧ [class]_cfct - 20/05/2026 09:20:52

      shared singleton Class constructor()
	
	
	// -----------------------------
	// MARK:Localisation
	// -----------------------------
	
Function LireLocatedSTR($ID : Integer; $options : Object)->$result : Text
	var $newTexte : Text:=""
	var $début; $fin : Integer
	var $libellé; $texte; $balise : Text
	var $UserPrefs : Object
	var $c; $cEL : Collection
	
	$texte:=Localized string(String($ID))
	
	// options
	If (Count parameters=1)
		// options par défaut
		$options:=New object("genre"; False; "plur"; False)
	End if 
	
	// traiter les chaines complexes dans un texte multistyle. Les balises d'éléments HTML sont traitées ailleurs (mécanisme différent)
	// v7.4.5 Remarque : traiter toutes les chaines. Les balises ALV sont différentes du mécanisme de 4D : "Utiliser des références dans les textes statiques"
	$UserPrefs:=cs.$session.me.prefs
	
	If (($ID>=1) & ($ID<=70999))
		// rechercher dans $result une balise d'un type de $c à partir de $début
		// une balise est la forme :typeBalise?xxxx:
		
		// d'abord chercher les balises de type xCode, référant un élément de langages
		// puis traiter les balises de type xliff dans un texte multistyle
		// puis traiter les balises de type uri dans un texte multistyle
		$c:=New collection(":xCode"; ":xliff"; ":uri")
		
		For each ($libellé; $c)
			$début:=1
			While ($début>0)
				// chercher la balise
				$fin:=Position($libellé; $texte; $début; *)
				
				If ($fin=0)
					// c'est fini : arrêter la recherche
					$début:=-1
					
				Else 
					// récupérer la balise
					$début:=$fin
					$fin:=Position(":"; $texte; $début+1; *)
					$balise:=Substring($texte; $début; $fin-$début+1)  // balise à remplacer
					
					// récupérer les paramètres
					$newTexte:=Substring($balise; 2; Length($balise)-2)  // virer les marqueurs (plus propre)
					$cEl:=Split string($newTexte; "?"; sk ignore empty strings)
					
					// plusieurs cas
					Case of 
							// il faut avoir trouvé la fin de la balise
						: ($fin=0)
							$début:=0
							$newTexte:=""
							cs.$trace.me.Créer(-15085; Current method name; "balise xliff incomplète dans la chaine "+String($ID)).LeverException([msgk_son; msgk_log])
							
							// il faut au moins 1 élément
						: ($cEl.length=0)
							// effacer la balise
							$texte:=Replace string($texte; $balise; "")
							
							// calculer le texte remplaçant la balise
						: ($libellé=":xCode")
							Case of 
									// traiter les balises dont la valeur est contextuelle (paramètres de la méthode)
								: ($cEl[1]="genre")
									$newTexte:="?"
									Case of 
										: (Not(OB Is defined($options; "genre")))
										: (Not(OB Is defined($UserPrefs; "Apparence")))
											// la langue n'est pas toujours définie (exemple : à l'ouverture de l'application, et avant l'ouverture de session)
											// imposer le français
											$newTexte:="e"*Num($options.genre)
											
										: ($UserPrefs.Apparence.Formulaire.CodeLangue="fr")
											$newTexte:="e"*Num($options.genre)
									End case 
									
								: ($cEl[1]="plur")
									$newTexte:="?"
									Case of 
										: (Not(OB Is defined($options; "plur")))
										: (Not(OB Is defined($UserPrefs; "Apparence")))
											// la langue n'est pas toujours définie (exemple : à l'ouverture de l'application, et avant l'ouverture de session)
											// imposer le français
											$newTexte:="s"*Num($options.plur)
											
										: ($UserPrefs.Apparence.Formulaire.CodeLangue="fr")
											$newTexte:="s"*Num($options.plur)
											
										: ($UserPrefs.Apparence.Formulaire.CodeLangue="en")
											$newTexte:="s"*Num($options.plur)
									End case 
									
								: ($cEl[1]="param_@")
									$newTexte:="?"
									Case of 
										: (Not(OB Is defined($options; $cEl[1])))
										Else 
											$newTexte:=$options[$cEl[1]]
									End case 
									
									// pour le reste, il faut au moins 2 éléments
								: ($cEl.length<3)
									// effacer la balise
									$newTexte:=""
									
									// une variable, sa valeur est renseignée dans Storage.STR
								: ($cEl[1]="variable")
									$newTexte:="err :xCode?variable"
									Case of 
										: (Not(OB Is defined(Storage; "STR")))
										: (Not(OB Is defined(Storage.STR; $cEl[2])))
											// pas créée
											$newTexte:="err "+$cEl[2]
										Else 
											// c'est ok
											$newTexte:=Storage.STR[$cEl[2]]
									End case 
							End case 
							
						: ($libellé=":xliff")
							Case of 
									// une chaine localisée
								: ($cEl.length=2)
									// une balise xliff peut contenir des éléments calculés => on boucle
									$newTexte:=This.LireLocatedSTR(Num($cEl[1]); $options)
									
									// une chaine en ressource
								: ($cEl.length=3)
									Case of 
										: ($cEl[1]="4D")
											// chaine ressource de 4D
											$newTexte:=Localized string($cEl[2])
											
											// chaine ressource de ALV (APP, WEB ...)
										: ($cEl[1]="ALV")
											// chaine ressource de APP
											$newTexte:=""
											If (Not(cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; $cEl[2]; Is text; ->$newTexte)))
												$newTexte:=$balise
											End if 
											
										: ($cEl[1]="WEB")
											// chaine ressource de WEB
											$newTexte:=""
											If (Not(cs.xSDK.ResourceALV.me.SetVariable(Est Ressource WEB; $cEl[2]; Is text; ->$newTexte)))
												$newTexte:=$balise
											End if 
											
										: ($cEl[1]="MAIL")
											// chaine ressource de WEB
											$newTexte:=""
											If (Not(cs.xSDK.ResourceALV.me.SetVariable(Est ressource MAIL; $cEl[2]; Is text; ->$newTexte)))
												$newTexte:=$balise
											End if 
											
										Else 
											// v6.7.1 : "Lire chaîne dans liste" : commande obsolète
											$newTexte:=$cEl[2]
									End case 
							End case 
							
							
						: ($libellé=":uri")
							// v8.4.5 : suppression de ST FIXER TEXTE. Ce traitement doit se faire après tous les autres
							// plusieurs cas
							Case of 
									// il faut au moins 3 éléments
								: ($cEl.length<4)
									// effacer la balise
									$result:=Replace string($result; $balise; "")
									
								Else 
									// un lien vers un objet ALV
									$newTexte:=String(CodeEnreg(Num($cEl[2]); [Num($cEl[3])]))
									$newTexte:="<span style=\"-d4-ref-user:'"+$newTexte+"'\">"+$cEl[1]+"</span>"
							End case 
							//// continuer depuis le début (on ne connait pas la longueur de ce qui a été inséré)
							//$début:=1
							//// pour passer les tests suivants
							//$balise:=""
							//$newTexte:=""
							
						Else 
							// on ne sait pas
							$newTexte:="err locatedSTR "+String($ID)
					End case 
					// traduire la balise (il peut y en avoir plusieurs)
					$texte:=Replace string($texte; $balise; $newTexte)
					
					// continuer
					$début:=$début+Length($newTexte)
				End if 
			End while 
			
			// balise suivante
		End for each 
	End if 
	
	$result:=$texte
	
	
Function LireLocatedSTR_APP($ID : Integer)->$result : Text
	// lire la chaine $ID dans la langue de l'application 
	// lire directement dans la ressource .lproj
	var $langue : Text:=""
	var $fichier : 4D.File
	var $structureDeDonnées; $dataTexte; $RacineXML; $Xpath; $ElementXML; $ErrorDescription : Text
	var $Error : Integer
	
	// la commande "Lire Chaine dans Liste" pourrait lire une chaine dans une langue autre que celle de la base ; en v16 la commande est déclarée obsolète
	// => autre principe : la chaine est lue dans la structure du fichier puis mémorisée dans un objet avec l'argument "ALV_$ID".
	// l'objet est créé à la volée en fonction des besoins; évite les ouvertures permanentes des fichiers
	
	$Error:=0
	$ErrorDescription:=""
	$dataTexte:=""
	$Xpath:="STR_ALV_"+String($ID)
	
	If (OB Is defined(Storage.RessourcesAPP; $Xpath))
		$dataTexte:=OB Get(Storage.RessourcesAPP; $Xpath)
		
	Else 
		// ajouter $ID à l'objet
		// lire la langue application
		cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Ressources_Communes/CodeLangue_Application"; Is text; ->$langue)
		// lire la ressource dans cette langue
		$fichier:=Folder(fk resources folder).folder($langue+".lproj").file("Structure.xlf")
		cs.xSDK.XML.me.LireFichier($fichier; ->$structureDeDonnées)
		
		$RacineXML:=DOM Parse XML variable($structureDeDonnées)
		If (ok=1)  // l'erreur n'est pas captée par "Gere Erreurs" (?)
			// chercher la référence demandée
			$ElementXML:=DOM Find XML element by ID($RacineXML; String($ID))
			If (ok=1)
				$ElementXML:=DOM Find XML element($ElementXML; "trans-unit/target")
				DOM GET XML ELEMENT VALUE($ElementXML; $dataTexte)
				// pour la prochaine fois
				Use (Storage.RessourcesAPP)
					OB SET(Storage.RessourcesAPP; $Xpath; $dataTexte)
				End use 
				
			Else 
				$Error:=-15077  // élément inexistant dans la structure XML
				$ErrorDescription:="La valeur de <"+String($ID)+"> n'existe pas dans la structure XML de "+$fichier.platformPath
			End if 
		End if 
		DOM CLOSE XML($RacineXML)
	End if 
	
	cs.$trace.me.Créer($Error; Current method name; $ErrorDescription).LeverException([msgk_event; msgk_log])
	$result:=$dataTexte
	
	
Function LireLocatedSTR_LH($IDmin : Integer; $IDmax : Integer)->$result : Integer
	var $i; $j; $itemRef; $détail : Integer
	var $itemText; $texte : Text
	
	$result:=New list
	
	// liste nn : nnx00 = élément de liste, nnx0y = parent de sous-liste, nnxyy = élément de sous-liste
	For ($i; $IDmin; $IDmax; 100)
		$itemText:=Localized string(String($i))
		
		If (ok=1)
			// on a un élément de liste simple
			APPEND TO LIST($result; cs._rsc.me.symbole($i)+" "+Substring($itemText; 1; 255); $i)
			
		Else 
			$itemText:=Localized string(String($i+1))
			
			If (ok=1)
				// élément parent d'une sous liste
				// données de la sous liste
				$texte:=Substring($itemText; 1; 255)
				$itemRef:=$i
				$détail:=New list
				
				// créer la sous liste
				For ($j; $i+11; $i+19)
					$itemText:=Localized string(String($j))
					If (ok=1)
						// on a un élément de sous-liste
						APPEND TO LIST($détail; cs._rsc.me.symbole($j)+" "+Substring($itemText; 1; 255); $j)
					End if 
				End for 
				// ajouter la sous-liste
				APPEND TO LIST($result; $texte; $i; $détail; True)
				
			Else 
				// c'est fini
				$i:=$IDmax+1
			End if 
		End if 
	End for 
	
	
	// -----------------------------
	// MARK:SVG
	// -----------------------------
	
Function TraiterTemplateSVG($nomTemplate : Text; $ptrImage : Pointer; $params : Object)->$result : Integer
	// $nomTemplate : nom du fichier template en ressources, $ptrImage image destination, $params paramètres de construction
	var $format : Integer
	var $path : 4D.File
	var $dossier : 4D.Folder
	var $racineXML : Text
	var $pict : Picture
	var $texteBlobé : Blob
	var $dataText : Text
	
	$path:=Folder(fk resources folder).folder("TemplatesALV").file($nomTemplate)
	$dossier:=Folder(fk documents folder)
	
	$result:=-15068
	Case of 
		: (Not($path.exists))
		: (Type($ptrImage->)#Is picture)
			// créer le fichier
		: (This.TraiterBalisesFichier($path; $dossier; $params)#0)
			
		Else 
			$result:=0
			// résultat dans $dossier+$nomTemplate
			$path:=$dossier.file($nomTemplate)
	End case 
	
	Case of 
			// ok avant
		: ($result#0)
			// on a un fichier
		: (Not($path.exists))
		: (Not(OB Is defined($params; "Format")))
			
		Else 
			DOCUMENT TO BLOB($path.platformPath; $texteBlobé)
			$dataText:=BLOB to text($texteBlobé; UTF8 text without length)
			
			$racineXML:=DOM Parse XML source($path.platformPath)
			// on a une structure XML
			$result:=Erreur de lecture du fichier*Num(ok=0)
			If ($result=0)
				// convertir en image
				$format:=$params.Format
				SVG EXPORT TO PICTURE($racineXML; $pict; $format)
				DOM EXPORT TO FILE($racineXML; cs.$trace.me.GetGarbageDossier("_APPdebug").file("Test_SVG_Palette.xml").platformPath)  //pour des tests"
				DOM CLOSE XML($RacineXML)
				$path.delete()
				
				$ptrImage->:=$pict
			Else 
				cs.$trace.me.Créer(-15075; Current method name; "Erreur lecture du fichier "+$path.platformPath+" (voir détails dans logs)").LeverException([msgk_event; msgk_log])
				cs.$trace.me.EnvoyerMessages([msgk_log]; "Erreur lecture de fichier"; Current method name; JSON Stringify($params))
			End if 
	End case 
	
	
Function TraiterBalisesFichier($fichier : 4D.File; $dossier : 4D.Folder; $params : Object)->$result : Integer
	// appliquer le traitement des balises 4D au contenu d'un fichier texte
	// $1 est un fichier : traiter le texte du fichier
	// $2 dossier des fichiers traités
	// $3 : options
	var $dataTexte : Text
	var $chemin : 4D.File
	var $texteBlobé : Blob
	var $prefs : Object
	
	$result:=-15068
	Case of 
		: (Not($fichier.exists))
		Else 
			$result:=0
			
			// lire le contenu à traiter
			$dataTexte:=$fichier.getText()
			// créer le chemin de destination
			$chemin:=$dossier.file($fichier.fullName)
			// les prefs
			$prefs:=OB Copy(cs.$session.me.prefs)
			// on y va
			PROCESS 4D TAGS($dataTexte; $dataTexte; $params; $prefs)
			
			// on enregistre
			SET BLOB SIZE($texteBlobé; 0)
			TEXT TO BLOB($dataTexte; $texteBlobé; UTF8 text without length)
			
			$chemin.setContent($texteBlobé)
	End case 
	
	
	// -----------------------------
	// MARK:Divers
	// -----------------------------
	
Function MultiLignerTexte($texte : Text; $params : Object)
	// spliter dans le tableau $ptrTab le texte $texte en N lignes de $params.length max caractères
	// N ne doit pas dépasser $params.nbrMaxLignes
	var $c : Collection
	var $itemText; $mot : Text
	var $Error : Integer
	
	$Error:=-15068
	$params.lignes:=New collection
	
	Case of 
		: (Not(OB Is defined($params; "length")))
		: (Not(OB Is defined($params; "nbrMaxLignes")))
		Else 
			// c'est ok
			$Error:=0
			
			$c:=Split string($texte; " "; sk ignore empty strings)
			ARRAY TEXT($tabElements; 0)
			COLLECTION TO ARRAY($c; $tabElements)
			
			$itemText:=""
			For each ($mot; $c)
				If (Length($itemText+" "+$mot)<$params.length)
					$itemText:=$itemText+$mot+" "
					
				Else 
					$params.lignes.push($itemText)
					$itemText:=$mot+" "
				End if 
			End for each 
			// ajouter le petit dernier
			$params.lignes.push($itemText)
			
			// on ne veut pas plus de "nbrMaxLignes" lignes
			If ($params.lignes.length>$params.nbrMaxLignes)
				$params.lignes:=$params.lignes.resize($params.nbrMaxLignes)
				// finaliser le dernier élément
				$itemText:=$params.lignes[$params.lignes.length-1]
				$params.lignes[$params.lignes.length-1]:=Choose(Length($itemText+"...")>$params.length; Substring($itemText; 1; Length($itemText)-3)+"..."; $itemText+"...")
			End if 
			
	End case 
	cs.$trace.me.Créer($Error; Current method name; "paramètres incorrects").LeverException([msgk_event; msgk_log])
	
	
Function CoderID($ID : Integer; $code : Integer)->$result : Integer
	$result:=($code << 24)+$ID
	
	
Function estIDcodeDe($IDcodé : Integer; $code : Integer)->$result : Boolean
	var $codeIDcodé : Integer:=($IDcodé & 0xFF000000) >> 24
	
	Case of 
		: ($code=160)
			// un enfant
			$result:=(($codeIDcodé & 0x00E0)=$code)  // supprimer les 5 derniers bits
			
		: (($code=128) | ($code=144))
			// une union / un parent
			$result:=(($codeIDcodé & 0x00F0)=$code)  //supprimer les 4 derniers bits
			
		: (($code=200) | ($code=208))
			// un media / une ressource
			$result:=(($codeIDcodé & 0x00F8)=$code)  // supprimer les 3 derniers bits
			
		Else 
			$result:=($codeIDcodé=$code)
	End case 
	
	
Function estIDcodeDeClasses($itemRef : Integer; $classes : Collection)->$result : Boolean
	// renvoie vrai si $itemRef est un ID codé de l'une des classes de $classes
	var $class : Object
	
	$result:=False
	
	If ($classes.length>0)
		For each ($class; $classes)
			$result:=$result | This.estIDcodeDe($itemRef; $Class.getInfo().tableNumber)
		End for each 
	End if 
	
	
	// -----------------------------
	// MARK:Objets
	// -----------------------------
	
Function getVariableObjet($nomOBJ : Text)->$result : Pointer
	$result:=Get pointer($nomOBJ)
	
	
Function PartagerObjet($objet : Object; $avec : Variant)
	var $c : Collection
	var $objetCopy
	
	$objetCopy:=OB Copy($objet; ck shared)
	
	Case of 
		: (Value type($avec)=Is collection)
			// créer une collection de $objet et l'ajouter à $avec
			$c:=New shared collection(OB Copy($objet; ck shared))
			This.PartagerCollection($c; $avec)
			
	End case 
	
	
Function PartagerCollection($c : Collection; $avec : Variant)
	var $cCopy : Collection
	
	Case of 
		: (Value type($avec)=Is collection)
			// placer $c dans $avec
			$cCopy:=$c.copy(ck shared; $avec)
			Use ($avec)
				$avec.combine($cCopy)
			End use 
			
	End case 
	
	//Function CopierAttributs($deObjet : Object; $versObjet : Object)
	//// recopier les attributs de $deObjet
	//var $c : Collection
	//var $attribut : Text
	
	//$c:=OB Keys($deObjet)
	//For each ($attribut; $c)
	//Case of 
	//: (Value type($deObjet[$attribut])=Is object)
	
	//If (OB Is shared($versObjet))
	//Use ($versObjet)
	//$versObjet[$attribut]:=New shared object
	//$versObjet[$attribut]:=OB Copy($deObjet[$attribut]; ck shared)
	//End use 
	
	//Else 
	//$versObjet[$attribut]:=OB Copy($deObjet[$attribut])
	//End if 
	
	//: (Value type($deObjet[$attribut])=Is collection)
	//TRACE
	
	//Else 
	//// valeurs scalaires
	//If (OB Is shared($versObjet))
	//Use ($versObjet)
	//$versObjet[$attribut]:=$deObjet[$attribut]
	//End use 
	
	//Else 
	//$versObjet[$attribut]:=$deObjet[$attribut]
	//End if 
	//End case 
	//End for each

⇧ [class]$canalAudio - 18/04/2026 18:18:24

      property IDnomCanal; IDnomFichier : Text
property source; AVniveau; AVlecturePause : Integer
property préférences; session : Object

Class constructor($IDnomCanal : Text; $source : Integer; $IDnomFichier : Text; $préférences : Object)
	// cette classe gère un canal sonore
	
	// identifiant
	This.IDnomCanal:=$IDnomCanal
	// origine de la source sonore
	This.source:=$source
	
	This.IDnomFichier:=$IDnomFichier
	// paramètres utilisateur
	This.préférences:=$préférences
	
	This.session:=cs.$session.me
	
	// ----------------------
	//MARK:Flux
	// ----------------------
	
Function LireSon($IDnomFichier : Text)->$result : Object
	var $fichier : 4D.File
	var $media : cs.$media:=cs.$media.me
	var $fichierPath : Text:=""
	
	$result:=ds.initResult()
	
	// utiliser le IDnomFichier demandé
	If ($IDnomFichier#"")
		This.IDnomFichier:=$IDnomFichier
	End if 
	
	$fichierPath:=""
	$fichier:=Null
	$result.Error:=-15068
	Case of 
		: (This.source=Est Ressource Système)
			// son système MAC uniquement
			If (Is macOS)
				PLAY(This.IDnomFichier)
				$result.Error:=-1
			Else 
				$result.ErrorDescription:="Impossible de jouer un son 'système' sur Windows ("+This.IDnomFichier+")"
			End if 
			
		: (This.source=Est Ressource APP)
			// le fichier est en ressources
			$fichierPath:=Folder(fk resources folder; *).folder("Sons").file(This.IDnomFichier).platformPath
			$result.Error:=0
			
		: (This.source=Est Ressource Media)
			// v7.3.6 : il y a des ressources ALV (en BDD) et des ressources utilisateurs (sur DD)
			Case of 
				: (Match regex("[0-9]{1,5}"; This.IDnomFichier))
					// ressources en BDD
					$media.getCheminSurDD(Num(This.IDnomFichier))
					$result.Error:=$media.trace.Error
					$fichierPath:=$media.cheminFichier
					// attention au cas application client APP : téléchargement si besoin, donc erreur, gérée par l'appelant
				Else 
					// ressources sur DD
					cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Ressources_Communes/Dossier_Sons_Private"; Is text; ->$fichierPath)
					$fichierPath:=cs.$document.new().GetPrivateResourcesFolder().folder($fichierPath).file(This.IDnomFichier).platformPath
					$result.Error:=0
			End case 
			
		: (This.source=Is text)
			// le niveau doit être fixé avant le lancement de la lecture (voir classe AVplayer du plugIn)
			// initialiser le synthétiseur
			$result.Error:=This.LireTexte(" ")
			// fixer le niveau
			$result.Error:=This.FixerNiveau(This.AVniveau)
			
			// c'est parti
			$result.Error:=This.LireTexte(This.IDnomFichier)
			$result.Error:=-1
	End case 
	
	Case of 
		: (This.session.prefs=Null)
			$result.ErrorDescription:="Absence de UserPrefs"
			$result.Error:=-15068
			
		: (This.session.prefs.Sonorisation.Activation=1700)
			// pas de sonorisation
			$result.Error:=0
			
		: ($result.Error=-1)
			// synthèse vocale, elle est en cours, filtrer le message d'erreur
			$result.Error:=0
			
			// on a un fichier (hors synthèse vocale), le lire
		: ($result.Error=Fichier en téléchargement)
			// attendre, filtrer le message d'erreur
			$result.Error:=0
			
		: (Test path name($fichierPath)#Is a document)
			$result.ErrorDescription:="Le fichier '"+$fichierPath+"' n'est pas une ressource 'son'"
			$result.Error:=-15042
			
		: (Not(Storage.System.Status ?? 24))
			// pas de plugIn; utiliser 4D
			// arrêter le son précédent
			PLAY(""; 0)
			// lancer le second
			PLAY($fichierPath; 0)
			
		Else 
			// utiliser le plugIn
			If (Not(OB Is defined(This; "préférences")))
				This.préférences:=This.session.prefs.SonorisationPrefs[OB Get(This; "IDnomCanal"; Is text)]
			End if 
			
			// arrêter la précédente lecture sur ce canal
			$result.Error:=This.FixerLecturePause(0)
			
			// envoyer le fichier
			$result.Error:=This.FixerFichier(File($fichierPath; fk platform path))
			
			// régler le niveau
			$result.Error:=This.FixerNiveau(This.préférences.Niveau)
			
			// lire
			$result.Error:=This.FixerLecturePause(1)
			
			TEXT TO DOCUMENT(cs.$trace.me.GetGarbageDossier("_APPdebug/"+Current method name).file(Timestamp+".txt").platformPath; String(Storage.System.typeApplication=ALV Client APP)+". "+String(This.LireLecturePause()))
			
			
	End case 
	
	cs.$trace.me.Créer($result.Error; Current method name; $result.ErrorDescription).LeverException([msgk_event; msgk_log])
	$result.success:=($result.Error=0)
	
	
Function LireTexte($texte : Text)->$result : Integer
	$result:=-15068
	Case of 
		: (Not(Storage.System.Status ?? 24))
			$result:=0
		: ($texte="")
		Else 
			
			$result:=SV_Lire_Texte(This.IDnomCanal; $texte)
	End case 
	
	
Function EnregistrerTexte($texte : Text; $fichier : 4D.File)->$result : Integer
	var $pathOut_POSIX : Text
	
	$result:=-15068
	Case of 
		: (Not(Storage.System.Status ?? 24))
			$result:=0
			
		: ($texte="")
		: ($fichier.platformPath="")
		: (Not($fichier.isFile))
		Else 
			
			$pathOut_POSIX:=Convert path system to POSIX($fichier.platformPath)
			$result:=SV_Enregistrer_Texte(This.IDnomCanal; $texte; $pathOut_POSIX)
	End case 
	
	
Function Fermer()->$result : Integer
	$result:=0
	If (Storage.System.Status ?? 24)
		// on peut demander à fermer des canaux non ouverts ; $Error peut être non null
		$result:=AV_Fermer_Canal(This.IDnomCanal)
	Else 
		// pas de plugIn
		PLAY(""; 0)
	End if 
	
	
	// ----------------------
	//MARK:Propriétés
	// ----------------------
	
Function estEnLecture()->$result : Boolean
	var $valeur : Integer
	
	$valeur:=This.LireLecturePause()
	$result:=($valeur=1)
	
	
Function LireLecturePause()->$result : Integer
	var $valeur : Integer
	
	This.AVlecturePause:=-2
	If (Storage.System.Status ?? 24)
		$valeur:=AV_Lire_Proprietes_Canal(This.IDnomCanal; AV LecturePause)
		This.AVlecturePause:=$valeur
	End if 
	
	
Function FixerLecturePause($mode : Integer)->$result : Integer
	$result:=0
	Case of 
		: (This.session.prefs=Null)
			
		: (This.session.prefs.Sonorisation.Activation=1700)
			// pas de sonorisation
			
		: (Storage.System.Status ?? 24)
			$result:=AV_Fixer_Proprietes_Canal(This.IDnomCanal; AV LecturePause; $mode)
	End case 
	
	
Function FixerNiveau($valeur : Integer)->$result : Integer
	$result:=0
	If (Storage.System.Status ?? 24)
		$result:=AV_Fixer_Proprietes_Canal(This.IDnomCanal; AV Niveau; $valeur)
	End if 
	
	
Function LireNiveau()
	var $valeur : Integer
	
	This.AVniveau:=-1
	If (Storage.System.Status ?? 24)
		$valeur:=AV_Lire_Proprietes_Canal(This.IDnomCanal; AV Niveau)
		This.AVniveau:=$valeur
	End if 
	
	
Function FixerFichier($fichier : 4D.File)->$result : Integer
	var $pathIn_POSIX : Text
	
	$result:=-15068
	Case of 
		: (Not(Storage.System.Status ?? 24))
		: (Not($fichier.exists))
		Else 
			
			$pathIn_POSIX:=Convert path system to POSIX($fichier.platformPath)
			$result:=AV_Ouvrir_Canal(This.IDnomCanal; $pathIn_POSIX)
	End case

⇧ [class]_main - 23/07/2026 19:44:57

      property environnement : cs.xSDK.EnvironnementALV
property document:=cs.$document
property trace : cs.$trace
property rsc : cs.xSDK.ResourceALV
property session : cs.$session

Class constructor()
	
	This.environnement:=cs.xSDK.EnvironnementALV.new()
	This.document:=cs.$document.new()
	This.trace:=cs.$trace.me
	This.rsc:=cs.xSDK.ResourceALV.me
	This.session:=cs.$session.me
	
	
Function DemarrageALV()
	// appel par l'évènement base 'sur ouverture'
	
	// les erreurs APP non gérées par ailleurs
	ON ERR CALL(Formula(errorHandler_APP).source; ek global)
	// les erreurs Composants non gérées par ailleurs
	ON ERR CALL(Formula(errorHandler_COMP).source; ek errors from components)
	
	Case of 
		: (Application type=4D Local mode)
			// procéder au démarrage de l'APP
			This.DémarrerALV("ALV")
			
			//: (Type application=4D mode distant)
			//// procéder à l'installation du client APP
			//This.DémarrerClientALV()
			
		: (This.environnement.typeApplication()=ALV Client APP)
			// procéder au démarrage du client APP
			This.DémarrerClientALV("ClientALV")
			
		: (This.environnement.typeApplication()=4D Remote mode)
			// procéder au démarrage du client 4D
			This.DémarrerClientALV("Client4D")
			
	End case 
	
	
Function DemarrageServeurALV()
	// appel par l'évènement base 'sur démarrage serveur'
	
	// les erreurs SRV non gérées par ailleurs
	ON ERR CALL(Formula(errorHandler_APP).source; ek global)
	// les erreurs Composants non gérées par ailleurs
	ON ERR CALL(Formula(errorHandler_COMP).source; ek errors from components)
	
	// procéder à l'installation et au démarrage du serveur
	This.DémarrerALV("ServeurALV")
	
	
	// -----------------------------
	// MARK:Démarrages
	// -----------------------------
	
Function DémarrerALV($contexte : Text)
	// démarrage de l'APP ou serveur APP
	var $params : Object
	
	// ici pas de gestion particulières des erreurs
	// rappel : le worker de services "WK_Services" est déjà lancé par le composant
	
	// mode développement : tuer les process APP déjà présents (d'un précédent démarrage)
	// nettoyer de façon à tout initialiser correctement ici
	cs.$process.new().TuerUserProcesses()
	
	// toujours commencer par là
	This.InitVariablesSystème()
	// puis là
	This.InitExtensions()
	// puis
	cs._rsc.new()
	This.rsc.Inscrire(Est Ressource APP; New object("chemin"; Folder(fk resources folder).file("Commun.xml").platformPath))
	This.rsc.Inscrire(Est Ressource Release; New object("chemin"; Folder(fk resources folder).file("Releases.xml").platformPath))
	
	Case of 
		: (Not((Is compiled mode) | (Not(Shift down))))
			// on s'arrête ici
		: (Not(OB Is defined(This; "Process"+$contexte)))
			// pb, pas de fonction pour le process
		Else 
			// C'est parti
			$params:=New object
			$params.nomProcess:=Process Principal ALV
			$params.initProcess:=Formula(InitProcessCooperative)
			
			cs.$process.new().ExecuterDansWorker(cs._main; "Process"+$contexte; $params)
	End case 
	
	// fin de la méthode ouverture; donc ici, la méthode base 'sur après ouverture base hôte' des composant doit correctement fonctionner
	
	
Function ProcessALV($params : Object)
	var $texte : Text:=""
	var $wndNum : Integer
	var $data : Object
	
	// à partir d'ici, on s'autorise à avoir des erreurs
	This.InitProcess()
	// installer tous les fichiers
	This.InstallationALV()
	// rmk : il peut y avoir eu des erreurs
	
	// afficher une fenêtre
	This.session.ActiverApplication()
	
	// ouverture avec formulaires :  4D local (BDD mère) ou 4D volumeDesktop (ALV Bureau) ou 4D mode distant (ALV client APP)
	This.InitProcess_Principal()
	
	// pour le fun, attendre que le cartouche s'affiche
	DELAY PROCESS(Current process; 2*60)
	
	// ouvrir le formulaire d'accueil, en plein écran
	This.rsc.SetVariable(Est Ressource APP; "Ressources_Communes/Nom_Application"; Is text; ->$texte)
	If (Is Windows)
		$wndNum:=Open window(0; 0; Screen width; Screen height-30; 8; $texte)  // taille de la fenêtre dans la fenêtre de l'application
		MAXIMIZE WINDOW($wndNum)  // la fenêtre du formulaire prend la taille de la fenêtre de l'application
		DIALOG("Accueil")
		CLOSE WINDOW
		CLEAR VARIABLE($wndNum)
		
	Else 
		$data:=cs.$accueil.new()
		cs.$dialogue_3001.new().Ouvrir("Accueil"; Plain form window+Form has full screen mode Mac+Form has no menu bar; $texte; $data)
	End if 
	
	// le formulaire a été fermé
	If (cs.$application.new().OuvrirDeveloppement())
		// retour au développement
		SHOW MENU BAR
		ON ERR CALL("")
	End if 
	
	
Function ProcessServeurALV()
	var $texte : Text
	
	// à partir d'ici, on s'autorise à avoir des erreurs
	This.InitProcess()
	// installer tous les fichiers
	This.InstallationServeurALV()
	// rmk : il peut y avoir eu des erreurs
	
	$texte:=Get 4D folder(Active 4D Folder)+"InstallationAPP.json"
	Case of 
		: (Test path name($texte)=Is a document)
			// installation pas faite : finir la méthode pour relancer l'ouverture
			
		: (Storage.System.typeApplication=ALV Serveur HTTP)
			// ouverture avec 4D serveur ; en principe ce contexte sert au debugage du serveur ALV à partir de la BDDmère (non fusionnée)
			// installer et démarrer le serveur Web hôte
			cs.$serveurWEB.new().Installer()
			
			// dans cette version pas de tâches de maintenance
			
		: (Storage.System.typeApplication=ALV Serveur APP)
			// ouverture avec 4D serveur (serveur APP)
			// installer le serveur Web hôte
			cs.$serveurWEB.new().Installer()
			
			// démarrer les tâches de maintenance
			cs.$maintenance.new().Démarrer()
			
		Else 
	End case 
	
	
Function DémarrerClientALV($contexte : Text)
	// démarrage depuis ouverture
	var $params : Object
	
	// ici pas de gestion particulières des erreurs
	
	// lancer le worker de services
	CALL WORKER("WK_Services"; Formula(InitProcessThreadSafe).source)
	
	// toujours commencer par là
	This.InitVariablesSystème()
	// puis
	This.rsc.Inscrire(Est Ressource APP; New object("chemin"; Folder(fk resources folder).file("Commun.xml").platformPath))
	This.rsc.Inscrire(Est Ressource Release; New object("chemin"; Folder(fk resources folder).file("Releases.xml").platformPath))
	// remarque : ici les ressources APP et composants sont dans le cache de la machine client
	// ex  MacOS:Users:philippe:Library:Caches:AinsiLaVieClient:alv_192_168_1_23_8813_624:Resources:Releases.xml
	
	Case of 
		: (Not(OB Is defined(This; "Process"+$contexte)))
		Else 
			// C'est parti
			$params:=New object
			$params.nomProcess:=Process Principal ALV
			$params.initProcess:=Formula(InitProcessCooperative)
			
			cs.$process.new().ExecuterDansWorker(cs._main; "Process"+$contexte; $params)
	End case 
	
	
Function ProcessClientALV()
	var $texte : Text:=""
	var $data : Object
	var $wndNum : Integer
	
	// à partir d'ici, on s'autorise à avoir des erreurs
	This.InitProcess()
	
	// ici pas de gestion d'erreur
	ON ERR CALL(Formula(errorHandler_APP).source; ek local)
	
	This.InitSystèmeClientALV()
	
	This.FixerEtatDossiersMedias()
	
	This.InitExtensions()
	
	ON ERR CALL(Formula(traceHandler).source; ek local)
	// fin initsystem
	
	// vérifier l'authentification de l'utilisateur
	If (This.session.ActiverApplication())
		// ici :
		// l'alias est défini
		// l'utilisateur 4D et This.session.userName sont fixés
		
		$data:=New object
		$data.Libellé:="Ouverture"
		$data.Source:=Current method name
		$data.Description:="Connexion de l'utilisateur <"+This.session.userName+">"
		This.PosterMessageSurServeur($data)
		
	Else 
		// tant pis, on quitte, poliment
		// avertir l'utilisateur que cela se passe mal
		$data:=New object("titre"; ""; "numPageForm"; 2; "message"; cs._cfct.me.LireLocatedSTR(5152); "AfficherReport"; False)
		cs.$dialogue_3001.new().Lancer($data)
		QUIT 4D
	End if 
	
	// plateform Windows pas concernée
	// 'ALV client' ouvre le serveur ALV (fusionnée avec 4D serveur). 2 cas :
	Case of 
		: (Shift down)
			// ALV client en debug, connecter un développeur
			This.ProcessClientALVmaintenance()
			
		Else 
			// ALV client cas normal
			// finir l'init du client
			This.InitProcess_Principal()
			
			// accueil
			This.rsc.SetVariable(Est Ressource APP; "Ressources_Communes/Nom_Application"; Is text; ->$texte)
			$texte:="Client "+$texte
			If (Is Windows)
				$wndNum:=Open window(0; 0; Screen width; Screen height-30; 8; $texte)  // taille de la fenêtre dans la fenêtre de l'application
				DIALOG("Accueil")
				CLOSE WINDOW
				CLEAR VARIABLE($wndNum)
				
			Else 
				$data:=cs.$accueil.new()
				cs.$dialogue_3001.new().Ouvrir("Accueil"; Plain form window+Form has full screen mode Mac+Form has no menu bar; $texte; $data)
			End if 
			
			// le formulaire a été fermé
			$data:=New object
			$data.Libellé:="Fermeture"
			$data.Source:=Current method name
			$data.Description:="Déconnexion de l'utilisateur <"+This.session.userName+">"
			This.PosterMessageSurServeur($data)
			
			DELAY PROCESS(Current process; 10)
	End case 
	
	
Function ProcessClientALVmaintenance()
	// ouvrir le formulaire de reportServeur dans un nouveau process
	// appel par programmation (ouverture de ALVclient ou menu exécuter methode)
	var $params : Object
	var $result : Boolean
	
	// fixer type application
	Use (Storage.System)
		Storage.System.typeApplication:=ALV Client APP maintenance
	End use 
	
	If (This.session.ActiverApplication())
		
		// créer les barres de menus
		This.session.Ouvrir()
		// fixer la barre de menus
		//SET MENU BAR(Storage.BarresMenus.Standard; Current process)
		//SHOW MENU BAR
		
		// créer les paramètres d'un menu, lié à une pseudo commande 3124
		// rappel : le menu 3124 n'existe pas dans les barres de menus
		$params:=New object
		
		$params.type:="Palette"
		$params.commande:="3124"
		$params.DataClassNom:=""
		$params.nomClass:="$serveursEditeur"
		$params.titre:=Localized string("3124")
		$result:=cs.$processUser.new().AfficherPalette($params)
	End if 
	
	
Function ProcessClient4D()
	var $data : Object
	
	// à partir d'ici, on s'autorise à avoir des erreurs
	This.InitProcess()
	
	// ici pas de gestion d'erreur
	ON ERR CALL(Formula(errorHandler_APP).source; ek local)
	
	This.InitSystèmeClientALV()
	
	This.FixerEtatDossiersMedias()
	
	This.InitExtensions()
	
	// pour les échanges
	Use (This.session.prefs)
		This.session.prefs.Session_Etat:=((This.session.prefs.Session_Etat ?+ 6) ?+ 16)
	End use 
	
	ON ERR CALL(Formula(traceHandler).source; ek local)
	// fin initsystem
	
	//// vérifier l'authentification de l'utilisateur
	//If (This.session.ActiverApplication())
	//// l'alias est défini
	//// l'utilisateur 4D et This.session.userName sont fixés
	
	//$data:=New object
	//$data.Libellé:="Ouverture"
	//$data.Source:=Current method name
	//$data.Description:="Connexion de l'utilisateur <"+This.session.userName+">"
	//This.PosterMessageSurServeur($data)
	
	//Else 
	//// tant pis, on quitte, poliment
	//// avertir l'utilisateur que cela se passe mal
	//$data:=New object("titre"; ""; "numPageForm"; 2; "message"; cs._cfct.me.LireLocatedSTR(5152); "AfficherReport"; False)
	//cs.$dialogue_3001.new().Lancer($data)
	//QUIT 4D
	//End if 
	ALERT("toto "+Current process name+". "+Current method name)
	TRACE
	// '4D mode distant' se connecte à 4D serveur (donc non compilée)
	// environnement pour le debug :
	$data:=cs.$formulaire.new()
	$data.menu.params:=New object("commande"; "3119")
	$data.menu.AfficherFormulaire()
	ALERT("toto "+Current process name+". "+Current method name+JSON Stringify($data; *))
	ABORT
	
	
	// -----------------------------
	// MARK:Initialisation
	// -----------------------------
	
Function InitVariablesSystème()
	//•••••  variables globales système  •••••
	
	SET DEFAULT CENTURY(0)
	
	Use (Storage)
		Storage["System"]:=New shared object
		Storage["ServeurHTTP"]:=New shared object
		Storage["BarresMenus"]:=New shared object
		Storage["Processes"]:=New shared object
		Storage["RessourcesAPP"]:=New shared object
	End use 
	
	Use (Storage.System)
		Storage.System.Navigation:=New shared object
		// RAZ sélections courantes
		Storage.System.Navigation.Process:=New shared object
		// RAZ ZS survolée courante
		Storage.System.Navigation.ZS:=New shared object
		Storage.System.Navigation.ZS.ZoneSurvolée:=-1
		Storage.System.Navigation.ZS.EnregistrementLié:=-1
		// RAZ menus associés aux ZS survolées
		Storage.System.Navigation.ZS.menus:=New shared object
		
		Storage.System.GlisserDéposer:=New shared object
		
		// sert, rapidement, dans initExtensions
		Storage.System.Status:=0
		// sert, en particulier, pour les process de type monitoring
		Storage.System.ArrêtAPP:=False
		
		Storage.System.typeApplication:=This.environnement.typeApplication()
		Storage.System.estServeur:=This.environnement.estServeur()
		Storage.System.estClient:=This.environnement.estClient()
		Storage.System.schemaCouleur:=Choose(Get Application color scheme="light"; "clair"; "sombre")
		Storage.System.schemaCouleurPolice:=Choose(Get Application color scheme="light"; "black"; "white")
		Storage.System.estClientAPP:=False
	End use 
	
	
Function InitExtensions()
	var $system : Object
	var $texte : Text
	
	ARRAY LONGINT($tabNum; 0)
	ARRAY TEXT($Elements; 0)
	
	$system:=Storage.System
	Use ($system)
		
		// •••••  Gestion des plug-In •••••
		PLUGIN LIST($tabNum; $Elements)
		If (Find in array($tabNum; 15003)=-1)  // ID "AinsiLaVie Pack" = 15003, défini dans "4D Plugin Wizard"
			$system.Status:=$system.Status ?- 21
		Else 
			$system.Status:=$system.Status ?+ 21
		End if 
		If (Find in array($tabNum; 15004)=-1)  // ID "AinsiLaVie Audio" = 15004, défini dans "4D Plugin Wizard"
			$system.Status:=$system.Status ?- 24
		Else 
			$system.Status:=$system.Status ?+ 24
		End if 
		//le test de la présence des plugsin 4D est fait en dynamique (permet leur utilisation avec 4D_2004 version démo)
		
		// •••••  Gestion des Composants •••••
		COMPONENT LIST($Elements)
		If (Find in array($Elements; "ALV sdk")=-1)
			// grave docteur? oui, très
			$system.Status:=$system.Status ?- 23
		Else 
			$system.Status:=$system.Status ?+ 23
		End if 
		If (Find in array($Elements; "ALV Serveur Web")=-1)
			// invalider les commandes du serveur Web
			$system.Status:=$system.Status ?- 20
		Else 
			$system.Status:=$system.Status ?+ 20
		End if 
		If (Find in array($Elements; "ALV Journal Web")=-1)
			// impossibilité de mettre à jour la BDD mère avec les modifications faites sur le serveur Web
			$system.Status:=$system.Status ?- 22
		Else 
			$system.Status:=$system.Status ?+ 22
		End if 
		If (Find in array($Elements; "ALV Albums")=-1)
			$system.Status:=$system.Status ?- 25
		Else 
			$system.Status:=$system.Status ?+ 25
		End if 
		
	End use 
	
	// informer
	Case of 
		: ($System.Status ?? 23)
			
		Else 
			// avertir l'utilisateur que cela se passe mal
			$texte:="Ainsi La Vie : le composant 'AVL sdk' est absent du dossier 'Components' de l'application. L'installer et ré-ouvrir"
			ALERT($texte)  // on va quitter !
			QUIT 4D
	End case 
	
	
Function InitProcess()
	// initialiser le process courant
	var $data : Object
	var $texte : Text
	
	ON ERR CALL(Formula(traceHandler).source; ek local)
	
	// toujours nécessaire (par défaut lecture / ecriture => ajout par ORDA impossible)
	READ ONLY(*)
	
	// init des communications entre process
	If (OB Is defined(Storage; "Processes"))
		If (Not(OB Is defined(Storage.Processes; Current process name)))
			Use (Storage.Processes)
				Storage.Processes[Current process name]:=New shared object
			End use 
		End if 
		
		$data:=Storage.Processes[Current process name]
		Use ($data)
			// infos du process courant
			// commande reçue de l'extérieur
			$data.Commande:=""
			
			// état du process courant (partageable en lecture)
			$data.Status:=New shared object
			$data.Status.Time:=0
			$data.Status.Etat:=""
			$data.Status.State:=0
			$data.Status.Waiting:=0
			
			// données du process courant (partageables)
			$data.Data:=New shared object
			
			// infos du process que le process courant a lancé
			$data.ProcInProgress:=New shared object
			$data.ProcInProgress.numProcess:=0
			$data.ProcInProgress.name:=""
			$data.ProcInProgress.Status:=New shared object
		End use 
		
		// purger des reliquats de tâches qu'un ancien process du même nom aurait lancé, non purgé...
		cs.xSDK.RegistreTaches.me.Tuer(Current process)
		
	Else 
		// init pas faite, le process courant est rapide !)
	End if 
	// message de démarrage du process
	$texte:=cs.xSDK.Outils.me.getTextDeTypeProcess(Current process)
	CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Information"; Current method name; $texte; New object("nomProcess"; Current process name; "numProcess"; Current process))
	
	
Function InitProcess_Principal()
	// ici on est dans le process principal d'une application non serveur ou debug
	var $process : Object
	var $numProc; $largeur; $hauteur : Integer
	var $pict : Picture
	
	
	DEFAULT TABLE([Actions])
	// ici les menus n'existent pas encore
	SET MENU BAR("Defaut"; Current process)
	
	// re init les coordonnées du cartouche d'accueil
	$numProc:=0
	Repeat   // rechercher le process "principal"
		$numProc:=$numProc+1
		$process:=Process activity(Processes only).processes.query("number = :1"; $numProc)[0]
	Until (($process.type=Main process) | ($process.number>Count tasks))
	$numProc:=$process.number
	
	If ($numProc<=Count tasks)  // process trouvé
		// re init les dimensions de la fenêtre
		BRING TO FRONT($numProc)
		$pict:=cs._rsc.me.image(16204)
		PICTURE PROPERTIES($pict; $largeur; $hauteur)
		SET WINDOW RECT((Screen width-$largeur)/2; (Screen height-$hauteur)/2; (Screen width+$largeur)/2; (Screen height+$hauteur)/2; Frontmost window)
	End if 
	
	//••••• init du fichier d'appel de l'aide par le navigateur
	cs.$documentation.new().CréerPageConnexionServeurWeb()
	
	//••••• init de la correction orthographique
	cs.$texteTraitement.new().MettreAjourDictionnaire()
	
	// démarrer les tâches de maintenance
	cs.$maintenance.new().Démarrer()
	
	
	
	// -----------------------------
	// MARK:Installations
	// -----------------------------
	
Function InstallationALV()
	// ici pas de gestion d'erreur
	ON ERR CALL(Formula(errorHandler_APP).source; ek local)
	
	This.InitSystèmeALV()
	
	// autoriser la gestion des erreurs
	ON ERR CALL(Formula(traceHandler).source; ek local)
	
	// identification du user et des données
	// v18 : l'utilisateur courant est défini par un alias du super_utilisateur : fixer cet alias
	If (Shift down)
		SET USER ALIAS("Auteur")
	Else 
		SET USER ALIAS("Visiteur")
	End if 
	
	This.trace.EnvoyerMessages([msgk_event; msgk_instal]; "Ouverture Application"; Current method name; "Dossier des données <"+Data file+">")
	
	
Function InstallationServeurALV()
	var $installation; $dataTexte : Text
	var $dossier; $dossierDEFAULTDATA : 4D.Folder
	var $data : Object
	
	// ici pas de gestion d'erreur
	ON ERR CALL(Formula(errorHandler_APP).source; ek local)
	
	This.InitSystèmeALV()
	
	// identification du user et des données
	// v 11.0.10 sur un 4D serveur on ne peut pas FIXER ALIAS UTILISATEUR("Visiteur")
	
	// $dossier est le chemin du dossier des fichiers data (autre que pour BDDmère)
	$dossier:=This.document.GetDataFileFolder()
	This.trace.EnvoyerMessages([msgk_event; msgk_instal]; "Ouverture Application"; Current method name; "Dossier des données <"+$dossier.platformPath+">")
	
	// installer le fichier de données dans les documents utilisateur (=> lors d'une mise à jour de l'application, les données ne sont pas modifiées)
	// au premier démarrage, le fichier de donnéees est dans le dossier "Default Data" (cf Export de la BDD)
	$dossierDEFAULTDATA:=This.document.getStructureFolder().folder("Default Data")
	// ouverture avec les données "Default Data" (installlation vierge) ou "Fichier données" de la précédente ouverture
	
	// pour l'installation
	$installation:=Get 4D folder(Active 4D Folder)+"InstallationAPP.json"
	If (Test path name($installation)=Is a document)
		// voir où on en est
		$dataTexte:=Document to text($installation; "UTF-8")
		$data:=JSON Parse($dataTexte)
	Else 
		// initialiser l'installation de l'application
		$data:=New object("Start_DataFile"; Data file; "filePath"; "")
		$dataTexte:=JSON Stringify($data)
		TEXT TO DOCUMENT($installation; $dataTexte)
	End if 
	
	Case of 
		: (Not($dossierDEFAULTDATA.exists))
			// ce dossier par défaut n'existe plus, c'est que l'initialisation a dû être faite avant
			// normalement on est à la Nième (> 1) ouvertures
			This.trace.EnvoyerMessages([msgk_event; msgk_instal]; "Ouverture Application"; Current method name; "l'application est correctement installée")
			// ne sert plus
			DELETE DOCUMENT($installation)
			
		: ($data.filePath#"")
			// les données ont été installées ; nettoyer
			File($installation; fk platform path).delete()
			
			// le fichier de données ouvert est à sa place, mais le dossier par défaut est toujours là : le supprimer
			This.trace.EnvoyerMessages([msgk_event; msgk_instal]; "Installation Application"; Current method name; "finalisation : suppression du dossier <"+$dossierDEFAULTDATA.platformPath+">")
			$dossierDEFAULTDATA.delete(Delete with contents)
			This.environnement.VersionnerBDD()
			
			// on a peut être démarré sur un ancien fichier de donnée; le supprimer
			$dossier:=Folder($data.Start_DataFile; fk platform path)
			
			Case of 
				: ($dossier.platformPath#$dossierDEFAULTDATA.platformPath)
					// instalation vierge
				: (Not($dossier.exists))
					// bof!
				Else 
					// une ancienne version existe
					$dossier:=$dossier.parent
					This.trace.EnvoyerMessages([msgk_event; msgk_instal]; "Installation Application"; Current method name; "finalisation : suppression du dossier <"+$dossier.platformPath+">")
					$dossier.delete(Delete with contents)
			End case 
			
			// c'est fini
			This.trace.EnvoyerMessages([msgk_event; msgk_instal]; "Installation Application"; Current method name; "finalisation : suppression du fichier <"+$installation+">")
			
		Else 
			This.trace.EnvoyerMessages([msgk_event; msgk_instal]; "Installation Application"; Current method name; "Default Data <"+$dossierDEFAULTDATA.platformPath+">")
			// installer les données
			$dossier:=$dossier.folder(This.environnement.HorodaterBDD())
			This.trace.EnvoyerMessages([msgk_event; msgk_instal]; "Installation Application"; Current method name; "mise en place du fichier de données dans <"+$dossier.platformPath+">")
			// comme il faut renommer les fichiers avec le nom de l'application, on les transfert un par un
			// récupérer le nom de l'application
			$dataTexte:=File(Structure file(*); fk platform path).fullName
			
			$dossierDEFAULTDATA.file("Default.4DD").copyTo($dossier; $dataTexte+".4DD"; fk overwrite)
			$dossierDEFAULTDATA.file("Default.4DIndx").copyTo($dossier; $dataTexte+".4DIndx"; fk overwrite)
			$dossierDEFAULTDATA.file("Default.Match").copyTo($dossier; $dataTexte+".Match"; fk overwrite)
			
			$data.filePath:=$dossier.file($dataTexte+".4DD").platformPath
			// pour la ré ouverture
			$dataTexte:=JSON Stringify($data; *)
			TEXT TO DOCUMENT($installation; $dataTexte)
			
			// redémarrer 4D avec le bon fichier de données
			This.trace.EnvoyerMessages([msgk_event; msgk_instal]; "Installation Application"; Current method name; "ouverture du fichier de données <"+$data.filePath+">")
			OPEN DATA FILE($data.filePath)
			// attention : l'ouverture est asynchrone : la méthode sur ouverture s'exécute jusqu'au bout avant le redémarrage
	End case 
	
	// autoriser la gestion des erreurs
	ON ERR CALL(Formula(traceHandler).source; ek local)
	
	
Function InitSystèmeALV()
	// initialisations communes app ALV et serveur ALV
	var $dataBool : Boolean:=False
	var $dossier : 4D.Folder
	var $System : Object
	
	// déactiver les ASSERT si l'application est compilée (réactivable avec le bit 9 de system.Status)
	SET ASSERT ENABLED(Not(Is compiled mode))
	
	// infos application
	This.trace.EnvoyerMessages([msgk_event; msgk_instal]; "Ouverture Application"; Current method name; "Application 4D type <"+String(This.environnement.typeApplication4D)+"> - version <"+Application version+">")
	This.trace.EnvoyerMessages([msgk_event; msgk_instal]; "Ouverture Application"; Current method name; "Application ALV type <"+String(This.environnement.typeApplication())+"> - version <"+This.environnement.LireVersionAPP()+">")
	This.trace.EnvoyerMessages([msgk_event; msgk_instal]; "Ouverture Application"; Current method name; "Application ALV nom long <"+This.environnement.infosApplication().nomLong+"> - nom court <"+This.environnement.infosApplication().nomCourt+">")
	
	// emplacement des dossiers 4D
	This.trace.EnvoyerMessages([msgk_event; msgk_instal]; "Ouverture Application"; Current method name; "Dossier Support 4D <"+Get 4D folder(Active 4D Folder)+">")
	This.trace.EnvoyerMessages([msgk_event; msgk_instal]; "Ouverture Application"; Current method name; "Dossier Base <"+Get 4D folder(Database folder)+">")
	This.trace.EnvoyerMessages([msgk_event; msgk_instal]; "Ouverture Application"; Current method name; "Dossier Données <"+Get 4D folder(Data folder)+">")
	This.trace.EnvoyerMessages([msgk_event; msgk_instal]; "Ouverture Application"; Current method name; "Dossier Logs <"+Get 4D folder(Logs folder)+">")
	This.trace.EnvoyerMessages([msgk_event; msgk_instal]; "Ouverture Application"; Current method name; "Dossier Ressources courant <"+Get 4D folder(Current resources folder)+">")
	
	// alias du fichier logs courant
	$dossier:=This.document.getStructureFolder().parent.folder("Logs")
	CREATE ALIAS(Get 4D folder(Logs folder); $dossier.platformPath)
	
	This.FixerRessources()
	
	This.FixerLangueAPP()
	
	This.TesterVerrouillageAPP()
	
	This.TesterClésCryptage()
	
	This.FixerEtatDossiersMedias()
	
	//•••••  tester si l'application est le Serveur WEB •••••
	// toujours utile?
	$System:=Storage.System
	Use ($System)
		$System.Status:=$System.Status ?- 8  // l'application n'est pas un serveur Web
		Case of 
			: (Not(This.rsc.SetVariable(Est Ressource APP; "Serveur_Web/IsServeurWeb"; Is boolean; ->$dataBool)))
			: ($dataBool)
				$System.Status:=$System.Status ?+ 8  // serveur Web
			Else 
		End case 
	End use 
	
	//••••• définir le serveur WEB à utiliser
	// à faire très tôt (utilisation par la maintenance)
	//Connexion servicesHTTP("FixerURLserveur")
	WEB STOP SERVER
	
	//••••• lancer les workers
	// v8.1.6 : WK_Services a été lancé par le SDK
	// si une méthode est très intrusive, son exécution par "WK_selectionsBDD" déplace le bordel dans un process externe
	CALL WORKER("WK_selectionsBDD"; Formula(InitProcessThreadSafe).source)
	// communication entre process / workers ; doit pouvoir exécuter des functions NON thread-safe
	CALL WORKER("WK_Communication"; Formula(InitProcessCooperative).source)
	
	
Function InitSystèmeClientALV()
	var $System : Object
	var $timeOut; $nbreAttente : Integer
	var $actif : Boolean
	
	cs.$trace.me.EnvoyerMessages([msgk_event; msgk_instal]; "Ouverture Application"; Current method name; "Application 4D type <"+String(This.environnement.typeApplication4D)+">")
	cs.$trace.me.EnvoyerMessages([msgk_event; msgk_instal]; "Ouverture Application"; Current method name; "Application ALV type <"+String(This.environnement.typeApplication())+">")
	cs.$trace.me.EnvoyerMessages([msgk_event; msgk_instal]; "Ouverture Application"; Current method name; "Application ALV nom long <"+This.environnement.infosApplication().nomLong+">")
	cs.$trace.me.EnvoyerMessages([msgk_event; msgk_instal]; "Ouverture Application"; Current method name; "Application ALV nom court <"+This.environnement.infosApplication().nomCourt+">")
	
	$system:=Storage.System
	Use ($system)
		// fichier "structure" non verrouillée
		$system.Status:=$system.Status ?+ 0
		// fichier "données" modifiiable (non verrouillé)
		$system.Status:=$system.Status ?+ 1
		// ressources structure présentes
		$system.Status:=$system.Status ?+ 4
		
		// activer les requetes HTTP vers Serveur APP
		Storage.System.estClientAPP:=True
	End use 
	// lancer la scrutation du serveurHTTP
	CALL WORKER("WK_EtatConnexionHTTP"; Formula(cs.$requeteHTTP.me.FixerEtatConnexion()))
	// attendre que la connexion HTTP soit active
	$timeOut:=6
	$nbreAttente:=0
	Repeat 
		// Waiting(10) pose problème à la compilation
		DELAY PROCESS(Current process; 10)
		$nbreAttente:=$nbreAttente+1
		$actif:=(cs.$requeteHTTP.me.connexionHTTPactive=True) | ($nbreAttente>$timeOut)
	Until ($actif)
	
	CALL WORKER("WK_selectionsBDD"; Formula(InitProcessThreadSafe).source)
	CALL WORKER("WK_Communication"; Formula(InitProcessCooperative).source)
	
	cs.$trace.me.EnvoyerMessages([msgk_event; msgk_instal]; "Ouverture Application"; Current method name; "EtatConnexionHTTP "+Choose(cs.$requeteHTTP.me.connexionHTTPactive; "[OK]"; "KO")+", attente = "+String(10/60*$nbreAttente; "#0.##")+" s (timeOut = "+String($timeOut*10/60; "#0.##")+" s)")
	
	
Function FixerRessources()
	// Ouvrir les ressources non localisées, éventuellement les re-créer
	var $System : Object
	var $fichier : 4D.File
	var $dataTexte : Text
	var $dataBool : Boolean
	
	$System:=Storage.System
	Use ($System)
		$fichier:=Folder(fk resources folder).file("Commun.xml")
		
		// par défaut : présence des ressources structure
		$System.Status:=$System.Status ?+ 4
		If (Not($fichier.exists))  // absence de fichier : le recréer
			If (cs.xSDK.XML.me.EcrireLeChemin(->$fichier; "Ainsi_La_Vie").success)  // pas d'erreur
				//If (XML Ecrire le chemin(->$fichier; "Ainsi_La_Vie")=0)  // pas d'erreur
				$dataTexte:="Ainsi La Vie"  // nom de l'application
				This.rsc.SetResourceALV(Est Ressource APP; "Ressources_Communes/Nom_Application"; ->$dataTexte)
				$dataTexte:="Tempo Media"  // dossier des fichiers compressés
				This.rsc.SetResourceALV(Est Ressource APP; "Ressources_Communes/Dossier_Medias_Compressed"; ->$dataTexte)
				$dataTexte:=" PDF_images"  // dossier des fichiers compressés
				This.rsc.SetResourceALV(Est Ressource APP; "Ressources_Communes/Suffixe_Dossier_ImagesPDF"; ->$dataTexte)
				
				$dataBool:=False
				This.rsc.SetResourceALV(Est Ressource APP; "Serveur_Web/IsServeurWeb"; ->$dataTexte)
				
			Else 
				$System.Status:=$System.Status ?- 4  // absence des ressources structure
			End if 
		End if 
	End use 
	
	
Function FixerLangueAPP()
	var $dataTexte : Text:=""
	var $data : Object
	
	$dataTexte:=""
	$data:=New object
	
	// la langue application initiale est la langue de l'OS; vérifier qu'elle est bien gérable ici
	If (Storage.System.Status ?? 4)
		// lire la langue renseignée
		If (This.rsc.SetVariable(Est Ressource APP; "Ressources_Communes/CodeLangue_Application"; Is text; ->$dataTexte))
			// peut arriver sur des fichiers anciens
			$dataTexte:=Get database localization(User system localization)  // langue du système d'exploitation (fixée par l'utilisateur dans l'OS)
		End if 
		// cela peut être un code région xx-yy, passer au code ISO639-1 xx
		If (Position("-"; $dataTexte)>0)
			$dataTexte:=Substring($dataTexte; 1; Position("-"; $dataTexte)-1)
		End if 
		// est une langue gérée ici?
		$data:=cs.xSDK.Outils.me.ListerLanguesApplication()
		If ($data.codes.indexOf($dataTexte)=-1)
			// langue inconnue, imposer l'anglais
			$dataTexte:="en"
		End if 
		// mettre à jour
		This.rsc.SetResourceALV(Est Ressource APP; "Ressources_Communes/CodeLangue_Application"; ->$dataTexte)
	End if 
	This.trace.EnvoyerMessages([msgk_event; msgk_instal]; "Ouverture Application"; Current method name; "Langue application <"+$dataTexte+">")
	
	
Function FixerEtatDossiersMedias()
	// vérifier si les fichiers medias sont disponibles
	// init bits 2 et 3 de System.Status
	var $chemin : Text:=""
	var $dossier : 4D.Folder
	var $system : Object
	// attention : $dossier peut renvoyer NULL
	
	// créer / lire le dossier des ajouts de medias
	If (This.environnement.typeApplication()=ALV BDD mère)
		$dossier:=This.document.GetMediaFolder(0)
		
	Else 
		// crée le dossier s'il n'existe pas
		// remarque : utiliser .LeChemin (exécution locale) plutôt que .LeDossier() (exécution sur le serveur)
		$chemin:=ds.Dossiers.query("volume = :1"; 0)[0].LeChemin("")
		$dossier:=Folder($chemin)  // POSIX
		Case of 
			: ($dossier.exists)
			: ($dossier.create())
			Else 
				// erreur
		End case 
	End if 
	This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Chemin du dossier des medias ajoutés"; Current method name; $dossier.platformPath)
	
	$system:=Storage.System
	Use ($system)
		// par défaut
		$system.Status:=$system.Status ?- 2  // dossier medias pas encore trouvé
		$system.Status:=$system.Status ?- 3  // medias non modifiables
		
		Case of 
			: ($dossier=Null)
			: (Not($dossier.isFolder))
			Else 
				$system.Status:=$system.Status ?+ 2  //  dossier medias trouvé
				
				// test du verrouillage du dossier
				If (This.document.estDossierVerrouillé($dossier))
					$system.Status:=$system.Status ?- 3  // medias non modifiables
				Else 
					$system.Status:=$system.Status ?+ 3  // medias modifiables
				End if 
		End case 
	End use 
	
	
Function TesterVerrouillageAPP()
	//test du verrouillage des fichiers
	var $System : Object
	var $fichier : 4D.File
	
	$System:=Storage.System
	
	$fichier:=Folder(fk resources folder).folder("Images").file("toto.png")
	WRITE PICTURE FILE($fichier.platformPath; cs._rsc.me.image(16201))
	Use ($System)
		If (ok=1)  // pas d'erreur
			$fichier.delete()
			$System.Status:=$System.Status ?+ 0
			
		Else 
			// fichier "structure" verrouillée
			$System.Status:=$System.Status ?- 0
		End if 
		
		// fichier "données" modifiiable (non verrouillé)
		$System.Status:=$System.Status ?+ 1
		Case of 
			: (Application type=4D Server)
				// filtrer (pourquoi?)
			: (Is data file locked)
				// fichier "données" verrouillé
				$System.Status:=$System.Status ?- 1
		End case 
	End use 
	
	
Function TesterClésCryptage()
	// test des clés SYS de cryptage
	var $System : Object
	var $dataBlob; $CléPrivée; $CléPublique : Blob
	
	This.trace.Initialiser(Current method name)
	
	$System:=Storage.System
	
	// test de la présence et appairage des clés publique/privée
	This.trace.Error:=-15016
	This.trace.ErrorDescription:="Les clés privée et publique du groupe 15007 sont incorrectes"
	
	Use ($System)
		Case of 
			: (cs.xSDK.$document.new().LireCleCryptage(->$CléPrivée; New object("trousseau"; "private_key"; "groupID"; 15007)).success=False)  //; "chemin"; Dossier 4D(Dossier Resources courant)))#0)  // lire clé privée
			: (cs.xSDK.$document.new().LireCleCryptage(->$CléPublique; New object("trousseau"; "public_key"; "groupID"; 15007)).success=False)  // lire clé publique
			Else 
				This.trace.Error:=-15019
				
				TEXT TO BLOB("toto"; $dataBlob; UTF8 text with length)
				ENCRYPT BLOB($dataBlob; $CléPrivée)
				
				If (ok=1)
					This.trace.Error:=-15018
					DECRYPT BLOB($dataBlob; $CléPublique)
					
					If (ok=1)
						If (BLOB to text($dataBlob; UTF8 text with length)="toto")
							This.trace.Error:=0
						End if 
					End if 
				End if 
				
		End case 
	End use 
	
	This.trace.LeverException([msgk_event; msgk_log])
	
	
	// -----------------------------
	// MARK:Requetes
	// -----------------------------
	
Function PosterMessageSurServeur($message : Object)
	// appeler "EnvoyerMessages" sur le serveur
	var $params : Object
	
	$params:=OB Copy($message)
	$params.Options:=[msgk_event; msgk_log]
	$params.Origine:="CLIENT"
	$params.Contexte:=New object("nomProcess"; Current process name; "numProcess"; Current process)
	
	cs.$serveurAPP.me.Executer(OB Class(This).name; "EnvoyerMessages"; $params)
	
	
Function EnvoyerMessages($params : Object)
	// on est sur le serveur ; générer les messages
	Case of 
		: (Not(OB Is defined($params; "Options")))
		: (Not(OB Is defined($params; "Origine")))
		: (Not(OB Is defined($params; "Libellé")))
		: (Not(OB Is defined($params; "Source")))
		: (Not(OB Is defined($params; "Description")))
		: (Not(OB Is defined($params; "Contexte")))
		Else 
			
			This.trace.cible.EnvoyerMessages($params.Options; $params.Origine; $params.Libellé; $params.Source; $params.Description; $params.Contexte)
	End case 
	
	
	// -----------------------------
	// MARK:Arrêt
	// -----------------------------

⇧ [class]DossiersEntity - 12/04/2026 15:57:37

      Class extends Entity

Function IDcodé()->$ID : Integer
	$ID:=cs._ds.me.IDcodé(This)
	
	// ----------------------
	// MARK:Sélections
	// -----------------------
	
Function LeVolume()->$dossier : Object
	// renvoie le dossier media de this (volume>0)
	$dossier:=This
	If (This.volume<0)
		$dossier:=This.leDossierParent.leDossier.LeVolume()
	End if 
	
	
local Function LeChemin($path)->$chemin : Text
	// renvoie le chemin POSIX de this
	// rappel important : les classes s'exécutent par défaut sur le serveur. Forcer l'exécution en local pour avoir accès au DD du client
	// -> pas utile avec la BDDmère
	
	// renvoyer le chemin du parent
	$chemin:=This.nom+Folder separator+$path
	If (This.volume<0)
		// appeler le dossier parent
		$chemin:=This.leDossierParent.leDossier.LeChemin($chemin)
		
	Else 
		// on est au bout
		// ajouter le chemin du volume
		Case of 
			: (Storage.System.typeApplication=ALV BDD mère)
				// BDDmère
				$chemin:=cs.$document.new().GetMediaFolder(This.volume).platformPath+$chemin
				
			Else 
				// contrairement à la BDD mère, les medias des applications ALV, serveurs HTTP (v 5.3.10) APP (v 9.1.20) et Client ALV (v 9.0.3) sont dans le dossier local "documents" de l'utilisateur
				// chemin du fichier à récupérer
				$chemin:=cs.$document.new().GetMediaFolder(Dossier Media Client).platformPath+$chemin
				
		End case 
		$chemin:=Convert path system to POSIX($chemin)
	End if 
	
	
Function LeDossier()->$dossier : 4D.Folder
	// remonter le chemin de this et renvoyer l'objet
	var $chemin : Text
	
	$chemin:=This.LeChemin("")
	$dossier:=Folder($chemin)
	
	
	// ----------------------
	// MARK:Modification DataStore
	// -----------------------
	
Function Ajouter($quoi : Integer; $qui : Object; $params : Object)->$result : Object
	// créer un dossier ou un fichier à this
	// $1 = code de la création, $2 = entité (peut-être null), $3 paramètres
	var $item : Object
	ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "Début de l'ajout à ["+This.getDataClass().getInfo().name+"]"))
	
	$result:=ds.initResult()
	
	// fixer Qui
	If ($qui=Null)
		// créer qui
		$result:=ds.Créer($quoi; ""; $params)
		$qui:=$result.entitéAjoutée
	End if 
	
	Case of 
		: ($qui=Null)
			// il y a eu une erreur
		: ($quoi=imk Volume)
			// on a un chemin de dossier : créer en BDD l'arborescence du dossier
			// ajouter tous les fichiers
			For each ($item; $params.dossier.files(fk ignore invisible))
				$params.fichier:=$item
				$result.Fichier:=This.Ajouter(imk Fichier; Null; $params)
			End for each 
			
			// ajouter tous les sous dossiers
			For each ($item; $params.dossier.folders(fk ignore invisible))
				$params.dossier:=$item
				$result.Dossier:=This.Ajouter(imk Dossier; Null; $params)
				// $qui est le dossier ajouté, on reboucle
				$result.volume:=$result.Dossier.entitéAjoutée.Ajouter(imk Volume; This; $params)
			End for each 
			
		: ($quoi=imk Dossier)
			// Ajouter le dossier $qui à ce dossier
			$result.arborescence:=ds.Créer(imk Arborescence; ""; $params)
			$result.arborescence.entitéAjoutée.SousDossier:=$qui.ID
			$result.arborescence.entitéAjoutée.dossier:=This.ID
			$result.arborescence.entitéAjoutée.save()
			
		: ($quoi=imk Fichier)
			// ajouter le fichier $qui à ce dossier
			$qui.dossier:=This.ID
			$qui.save()
	End case 
	
	
	$result.success:=($result.Error=0)
	ds.NotifierResultat(This; $quoi; $result)
	
	
Function _FixerDonnées($quoi : Integer; $params : Object)->$result : Object
	// un dossier a été créé : on initialise ses données
	var $ID : Integer
	
	$result:=ds.initResult()
	
	// fixer ID volume du dossier
	Case of 
		: ($quoi=imk Dossier)
			This.volume:=-1
			
		: ($quoi=imk Volume)
			// chercher le prochain ID volume
			If (OB Is defined($params; "IDvolume"))
				$ID:=$params.IDvolume
				
			Else 
				$ID:=-1
				Repeat 
					$ID:=$ID+1
				Until (ds.Dossiers.query("volume = :1"; $ID).length=0)
			End if 
			This.volume:=$ID
			This.save()
			
			// compléter la ressource
			cs.$formulaire.new().document.SetMediaFolder(This.volume; $params.dossier.platformPath)
			
			// mémoriser pour la suite (voir FixerDonnées de Fichiers, on doit savoir si c'est un volume de BDD ou de DD)
			$params.IDvolume:=$ID
			
			// la suite va mettre le souk dans $params.dossier ; mémoriser ici le dossier du volume
			$params.volume:=$params.dossier
			$result:=This.Ajouter(imk Volume; This; $params)
			// restaurer pour finaliser
			$params.dossier:=$params.volume
	End case 
	
	// fixer le nom du dossier
	$result.Error:=-15068
	Case of 
		: (Not(OB Is defined($params; "dossier")))
			$result.ErrorDescription:="Absence du paramètre 'dossier'"
		: (Not($params.dossier.isFolder))
			$result.ErrorDescription:="'dossier' n'est pas un chemin de dossier"
		Else 
			// attention : le chemin peut ne pas exister dur le DD (exemple : cas création d'un dossier en BDD, mais encore absent du DD)
			$result.Error:=0
			This.nom:=$params.dossier.name
	End case 
	This.save()
	
	
Function Supprimer()->$result : Object
	// supprimer les fichiers et sous dossiers de this
	// attention this ne peut pas se suicider !
	ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "Début de suppression dans ["+This.getDataClass().getInfo().name+"]"))
	
	$result:=ds.initResult()
	
	// supprimer les fichiers
	$result.Fichiers:=This.lesFichiers.drop()
	
	If ($result.Fichiers.length=0)
		// supprimer l'arborescence
		$result.Arborescence:=This.lesLiensSousDossiers.Supprimer()
		
		If ($result.Arborescence.success)
			$result.Error:=-15023
			$result.ErrorDescription:=String($result.Arborescence.length)+"entités de [Arborescence] non supprimées"
			$result.success:=False
		End if 
		
	Else 
		$result.Error:=-15023
		$result.ErrorDescription:=String($result.Fichiers.length)+"entités de [Fichiers] non supprimées"
		$result.success:=False
	End if 
	
	ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "Fin de suppression dans ["+This.getDataClass().getInfo().name+"], success "+String($result.success)))

⇧ [class]LieuxSelection - 06/04/2026 15:48:24

      Class extends EntitySelection

Function IDcodés()->$c : Collection
	$c:=cs._ds.me.IDcodés(This)
	
	
	// ----------------------
	// MARK:DataStore
	// -----------------------
	
Function Le($DataClassNom : Text)->$result : Object
	// renvoie la sélection d'entités [$DataClassNom]
	$result:=This.leSite.Le($DataClassNom)
	
	
Function Les($DataClassNom : Text)->$result : Object
	// renvoie la sélection d'entités [$dataClassNom]
	$result:=This
	
	
Function LesLieux($params : Object)->$result : Object
	// méthode générique
	// renvoie la sélection d'entités filtrées
	$result:=This.Filtrer($params)
	
	
	// ----------------------
	// MARK:Affichage
	// -----------------------
	
Function CréerListBox()->$result : Collection
	// renvoie une collection hiérarchique de la sélection courante (image d'une liste hiérarchique)
	var $élément : Object
	var $entité : cs.LieuxEntity
	
	$result:=New collection
	For each ($entité; This)
		// un item
		$élément:=New object
		$élément.itemText:=$entité.Libellé()  // utiliser les formats par défaut
		$élément.itemRef:=$entité.IDcodé()
		
		$élément.DataClassNom:=$entité.getDataClass().getInfo().name
		$élément.ID:=$entité.ID
		
		$result.push($élément)
	End for each 
	
	
Function CréerHiérarchie($params : Object)
	var $entité; $result : Object
	var $c : Collection
	
	$entité:=This[0]
	$result:=ds._classeParente($entité)
	
	$c:=New collection
	$result.sélection.CréerLH($c; $params.Options)
	$params.liste:=$c
	// renvoyer le parent trouvé
	$params.parent:=$result.parent
	
	
Function CréerLH($LH : Collection; $options : Integer)
	// les LH servent toujours à des FORM ; ne pas traiter sur le serveur
	var $objet; $data; $entité : Object
	
	For each ($entité; This)
		$objet:=New object
		$objet.itemText:=$entité.nom
		$objet.itemRef:=cs._ds.me.IDcodé($entité)
		
		// ajouter les données de l'item
		$data:=New object
		// les properties de l'item
		$data.properties:=New object("saisissable"; False; "style"; Bold)
		$objet.data:=CoDecBase64_Objet($data)
		
		$LH.push($objet)
	End for each 
	
	
Function CréerListBoxMedia($params : Object)
	var $selection : cs.MediasSelection
	
	$selection:=This.LesMedias($params)
	If ($params.cléTri=Null)
		$selection:=$selection.orderBy("dateNum asc, heure asc")
	Else 
		$selection:=$selection.orderBy($params.cléTri)
	End if 
	// demander la LB
	$params.liste:=$selection.CréerListBox($params.attribut)
	
	
	// ----------------------
	// MARK:Sélections
	// -----------------------
	
Function LesMedias($params : Object)->$result : cs.MediasSelection
	// sélectionner les media de this de type $params.typeZone, eventuellement privé
	$result:=This.lesIllustrations.laZone.Filtrer($params).leMedia.Filtrer($params)
	$result:=$result.orderBy("dateNum asc, heure asc")
	
	
Function Filtrer($userOptions : Object)->$result : cs.LieuxSelection
	
	$result:=This
	Case of 
		: (This.length=0)
		: (Count parameters=0)
		: ($userOptions.géolocalisés=False)
			// les lieux non géolocalisés sont admis dans cette sélection
		Else 
			$result:=This.query("latitude != 0 and longitude != 0")
	End case

⇧ [class]_ds_EXT - 06/07/2026 11:55:50

      // point d'entrée de toutes les modifications de la BDD par le clientAPP, le serveur Web et la classe importJALV
Class extends _ds

Class constructor()
	
	Super()
	
	
	
Function Modifier($params : Object)
	// appel par une requête clientAPP ou serveur Web : modifier la BDD suivant $params
	// Pour toutes les commandes il faut un UserID et une entité (paramètres aQui)
	var $data; $selection; $aQui : Object
	var $UserID; $ID : Integer
	
	This.result:=This._InitResult(-15068; ""; False)
	This.result.Source:=Current method name
	
	// il faut un ID d'utilisateur
	Case of 
		: (Not(OB Is defined($params; "UserID")))
			This.result.ErrorDescription:="$params n'a pas l'attribut 'UserID'"
		: (Not(OB Is defined($params.UserID; "ID")))
			This.result.ErrorDescription:="$params.UserID n'a pas l'attribut 'ID'"
		Else 
			// c'est ok
			// vérifier que l'utilisateur est connu
			
			$UserID:=$params.UserID.ID
			$ID:=-1
			Begin SQL
				SELECT ID FROM UtilisateursALV WHERE ID = :$UserID INTO :$ID;
			End SQL
			
			This.result.Error:=-15068*Num($ID<0)
			
			cs.$trace.me.EnvoyerMessages([msgk_event; msgk_log]; "WARNING Accès BDD par SQL"; Current method name; This.result.ErrorDescription+". ")
	End case 
	This.result.success:=(This.result.Error=0)
	
	Case of 
		: (Not(This.result.success))
			// on ne va pas plus loin
			// ici il faut exécuter l'une des functions de this
		: (Not(OB Is defined($params; "functionJALV")))
			This.result:=New object("Error"; -15007; "ErrorDescription"; "la function de $params ("+String($params.functionJALV)+") n'est pas reconnue")
			
		: (Not(OB Is defined(This; $params.functionJALV)))
			This.result:=New object("Error"; -15007; "ErrorDescription"; "la function de $params ("+String($params.functionJALV)+") n'est pas reconnue")
			
		: ($params.functionJALV="@Journal@")
			This[$params.functionJALV]($params)
			This.result.Error:=0
			
		Else 
			// action ORDA
			$aQui:=Null
			
			// il faut une entité ORDA
			This.result.Error:=-15068
			Case of 
				: (Not(OB Is defined($params; "aQui")))
					This.result.ErrorDescription:="$params n'a pas l'attribut 'aQui'"
				: ($params.aQui=Null)
					This.result.ErrorDescription:="$params.aQui est null"
				: (Not(OB Is defined($params.aQui; "DataClassNom")))
					This.result.ErrorDescription:="$params.aQui n'a pas l'attribut 'DataClassNom'"
				: (Not(OB Is defined($params.aQui; "IDunique")))
					This.result.ErrorDescription:="$params.aQui n'a pas l'attribut 'IDunique'"
				Else 
					
					// c'est ok
					$selection:=ds[$params.aQui.DataClassNom].query("IDunique = :1"; $params.aQui.IDunique)
					Case of 
						: ($selection.length=0)
							This.result.ErrorDescription:="$params.aQui n'est pas une entité ORDA de la BBD"
						: ($selection.length>1)
							This.result.ErrorDescription:="$params.aQui n'est pas une entité ORDA unique de la BBD"
							
						Else 
							// c'est ok
							This.result.Error:=0
							$aQui:=$selection[0]
					End case 
			End case 
			This.result.success:=(This.result.Error=0)
			
			// ici on a une entité
			// 2 possibilités
			Case of 
				: (Not(This.result.success))
					
				: ($aQui=Null)
					// ajouter un ex-nihilo
					
					$data:=Null
					If (OB Is defined($params; "Data"))
						$data:=$params.Data
					End if 
					$data.UserID:=$params.UserID
					This.result:=ds.Ajouter($params.Quoi; Null; Null; $data)
					
					// passer une entité réduite
					If (This.result.success)
						This.result.entitéAjoutée:=This.EntitéRéduite(This.result.entitéAjoutée)
						This.result.entitéRetour:=This.EntitéRéduite(This.result.entitéRetour)
					End if 
					
				Else 
					// cas général, exécuter la function locale demandée
					This[$params.functionJALV]($params; $aQui)
					// This.result peut avoir été modifié
			End case 
	End case 
	
	// nettoyer
	This.result.ErrorDescription:=This.result.ErrorDescription*Num(This.result.Error#0)
	This.result.success:=(This.result.Error=0)
	cs.$trace.me.Créer(This.result.Error; Current method name; This.result.ErrorDescription).LeverException([msgk_event; msgk_log])
	
	// envoyer le résultat
	$params.result:=OB Copy(This.result)
	CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "reqRetour"; Current method name; JSON Stringify(This.result); New object("nomProcess"; Current process name; "numProcess"; Current process))
	
	
	// ----------------------
	//MARK:Modification Externe
	// -----------------------
	
Function ModifierBDD($params : Object; $aQui : Object)
	// $params doit contenir : SaisieData
	var $modification : Object
	
	This.result.Error:=-15068
	
	Case of 
		: (Not(OB Is defined($params; "SaisieData")))
			This.result.ErrorDescription:="$params n'a pas l'attribut 'SaisieData'"
		Else 
			// c'est ok : simuler une saisie
			// l'attribut à modifier est lu dans .SaisieData (voir plus bas la structure requise)
			$modification:=$params.SaisieData
			Case of 
				: (Not(OB Is defined($modification; "attribut")))
				: (Not(OB Is defined($modification; "valeurAttribut")))
				: (Not(OB Is defined($modification; "typeValeur")))
				Else 
					// typer la donnée saisie
					Case of 
						: ($aQui[$modification.attribut]=Null)
							// peut arriver (serveur Web en particulier)
							
						: ($modification.typeValeur=Is text)
							$aQui[$modification.attribut]:=$modification.valeurAttribut
							
							// attention : ici typeValeur 'est un numerique' veut dire 'est un entier' !
						: (($modification.typeValeur=Is real) | ($modification.typeValeur=Is longint))
							$aQui[$modification.attribut]:=Num($modification.valeurAttribut)
							
						: ($modification.typeValeur=Is time)
							$aQui[$modification.attribut]:=Time($modification.valeurAttribut)
							
						: ($modification.typeValeur=Is picture)
							BEEP
							TRACE
						Else 
							// modification non reconnue
					End case 
			End case 
			// modifier la DS (vu les tests, il peut ne pas y avoir de modification)
			This.result:=ds.Modifier(cdk Modifier; $aQui; $params)
	End case 
	
	
Function LierDansBDD($params : Object; $aQui : Object)
	// paramètres des liens
	
	This.result.Error:=-15068
	
	Case of 
		: (Not(OB Is defined($params; "params")))
			This.result.ErrorDescription:="$params n'a pas l'attribut 'params'"
		: (Not(OB Is defined($params.params; "attribut")))
			This.result.ErrorDescription:="$params.params n'a pas l'attribut 'attribut'"
		: (Not(OB Is defined($params.params; "valeur")))
			This.result.ErrorDescription:="$params.params n'a pas l'attribut 'valeur'"
		Else 
			This.result:=ds.Modifier(cdk Lier; $aQui; $params)
	End case 
	
	
Function AjouterBDD($params : Object; $aQui : Object)
	// paramètres des ajouts : Quoi, Qui, (aQui = entité)
	var $qui; $selection; $data : Object
	
	This.result.Error:=-15068
	
	Case of 
		: (Not(OB Is defined($params; "quoi")))
			This.result.ErrorDescription:="$params.quoi n'est pas défini"
		: (Not(OB Is defined($params; "Data")))
			This.result.ErrorDescription:="$params.Data n'est pas défini"
		Else 
			// fixer Qui
			This.result.Error:=0
			$qui:=Null
			Case of 
				: (Not(OB Is defined($params; "Qui")))
				: ($params.Qui=Null)
				: (Not(OB Is defined($params.Qui; "DataClassNom")))
					This.result.Error:=-15068
					This.result.ErrorDescription:="$params.Qui.DataClassNom n'est pas défini"
				: (Not(OB Is defined($params.Qui; "IDunique")))
					This.result.Error:=-15068
					This.result.ErrorDescription:="$params.Qui.IDunique n'est pas défini"
				Else 
					// il faut une entité Qui ORDA
					$selection:=ds[$params.Qui.DataClassNom].query("IDunique = :1"; $params.Qui.IDunique)
					Case of 
						: ($selection.length=0)
							// peut être normal
							
						: ($selection.length>1)
							This.result.Error:=-15005
							This.result.ErrorDescription:="$params.Qui n'est pas une entité ORDA unique de la BBD"
							
						Else 
							// c'est ok
							$qui:=$selection[0]
					End case 
			End case 
			
			If (This.result.Error=0)
				// on peut avoir une entité dans les paramètres
				Case of 
					: (Not(OB Is defined($params.Data; "deQui")))
					: ($params.Data.deQui=Null)
					: (Not(OB Is defined($params.Data.deQui; "DataClassNom")))
						This.result.Error:=-15068
						This.result.ErrorDescription:="$params.Data.deQui.DataClassNom n'est pas défini"
					: (Not(OB Is defined($params.Data.deQui; "IDunique")))
						This.result.Error:=-15068
						This.result.ErrorDescription:="$params.Data.deQui.IDunique n'est pas défini"
					Else 
						
						$selection:=ds[$params.Data.deQui.DataClassNom].query("IDunique = :1"; $params.Data.deQui.IDunique)
						Case of 
							: ($selection.length=0)
								// peut être normal
								
							: ($selection.length>1)
								This.result.Error:=-15005
								This.result.ErrorDescription:="$params.deQui n'est pas une entité ORDA unique de la BBD"
								
							Else 
								// c'est ok
								$params.Data.deQui:=$selection[0]
						End case 
				End case 
				
				// on y va
				$data:=$params.Data
				$data.UserID:=$params.UserID
				$data.PartageALV:=$params.PartageALV
				This.result:=ds.Ajouter($params.quoi; $aQui; $qui; $data)
				
				// passer en entité réduite
				If (This.result.success)
					If (This.result.entitéAjoutée=Null)
						// on a ajouté une entité existante
						This.result.entitéAjoutée:=Null
						This.result.entitéRetour:=$qui
						
					Else 
						// on a ajouté une nouvelle entité
						This.result.entitéAjoutée:=This.EntitéRéduite(This.result.entitéAjoutée)
						This.result.entitéRetour:=This.EntitéRéduite(This.result.entitéRetour)
					End if 
				End if 
			End if 
	End case 
	
	
	// ----------------------
	//MARK:Journalisation
	// -----------------------
	
Function OuvrirJournal($params : Object)
	This.result.Error:=0
	
	$params.actionID:=cdk Ouvrir Journal
	$params.Description_Action:="Ouverture du Journal"
	cs.$journalALV.me.Ecrire($params; Null; Null)
	
	
Function FermerJournal($params : Object)
	This.result.Error:=0
	
	$params.actionID:=cdk Fermer Journal
	$params.Description_Action:="Fermeture du Journal"
	cs.$journalALV.me.Ecrire($params; Null; Null)

⇧ [class]$dialogue_3105 - 18/04/2026 18:16:35

      property liste : Collection
property joursRepublicains; moisRepublicains; anneesRepublicaines; joursGregoriens; moisGregoriens; anneesGregoriennes : Object
property zoneCalculCalendriers : Text
property documentation : Integer

Class extends $formulaire

Class constructor()
	
	Super()
	
	
	This.joursRepublicains:=Null
	This.moisRepublicains:=Null
	This.anneesRepublicaines:=Null
	This.joursGregoriens:=Null
	This.moisGregoriens:=Null
	This.anneesGregoriennes:=Null
	
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	// convertit une date d'un calendrier en une date d'un autre
	
Function _FORM()
	
	Case of 
		: (FORM Event.code=On Load)
			
			// charger les objets
			This.onEndLoad()
			
	End case 
	
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	// attention à l'ordre
	$c:=New collection("moisRepublicains"; "anneesRepublicaines"; "anneesGregoriennes"; "joursGregoriens"; "moisGregoriens"; "zoneCalculCalendriers"; "modifierBDD")
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:FORMevents
	// ----------------------
	
Function _FORM_joursRepublicains()
	If (FORM Event.code=On Clicked)
		This.CalculerDateGrégorienne()
	End if 
	
	
Function _FORM_moisRepublicains()
	
	If (FORM Event.code=On Load)
		This._InitialiserListe(This.nomOBJ; "Cal_RépublicainMois")
	End if 
	
	If ((FORM Event.code=On Load) | (FORM Event.code=On Clicked))
		This.SélectionnerJoursRépublicain()
	End if 
	
	If (FORM Event.code=On Clicked)
		This.CalculerDateGrégorienne()
	End if 
	
	
Function _FORM_anneesRepublicaines()
	
	If (FORM Event.code=On Load)
		This._InitialiserListe(This.nomOBJ; "Cal_RépublicainAnnées")
	End if 
	
	If ((FORM Event.code=On Load) | (FORM Event.code=On Clicked))
		If (This.moisRepublicains.currentValue=13)
			// 13ième mois = jours complémentaires
			This._InitialiserListe("joursRepublicains"; "Cal_RépublicainCompléments")
			
			If (Mod(Form[This.nomOBJ]+1; 4)#0)  // année non bissextile
				//DELETE FROM LIST(btnSaisie1; 6)??
			End if 
		End if 
	End if 
	
	If (FORM Event.code=On Clicked)
		This.CalculerDateGrégorienne()
	End if 
	
	
Function _FORM_joursGregoriens()
	Case of 
		: (FORM Event.code=On Load)
			This.SélectionnerJoursGrégorien(0)
			
		: (FORM Event.code=On Data Change)
			This.CalculerDateRépublicaine()
	End case 
	
	
Function _FORM_moisGregoriens()
	
	Case of 
		: (FORM Event.code=On Load)
			This.SélectionnerMoisGrégorien(0)
			
		: (FORM Event.code=On Data Change)
			This.SélectionnerJoursGrégorien()
			This.CalculerDateRépublicaine()
	End case 
	
	
Function _FORM_anneesGregoriennes()
	var $c : Collection
	var $i : Integer
	
	Case of 
		: (FORM Event.code=On Load)
			
			$c:=New collection
			$c.push(New object("type"; "Année"; "référence"; 0))
			For ($i; 1792; 1806)
				$c.push(New object("type"; $i; "référence"; $i))
			End for 
			
			Form[This.nomOBJ]:=New object
			Form[This.nomOBJ].codes:=$c.extract("référence")
			Form[This.nomOBJ].values:=$c.extract("type")
			Form[This.nomOBJ].index:=0
			Form[This.nomOBJ].currentValue:=Form[This.nomOBJ].codes[0]
			
		: (FORM Event.code=On Data Change)
			This.SélectionnerMoisGrégorien()
			This.SélectionnerJoursGrégorien()
			
			This.CalculerDateRépublicaine()
	End case 
	
	
Function _FORM_zoneCalculCalendriers()
	var $fichier : Text
	
	Case of 
		: (FORM Event.code=On Load)
			$fichier:=Folder(fk resources folder).folder("javascripts/CalculCalendriers").file("index.html").platformPath
			WA OPEN URL(*; This.nomOBJ; $fichier)
			WA SET PREFERENCE(*; This.nomOBJ; WA enable Web inspector; This.session.prefs.Session_Etat ?? 6)  // autoriser l'inspecteur Web
	End case 
	
	
Function _FORM_documentation()
	Case of 
		: (FORM Event.code=On Clicked)
			OPEN URL("https://www.fourmilab.ch/documents/calendar/")
	End case 
	
	
	// ----------------------
	//MARK:Saisie
	// ----------------------
	
Function SélectionnerJoursRépublicain($itemRef : Integer)
	var $nomOBJ : Text:="joursRepublicains"
	
	If (Count parameters=0)
		// mémoriser sélection courante
		$itemRef:=This.joursRepublicains.codes[This.joursRepublicains.index]
	End if 
	
	// ici moisRepublicains.index = moisRepublicains.currentCode
	If (This.moisRepublicains.index=13)
		// 13ième mois = jours complémentaires
		This._InitialiserListe($nomOBJ; "Cal_RépublicainCompléments")
		
		If (Mod(This.moisRepublicains.index+1; 4)#0)  // pb????
			// année non bissextile
			//DELETE FROM LIST(btnSaisie1; 6) ????
		End if 
		
	Else 
		This._InitialiserListe($nomOBJ; "Cal_républicainJours")
	End if 
	This.SélectionnerCurrentValue($nomOBJ; $itemRef)
	
	
Function SélectionnerJoursGrégorien($itemRef : Integer)
	var $nomOBJ : Text:="joursGregoriens"
	var $c : Collection
	var $i; $nbrJours : Integer
	
	If (This.anneesGregoriennes#Null)
		// liste années initialisée
		If (Count parameters=0)
			// mémoriser sélection courante
			$itemRef:=This.joursGregoriens.currentValue
		End if 
		
		// lire le nombre de jours du mois
		This._InitialiserListe("GrégorienJours"; "Cal_GrégorienJours")
		$nbrJours:=This.moisGregoriens.codes[This.moisGregoriens.index]  // ID mois
		$nbrJours:=This["GrégorienJours"].values[This["GrégorienJours"].codes.indexOf($nbrJours)]
		
		// initiliaiser la liste des jours
		$c:=New collection
		$c.push(New object("type"; "Jour"; "référence"; 0))
		For ($i; 1; Num($nbrJours))
			$c.push(New object("type"; String($i); "référence"; $i))
		End for 
		Form[$nomOBJ]:=New object
		Form[$nomOBJ].codes:=$c.extract("référence")
		Form[$nomOBJ].values:=$c.extract("type")
		
		// test des années bissextiles
		$i:=This.anneesGregoriennes.currentValue  // année
		If ((This.moisGregoriens.currentValue=2) & ($i>0))  // mois de février et année valide
			
			If ((($i%4)>0) | ((($i%100)=0) & (($i%400)>0)))
				// pas bisssextile
				$c:=$c.remove($c.length-1)
			End if 
		End if 
		
		Form[$nomOBJ].index:=Form[$nomOBJ].codes.indexOf($itemRef)
	End if 
	
	
Function SélectionnerMoisGrégorien($itemRef : Integer)
	var $c : Collection
	var $anneesGregoriennesRef; $i; $nbrDébut; $nbrFin : Integer
	var $nom; $nomOBJ : Text
	
	If (Count parameters=0)
		// mémoriser sélection courante
		$itemRef:=This.moisGregoriens.currentValue
	End if 
	
	// initialiser la liste des mois
	$c:=New collection
	$c.push(New object("type"; "Mois"; "référence"; 0))
	
	If (This.anneesGregoriennes#Null)
		$anneesGregoriennesRef:=This.anneesGregoriennes.codes[This.anneesGregoriennes.index]
		Case of 
			: ($anneesGregoriennesRef=0)  // liste vide
				$nbrDébut:=1
				$nbrFin:=0
				
			: ($anneesGregoriennesRef=1792)
				$nbrDébut:=9
				$nbrFin:=12
				
			: ($anneesGregoriennesRef=1806)
				$nbrDébut:=1
				$nbrFin:=12
				
			Else 
				$nbrDébut:=1
				$nbrFin:=12
		End case 
		
		For ($i; $nbrDébut; $nbrFin)
			$nom:=String(Add to date(!1999-12-01!; 0; $i; 0); Internal date long)
			$nom:=Substring($nom; Position(" "; $nom; *)+1)
			$nom:=Substring($nom; 1; Position(" "; $nom; *)-1)  // nom du mois $i dans la langue courante
			
			$c.push(New object("type"; $nom; "référence"; $i))
		End for 
		
		$nomOBJ:="moisGregoriens"
		Form[$nomOBJ]:=New object
		Form[$nomOBJ].codes:=$c.extract("référence")
		Form[$nomOBJ].values:=$c.extract("type")
		Form[$nomOBJ].index:=Form[$nomOBJ].codes.indexOf($itemRef)
	End if 
	
	
Function _FORM_modifierBDD()
	var $texte : Text
	
	Case of 
		: (FORM Event.code=On Load)
			OBJECT SET VISIBLE(*; This.nomOBJ; (Current default table=->[Events]))
			
		: (FORM Event.code=On Clicked)
			If (This.joursGregoriens.index>0)
				$texte:=This.joursGregoriens.currentValue
				
				If (This.moisGregoriens.index>0)
					$texte+=" "+This.moisGregoriens.currentValue
					
					If (This.anneesGregoriennes.index>0)
						$texte+=" "+String(This.anneesGregoriennes.currentValue)
						
						ACCEPT
						Form.entité.dateChaine:=$texte
						cs._ds.me.Modifier(cdk Modifier; New collection(Form.entité); Null)
					End if 
				End if 
			End if 
	End case 
	
	// ----------------------
	//MARK:Calculs
	// ----------------------
	
Function CalculerDateGrégorienne()
	var $jour; $décade; $mois; $an : Integer
	
	$an:=This.anneesRepublicaines.codes[This.anneesRepublicaines.index]
	$mois:=This.moisRepublicains.codes[This.moisRepublicains.index]
	$jour:=This.joursRepublicains.codes[This.joursRepublicains.index]
	
	If ($mois<13)  // pas les sans culottides
		$jour:=$jour-1  // 1 à 30 -> 0 à 29
		$décade:=($jour\10)+1
		$jour:=($jour%10)+1
	End if 
	
	If (($jour>0) & ($mois>0) & ($an>0))
		WA EXECUTE JAVASCRIPT FUNCTION(*; "zoneCalculCalendriers"; "calculer_date_gregorienne"; *; $an; $mois; $décade; $jour)
		WA EXECUTE JAVASCRIPT FUNCTION(*; "zoneCalculCalendriers"; "Lire_an_date_gregorienne"; $an)
		WA EXECUTE JAVASCRIPT FUNCTION(*; "zoneCalculCalendriers"; "Lire_mois_date_gregorienne"; $mois)
		WA EXECUTE JAVASCRIPT FUNCTION(*; "zoneCalculCalendriers"; "Lire_jour_date_gregorienne"; $jour)
		
		This.SélectionnerCurrentValue("anneesGregoriennes"; $an)
		This.SélectionnerMoisGrégorien($mois)
		This.SélectionnerJoursGrégorien($jour)
	End if 
	//This.Conversion:=String(Add to date(!00-00-00!; $an; $mois; $jour); System date long)
	
	
Function CalculerDateRépublicaine()
	var $jour; $mois; $an; $décade : Integer
	
	$an:=This.anneesGregoriennes.codes[This.anneesGregoriennes.index]
	$mois:=This.moisGregoriens.codes[This.moisGregoriens.index]
	$jour:=This.joursGregoriens.codes[This.joursGregoriens.index]
	
	If (($jour>0) & ($mois>0) & ($an>0))
		WA EXECUTE JAVASCRIPT FUNCTION(*; "ZoneCalculCalendriers"; "calculer_date_republicaine"; *; $an; $mois; $jour)
		// afficher la date
		WA EXECUTE JAVASCRIPT FUNCTION(*; "ZoneCalculCalendriers"; "Lire_an_date_republicaine"; $an)
		WA EXECUTE JAVASCRIPT FUNCTION(*; "ZoneCalculCalendriers"; "Lire_mois_date_republicaine"; $mois)
		WA EXECUTE JAVASCRIPT FUNCTION(*; "ZoneCalculCalendriers"; "Lire_jour_date_republicaine"; $jour)
		WA EXECUTE JAVASCRIPT FUNCTION(*; "ZoneCalculCalendriers"; "Lire_decade_date_republicaine"; $décade)
		
		This.SélectionnerCurrentValue("anneesRepublicaines"; $an)
		This.SélectionnerCurrentValue("moisRepublicains"; $mois)
		This.SélectionnerJoursRépublicain($jour+(($décade-1)*10))
	End if 
	
	
	// ----------------------
	//MARK:Utilitaires
	// ----------------------
	
Function _InitialiserListe($nomOBJ : Text; $nomListe : Text)
	var $dataTexte : Text
	var $c : Collection
	
	$dataTexte:=Folder(fk resources folder).folder("Enumerations").file($nomListe+".json").getText()
	$c:=JSON Parse($dataTexte)
	
	Form[$nomOBJ]:=New object
	Form[$nomOBJ].codes:=$c.extract("référence")
	Form[$nomOBJ].values:=$c.extract("type")
	
	Form[$nomOBJ].index:=0
	Form[$nomOBJ].currentValue:=Form[$nomOBJ].codes[0]
	
	
Function SélectionnerCurrentValue($nomOBJ : Text; $itemRef : Integer)
	Form[$nomOBJ].index:=Form[$nomOBJ].codes.indexOf($itemRef)
	Form[$nomOBJ].currentValue:=Form[$nomOBJ].values[Form[$nomOBJ].index]

⇧ [class]$session - 23/07/2026 17:23:29

      // les données .user et .prefs de cette classe sont utilisées en local
// les opérations sur le serveur utilisent les mêmes données dans Session.store.user et .prefs
// pour modifier les données les functions doivent être shared ; si la propriété n'est pas scalaire, la modification doit être encadrée par un use()
Class extends $userPreferences

property userName : Text:=""
property user : Object

shared singleton Class constructor()
	
	Super()
	
	This.user:=New shared object()
	
	
	
	// ----------------------
	// MARK:Activation
	// -----------------------
	
shared Function ActiverApplication()->$result : Boolean
	// on arrive ici au démarrage d'une application client APP (connexion au serveur) ou BDD mère
	var $selection : cs.UtilisateursALVSelection
	var $data : Object
	var $trace : cs.$trace
	ALERT("toto 1"+Current process name+". "+Current method name)
	
	$trace:=cs.$trace.me.Initialiser(Current method name)
	
	Case of 
		: (Storage.System.typeApplication=ALV Client APP)
			// connexion par client APP
			$data:=New object
			Case of 
				: (This._estLicenceClientValide($data))
					// on a un une licence valide, $data contient le user
					
				: (Not(This.getLogInConnexion($data)))
					// pb de saisi
					$trace.Error:=-15014
					$trace.ErrorDescription:="Saisie incorrecte des LogIn / mot de passe"
					
				: (This._CréerLicenceClient($data))
					// première connexion ; la licence a été créée
					// $data.params est fixé
					
				Else 
					$trace.Error:=-15014
					$trace.ErrorDescription:="Licence clientAPP invalide"
			End case 
			
			// en final, $data.params contient ID, LogIn, Password, droits, privileges, role, IDfamille
			If ($trace.Error=0)
				This.userName:=$data.params.LogIn
				
				If (Current user#"Visiteur")
					// l'utilisateur ALV est identifié
					// l'inscrire : tous les process suivants de la session seront à ce nom
					REGISTER CLIENT(This.userName)
				End if 
			End if 
			
			
		: (Storage.System.typeApplication=ALV BDD mère)
			// connexion à la BDD mère
			
			If (This.userName="")
				// utiliser le visiteur
				$selection:=ds.UtilisateursALV.query("ID=:1"; 1018)
				This.userName:=$selection[0].LogIn
			End if 
			
			
		: (Storage.System.typeApplication=ALV Client APP maintenance)
			
			$data:=New object
			// on est toujours appelé par un ALV client, pas besoin de tester
			Case of 
				: (Not(This.getLogInConnexion($data)))
					// pb user
					$trace.Error:=-15014
					$trace.ErrorDescription:="Licence clientAPP invalide"
					
				: (Not(ds.UtilisateursALV.query("LogIn = :1"; $data.LogIn)[0].estDansGroupeAPP("Developpement")))
					// on veut un développeur
					$trace.Error:=-15014
					$trace.ErrorDescription:="L'utilisateur n'appartient pas au groupe 'Developpement'"
					
				Else 
					// ok, on a les données du process
			End case 
			
			
		: (Storage.System.typeApplication=4D Remote mode)
			// debug du client avec un 4D distant
			
			$data:=ds.UtilisateursALV.get(1001)
			This.userName:=$data.LogIn
			ALERT("toto 2"+Current process name+". "+Current method name+This.userName)
			
		Else 
			// autres cas ??? (serveur Web), ne rien faire ici
	End case 
	// ici, this.useName est toujours renseigné
	TRACE
	
	If ($trace.Error=0)
		// renseigner .user dans Session
		$data:=New object("userName"; This.userName)
		cs.$serveurAPP.me.Executer(OB Class(This).name; "FixerSessionUser"; $data)
		
		If ($data.reqRetour.success)
			// renseigner la session locale
			Use (This.user)
				This.user:=OB Copy($data.reqRetour.user; ck shared; This.user)
			End use 
			
		Else 
			$trace.Error:=-15014
			$trace.ErrorDescription:="Les données 'user' de la Session ne sont pas renseignées"
		End if 
	End if 
	
	// renseigner l'utilisateur générique courant (role)
	This._FixerUtilisateur4Dcourant()
	
	// compléter .user
	This.FixerAdhesionsCurrentUser()
	
	$trace.FixerSuccess()
	$result:=$trace.success
	$trace.LeverException([msgk_event; msgk_log])
	
	
Function _estLicenceClientValide($data : Object)->$result : Boolean
	// lire les infos de la licence utilisateur et chercher un user dans la BDD
	var $fichier : 4D.File
	var $erreur : cs.$trace
	var $dataTexte; $LogIn; $Password : Text
	var $selection : cs.UtilisateursALVSelection
	
	$erreur:=cs.$trace.me.Initialiser(Current method name)
	
	$fichier:=Folder(Application file+":"; fk platform path).folder("Contents/DataBase").file("EnginedServer.4Dlink")
	
	$dataTexte:=""
	Case of 
		: (Not($fichier.exists))
			$erreur.Error:=-15044
			$erreur.ErrorDescription:="le fichier "+$fichier.platformPath+" n'existe pas"
			
		: (Not(cs.xSDK.XML.me.LireFichier($fichier; ->$dataTexte).success))
			$erreur.Error:=-15012
			$erreur.ErrorDescription:="Erreur de lecture du fichier '"+$fichier.platformPath+"'"
			
		: (Not(cs.xSDK.XML.me.LireLeChemin(->$dataTexte; "user_name"; ->$LogIn).success))
			$erreur.Error:=-15012
			$erreur.ErrorDescription:="Erreur de lecture du logIn, 'user_name' (peut être normal si le client a été mis à jour)"
			
		: (Not(cs.xSDK.XML.me.LireLeChemin(->$dataTexte; "bcrypt_password"; ->$Password).success))
			$erreur.Error:=-15012
			$erreur.ErrorDescription:="Erreur de lecture du mot de passe, 'bcrypt_password'"
			
		Else 
			// ok, on a des infos
			$selection:=ds.UtilisateursALV.query("LogIn=:1"; $LogIn)
			
			$erreur.Error:=-15012
			Case of 
				: ($selection.length=0)
					$erreur.ErrorDescription:="Le login saisi "+$LogIn+" ne correspond à aucun utilisateur ALV"
					
				: (Not(Verify password hash($selection[0].Password; $Password)))
					// remarque : le passeWord est stocké codé dans la licence
					$erreur.ErrorDescription:="L'utilisateur "+$LogIn+" a saisi un mot de passe erroné"
					
				Else 
					$erreur.Error:=0
					
					// lire les infos de license
					$data.params:=$selection[0].toObject(["ID"; "LogIn"; "Password"; "droits"; "privileges"; "role"])
					$data.params.IDfamille:=$selection[0].leGroupe.IDfamille
			End case 
	End case 
	
	$erreur.FixerSuccess()
	$result:=$erreur.success
	$erreur.LeverException([msgk_event; msgk_log])
	
	
Function _CréerLicenceClient($data : Object)->$result : Boolean
	// compléter le fichier .4Dlink par les infos de $params
	var $erreur : cs.$trace
	var $fichier : 4D.File
	var $selection : cs.UtilisateursALVSelection
	var $dataTexte; $LogIn; $Password : Text
	
	$erreur:=cs.$trace.me.Initialiser()
	
	$fichier:=Folder(Application file+":"; fk platform path).folder("Contents/DataBase").file("EnginedServer.4Dlink")
	
	$Login:=$data.LogIn
	$Password:=Generate password hash($data.Password; New object("algorithm"; "bcrypt"; "cost"; 4))
	
	$dataTexte:=""
	Case of 
		: (Not($fichier.exists))
			$erreur.Error:=-15044
			$erreur.ErrorDescription:="le fichier "+$fichier.platformPath+" n'existe pas"
			
		: (Not(cs.xSDK.XML.me.LireFichier($fichier; ->$dataTexte).success))
			$erreur.Error:=-15012
			$erreur.ErrorDescription:="Erreur de lecture du fichier '"+$fichier.platformPath+"'"
			
		: (Not(cs.xSDK.XML.me.EcrireLeChemin(->$dataTexte; "user_name"; ->$LogIn).success))
			$erreur.Error:=-15012
			$erreur.ErrorDescription:="Erreur d'écriture du logIn, 'user_name'"
			
		: (Not(cs.xSDK.XML.me.EcrireLeChemin(->$dataTexte; "bcrypt_password"; ->$Password).success))
			$erreur.Error:=-15012
			$erreur.ErrorDescription:="Erreur d'écriture du mot de passe, 'bcrypt_password'"
	End case 
	
	If ($erreur.Error=0)
		// ok on crée la licence
		TEXT TO DOCUMENT($fichier.platformPath; $dataTexte)
		// ok, renvoyer les infos BDD
		$selection:=ds.UtilisateursALV.query("LogIn=:1"; $LogIn)
		//
		$data.params:=$selection[0].toObject(["ID"; "LogIn"; "Password"; "droits"; "privileges"; "role"])
		$data.params.IDfamille:=$selection[0].leGroupe.IDfamille
	End if 
	
	$erreur.FixerSuccess()
	$result:=$erreur.success
	$erreur.LeverException([msgk_event; msgk_log])
	
	
Function _FixerUtilisateur4Dcourant()
	var $selection : cs.UtilisateursALVSelection
	var $contexte : Text
	
	// les données session sont dans .user
	Case of 
		: (Storage.System.typeApplication=ALV BDD mère)
			// BDD mère
			Case of 
				: (This.user.role=Null)
				: (This.user.role="")
					// zarbi
					SET USER ALIAS(ds.UtilisateursALV.query("LogIn = :1"; "Visiteur")[0].role)
					Form.AfficherMessageUtilisateur(New object("ID"; 5185))
					
				Else 
					SET USER ALIAS(This.user.role)
			End case 
			$contexte:="BDD mère"
			
			
		: (Storage.System.typeApplication=ALV Client APP)
			// application client APP
			
			// utilisateur non reconnu
			SET USER ALIAS("Visiteur")
			Case of 
				: (This.user.role=Null)
				: (This.user.role="")
					// il faut un role
					Form.AfficherMessageUtilisateur(New object("ID"; 5185))
					
				: (This.user.IDfamille=Null)
					// utilisateur non rattaché à un groupe
					Form.AfficherMessageUtilisateur(New object("ID"; 5185))
					
				Else 
					// Alias user = role
					SET USER ALIAS(This.user.role)
			End case 
			$contexte:="Activation de APP"  // ne pas mettre d'apostrophe
			
			
		: (Storage.System.typeApplication=ALV Serveur HTTP)
			// application serveur Web
			$selection:=ds.UtilisateursALV.query("LogIn=:1"; This.user.LogIn)
			
			// il faut un user
			$contexte:="Ouverture d'une session Web"
			Case of 
				: (Current process name#"Process Web@")
					// un utilisateur 4D, fixé à l'ouverture de la base
					// rappel : il n'y a que 4 possibilités
					SET USER ALIAS(This.user.LogIn)
					$contexte:="Ouverture Serveur Web"
					
				: ($selection.length=0)
					// un utilisateur web non identifié
					SET USER ALIAS("Visiteur-Web")
					
				Else 
					// ici, l'utilisateur s'est identifié : peut éditer les données
					SET USER ALIAS("Utilisateur Web")
					// changer d'utilisateur dans une session web ne semble pas possible
			End case 
			
			
		: ((Storage.System.typeApplication=ALV Client APP maintenance) | (Storage.System.typeApplication=4D Remote mode))
			// pour debug
			// (cs.xSDK.Outils.me.ContientJoker(This.userName))
			// Pour des raisons de sécurité, refuser les noms qui contiennent @
			
			SET USER ALIAS(This.user.LogIn)
			
	End case 
	
	cs.$trace.me.EnvoyerMessages([msgk_event; msgk_log]; $contexte; Current method name; "Avec l'alias <"+Current user+">")
	
	
Function FixerSessionUser($data : Object)
	// ici on est toujours dans BDDmère ou le serveurAPP (où la session existe)
	// on repond à une requete WEB, donc les privilèges s'appliquent. authentifyClient est déclarée dans le fichier roles.json
	ALERT("toto "+Current method name)
	
	If (ds.FixerSessionUser($data))
		// Fixer dans Session
		Use (Session.storage)
			Session.storage.user:=OB Copy($data.user; ck shared; Session.storage.user)
		End use 
	End if 
	
	
	// ----------------------
	// MARK:Autentification
	// -----------------------
	
Function getLogInConnexion($data : Object)->$result : Boolean
	// demander ID et MdP, les faire vérifier par la BDD
	var $erreur : cs.$trace
	var $ID : Integer
	var $params : Object
	
	$erreur:=cs.$trace.me.Initialiser(Current method name)
	
	$erreur.Error:=-15012
	// demander à l'utilisateur son identifiant et MdP (3 essais possibles)
	$ID:=3
	While (($ID>0) & ($erreur.Error#0))
		// demander les infos
		
		$params:=New object("titre"; Localized string("113"); "message"; Localized string("5151")+" "+Localized string("5130"); "numPageForm"; 1; "LogIn"; ""; "Password"; "")
		Case of 
			: (cs.$dialogue_3001.new().Lancer($params))
				// annulation par l'utilisateur
				$ID:=-1  // arrêter les frais
				
			: (($params.LogIn="") | ($params.Password=""))
				// relancer
				
			: (Not(This._testerLogIn($params)))
				// erreur de saisi ; relancer
			Else 
				// ok : on est identifié
				$erreur.Error:=0
				$data.LogIn:=$params.LogIn
				$data.Password:=$params.Password
				
				This.userName:=$params.LogIn
		End case 
		
		// relancer
		$ID:=$ID-1
	End while 
	
	$erreur.FixerSuccess()
	$result:=$erreur.success
	$erreur.LeverException([msgk_event; msgk_log])
	
	
Function _testerLogIn($data : Object)->$result : Boolean
	var $selection : cs.UtilisateursALVSelection
	var $erreur : cs.$trace
	
	$erreur:=cs.$trace.me.Initialiser(Current method name)
	
	$selection:=ds.UtilisateursALV.query("LogIn=:1"; $data.LogIn)
	
	$erreur.Error:=-15012
	Case of 
		: ($selection.length=0)
			$erreur.ErrorDescription:="Le logIn saisi "+$data.LogIn+" ne correspond à aucun utilisateur ALV"
			
		: ($selection[0].Password#$data.Password)
			// remarque : le passeWord est stocké en clair dans la BDD
			$erreur.ErrorDescription:="L'utilisateur "+$data.Password+" a saisi un mot de passe erroné"
			
		Else 
			$erreur.Error:=0
	End case 
	
	$erreur.FixerSuccess()
	$result:=$erreur.success
	$erreur.LeverException([msgk_event; msgk_log])
	
	
	// ----------------------
	// MARK:Menu
	// -----------------------
	
Function NouvelleSession($params : Object)
	// ouvrir une nouvelle session à la place la session courante
	var $data : Object
	var $result : Boolean
	
	// commande disponible quelle que soit la version de l'application (en particulier permet un "debug" d'une application fusionnée)
	$data:=New object("titre"; $params.titre; "message"; Localized string("5151"); "numPageForm"; 5; "LogIn"; ""; "Password"; "")
	$result:=False  // abandon
	
	Case of 
		: (Current process#Process number(Process Principal ALV))
			// l'appel doit s'exécuter dans le process utilisateur principal
			Appeler_Le_Formulaire(Process number(Process Principal ALV); "callFunction"; New object("nomClass"; OB Class(This).name; "functionID"; "NouvelleSession"; "params"; $params))
			
		: (This.Fermer())
			// session courante fermée
			
		: (cs.$dialogue_3001.new().Lancer($data))
			// annulation par l'utilisateur
			
		: (($data.LogIn="") | ($data.Password=""))  // MotDePasseSaisi peut être vide
			// erreur
			
		: (Not(This._testerLogIn($data)))
			// erreur de saisi ; relancer
			
		Else 
			// ok : on change d'utilisateur 4D
			$result:=True
			
			Use (This)
				This.userName:=$data.LogIn
			End use 
			
			This.ActiverApplication()
			
	End case 
	
	If ($result)
		// nouvel utilisateur sélectionné et authentifié
		This.Ouvrir()
		Form.MettreAjourSelection()
	End if 
	
	
Function OuvrirAvecPrefs()
	// nouvelle session avec prefs ré-initilisées
	var $data : Object
	
	Case of 
		: (Current process#Process number(Process Principal ALV))
			// l'appel doit s'exécuter dans le process utilisateur principal
			Appeler_Le_Formulaire(Process number(Process Principal ALV); "callFunction"; New object("nomClass"; OB Class(This).name; "functionID"; "OuvrirAvecPrefs"; "params"; Null))
			
		: (This.Fermer())
			
		Else 
			// créer les nouvelle prefs
			// attention ici this.userPreferences n'existe pas
			$data:=This.InitialiserPrefs()
			
			// ouvrir la session avec les nouvelles prefs
			This.Ouvrir()
			Form.MettreAjourSelection()
	End case 
	
	
Function Quitter()->$result : Boolean
	// seul point d'appel pour fermer l'application
	// s'exécute dans un worker pour libérer le process utilisateur courant
	var $data : Object
	
	$result:=False  // c'est comme ça !!!
	
	$data:=New object
	$data.params:=New object
	$data.execute:=Formula(cs.$session.me["Quitter_process"](This.params))
	
	CALL WORKER("WK_Services"; Formula($data.execute()))
	
	
Function Quitter_process($params : Object)
	// fermer la session
	// attention ici on est dans une tâche worker ; la fermeture doit se faire dans cette tâche (ou un autre worker, solution non retenue)
	This.Fermer_process(Null)
	
	Waiting(60*2)
	QUIT 4D
	// la méthode base va s'exécuter
	
	
	// ----------------------
	// MARK:Gestion
	// -----------------------
	
Function Ouvrir()
	var $dataTexte : Text:=""
	
	cs.$trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Nouvelle session"; Current method name; "Avec l'utilisateur LogIn <"+This.userName+">, ID <"+String(This.user.ID)+">, alias <"+Current user+">, appartenant au groupe familial <"+String(This.user.IDfamille)+">")
	
	// Fixer les préférences du nouvel utilisateur
	This.LirePrefs()
	
	// initialisation du journal des actions
	cs.$journalALV.me.Ecrire(New object("actionID"; cdk Ouvrir Journal; "Description_Action"; "Ouverture du Journal"))
	
	// afficher le bureau de l'utilisateur
	This.ChargerLeBureau()
	
	cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Ressources_Communes/Nom_Application"; Is text; ->$dataTexte)
	$dataTexte:=cs._cfct.me.LireLocatedSTR(123)+$dataTexte
	SET ABOUT($dataTexte; "Afficher aPropos")
	
	// mettre à jour les tâches ALV
	cs.$maintenance.new().Démarrer()
	
	
Function Fermer()->$result : Boolean
	// s'exécute dans un worker pour libérer le process utilisateur courant
	var $signal; $data : Object
	
	$result:=False  // c'est comme ça !!!
	
	$signal:=New signal("FermetureUserSession")
	
	$data:=New object
	$data.params:=$signal
	$data.execute:=Formula(cs.$session.me["Fermer_process"](This.params))
	
	CALL WORKER("WK_Services"; Formula($data.execute()))
	$signal.wait(20)
	
	
Function Fermer_process($signal)
	// fermer la session courante depuis le process principal
	// remarque : ici on est dans un worker mais le singleton de la session est toujours vivant
	
	// Mémoriser le bureau (fenêtres ouvertes)
	cs.$session.me.EnregistrerLeBureau()
	
	// fermer le journal
	cs.$journalALV.me.Ecrire(New object("actionID"; cdk Fermer Journal; "Description_Action"; "Fermeture du Journal"); Null; Null)
	
	// tuer tous les process utilisateur "U_Nav, U_Palettes..."
	cs.$process.new().TuerUserProcesses()
	
	// enregistrer les préférences de l'utilisateur courant
	cs.$session.me.MemoriserPrefs()
	
	// supprimer les fichiers temporaires
	cs.$document.new().GetSessionFolder().delete(Delete with contents)
	
	If ($signal#Null)
		$signal.trigger()
	End if 
	
	
	// ----------------------
	// MARK:Bureau
	// -----------------------
	
Function ChargerLeBureau()
	var $data; $CommandesEditeur : Object
	var $c : Collection
	var $ID : Integer
	// afficher le bureau (fenêtres...)
	
	Case of 
		: (Storage.System.typeApplication=ALV Serveur APP)
		: (Storage.System.typeApplication=ALV Serveur HTTP)
		: (Storage.System.typeApplication=ALV Client APP maintenance)
		: (Not(OB Is defined(This.prefs; "Bureau")))
		Else 
			
			$data:=This.prefs.Bureau
			
			$c:=$data.Fenetres
			Case of 
				: ($data.Fenetres=Null)
				: ($c.length=0)
				Else 
					$CommandesEditeur:=cs.CommandesEditeur.new()
					For each ($ID; $c)
						// tester les différentes possibilités
						Case of 
							: ($CommandesEditeur.ExécuterClicZSedition($ID))
								// un éditeur est ouvert
								
							: ($CommandesEditeur.ExécuterClicZSsystem($ID))
								// une palette (pas d'autres possibilités) est ouverte
						End case 
					End for each 
			End case 
	End case 
	
	
shared Function EnregistrerLeBureau()
	var $data : Object
	var $c : Collection
	
	// lister les fenêtres utilisateur ouvertes
	$c:=ds.Commandes.MemoriserLeBureau()
	
	// écrire
	If (Not(OB Is defined(This.prefs; "Bureau")))
		This.prefs.Bureau:=New shared object
	End if 
	
	If ($c.length=0)
		This.prefs.Bureau.Fenetres:=Null
		
	Else 
		$data:=New object("Fenetres"; $c)
		This.prefs.Bureau:=OB Copy($data; ck shared; This.prefs.Bureau)
	End if 
	
	
	// ----------------------
	// MARK:Propriétés
	// -----------------------
	
Function FixerAdhesionsCurrentUser()
	var $entité : cs.UtilisateursALVEntity
	var $c : Collection
	var $nomGroupe : Text
	
	$entité:=ds.UtilisateursALV.query("LogIn = :1"; Current user).first()
	
	// tous les noms de groupeAPP
	$c:=ds.GroupesAPP.all().nom
	
	Use (This.user)
		For each ($nomGroupe; $c)
			This.user["estMembreDe_"+$nomGroupe]:=$entité.estDansGroupeAPP($nomGroupe)
		End for each 
	End use

⇧ [class]$dialogue_3001 - 06/05/2026 16:21:00

      Class extends $formulaire

Class constructor()
	// construction commune
	
	Super()
	
	
	
	// -----------------------------
	// MARK:Dialogue
	// -----------------------------
	
Function Ouvrir($nomForm : Text; $wndType : Integer; $titreWnd : Text; $class : Object)->$result : Boolean
	// $class est une instance de la classe qui gère le FORM $nomForm
	// renvoie vrai si annulation
	var $wndNum : Integer
	
	// récupérer l'entité courante
	Case of 
		: (Not(OB Is defined(Form)))
		: (Not(OB Is defined(Form; "entité")))
		Else 
			$class.entité:=Form.entité
	End case 
	
	Case of 
		: ($class.grandEcran)
			HIDE MENU BAR
			$wndNum:=Open form window($nomForm; $wndType)
			SET WINDOW RECT(0; 0; Screen width; Screen height; $wndNum)
			
		: ($class.mémoTaille)
			// position et taille de la fenêtre sont mémorisées dans le dossier "Application Support:ALV:4D Window Bounds vxx"
			$wndNum:=Open form window($nomForm; $wndType; Horizontally centered; Vertically centered; *)
			This.rePositionnerFormulaire($wndNum)
			
		Else 
			$wndNum:=Open form window($nomForm; $wndType; Horizontally centered; Vertically centered)
	End case 
	
	SET WINDOW TITLE($titreWnd; $wndNum)
	DIALOG($nomForm; $class)
	CLOSE WINDOW
	CLEAR VARIABLE($wndNum)
	
	$result:=(ok=0)
	
	
Function rePositionnerFormulaire($wndNum : Integer)
	// vérifier que le formulaire est bien dans la fenêtre
	// sinon, re-cadrer la fenêtre dans l'écran
	var $gauche; $haut; $droite; $bas : Integer
	
	GET WINDOW RECT($gauche; $haut; $droite; $bas; $wndNum)
	If ($gauche<0)
		SET WINDOW RECT(10; $haut; $droite-$gauche+10; $bas; $wndNum; *)
	End if 
	If ($droite>Screen width)
		SET WINDOW RECT($gauche-$droite+Screen width-10; $haut; Screen width-10; $bas; $wndNum; *)
	End if 
	If ($haut<20)
		SET WINDOW RECT($gauche; 20; $droite; 20+$bas-$haut; $wndNum; *)
	End if 
	If ($bas>Screen height)
		SET WINDOW RECT($gauche; Screen height-10-($bas-$haut); $droite; Screen height-10; $wndNum; *)
	End if 
	
	
Function Lancer($params : Object)->$result : Boolean
	// afficher la fenêtre de dialogue "U_Dialogue?3001" : $params paramètres de la fenêtre
	// si le formulaire renvoie des données, elles doivent être dans $params.retour
	// renvoie vrai si annuler
	
	$result:=True
	Case of 
		: ($params.titre=Null)
			// il faut un message
		: ($params.message=Null)
			// il faut un numéro de page
		: ($params.numPageForm=Null)
			
		Else 
			// c'est ok
			
			// fixer les paramètres optionnels
			If ($params.typeFenetre=Null)
				OB SET($params; "typeFenetre"; Movable form dialog box)
			End if 
			If ($params.AfficherReport=Null)
				OB SET($params; "AfficherReport"; True)
			End if 
			If ($params.AfficherSaisie=Null)
				OB SET($params; "AfficherSaisie"; True)
			End if 
			If ($params.AfficherID=Null)
				OB SET($params; "AfficherID"; True)
			End if 
			If ($params.texteExemple=Null)
				OB SET($params; "texteExemple"; "")
			End if 
			$params.mémoTaille:=False
			
			$params.LogIn:=""
			$params.Password:=""
			
			This.InitParams($params)
			$result:=This.Ouvrir("U_Dialogue?3001"; $params.typeFenetre+Form has no menu bar; $params.titre; This)
			// éviter de créer des property
			$params.LogIn:=OB Get(This; "LogIn"; Is text)
			$params.Password:=OB Get(This; "Password"; Is text)
			$params.texteSaisi:=OB Get(This; "texteSaisi"; Is text)
	End case 
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	var InformationObjet : Text:=""
	
	This.surEvenementFormulaire()
	
	Case of 
		: (FORM Event.code=On Load)
			// passer par une variable process pour que les liens uri fonctionnent
			InformationObjet:=Form.message
			
			FORM GOTO PAGE(OB Get(Form; "numPageForm"; Is longint))
			// dans l'ordre :
			// btn message "rappeler plus tard"
			OBJECT SET VISIBLE(*; "grpAccept@"; OB Get(Form; "AfficherReport"; Is boolean))
			// message de détresse
			OBJECT SET VISIBLE(*; "grpSaisie@"; OB Get(Form; "AfficherSaisie"; Is boolean))
			// saisie mdP seul
			OBJECT SET VISIBLE(*; "grpSaisieLogIn@"; OB Get(Form; "AfficherID"; Is boolean))
			// texte exemple
			OBJECT SET PLACEHOLDER(*; "texteSaisi"; OB Get(Form; "texteExemple"; Is text))
			
			// charger les objets
			This.onEndLoad()
	End case 
	
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection("Icone")
	$c.combine(["ListeUtilisateurALV"])
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:FORMevents Page Fond
	// ----------------------
	
Function _FORM_Icone()
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=cs._rsc.me.image(16208)
	End case 
	
	
Function _FORM_InformationObjet()
	Case of 
		: (FORM Event.code=On Clicked)
			Liens HyperText("Activer"; ->InformationObjet)
	End case 
	
	
	// ----------------------
	//MARK:FORMevents Page 5
	// ----------------------
	
Function _FORM_ListeUtilisateurALV()
	var $c : Collection
	
	Case of 
		: (FORM Event.code=On Load)
			// sélectionner les utilisateurs candidats
			$c:=New collection
			Case of 
				: (Storage.System.typeApplication=ALV Client APP)
					// APP : les membre du groupe, et tous les utilisateurs ALV, sauf archiviste
					$c:=ds.wwwGroupes.query("IDfamille = :1"; This.session.user.IDfamille).lesMembres.extract("ID")
					
				: (Storage.System.typeApplication=ALV Serveur HTTP)
					// serveur Web : rien de particulier
					
				: (Storage.System.typeApplication=ALV BDD mère)
					// BDDmère : l'archiviste
					$c:=New collection(1013)
				Else 
			End case 
			// ajouter tous les autre utilisateurs ALV
			$c:=$c.push(1018; 1019; 1020)
			
			Form[This.nomOBJ]:=ds.UtilisateursALV.query("ID in :1"; $c).orderBy("LogIn")
			
		: (FORM Event.code=On Selection Change)
			Form.LogIn:=Form.ListeUtilisateurALVelementCourant.LogIn
	End case

⇧ [class]$gedcom - 08/06/2026 11:58:52

      // export de la BDD au format GEDCOM
// pour rester autonome, la classe n'appelle pas les ds.entities
property nomAPP : Text
property fHandler : 4D.FileHandle
property tache : cs.xSDK.Tache
property sources : Collection:=New collection

Class extends $formulaire_3005

Class constructor()
	var $c : Collection:=New collection
	
	Super()
	
	This.rsc.SetObjet(Est Ressource APP; "Ressources_Communes/Nom_Application"; Is text; This; "nomAPP")
	
	$c.push(Folder(fk resources folder; *).folder("Enumerations").file("GEDCOM_Events.json"))
	$c.push(Folder(fk resources folder; *).folder("Enumerations").file("GEDCOM_Mois.json"))
	cs._rsc.me.ImporterFichiersRessources($c)
	
	
	
Function Exporter($params : Object)
	var $fichier : 4D.File
	var $options : Object:=New object
	
	This.tache:=This.registreTaches.Inscrire(New object("nomProcess"; Current process name; "nomTache"; $params.nomTache; "numProcessAppelant"; Current process))
	
	$fichier:=This.document.GetPrivateUserFolder().file(This.nomAPP+".ged")
	$fichier.delete()  // au cas ou
	
	// paramètre du fichier texte
	$options.mode:="append"
	$options.charset:="UTF-8"
	$options.breakModeWrite:="cr"
	This.fHandler:=$fichier.open($options)
	
	This.EcrireEntete()
	This.tache.FixerTime(200)
	
	// exporter les personnes
	This.tache.FixerEtat(Localized string("5195"))
	This.EcrirePersonnes()
	
	// exporter les unions
	This.tache.FixerEtat(Localized string("5196"))
	This.EcrireUnions()
	
	This.EcrireSources()
	
	This.EcrireFinFichier()
	This.tache.FixerTime(10000)
	
	
Function EcrireSources()
	var $data : Object
	
	For each ($data; This.sources)
		This.fHandler.writeLine("0 "+$data.tag+" SOUR")
		This.fHandler.writeLine("1 TITL"+$data.value)
	End for each 
	
	
	// ----------------------
	//MARK:Sélections
	// -----------------------
	
Function EcrireEntete()
	This.fHandler.writeLine("0 HEAD")
	
	// système créateur du fichier
	This.fHandler.writeLine("1 SOUR "+This.nomAPP)
	This.fHandler.writeLine("2 VERS 2.6")
	This.fHandler.writeLine("2 NAME "+This.nomAPP)
	This.fHandler.writeLine("2 CORP Sapay Family")
	This.fHandler.writeLine("3 ADDR 6 , rue Antoine de Lavoisier")
	This.fHandler.writeLine("4 CONT 78180 Montigny le Bretonneux FRANCE")
	
	// format & identification GEDCOM
	This.fHandler.writeLine("1 DATE "+String(Current date; Internal date long))
	This.fHandler.writeLine("1 CHAR MACINTOSH")
	This.fHandler.writeLine("1 PLAC")
	This.fHandler.writeLine("2 FORM Town , Area code , County")
	This.fHandler.writeLine("1 GEDC")
	This.fHandler.writeLine("2 VERS 5.5")
	This.fHandler.writeLine("2 FORM LINEAGE-LINKED")
	
	
Function EcrireFinFichier()
	This.fHandler.writeLine("0 TRLR")
	
	
Function EcrirePersonnes()
	var $selection : cs.PersonnesSelection
	var $entité : cs.PersonnesEntity
	
	$selection:=ds.Personnes.all().orderBy("nom asc, prenom asc")
	For each ($entité; $selection)
		This._EcrirePersonne($entité)
		
		// ajouter les unions
		This.EcrireUnionsDe($entité)
		
		// ajouter les évènements personnels s'ils existent
		This.EcrireEventsPersoDe($entité)
		
		This.tache.FixerTime(200+(5000*$entité.indexOf($selection)/$selection.length))
	End for each 
	
	
Function EcrireUnionsDe($personne : cs.PersonnesEntity)
	var $selection : cs.UnionsSelection
	var $entité : cs.UnionsEntity
	
	$selection:=$personne.LesUnions()
	
	If ($selection.length>0)
		For each ($entité; $selection)
			This.fHandler.writeLine("1 FAMS @"+This.setID(cs.Unions; $entité.ID)+"@")
		End for each 
	End if 
	
	
Function EcrireEventsPersoDe($personne : cs.PersonnesEntity)
	var $selection : cs.EventsSelection
	var $entité : cs.EventsEntity
	
	$selection:=$personne.LesEvenementsPersonnels()
	If ($selection.length>0)
		For each ($entité; $selection)
			This._EcrireEvent($entité)
		End for each 
	End if 
	
	
Function EcrireUnions()
	var $selection : cs.UnionsSelection
	var $entité : cs.UnionsEntity
	
	$selection:=ds.Unions.all()
	For each ($entité; $selection)
		This._EcrireUnion($entité)
		
		This.tache.FixerTime(5000+(5000*$entité.indexOf($selection)/$selection.length))
	End for each 
	
	
	// ----------------------
	//MARK:Entités
	// -----------------------
	
Function _EcrirePersonne($personne : cs.PersonnesEntity)
	This.fHandler.writeLine("0 @"+This.setID(cs.Personnes; $personne.ID)+"@ INDI")
	This.fHandler.writeLine("1 NAME "+$personne.prenom+" "+$personne.autres_prenoms+"/"+$personne.nom+"/")
	This.fHandler.writeLine("1 SEX "+Choose($personne.sexe; "F"; "M"))
	
	This.EcrireChampNonVide("1 OCCU "; $personne.metier)
	This.EcrireChampNonVide("1 NOTE "; $personne.commentaire)
	
	// ajouter le lien de parenté
	If ($personne.parents>0)
		This.fHandler.writeLine("1 FAMC @"+This.setID(cs.Unions; $personne.parents)+"@")
	End if 
	
	
Function _EcrireUnion($union : cs.UnionsEntity)
	var $personne : cs.PersonnesEntity
	var $selection : cs.PersonnesSelection
	
	This.fHandler.writeLine("0 @"+This.setID(cs.Unions; $union.ID)+"@ FAM")
	
	// les conjoints
	$selection:=$union._lesMembres(agk Tout)
	For each ($personne; $selection)
		This.fHandler.writeLine("1 "+Choose($personne.sexe; "WIFE"; "HUSB")+" @"+This.setID(cs.Personnes; $personne.ID)+"@")
	End for each 
	
	// les enfants
	$selection:=$union.LesEnfants()
	If (Not($selection=Null))
		For each ($personne; $selection)
			This.fHandler.writeLine("1 CHIL @"+This.setID(cs.Personnes; $personne.ID)+"@")
		End for each 
		
		This.fHandler.writeLine("1 NCHI "+String($selection.length))
	End if 
	
	// les events
	This.EcrireEventsFamDe($union)
	
	
Function EcrireEventsFamDe($union : cs.UnionsEntity)
	var $selection : cs.EventsSelection
	var $entité : cs.EventsEntity
	
	$selection:=$union.LesEvenementsFamiliaux()
	If ($selection.length>0)
		For each ($entité; $selection)
			This._EcrireEvent($entité)
		End for each 
	End if 
	
	
Function _EcrireEvent($event : cs.EventsEntity)
	var $commune : cs.CommunesEntity
	var $tag : Text
	
	This.fHandler.writeLine("1 "+cs._rsc.me.gedcom($event.type))
	This.fHandler.writeLine("2 DATE "+("ABT "*Num(Not($event.dateNumValid)))+String(Day of($event.dateNum))+" "+cs._rsc.me.gedcom(Month of($event.dateNum))+" "+String(Year of($event.dateNum)))
	
	If (Not($event.leLieu=Null))
		$commune:=$event.LeLieu().Le(cs.Communes.name)
		This.fHandler.writeLine("2 PLAC "+$commune.nom+", "+$commune.Le(cs.Departements.name).nom+", "+$commune.Le(cs.Pays.name).nom)
	End if 
	
	This.EcrireChampNonVide("2 NOTE "; $event.commentaire)
	
	If ($event.source#"")
		$tag:="@S"+String($event.ID)+"@"
		This.fHandler.writeLine("2 SOUR "+$tag)
		This.sources.push(New object("tag"; $tag; "value"; $event.source))
	End if 
	
	
	// ----------------------
	//MARK:Utilitaires
	// -----------------------
	
Function setID($class : 4D.Class; $ID : Integer)->$result : Text
	$result:=$class.name+"_"+String($ID)
	
	
Function EcrireChampNonVide($tag : Text; $valeur : Text)
	If ($valeur#"")
		This.fHandler.writeLine($tag+$valeur)
	End if

⇧ [class]$certificatSSL - 07/05/2026 17:21:40

      property serveurWEB : cs.$serveurWEB

Class extends $document

Class constructor()
	
	Super()
	
	This.serveurWEB:=cs.$serveurWEB.new()
	
	
	// -----------------------------
	// MARK:Installation
	// -----------------------------
	
Function InstallerCertificatServeurWeb()
	// installer les certificats SSL pour le serveur Web hôte
	var $dataTexte : Text:=""
	var $DossierSource; $DossierDestination; $fichier : Object
	
	This.rsc.SetVariable(Est Ressource APP; "Serveur_Web/nomDossierSSLserveurWeb"; Is text; ->$dataTexte)
	// rappel : $dataTexte dit quel est le certificat (certifié ou autosigné) à utiliser
	$DossierSource:=This.GetCertificatSSLRessourcesFolder($dataTexte)
	// dans
	$DossierDestination:=cs.$document.new().GetCertificatSSLFolderForWebServer()
	// copier les certificats
	For each ($fichier; $DossierSource.files())
		$fichier.copyTo($DossierDestination; fk overwrite)
	End for each 
	
	CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Serveur Web Hôte"; Current method name; "Le certificat SSL est installé dans "+$DossierDestination.platformPath; New object("nomProcess"; Current process name; "numProcess"; Current process))
	
	
Function InstallerCertificatServeurAPP()
	// installer les certificats SSL pour le serveur APP
	var $dataTexte : Text:=""
	var $DossierSource; $DossierDestination; $fichier : Object
	
	This.rsc.SetVariable(Est Ressource APP; "Serveurs_ALV/nomDossierSSLserveurAPP"; Is text; ->$dataTexte)
	// rappel : $dataTexte dit quel est le certificat (certifié ou autosigné) à utiliser
	$DossierSource:=This.GetCertificatSSLRessourcesFolder($dataTexte)
	// dans
	$DossierDestination:=cs.$document.new().GetCertificatSSLFolderForAppServer()
	// copier les certificats
	For each ($fichier; $DossierSource.files())
		$fichier.copyTo($DossierDestination; fk overwrite)
	End for each 
	
	CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Serveur Web Hôte"; Current method name; "Le certificat SSL est installé dans "+$DossierDestination.platformPath; New object("nomProcess"; Current process name; "numProcess"; Current process))
	
	
	// -----------------------------
	// MARK:Certificat SSL en ressources
	// -----------------------------
	
Function CertificatSSL($params : Object)
	// ici on est sur BDDmère ou serveur APP ; on a accès aux ressources hôte
	cs.xSSL.$lectureCERT.new().getInformations($params)
	// le résultat est dans $params
	
	
Function getCertificatSSL($nomDossierSSL : Text)->$result : Object
	// lire le certificat $nomDossierSSL en ressources
	var $params : Object
	
	$params:=New object("nomDossierSSL"; $nomDossierSSL)
	cs.$serveurAPP.me.Executer(OB Class(This).name; "CertificatSSL"; $params)
	// le résultat est dans .reqRetour.infos
	$result:=$params.reqRetour.infos
	
	
	// -----------------------------
	// MARK:Certificat SSL en production
	// -----------------------------
	
Function CertInformations($params : Object)
	// ici on est sur BDDmère ou serveur APP ; on a accès au serveurs Web
	var $c : Collection
	
	// lire le chemin des certificats du serveur demandé
	Case of 
		: (Not(OB Is defined($params; "serveurWeb")))
			
		: ($params.serveurWeb=This.environnement.infosApplication(102).nomLong)
			// on veut les infos du serveur Web de la base Hôte
			$params.CertificatSSLFolderPath:=This.GetCertificatSSLFolderForWebServer().platformPath
			
		: ($params.serveurWeb="ALV Serveur Web")
			// on veut les infos du serveur Web du composant Web
			
			// ici on suppose que le serveur est lancé : lire ses propriétés
			$c:=WEB Server list.query("name = :1"; $params.serveurWeb)
			Case of 
				: ($c=Null)
				: ($c.length=0)
				Else 
					$params.CertificatSSLFolderPath:=Folder($c[0].certificateFolder; fk posix path).platformPath
			End case 
	End case 
	
	cs.xSSL.$lectureCERT.new().getInformations($params)
	// le résultat est dans $params
	
	
Function getCertInformations($nomServeur : Text)->$result : Object
	// lire le certificat utilisé par le serveur $nomServeur
	var $params : Object
	
	$params:=New object("serveurWeb"; $nomServeur)
	cs.$serveurAPP.me.Executer(OB Class(This).name; "CertInformations"; $params)
	// le résultat est dans .reqRetour.infos
	$result:=$params.reqRetour.infos
	
	
Function ProgrammerRenouvellementSSL($data : Object)->$result : Boolean
	// renvoyer la méthode à faire exécuter par le planificateur de tâches
	var $params : Object:=New object()
	
	Case of 
			// filtrer les applications non concernées
		: (Storage.System.typeApplication=ALV BDD mère)
		: (Storage.System.typeApplication=ALV Client APP)
		Else 
			// c'est ok, renvoyer les données
			
			$params:=New object("nomClass"; "$certificatSSL"; "functionID"; "RenouvelerCertificat"; "params"; New object)
			// demain 8 h
			$params.params.dateTache:=String(Add to date(Current date; 0; 0; 1); ISO date GMT; ?08:00:00?)
			// tous les jours
			$params.params.période:=New object("jour"; 1; "seconde"; 0)
			// pour test
			$params.params.initialiser:=False
			
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Programmation"; Current method name; "tâche programmée (voir détails dans Logs)"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_log]; "Donnée"; Current method name; JSON Stringify($params))
	End case 
	// finalement
	$data.params:=$params
	
	
Function RenouvelerCertificat()
	var $data : Object
	
	$data:=This.getCertificatSSL("Certificat_LetsEncrypt")
	
	Case of 
		: (Not($data.Production.exists))
			// pas de certificat erreur ?
			CALL WORKER(Worker Services; Formula from string(Formule_EnvoyerMessage); [msgk_event; msgk_log]; "Maintenance SSL [KO]"; Current method name; "Pas de certificat en production"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		: ($data.Production.Invalide)
			// https à renouveler
			CALL WORKER(Worker Services; Formula from string(Formule_EnvoyerMessage); [msgk_event; msgk_log]; "Maintenance SSLL [KO]"; Current method name; "Certificat non valide"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		: ($data.Production.aRenouveler)
			// https à renouveler
			CALL WORKER(Worker Services; Formula from string(Formule_EnvoyerMessage); [msgk_event; msgk_log]; "Maintenance SSL [ALERT]"; Current method name; "Certificat à renouveler"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		Else 
			// cas normal, https certificat ok
			CALL WORKER(Worker Services; Formula from string(Formule_EnvoyerMessage); [msgk_event; msgk_log]; "Maintenance SSL [OK]"; Current method name; "Certificat valide"; New object("nomProcess"; Current process name; "numProcess"; Current process))
	End case 
	
	
	// -----------------------------
	// MARK:Certificat SSL certifié (certbot)
	// -----------------------------
	// certbot, installé sur la machine hôte du serveur, sert à la génération des certificats SSL par Let'Encrypt
	// certbot mplémente le protocole ACME (Automated Certificate Management Environment) de Let'sEncrypt
	
Function AutoriserACME()
	// on veut passer en mode HTTP
	// rappel : le composant WEB n'est pas concerné
	
	// arrêter le serveur hôte
	This.serveurWEB.Arrêter()
	// redémarrer en mode compatible Certbot
	This.serveurWEB.Démarrer("ModeCertbot")
	
	CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "ALV - Activer CertBot"; Current method name; "Demande envoyée au serveur"; New object("nomProcess"; Current process name; "numProcess"; Current process))
	
	
Function InterdireACME()
	// on veut passer en mode HTTPS
	
	// arrêter le serveur
	This.serveurWEB.Arrêter()
	// redémarrer le serveur WEB en fonctionnement normal
	This.serveurWEB.Démarrer("ModeNominal")
	
	CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "ALV - Désactiver CertBot"; Current method name; "Demande envoyée au serveur"; New object("nomProcess"; Current process name; "numProcess"; Current process))
	
	
Function OnACMEAuthentification($url : Text)->$result : Boolean
	// tester si $url est une url du process ACME (génération de certificat SSL par certbot de let'sEncrypt)
	// on reçoit une requete du type :
	// {
	//     "method": "GET",
	//     "url": "/.well-known/acme-challenge/LoqXcYV8q5ONbJQxbmR7SCTNo3tiAXDfowyjxAjEuX0",
	//     "version": "HTTP/1.1",
	//     "ssl": false,
	//     "requestHeaders": {
	//         "Accept": "*/*",
	//         "Accept-Encoding": "gzip",
	//         "Connection": "close",
	//         "Host": "www.example.org",
	//         "User-Agent": "Mozilla/5.0 (compatible; Let's Encrypt validation server; +https://www.letsencrypt.org)"
	//     }
	// }
	
	$result:=False
	Case of 
		: (WEB Is secured connection)
			// certbot interroge le port 80, pas possible ici
			
		: (Not(This.ACMEchallengeReqUrlMatch($url)))
			// ce n'est pas une requête certbot
			
		Else 
			$result:=True
	End case 
	
	
Function ObtenirCertificatSSL()->$result : Object
	var $texte : Text:=""
	var $stdin; $stdout; $stderr : Text
	var $pid : Integer
	var $dossier : Object
	var $bool : Boolean
	
	$result:=New object
	$result.infosServeurWebHôte:=WEB Get server info
	$result.success:=True
	
	// nom du domaine
	This.rsc.SetVariable(Est Ressource APP; "serveur_URL/Nom_sousDomaine"; Is text; ->$texte)
	$result.nomDomaine:=$texte
	
	// dossier de réception des produits
	ALERT(Current method name+".  ACME CertActiveDirPathGet supprimé")
	ABORT
	//$dossier:=ACME CertActiveDirPathGet.parent.folder("toto")
	// créer , au cas où
	$bool:=$dossier.create()
	$result.dossier:=$dossier.path
	
	$texte:="sudo -S certbot renew"
	$stdin:="phil"+Char(LF ASCII code)
	//$texte:="sudo certbot renew"
	$stdin:="phil\n"
	$stdout:=""
	$stderr:=""
	
	LAUNCH EXTERNAL PROCESS($texte; $stdin; $stdout; $stderr; $pid)
	$result.renew:=New object("stdout"; $stdout; "stderr"; $stderr)
	$result.success:=$result.success & ($result.renew.stderr="")
	
	$texte:="sudo cp /etc/letsencrypt/live/srv-sourderie.ainsilavie.fr/fullchain.pem /Users/philippe/ALV_Serveurs/toto/cert.pem"
	LAUNCH EXTERNAL PROCESS($texte; $stdin; $stdout; $stderr; $pid)
	$result.cp_fullchain:=New object("stdout"; $stdout; "stderr"; $stderr)
	$result.success:=$result.success & ($result.cp_fullchain.stderr="")
	
	$texte:="sudo cp /etc/letsencrypt/live/srv-sourderie.ainsilavie.fr/privkey.pem /Users/philippe/ALV_Serveur_HTTP/toto/key.pem"
	LAUNCH EXTERNAL PROCESS($texte; $stdin; $stdout; $stderr; $pid)
	$result.cp_key:=New object("stdout"; $stdout; "stderr"; $stderr)
	$result.success:=$result.success & ($result.cp_key.stderr="")
	
	$texte:="sudo chmod +r /Users/philippe/ALV_Serveurs/*.pem"
	LAUNCH EXTERNAL PROCESS($texte; $stdin; $stdout; $stderr; $pid)
	$result.chmod:=New object("stdout"; $stdout; "stderr"; $stderr)
	$result.success:=$result.success & ($result.chmod.stderr="")
	
	
Function RenouvelerCertificatSSL()->$result : Object
	// la méthode doit s'exécuter sur le serveur
	var $data : Object
	
	Case of 
		: (Storage.System.typeApplication=ALV Client APP)
			// appeler le serveur. Rappel : pour être requêtée, la méthode doit être thread-safe.
			$data:=New object("reqMethode"; Current method name; "reqRetour"; New object)
			EXECUTE METHOD(Client Requêter; *; "Post"; $data)
			EXECUTE METHOD(Client Requêter; *; "Get Retour"; $data)
			
			$result:=$data.reqRetour
			
		Else 
			$result:=New object("success"; False)
			
			// lire les infos du certificat courant
			$data:=This.getCertInformations("ALV Serveur Web")
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log; msgk_mail]; "ALV - Maintenance serveur Web"; Current method name; "Le certificat Let'Encrypt expire le "+String($data.Production.date; Date RFC 1123; Time($data.Production.heure)); New object("nomProcess"; Current process name; "numProcess"; Current process))
			
			If ($data.Production.aRenouveler)
				CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log; msgk_mail]; "ALV - Maintenance serveur Web"; Current method name; "Demande de renouvellement du certificat Let'Encrypt"; New object("nomProcess"; Current process name; "numProcess"; Current process))
				// fixer les paramètres du CertBot
				//Certbot Paramétrer(Créer objet("Commande"; "Démarrage"))
				
				// obtenir le certificat
				$result:=This.ObtenirCertificatSSL()
				
				// restaurer les paramètres du serveur Web hôte
				//Certbot Paramétrer(Créer objet("Commande"; "Arrêt"))
				CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log; msgk_mail]; "ALV - Maintenance serveur Web"; Current method name; "Renouvellement du certificat Let'Encrypt "+Choose($result.success; "[OK]"; "[KO]"); New object("nomProcess"; Current process name; "numProcess"; Current process))
			End if 
			
	End case 
	
	
Function ACMEchallengeReqUrlMatch($url : Text)->$result : Boolean
	var $length : Integer
	var $regex : Text
	
	$result:=False
	$length:=Length($url)
	
	Case of 
		: (Not(($length>=27) & ($length<=120)))
		: (Not(($url=".well-known/acme-challenge/@") | ($url="/.well-known/acme-challenge/@")))
			// pas concerné ici
		Else 
			
			$regex:="^/?\\.well-known/acme-challenge/[-_A-Za-z0-9]{43,}$"
			$result:=Match regex($regex; $url; 1; *)
			
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log; msgk_mail]; "URL did match regex "+Choose($result; "[OK]"; "[KO]"); Current method name; $url; New object("nomProcess"; Current process name; "numProcess"; Current process))
	End case 
	
	
	// -----------------------------
	// MARK:Certificat SSL auto-signé
	// -----------------------------
	
Function CréerCertAutoSigné()
	var $libSSL; $csrObject; $csrReqConfObject : Object
	var $key; $cert : Blob
	var $dossier; $dataTexte : Text
	
	$libSSL:=cs.xSSL.$generation.new()
	
	$dataTexte:=""
	If (This.rsc.SetVariable(Est Ressource APP; "serveur_URL/Nom_sousDomaine"; Is text; ->$dataTexte))
		
		OB SET($csrObject; "CN"; $dataTexte)
		$csrReqConfObject:=$libSSL.NewCsrReqConfObject($csrObject)
		
		SET BLOB SIZE($key; 0)
		SET BLOB SIZE($cert; 0)
		$libSSL.CreateRsaCertSelfSigned(->$key; ->$cert; $csrReqConfObject)
		
		$dossier:=This.GetCertificatSSLRessourcesFolder("Certificat_Autosigne").platformPath
		BLOB TO DOCUMENT($dossier+"key.pem"; $key)
		BLOB TO DOCUMENT($dossier+"cert.pem"; $cert)
		
		CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Serveur Web Hôte"; Current method name; "Le certificat SSL autosigné est renouvelé dans le dossier "+$dossier; New object("nomProcess"; Current process name; "numProcess"; Current process))
		
		// installer le nouveau certificat
		This.InstallerCertificatServeurWeb()
		This.InstallerCertificatServeurAPP()
	End if 
	
	
Function RecréerCertAutoSigné()
	var $data : Object
	
	$data:=This.getCertInformations(This.environnement.infosApplication(102).nomLong)
	CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Serveur Web Hôte"; Current method name; "Le certificat SSL autosigné expire le "+String($data.Production.date; ISO date GMT; $data.Production.heure); New object("nomProcess"; Current process name; "numProcess"; Current process))
	
	Case of 
		: (Not($data.Production.exists))
		: (Not($data.Production.aRenouveler))
			
		Else 
			// renouveler
			This.CréerCertAutoSigné()
	End case

⇧ [class]SitesEntity - 12/04/2026 13:10:20

      Class extends Entity

Function IDcodé()->$ID : Integer
	$ID:=cs._ds.me.IDcodé(This)
	
	
Function Libellé($userFormats : Object)->$libellé : Text
	// renvoie le nom formaté suivant les options $1
	// $formats
	// .Options
	// bit 17 = ajouter la commune
	// bit 21 = type de site
	// et
	// bit 16 = ajouter le n° de département
	// bit 19 = ajouter le pays
	
	var $texte : Text
	var $formats : Object
	var $options : Integer
	var $entité : Object
	
	$formats:=New object("Options"; 0)
	Case of 
		: (Count parameters=0)
		: (OB Is defined($userFormats; "Options"))
			$formats:=$userFormats
	End case 
	$options:=$formats.Options
	
	$libellé:=This.nom
	$libellé:=(Num($options ?? 21)*(Localized string(String(This.type))+" "))+This.nom
	// ajouter la communes
	$entité:=This.Le("Communes")
	// format du département
	$options:=$options ?- 16
	$texte:=$entité.Libellé($formats)
	$libellé+=(Num(($options ?? 17) & ($libellé#""))*(Localized string("1015")+$texte))
	$libellé+=((" ("+(This.Le("Departements").nom*Num(This.Le("Departements")#Null))+(" - "*Num(($options ?? 16) & ($options ?? 19)))+(This.Le("Pays").nom*Num(This.Le("Pays")#Null))+")")*Num(($options ?? 16) | ($options ?? 19)))
	
	
	// ----------------------
	//MARK:Sélections
	// -----------------------
	
Function Le($DataClassNom : Text)->$result : Object
	// renvoie l'entité [$DataClassNom]
	If ($DataClassNom=This.getDataClass().getInfo().name)
		$result:=This
	Else 
		$result:=This.laCommune.Le($DataClassNom)
	End if 
	
	
	// ----------------------
	//MARK:Modification DataStore
	// -----------------------
	
Function Ajouter($quoi : Integer; $qui : Object; $params : Object)->$result : Object
	// ajouter un lieu à this
	ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "Début de l'ajout à ["+This.getDataClass().getInfo().name+"]"))
	
	$result:=ds.initResult()
	
	If ($quoi=geok Lieu)
		// sous traiter
		$result:=ds.AjouterLienRetour($quoi; This; $qui; $params)
		
		// pour le journal
		$params.Description_Action:=Localized string(String($quoi))+Localized string("33")+This.Libellé()
	End if 
	
	$result.success:=($result.Error=0)
	ds.NotifierResultat(This; $quoi; $result)
	
	
Function _FixerDonnées($quoi : Integer; $params : Object)->$result : Object
	// un site a été créé : on initialise ses données suivant 2 cas
	// dans les 2 cas on complète le journal
	var $JALV_UUID : Text
	var $qui : Object
	
	$result:=ds._FixerDonnées(This; $quoi; $params)
	
	// pour le journal
	$result.LectureJournal:=False
	$JALV_UUID:="JALV_UUID_"+String(geok Lieu)
	Case of 
		: (This.lesLieux.length=0)
		: (OB Is defined($params; $JALV_UUID))
			// cas ajout par lecture du journal
			$result.LectureJournal:=True
			$qui:=This.lesLieux[0]
			$qui.IDunique:=$params[$JALV_UUID]  // utiliser cet UUID
			$qui.save()
			
		Else 
			// cas ajout par BDD mère, le serveur APP ou par le site Web
			// renseigner le journal
			$params["JALV_UUID_"+String(geok Lieu)]:=This.lesLieux[0].IDunique
	End case 
	// ici, pour les 2 cas "Ajout DataStore" ou "Modifier DataStore_Extérieur", $params a les mêmes informations
	
	
Function _TriggerCreer()
	var $entité : cs.LieuxEntity
	
	This.nom:=Localized string("46")+" ID_"+String(This.ID)
	This.type:=50200
	
	// ajouter un lieu
	$entité:=ds.Lieux.new()
	ds._TriggerHoroDater($entité)
	
	// fixer l'identifiant
	ds.FixerIDentification($entité)
	// faire le lien
	$entité.site:=This.ID
	// appeler le trigger du lieu
	$entité._TriggerCreer()
	$entité.save()
	
	
	// ----------------------
	//MARK:Interface externe
	// -----------------------
	
Function CopierVersObjet($entitéExt : Object)
	// recopier les attributs de this dans $entitéExt (pour une utilisation hors BDD mère)
	var $entité : Object
	
	$entitéExt.ID:=This.ID
	$entitéExt.IDunique:=This.IDunique
	
	$entitéExt.type:=This.type
	$entitéExt.nom:=This.nom
	
	// reconstituer la hiérarchie administrative : commune, département, région et pays du site
	// demander à l'appelant sa classe Communes
	$entité:=OB Copy($entitéExt.protoCommune)
	// faire compléter
	This.laCommune.CopierVersObjet($entité)
	$entitéExt.laCommune:=$entité
	
	
	// ----------------------
	//MARK:APP mobile
	// -----------------------
	
exposed local Function get photo($event : Object)->$result : Picture
	$result:=This.laCommune.photo
	
	
exposed local Function get labeledNom($event : Object)->$result : Text
	$result:=This.nom+" ("+This.label+")"
	
	
exposed local Function get label($event : Object)->$result : Text
	$result:=Localized string(String(This.type))
	
	
exposed local Function get events($event : Object)->$result : Text
	// remarque cette function est appliquée à la construction de l'app pour filtrer les sites sans lieux
	var $lieu : Object  // cs.Lieux.entity interdit !
	
	If (estAppelMobile)
		$result:=""
		For each ($lieu; This.lesLieux.orderBy("nom asc"))
			$result:=$result+(2*Char(Line feed))+"-  "+$lieu.labeledNom
			$result:=$result+$lieu.NombreEvents()
		End for each 
		$result:=Replace string($result; 2*Char(Line feed); ""; 1)
		
	Else 
		$result:="Les évènements..."
	End if 
	
	
exposed local Function get etatCivil($event : Object)->$result : Text
	var $lieu : Object
	
	If (estAppelMobile)
		$result:=""
		For each ($lieu; This.lesLieux.orderBy("nom asc"))
			$result:=$result+(2*Char(Line feed))+"-  "+$lieu.labeledNom+Char(Line feed)
			$result:=$result+$lieu.etatCivil()
		End for each 
		$result:=Replace string($result; 2*Char(Line feed); ""; 1)
	Else 
		$result:="L'état civil..."
	End if 
	$result:=$result+ds._FinirTexteFormDetail()

⇧ [class]ZonesEntity - 30/04/2026 14:22:56

      Class extends Entity

Function IDcodé()->$ID : Integer
	$ID:=cs._ds.me.IDcodé(This)
	
	
Function _Liaison()->$result : Object
	// attention : this.xxx est une sélection, peut être vide
	// [0] n'existe pas, ou bien UN SEUL répond, .length=1
	
	$result:=New object
	Case of 
		: (This.lesPersonnages.length>0)
			$result.entité:=This.lesPersonnages[0]
			$result.membre:="personne"
			
		: (This.lesInstantanes.length>0)
			$result.entité:=This.lesInstantanes[0]
			$result.membre:="event"
			
		: (This.lesPaysages.length>0)
			$result.entité:=This.lesPaysages[0]
			$result.membre:="lieu"
			
		: (This.lesDetails.length>0)
			$result.entité:=This.lesDetails[0]
			$result.membre:="media"
			
		: (This.lesActions.length>0)
			$result.entité:=This.lesActions[0]
			$result.membre:="Commande"
			
		Else 
			$result:=Null
	End case 
	
	If ($result#Null)
		$result.DataClassNomLiée:=$result.entité.LeLien().getDataClass().getInfo().name
	End if 
	
	
Function LeLien()->$result : Object
	$result:=This._Liaison().entité.LeLien()
	
	
Function FixerLeLien($ID : Integer)->$result : Object
	// fixe le membre lié à la zone this ; on renvoie l'entité du lien (table de jonction)
	var $lien : Object
	
	$lien:=This._Liaison()
	$result:=$lien.entité
	$result[$lien.membre]:=$ID
	
	
Function Libellé()->$libellé : Text
	$libellé:=This._Liaison().entité.Libellé()
	
	
Function _criteresTriParTaille()->$result : Real
	$result:=(This.droite-This.gauche)*(This.bas-This.haut)
	
	
	// ----------------------
	//MARK:Modification DataStore
	// -----------------------
	
Function _FixerDonnées($quoi : Integer; $params : Object)->$result : Object
	var $data : Object
	
	// traitement standard
	$result:=ds._FixerDonnées(This; $quoi; $params)
	
	This.gauche:=0
	This.haut:=0
	This.droite:=1
	This.bas:=1
	This.save()
	
	Case of 
		: (Not(OB Is defined($params; "deQui")))
			$result:=ds.initResult(-15068; ".deQui non renseignés dans $params"; False)
		: ($params.deQui=Null)
			$result:=ds.initResult(-15068; ".deQui de $params est null"; False)
		: (Not(OB Is defined($params; "typeZone")))
			$result:=ds.initResult(-15068; ".typeZone non renseignés dans $params"; False)
		: (Not(OB Is defined($params; "numPage")))
			$result:=ds.initResult(-15068; ".numPage non renseignés dans $params"; False)
		Else 
			
			// pour une zone : dans l'ordre
			
			// le type de zone 1 correspond à une zone sensible sur un media lié à deQui, de type illustration (listable dans FORM.this)
			// le type de zone 2 correspond à une zone sensible sur un media vers deQui, de type lien (NON listable dans FORM.this)
			// le type de zone 3 correspond à une zone sensible sur un media lié à deQui, de type document (listable dans FORM.this)
			This.type:=$params.typeZone
			This.page:=$params.numPage
			
			// trouver la jointure avec qui
			// lister les dataclass en relation avec this,  et trouver celle qui a un lien aller avec $qui
			$data:=ds.Zones.LeIllustré($params.deQui.getDataClass().getInfo().name)
			// on a reçu le nom de la dataClass jointure (.DataClassNom)
			If ($data.Error=0)
				// créer la jointure et le lien avec .deQui
				$result.lien:=ds.Créer(0; $data.DataClassNom; $params)
				// on passe en entité réduite
				$params.deQui:=cs._ds.me.EntitéRéduite($params.deQui)
				
				// lier à this
				If ($result.lien.Error=0)
					$result.lien.entitéAjoutée.zone:=This.ID
					$result.lien.entitéAjoutée.save()
				Else 
					$result.Error:=$result.lien.Error
					$result.ErrorDescription:=$result.lien.ErrorDescription
				End if 
				
			Else 
				$result.Error:=$data.Error
				$result.ErrorDescription:=$data.ErrorDescription
			End if 
			
			This.save()
	End case 
	
	
Function Positionner($data : Object; $params : Object)->$result : Object
	var $width; $height : Real
	// par défaut la zone couvert tout le media (cf trigger)
	// si besoin positionner la zone
	
	$result:=ds.initResult()
	
	// créer une ZS carrée autour de PositionX/Y
	Case of 
		: (Not(OB Is defined($params; "PositionX")))
		: (Not(OB Is defined($params; "PositionY")))
		Else 
			// utiliser les dimensions du media lues dans $data
			$width:=0.05
			
			// on a tout
			$height:=$width
			// zoomer pour avoir une zone carrée !
			If ($data.largeur/$data.hauteur<1)
				$width:=$width/$data.largeur*$data.hauteur
			Else 
				$height:=$height*$data.largeur/$data.hauteur
			End if 
			// positionner la zone
			This.gauche:=($params.PositionX-($width/2))*Num($params.PositionX-($width/2)>=0)
			This.haut:=($params.PositionY-($height/2))*Num($params.PositionY-($height/2)>=0)
			// fixer sa largeur
			This.droite:=This.gauche+$width
			// supprimer un débordement à droite
			If (This.droite>1)
				This.droite:=1
				This.gauche:=1-$width
			End if 
			// fixer sa hauteur
			This.bas:=This.haut+$height
			// supprimer un débordement en bas
			If (This.bas>1)
				This.bas:=1
				This.haut:=1-$height
			End if 
	End case 
	
	// créer une ZS avec des dimensions imposées
	Case of 
		: (Not(OB Is defined($params; "gauche")))
		: (Not(OB Is defined($params; "haut")))
		: (Not(OB Is defined($params; "droite")))
		: (Not(OB Is defined($params; "bas")))
		Else 
			This.gauche:=$params.gauche
			This.haut:=$params.haut
			This.droite:=$params.droite
			This.bas:=$params.bas
	End case 
	
	This.save()
	// sinon, dimensions par défaut fixées par le trigger de [Zones]
	
	
	// ----------------------
	//MARK:APP mobile
	// -----------------------
	
exposed Function get urlPhoto()->$result : Text
	$result:="/photosMobile/test.jpg"

⇧ [class]$texteEditeur - 15/06/2026 12:35:58

      // toutes les functions doivent être thread-safe, en particulier pour une exécution sur le serveur
// classe de gestion du composant 4DwritePro
// attention ici il faut utiliser Form pour accéder à l'objet de la zone 4DwritePro
property zoneDocumentNom; widgetNom; tab; finLigne; finParag; entête; cheminFichier; titre; DataClassNom; IDunique; texteWorké : Text
property data; params : Object

Class extends $formulaire

Class constructor()
	Super()
	
	// nom de la zone texte
	This.zoneDocumentNom:="WParea"
	// nom du WPwidget
	This.widgetNom:="WPwidget"
	
	// initialisation des caractères
	This.tab:=Char(Tab)
	This.finLigne:=Char(Line feed)  //$tab+Caractère(10)  // idem ASCII / unicode?
	This.finParag:=Char(Carriage return)
	This.entête:=" --"+This.tab
	
	
	// ----------------------
	// MARK:Initialisation
	// -----------------------
	
Function Paramètrer($params : Object)
	// initialiser les paramètres de la classe
	var $attribut : Text
	
	For each ($attribut; OB Keys($params))
		This[$attribut]:=$params[$attribut]
	End for each 
	
	
Function FixerParamètres($params : Object)
	// $params = paramètres de menu
	
	Super.FixerParamètres($params)
	This.informations.nomForm:="U_Palette?3006"
	
	Case of 
		: (This.menu.params.commande="3006")
			// sélectionner un document
			This.cheminFichier:=""
			If (Select document(cs.$document.new().GetPrivateUserFolder().platformPath; ".4wp"; Localized string("191"); Use sheet window)#"")
				This.cheminFichier:=document
			End if 
			This.menu.params.titre:=Localized string("5068")
			
		: (This.menu.params.commande="3027")
			// éditer la descendance de
			This.data:=New object("class"; ds.Personnes.query("ID = :1"; This.menu.params.deQui.sélection[0] & 0x00FFFFFF); "functionID"; "CréerHiérarchie")
			
			This.menu.params.titre:=Localized string("10111")+Localized string("1001")+This.data.class[0].Libellé()
			// éditer la descendance
			This.params:=New object("Options"; 0xC0100D3F; "Xcendance"; This.titre)
			
		: (This.menu.params.commande="3028")
			// éditer l'ascendance de
			This.data:=New object("class"; ds.Personnes.query("ID = :1"; This.menu.params.deQui.sélection[0] & 0x00FFFFFF); "functionID"; "CréerHiérarchie")
			
			This.menu.params.titre:=Localized string("10112")+Localized string("1001")+This.data.class[0].Libellé()
			// éditer l'ascendance
			This.params:=New object("Options"; 0x40100D3F; "Xcendance"; This.titre)
	End case 
	
	
Function getObjetZoneWP()->$result : Variant
	// trouver la zone 4DwritePro ou la variable scalaire, et la renvoyer (-> un variant)
	
	ARRAY TEXT($tabObjets; 0)
	ARRAY POINTER($tabVariables; 0)
	FORM GET OBJECTS($tabObjets; $tabVariables)
	Case of 
		: (Find in array($tabObjets; This.zoneDocumentNom)=-1)
			$result:=Null
			
		: ($tabVariables{Find in array($tabObjets; This.zoneDocumentNom)}=Null)
			// une variable scalaire
			$result:=Form[This.zoneDocumentNom]
			
		: (Value type($tabVariables{Find in array($tabObjets; This.zoneDocumentNom)})#Is object)
			// un pb
		Else 
			// une variable objet
			$result:=$tabVariables{Find in array($tabObjets; This.zoneDocumentNom)}->
	End case 
	
	
Function getZoneVariable()->$result : Pointer
	// trouver la zone 4DwritePro, et fixer sa variable
	$result:=Null
	ALERT("utiliser "+Current method name+".   .getZoneObjet()")
	
	ARRAY TEXT($tabObjets; 0)
	ARRAY POINTER($tabVariables; 0)
	FORM GET OBJECTS($tabObjets; $tabVariables)
	If (Find in array($tabObjets; This.zoneDocumentNom)>0)
		$result:=$tabVariables{Find in array($tabObjets; This.zoneDocumentNom)}
	End if 
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	var $data; $params : Object
	
	This.surEvenementFormulaire()
	
	Case of 
		: (FORM Event.code=On Load)
			
			Case of 
				: (This.AfficherDocument())
				: (Not(OB Is defined(This; "data")))
				: (Not(OB Is defined(This; "params")))
				Else 
					
					This.AfficherContenu()
			End case 
			
			// charger les objets
			This.onEndLoad()
			
		: (FORM Event.code=On Timer)  // MaJ des IHM
			Afficher Progression Process  // dans cet ordre
	End case 
	
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection("WParea")
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:FORMevents Page 1
	// ----------------------
	
Function _FORM_WParea()
	var $range : Object
	
	WP UpdateWidget(Form.widgetNom; Form.zoneDocumentNom)
	
	Case of 
		: (FORM Event.code=On Load)
			$range:=WP Selection range(*; Form.zoneDocumentNom)
			WP SET ATTRIBUTES($range; wk margin; "0.5cm")
			WP SET ATTRIBUTES($range; wk text align; wk justify)
			
		: (FORM Event.code=On Alternative Click)
			OBJECT SET VISIBLE(*; "grpEditValider"; True)
			
		: (FORM Event.code=On Clicked)
			// afficher la référence encyclo du lien cliqué
			Form.ActiverLienHyperText()
	End case 
	
	
Function _FORM_previousItem()
	var $itemsText : Text
	var $gauche; $haut; $droite; $bas; $choix : Integer
	
	Case of 
		: (FORM Event.code=On Clicked)
			Form.ElementPrécédent()
			
		: (FORM Event.code=On Alternative Click)
			// lister les recherches précédant la recherche courante
			$itemsText:=Form.Items.join(";")
			
			// supprimer les codes de contrôles
			$itemsText:=Replace string($itemsText; "@"; ""; *)
			$itemsText:=Replace string($itemsText; Char(162); ""; *)
			
			OBJECT GET COORDINATES(*; This.nomOBJ; $gauche; $haut; $droite; $bas)
			$choix:=Pop up menu($itemsText; 0; $gauche; $bas+5)
			If ($choix#0)
				Form.indiceItems:=$choix-1
				Form.AfficherElement(Form.Items[Form.indiceItems])
			End if 
	End case 
	
	
Function _FORM_nextItem()
	var $itemsText : Text
	var $gauche; $haut; $droite; $bas; $choix : Integer
	
	Case of 
		: (FORM Event.code=On Clicked)
			Form.ElementSuivant()
			
		: (FORM Event.code=On Alternative Click)
			// lister les recherches suivant la recherche courante
			$itemsText:=Form.Items.join(";")
			
			// supprimer les codes de contrôles
			$itemsText:=Replace string($itemsText; "@"; ""; *)
			$itemsText:=Replace string($itemsText; Char(162); ""; *)
			
			OBJECT GET COORDINATES(*; This.nomOBJ; $gauche; $haut; $droite; $bas)
			$choix:=Pop up menu($itemsText; 0; $gauche; $bas+5)
			If ($choix#0)
				Form.indiceItems:=$choix-1
				Form.AfficherElement(Form.Items[Form.indiceItems])
			End if 
	End case 
	
	
Function _FORM_EnregistrerSous()
	// sur clic
	var $data; $ZWP : Object
	var $dossier : 4D.Folder
	
	$data:=New object("titre"; Localized string("165"); "message"; cs._cfct.me.LireLocatedSTR(248); "numPageForm"; 4; "texteSaisi"; Get window title(Fenêtre du process(Current process)))
	
	Case of 
		: (Not(FORM Event.code=On Clicked))
		: (cs.$dialogue_3001.new().Lancer($data))
		: ($data.texteSaisi="")
			
		Else 
			$dossier:=cs.$document.new().GetPrivateUserFolder()
			$ZWP:=Form.getObjetZoneWP()
			WP EXPORT DOCUMENT($ZWP; $dossier.platformPath+$data.texteSaisi+".html"; wk web page complete; wk normal)
	End case 
	
	
	// ----------------------
	// MARK:Affichage
	// -----------------------
	
Function AfficherDocument()->$result : Boolean
	
	$result:=False
	Case of 
		: (Not(OB Is defined(This; "cheminFichier")))
		: (This.cheminFichier="")
		Else 
			$result:=True
			Form[This.zoneDocumentNom]:=WP Import document(This.cheminFichier)
	End case 
	
	
Function AfficherContenu()
	var $data; $params : Object
	
	Case of 
		: (This.informations.Contexte="3027")
			$data:=New object
			$data.className:=cs.PersonnesEditeur.name
			$data.functionID:="CréerHiérarchie"
			$params:=OB Copy(This.params)
			$params.entitéID:=This.data.class[0].ID
			
			This.AfficherXcendance($data; $params)
			
		: (This.informations.Contexte="3028")
			$data:=New object
			$data.className:=cs.PersonnesEditeur.name
			$data.functionID:="CréerHiérarchie"
			$params:=OB Copy(This.params)
			$params.entitéID:=This.data.class[0].ID
			
			This.AfficherXcendance($data; $params)
	End case 
	
	
Function AfficherTexte($params : Object)
	// callback réception des données  : mettre le texte créé dans le document
	var $zoneDocument : Object
	
	ST SET TEXT(*; Form.zoneDocumentNom; $params.texteWorké)
	
	$zoneDocument:=This.getObjetZoneWP()
	// formater tout le texte sélectionné
	WP SELECT($zoneDocument; wk start text; wk end text)
	This.AppliquerStylesZoneIncluse($zoneDocument)
	// désélectionner
	WP SELECT($zoneDocument; wk start text; 1)
	
	
	// ----------------------
	// MARK:Généalogie
	// -----------------------
	
Function AfficherXcendance($data : Object; $params : Object)
	var $zoneDocument : Object
	
	// compléter les params de LH
	$params.numGénérationMax:=20
	$params.génération:=0
	$params.FormatPersonne:=0x0007
	$params.FormatParent:=0x0007
	$params.FormatConjoint:=0x0027
	$params.FormatEnfant:=0x0006
	$params.FormatEvent:=0x00100D00  // avec lieu
	$params.FormatLieu:=0x00010200
	$params.FormatDate:=Internal date short
	
	// c'est parti
	$data:=New object
	$data.className:=cs.PersonnesEditeur.name
	$data.functionID:="CréerHiérarchiePersonne"
	cs.PersonnesEditeur.new().CréerHiérarchie($data; $params)
	// créer le texte
	This.CréerTexteXcendance($params)
	
	// pour une zone 4DwritePro, utiliser le nom de l'objet pour une mise à jour du formulaire
	ST SET TEXT(*; This.zoneDocumentNom; This.texteWorké)
	
	// mettre les styles
	$zoneDocument:=This.getObjetZoneWP()
	WP SELECT($zoneDocument; wk start text; wk end text)
	This.AppliquerStylesZoneIncluse($zoneDocument)
	This.AppliquerStylesXscendance($zoneDocument)
	WP SELECT($zoneDocument; 1; 1)
	
	
Function CréerTexteXcendance($params : Object; $ptrTexte : Pointer)->$result : Object
	var $texte : Text
	var $c : Collection
	var $i; $type : Integer
	var $data; $element; $subParams : Object
	var $blob : Blob
	
	Case of 
		: (Not(OB Is defined($params; "liste")))
		: (Count parameters=1)
			// initialisation de la récursivité
			
			$params.Time:=0
			$params.débutTache:=0
			$params.duréeTache:=10000
			
			// titre du texte
			$texte:=$params.Xcendance+This.tab+"- Edition"+Localized string("1008")+String(Current date; 3)+This.finParag
			// lancer le traitement
			This.CréerTexteXcendance($params; ->$texte)
			
			$params.Time:=10000
			Waiting(10)
			This.texteWorké:=$texte
			
		Else 
			// on est dans la récursivité
			
			$c:=$params.liste
			
			$result:=New object
			
			For ($i; 0; $c.length-1)
				$type:=Value type($c[$i])
				//$addedElement:=Faux
				
				Case of 
						
					: ($type=Is text)
						// ici on a un objet encodé avec les données de la liste
						BASE64 DECODE($c[$i]; $blob)
						BLOB TO VARIABLE($blob; $data)
						// pour la suite
						$result.list:=$data
						
						$element:=$data
						Case of 
							: (Not(OB Is defined($element; "itemText")))
							: (Not(OB Is defined($element; "itemRef")))
							Else 
								// ok on a tout
								$ptrTexte->:=$ptrTexte->+This.finParag+This.getGénération($element)+This.entête+$element.itemText
						End case 
						
					: ($type=Is object)
						// ici on a les info d'un élément de la liste
						$element:=$c[$i]
						Case of 
							: (Not(OB Is defined($element; "itemText")))
							: (Not(OB Is defined($element; "itemRef")))
								// le minimum syndical n'est pas requis
							: (CodeEnreg($element.itemRef)=Table(->[Personnes]))
								$ptrTexte->:=$ptrTexte->+This.finParag+This.getGénération($element)+This.entête+$element.itemText
								
							: (CodeEnreg($element.itemRef)=Table(->[Events]))
								$ptrTexte->:=$ptrTexte->+This.finLigne+This.tab+$element.itemText
								
							: (CodeEnreg($element.itemRef)=129)
								// un conjoint
								$ptrTexte->:=$ptrTexte->+" "+$element.itemText
						End case 
						
					: ($type=Is collection)
						// ici on a une sous liste
						$subParams:=OB Copy($params)
						$subParams.liste:=$c[$i]
						$subParams.texteWorké:=""
						
						$subParams.débutTache:=$Params.Time
						$subParams.duréeTache:=$Params.duréeTache/$c.length
						
						$element:=This.CréerTexteXcendance($subParams; $ptrTexte)
						
						$params.Time:=$subParams.Time
				End case 
				
				// tuerie ?
				If ((Storage.Processes[Current process name].Commande="Tuer process"))
					$i:=$c.length+1
				End if 
			End for 
	End case 
	
	
Function getGénération($element : Object)->$result : Text
	// extraire de $data le n° de génération (valeur texte)
	var $data : Object
	
	$result:="-1"
	// lire la génération
	If (OB Is defined($element; "data"))
		$data:=CoDecBase64_Objet($element.data)
		Case of 
			: (Not(OB Is defined($data; "parameters")))
			: ($data.parameters.query("sélecteur = :1"; Additional text).length=0)
			Else 
				$result:=$data.parameters.query("sélecteur = :1"; Additional text)[0]["valeur"]
		End case 
	End if 
	
	
	// ----------------------
	// MARK:Styles WP texte
	// -----------------------
	
Function AppliquerStylesZoneIncluse($zoneDocument : Object)
	// styles communs aux zones 4D write incluses
	var $plage : Object
	
	// rmk : si on utilise $plage, marge est attibuée aux paragraphes
	WP SET ATTRIBUTES($zoneDocument; wk margin; "0.3cm")
	WP SET ATTRIBUTES($zoneDocument; wk padding; wk none)
	// créer une plage de la sélection : elle peut être
	//  un groupe de mots sélectionné par l'utilisateur, le paragraphe où se trouve le curseur, tout le texte (ex sélection par programmation)
	$plage:=WP Selection range(*; This.zoneDocumentNom)
	// fixer les attributs à la sélection
	//WP FIXER ATTRIBUTS($1->;wk background clip;wk content box)
	WP SET ATTRIBUTES($plage; wk padding; wk none)
	WP SET ATTRIBUTES($plage; wk font family; This.session.prefs.Apparence.Formulaire.PoliceEditeur)
	WP SET ATTRIBUTES($plage; wk font size; 12)
	WP SET ATTRIBUTES($plage; wk text align; wk justify)
	
	
Function AppliquerStylesVisualisation()
	var $plage; $zoneDocument : Object
	
	$zoneDocument:=This.getObjetZoneWP()
	
	If ($zoneDocument#Null)
		// fond noir
		WP SET ATTRIBUTES($zoneDocument; wk margin; "0.2cm")
		// attention : la propriété "montrer le fond" de $1 doit être cochée
		WP SET ATTRIBUTES($zoneDocument; wk background color; "black")
		WP SET ATTRIBUTES($zoneDocument; wk padding; wk none)
		
		// sélectionner tout le texte
		WP SELECT(*; This.zoneDocumentNom; wk start text; wk end text)
		$plage:=WP Selection range(*; This.zoneDocumentNom)
		WP SET ATTRIBUTES($plage; wk text align; wk justify)
		WP SET ATTRIBUTES($plage; wk text color; "white")
		WP SET ATTRIBUTES($plage; wk font family; This.session.prefs.Apparence.Formulaire.PoliceEditeur)
		WP SET ATTRIBUTES($plage; wk font size; 12)
		// désélectionner
		WP SELECT(*; This.zoneDocumentNom; 1; 1)
	End if 
	
	
Function AppliquerStylesXscendance($zoneDocument : Object)
	var $plage : Object
	var $texte : Text
	var $début; $fin; $itemPos; $numParagraphe; $numParagrapheSuivant : Integer
	
	// créer pseudo entête / pied de page
	WP SET ATTRIBUTES($zoneDocument; wk margin top; "1.cm"; wk margin bottom; "1.cm")
	// sélectionner les paragraphes
	$plage:=WP Paragraph range($zoneDocument)
	// espacement des paragraphes
	WP SET ATTRIBUTES($plage; wk margin bottom; "1pt"; wk margin top; "3pt"; wk margin left; "0pt"; wk margin right; "0pt")
	// initialiser le retrait des paragraphes
	WP SET ATTRIBUTES($plage; wk text indent; "0cm")
	// position des tabulations des paragraphes
	WP SET ATTRIBUTES($plage; wk tab stop offsets; "1.cm")
	
	// appliquer un retrait à chaque paragraphe de personne (le retrait dépend du rang de la génération)
	// un paragraphe de personne débute par N° de génération + $3, et se termine par $4
	$texte:=ST Get plain text(*; This.zoneDocumentNom)
	
	$début:=0
	$fin:=0
	$itemPos:=0
	Repeat 
		$itemPos:=Position(This.entête; $texte; $itemPos)
		If ($itemPos=0)
			// il n'y a pas d'autre $ de personne : on est à la fin du texte
			$fin:=Length($texte)
			
		Else 
			// il y a un $ de personne après
			// chercher la fin du précédent (après le $4 qui précède $itemPos)
			// le N° de génération est sur 2 caractères max
			Case of 
				: ($itemPos<2)
					// impossible; un pb on arrête tout
					$début:=0
					$fin:=$début-1
					
				: (Position($texte[[$itemPos-1]]; "0123456789")=0)
					// on est au premier $ de personne (de cujus)
					$début:=$itemPos
					$numParagraphe:=0
					// poursuivre la recherche après cet entête
					$itemPos:=$début+2+Length(This.entête)
					
					// on est au début du $ de personne suivant
				: (Position($texte[[$itemPos-2]]; "0123456789")=0)
					// on a un N° de génération sur 1 caractère
					$fin:=$itemPos-2
					$numParagrapheSuivant:=Num(Substring($texte; $fin+1; 1))
					
				Else 
					// on a un N° de génération sur 2 caractères
					$fin:=$itemPos-3
					$numParagrapheSuivant:=Num(Substring($texte; $fin+1; 2))
			End case 
		End if 
		
		If ($début<$fin)
			// on a un $ de personne
			// créer le retrait
			$plage:=WP Text range($zoneDocument; $début; $fin)
			WP SET ATTRIBUTES($plage; wk text indent; String($numParagraphe*0.5; "&xml")+"cm")
			// initialiser la recherche suivante : la fin d'un $ = le début du $ suivant
			$début:=$fin+1
			$numParagraphe:=$numParagrapheSuivant
			// poursuivre la recherche après le dernier entête trouvé
			$itemPos:=$début+2+Length(This.entête)
		End if 
	Until ($fin=Length($texte))
	
	
	// ----------------------
	// MARK:HyperTexte
	// -----------------------
	
Function FixerLiensHyperText($texte : Text)->$result : Text
	// rechercher les mots-clé dans $1 et les hyperTexturer
	var $i; $j : Integer
	var $c; $cMotsClé : Collection
	var $sélection; $objet : Object
	
	ARRAY TEXT($mots; 0)
	GET TEXT KEYWORDS($texte; $mots; *)
	// pas de doublons
	SORT ARRAY($mots; >)
	
	// ne retenir que les mots-clés de la BDD
	$cMotsClé:=New collection
	
	For ($i; Size of array($mots); 1; -1)
		$sélection:=ds.Encyclopedia.query("MotCle = :1"; $mots{$i})
		Case of 
			: ($sélection.length=0)
				// passer
				//: ($Mots{$i}=This.MotCle)
				// on passe aussi
			Else 
				// on garde
				$cMotsClé.push(New object("MotCle"; $Mots{$i}; "LienMotCle"; $sélection[0].HyperTexturerMotCle()))
		End case 
	End for 
	
	// par defaut
	$result:=$texte
	// remplacer les mots clé trouvés par leur lien
	If ($cMotsClé.length>0)
		// saucissonner le texte
		$c:=Split string($texte; " "; sk trim spaces)
		
		For each ($objet; $cMotsClé)
			// remplacer chaque mot-clé par son lien
			Repeat 
				$j:=$c.indexOf($objet.MotCle)
				If ($j#-1)
					$c[$j]:=$objet.LienMotCle
				End if 
			Until ($j=-1)
		End for each 
		
		// reconstituer le texte, avec liens
		$result:=$c.join(" ")
	End if 
	
	
Function ActiverLienHyperText()->$result : Boolean
	// affcher la référence encyclo du lien cliqué
	var $début; $fin; $typeLien; $itemRef : Integer
	var $motClé : Text
	var $class : cs.$formulaire
	
	$result:=True
	
	// récupérer les données du lien
	GET HIGHLIGHT(*; This.zoneDocumentNom; $début; $fin)
	If ($début<$fin)  // ATTENTION il faut un champ / une variable saisissable
		// lire la balise <span>
		$motClé:=ST Get text(*; This.zoneDocumentNom; $début; $fin)
		// lire le type de lien
		$typeLien:=ST Get content type($motClé)  // ST Début sélection; ST Fin sélection  pas utile
		Case of   // traitement des différents types
			: ($typeLien=ST Url type)
				
			: ($typeLien=ST Expression type)
				
			: ($typeLien=ST User type)
				// c'est ok
				
				// récupérer le code de l'information du lien
				$itemRef:=Num(ST Get plain text($motClé; ST User links as links))
				Case of 
					: (cs._cfct.me.estIDcodeDeClasses($itemRef; [ds.Encyclopedia]))
						// on reste dans l'encyclopédie ; afficher le mot-clé $motClé
						$motClé:=ST Get plain text($motClé; ST User links as labels)
						Form.AfficherElement($motClé)
						Form.AjouterAliste($motClé)
						
					: (cs._cfct.me.estIDcodeDeClasses($itemRef; [ds.Events; ds.Lieux; ds.Medias; ds.Personnes]))
						// changer de sélection
						Form.EditerSélection($itemRef; 0)
						
					: (cs._cfct.me.estIDcodeDe($itemRef; 213))
						// ouvrir une page d'aide
						ALERT(Current method name+". on est passé là")
						$class:=cs.$formulaire.new()
						$class.menu.params:=New object("type"; "Palette"; "commande"; "3106"; "DataClassNom"; ""; "nomClass"; "$documentation"; "titre"; "Documentation"; "IDpage"; $itemRef & 0x00FFFFFF)
						$class.menu.Exécuter()
						
				End case 
				
		End case 
	Else 
		// pas de contenu sélectionné
		$result:=False
	End if 
	
	
	// ----------------------
	// MARK:Entité
	// -----------------------
	
Function InformationEntité($params : Object)
	var $data : Object
	var $texte : Text:=""
	
	This.Paramètrer($params)
	
	$data:=New object
	$data.params:=This.params
	$data.entité:=Null
	Case of 
		: (Not(OB Is defined(This; "DataClassNom")))
			cs.$trace.me.Créer(-15068; Current method name; "'DataClassNom' n'est pas défini dans $1").LeverException([msgk_event; msgk_log])
			
		: (This.DataClassNom="")
			// on veut un texte vide
		: (Not(OB Is defined(ds; This.DataClassNom)))
			cs.$trace.me.Créer(-15068; Current method name; "'DataClassNom' n'est pas une classe de ds").LeverException([msgk_event; msgk_log])
			
		: (Not(OB Is defined(This; "IDunique")))
			cs.$trace.me.Créer(-15068; Current method name; "'IDunique' n'est pas défini dans $1").LeverException([msgk_event; msgk_log])
			
		: (This.IDunique="")
			// on ne veut pas de texte
			
		: (Not(Match regex("[0-9ABCDEF]{32}"; This.IDunique)))
			cs.$trace.me.Créer(-15068; Current method name; "'IDunique' n'est pas un IDunique").LeverException([msgk_event; msgk_log])
			
		Else 
			// on a un IDunique
			$data.entité:=ds[This.DataClassNom].query("IDunique=:1"; This.IDunique)[0]
	End case 
	
	If ($data.entité#Null)
		// créer  les informations
		$texte:=This.EcrireInformationEntité($data)
	End if 
	$params.texteWorké:=$texte
	
	
Function EcrireInformationEntité($data : Object)->$result : Text
	// créer le texte de l'entité $params; utilise un template
	var $formats; $entité; $sélectionEntités; $sélectionEntité; $sélections; $sélection : Object
	var $dataClassNom; $texte; $soustexte; $Code : Text
	var $i; $numCode : Integer
	var $RacineXML; $ElementXML; $Xpath : Text
	
	// lire les formats
	$formats:=New object("Options"; 0)
	// options renseignées au coup par coup
	// les formats renseignés au coup par coup
	//$formats.FormatDate:=This.session.prefs.Apparence.Formulaire.FormatDate
	//$formats.FormatGeoLoc:=This.session.prefs.Apparence.Formulaire.FormatLieu
	//$formats.FormatHeure:=This.session.prefs.Apparence.Formulaire.FormatHeure
	
	// lire les paramètres
	$formats.params:=0
	If (OB Is defined($data; "params"))
		$formats.params:=$data.params
	End if 
	$formats.séparateurComments:=". "
	
	$texte:=""
	Case of 
		: (Not(OB Is defined($data; "entité")))
		: ($data.entité=Null)
		Else 
			$entité:=$data.entité
			
			$dataClassNom:=$entité.getDataClass().getInfo().name
			
			// lire la structure des informations de l'entité $2
			$Xpath:=Folder(Get 4D folder(Current resources folder); fk platform path).folder("TemplatesALV").file("TemplateInfosEntité.xml").platformPath
			$RacineXML:=DOM Parse XML source($Xpath)
			$ElementXML:=DOM Find XML element by ID($RacineXML; $dataClassNom)
			If (ok=1)
				DOM GET XML ELEMENT NAME($ElementXML; $Xpath)
				ARRAY TEXT($tabElements; 0)
				$ElementXML:=DOM Find XML element($ElementXML; $Xpath+"/information"; $tabElements)
				
				If (Size of array($tabElements)>0)
					// pour chaque info
					For ($i; 1; Size of array($tabElements))
						// récupérer les éléments de l'info $i
						ARRAY TEXT($tabNoms; 1)
						ARRAY TEXT($tabValeurs; 1)
						// pour les erreurs
						$tabNoms{0}:="#Erreur"
						$tabValeurs{0}:="#Erreur"
						$ElementXML:=DOM Get first child XML element($tabElements{$i}; $tabNoms{1}; $tabValeurs{1})
						While (ok=1)
							INSERT IN ARRAY($tabNoms; 1; 1)
							INSERT IN ARRAY($tabValeurs; 1; 1)
							$ElementXML:=DOM Get next sibling XML element($ElementXML; $tabNoms{1}; $tabValeurs{1})
						End while 
						// lire les données nécessaires
						$Code:=$tabValeurs{indexTableau(Find in array($tabNoms; "code"))}
						// séparateur entre l'information courante et la suivante
						$formats.séparateur:=$tabValeurs{indexTableau(Find in array($tabNoms; "separateur"))}
						$formats.séparateurBloc:=Choose($data.params ?? 2; Char(Line feed)+Char(Line feed); $formats.séparateur)
						
						$formats.Options:=Num($tabValeurs{indexTableau(Find in array($tabNoms; "format"))})
						
						If (Match regex("[0-9]{1,5}"; $Code))
							// un nombre de 1 à 5 chiffres
							$numCode:=Num($code)
							Case of 
								: ($numCode=0)
									If ($formats.params ?? 1)
										// nom de l'objet de la table courante
										$texte:=$texte+$entité.Libellé($formats)+$formats.séparateur
									End if 
									// ajouter le commentaire
									$formats.débutComment:=""
									$formats.finComment:=Choose($data.params ?? 2; $formats.séparateurBloc; ", ")
									$texte:=$texte+$entité.RédigerCommentaire($formats)
									
								: ($numCode=1)
									// les membres d'une union
									$texte:=$texte+$formats.séparateur+$entité.Libellé($formats)
									
								: ($numCode>=22000) & ($numCode<=22999)
									// évents persos
									$sélection:=$entité.LesEvenementsPersonnels().query("type = :1"; $numCode)
									If ($sélection.length>0)
										// utiliser les formats par défaut
										$texte:=$texte+$sélection[0].Libellé($formats)
										// ajouter le commentaire
										$formats.débutComment:=Choose($data.params ?? 2; Char(Line feed); ", ")
										$formats.finComment:=""
										$texte:=$texte+$sélection[0].RédigerCommentaire($formats)
										$texte:=$texte+$formats.séparateurBloc
									End if 
									
								: ($numCode>=33000) & ($numCode<=33999)
									// évent fam : pour chaque union, éditer le premier Event Fam
									// attention : $entité peut concerner différents types de table : chercher la liste des Unions
									Case of 
										: ($dataClassNom="Personnes")
											$sélectionEntités:=$entité.LesUnions()
											
										: ($dataClassNom="Unions")
											$sélectionEntités:=ds.Unions.query("ID = :1"; $entité.ID)
											
										Else 
											$sélectionEntités:=Null
									End case 
									
									// pour chaque union de la liste, éditer un event Fam
									Case of 
										: ($sélectionEntités=Null)
										: ($sélectionEntités.length=0)
										Else 
											// rappel : les unions sont classées par date, et les conjoints sont liés aux unions par [Unions]ID
											For each ($sélectionEntité; $sélectionEntités)
												// ajouter l'event, s'il existe
												$sélections:=$sélectionEntité.LesEvenementsFamiliaux()
												
												If ($sélections.length=0)
													$texte:=$texte+Localized string("33611")
													
												Else 
													$soustexte:=""
													
													// utiliser les formats par défaut
													$formats.Options:=0x3F00
													// ici il peut y avoir 1 à plusieurs évents pour cette union (rappel : ordre chronos)
													If ($formats.params ?? 3)
														// on les prend tous
													Else 
														$sélections:=$sélectionEntité.LesEvenementsFamiliaux().slice(0; 1)
													End if 
													For each ($sélection; $sélections)
														$soustexte:=$soustexte+$sélection.Libellé($formats)+$formats.séparateur
													End for each 
													// nettoyer
													$texte:=$texte+Substring($soustexte; 1; Length($soustexte)-Length($formats.séparateur))
												End if 
												
												// ajouter le conjoint , s'il existe
												// on aurait pu utiliser l'option 15 du codage de l'évent
												Case of 
													: ($dataClassNom#"Personnes")
													: ($sélectionEntité.LeConjoint($entité)=Null)
													Else 
														// ok on a un conjoint
														$formats.Options:=35
														$texte:=$texte+" "+$sélectionEntité.LeConjoint($entité).Libellé($formats)
												End case 
												
												// ajouter les commentaires
												$soustexte:=""
												$formats.débutComment:=Choose($data.params ?? 2; Char(Line feed); ", ")
												$formats.finComment:=""
												For each ($sélection; $sélections)
													$soustexte:=$soustexte+$sélection.RédigerCommentaire($formats)
												End for each 
												$texte:=$texte+$soustexte
												
												$texte:=$texte+$formats.séparateurBloc
											End for each 
									End case 
							End case 
							
						Else 
							// rien
						End if 
						
					End for 
					// nettoyer
					$texte:=Substring($texte; 1; Length($texte)-Length($formats.séparateur))
				End if 
			End if 
			DOM CLOSE XML($RacineXML)
	End case 
	// fixer le résultat
	$result:=$texte

⇧ [class]UtilisateursALVEditeur - 06/05/2026 11:26:02

      property UtilisateursALV; GroupeFamilial : Object
property GroupesFamiliaux; IndexGroupesFamiliaux; ListeMembresDuGroupe : Integer
property GroupOwner : Text

Class extends $editeur

Class constructor()
	// construction commune
	Super()
	
	// utilisateurs ALV visibles de l'utilisateur courant
	This.UtilisateursALV:=Null
	
	// Liste des groupes liés à l'utilisateur
	This.GroupesFamiliaux:=0
	This.IndexGroupesFamiliaux:=-1
	// groupe courant
	This.GroupeFamilial:=Null
	
	
Function getDataClassInfos()->$result : Object
	$result:=Super.getDataClassInfos("UtilisateursALV")
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	ASSERT(cs.$trace.me.DebugerEventForm(Current method name; "EventForm"; New object("numEvent"; FORM Event.code; "numTable"; Table(Current form table))))
	
	// traitements génériques
	This.surEvenementFormulaire()
	
	// traitements particuliers
	Case of 
		: (FORM Event.code=On Load)
			Case of 
				: (This.session.user.estMembreDe_ApplicationAutonome)
					FORM GOTO PAGE(1)
					
				: (This.session.user.estMembreDe_AdministrationBDD | (This.session.prefs.Session_Etat ?? 6))
					FORM GOTO PAGE(2)
					
				Else 
					FORM GOTO PAGE(1)
			End case 
			OBJECT SET VISIBLE(*; "logo"; FORM Get current page=1)
			
			// charger les objets
			This.onEndLoad()
			
			
		: (FORM Event.code=On Data Change)
			Case of 
					// virer les cas où le traitement est fait directement dans l'objet
				: (OBJECT Get name(Object with focus)="ressourceID_65")
				: (OBJECT Get name(Object with focus)="ressourceID_66")
				Else 
					cs._ds.me.Modifier(cdk Modifier; New collection(Form.membre); Null)
			End case 
			
		: (FORM Event.code=On Unload)
			This.onEndUnLoad()
	End case 
	
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	// dans l'ordre
	$c:=New collection()
	$c.combine(["listeGroupesFamiliaux"; "listeUtilisateursALV"])
	Super.onEndEventForm($c)
	
	
Function onEndUnLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection()
	$c.combine(["listeGroupes"])
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:FORMevents Page fond
	// ----------------------
	
Function _FORM_menuContext()
	Case of 
		: (FORM Event.code=On Clicked)
			Form.ActionMenuContextuel()
	End case 
	
	
Function _FORM_listeGroupesFamiliaux()
	var $params : Object
	var $itemRef : Integer
	
	Case of 
		: (FORM Event.code=On Load)
			// lister les groupes de responsabilité de utilisateur courant
			// exécuter
			$params:=New object
			$params.LogIn:=This.session.userName
			$params.IDgroupe:=This.session.user.IDfamille
			$params.estDebug:=(This.session.prefs.Session_Etat ?? 6)
			This.CréerLaListe(cs.wwwGroupes.name; "CréerLaListeDesGroupes"; $params)
			
			Form[This.nomOBJ]:=$params.liste
	End case 
	
	If ((FORM Event.code=On Load) | (FORM Event.code=On Clicked))
		// sélectionner le groupe courant
		This.GroupeFamilial:=Null
		Case of 
			: (Form[This.nomOBJ].values.length=0)
			: (Form[This.nomOBJ].index<0)
			Else 
				Form.IndexGroupesFamiliaux:=Form[This.nomOBJ].index
				
				$itemRef:=Form[This.nomOBJ].codes[Form[This.nomOBJ].index]
				Form.GroupeFamilial:=ds.wwwGroupes.get($itemRef & 0x00FFFFFF)
		End case 
		
		// afficher les membres du groupe
		This.ListerMembresDuGroupe()
		// afficher le membre courant
		This._FORM_listeMembres()
		// afficher les infos groupe
		This.AfficherGroupe()
	End if 
	
	
Function _FORM_listeMembres()->$result : Integer
	var $nomOBJ : Text
	
	Case of 
		: ((FORM Event.code=On Load) | (FORM Event.code=On Clicked))
			// appel par d'autres functions
			// récupérer le nom de l'objet de cette function
			$nomOBJ:=Split string(Current method name; "_").last()
			LISTBOX SELECT ROW(*; $nomOBJ; Form[$nomOBJ+"ElementPosition"]; lk replace selection)
			Form.AfficherMembre()
			
		: (FORM Event.code=On Selection Change)
			If (Form.membre#Null)
				Form.AfficherMembre()
			End if 
	End case 
	
	
Function _FORM_listeMembres_membreLabel()->$result : Integer
	var $entité : Object
	
	Case of 
		: (FORM Event.code=On Drag Over)
			// attention $glisserDeposer ne gère que le glisser/Deposer interprocess
			// bidouille locale !
			
			$result:=-1
			Case of 
				: (Not(This.glisserDeposer.estGlisserValide()))
				: (Not(cs._cfct.me.estIDcodeDeClasses(Storage.System.GlisserDéposer.refItem; [ds.UtilisateursALV])))
				Else 
					// ok, on a une EntitéCodée
					$result:=0
					This.glisserDeposer.FixerParamsMessage()
			End case 
			
			Case of 
				: ($result=-1)
					Form.EffacerMessageUtilisateur()
					
				: ($result=0)
					// dépose sur la liste
					This.glisserDeposer.paramsMessage.param_2:=This.GroupeFamilial.Libellé()
					Form.AfficherMessageUtilisateur(New object("libelle"; cs._cfct.me.LireLocatedSTR(5180; This.glisserDeposer.paramsMessage)))
			End case 
			
		: (FORM Event.code=On Drop)
			If (Form.ActionUtilisateur("[ModificationAutorisée]"))
				$entité:=cs._ds.me.EntitéAvecIDcodé(Storage.System.GlisserDéposer.refItem)
				$entité.Groupe:=Form.GroupeFamilial.ID
				
				cs._ds.me.Modifier(cdk Modifier; New collection($entité); Null)
			End if 
	End case 
	
	
Function _FORM_btnNavPreviousRecord()
	If (Form.listeMembresElementPosition>1)
		Form.listeMembresElementPosition:=Form.listeMembresElementPosition-1
		This._FORM_listeMembres()
	Else 
		BEEP
	End if 
	
	
Function _FORM_btnNavNextRecord()
	If (Form.listeMembresElementPosition<Form.listeMembres.length)
		Form.listeMembresElementPosition:=Form.listeMembresElementPosition+1
		This._FORM_listeMembres()
	Else 
		BEEP
	End if 
	
	
Function _FORM_ressourceID_65()
	Case of 
		: (FORM Event.code=On Clicked)
			If (Form[This.nomOBJ])
				Form.membre.droits:=Form.membre.droits ?+ 0
				
			Else 
				Form.membre.droits:=0
			End if 
			// mettre a jour
			This.FixerPrivilègesRole()
			
			cs._ds.me.Modifier(cdk Modifier; New collection(Form.membre); Null)
	End case 
	
	
Function _FORM_ressourceID_66()
	Case of 
		: (FORM Event.code=On Clicked)
			If (Form[This.nomOBJ])
				Form.membre.droits:=3
				
			Else 
				Form.membre.droits:=Form.membre.droits ?- 1
			End if 
			// mettre a jour
			This.FixerPrivilègesRole()
			
			cs._ds.me.Modifier(cdk Modifier; New collection(Form.membre); Null)
	End case 
	
	
Function _FORM_ressourceID_182()
	var $entité : Object
	
	If (FORM Event.code=On Clicked)
		$entité:=Form.GroupeFamilial
		
		If (Form[This.nomOBJ])
			
			If (Form.membre.Groupe>0)
				$entité.Proprietaire:=Form.membre.ID
			End if 
			
		Else 
			$entité.Proprietaire:=0
		End if 
		
		cs._ds.me.Modifier(cdk Modifier; New collection($entité); Null)
		// afficher les infos groupe
		This.AfficherGroupe()
	End if 
	
	
	// ----------------------
	//MARK:FORMevents Page 2
	// ----------------------
	
Function _FORM_listeUtilisateursALV()
	var $params : Object
	
	Case of 
		: (FORM Event.code=On Load)
			// lister les groupes de responsabilité de utilisateur courant
			// exécuter
			$params:=New object
			$params.LogIn:=This.session.userName
			$params.IDgroupe:=This.session.user.IDfamille
			$params.estDebug:=(This.session.prefs.Session_Etat ?? 6)
			This.CréerLaListe(cs.wwwGroupes.name; "CréerLaListeDesUtilisateursALV"; $params)
			
			Form[This.nomOBJ]:=$params.liste
	End case 
	
	
Function _FORM_listeUtilisateursALV_item()
	Case of 
		: (FORM Event.code=On Begin Drag Over)
			This.glisserDeposer.surDebutGlisserITEM_LB()
	End case 
	
	
Function _FORM_afficherAdministration()
	var $params : Object
	
	Case of 
		: (FORM Event.code=On Load)
			OBJECT SET VISIBLE(*; This.nomOBJ; User in group(Current user; "Administration BDD") | (This.session.prefs.Session_Etat ?? 6))
			
		: (FORM Event.code=On Clicked)
			// créer les paramètres d'un menu, lié à une pseudo commande 3072
			// rappel : le menu 3072 n'existe pas dans les barres de menus
			$params:=New object
			$params.commande:="3072"
			$params.type:="Formulaire"
			$params.nomClass:="$formulaire_3072"
			$params.titre:=Localized string("5205")
			
			cs.$processUser.new().AfficherFormulaire($params)
	End case 
	
	
	// ----------------------
	// MARK:Groupes
	// -----------------------
	
Function ListerMembresDuGroupe()
	// fixer une sélection d'entités
	Case of 
		: (This.GroupeFamilial=Null)
			// utilisateur non encore dans un groupe
			Form.listeMembres:=ds.UtilisateursALV.newSelection()
			// surligner l'utilisateur dans la listBox
		Else 
			// cas normal
			Form.listeMembres:=This.GroupeFamilial.lesMembres
	End case 
	Form.listeMembres:=Form.listeMembres.orderBy("Name asc, First_Name asc")
	Form.listeMembresElementPosition:=1
	Form.membre:=Form.listeMembres[Form.listeMembresElementPosition-1]
	
	
Function AfficherGroupe()
	var $sélection : cs.UtilisateursALVSelection
	var $params : Object
	
	OBJECT SET VISIBLE(*; "grpAddGroup@"; (This.GroupeFamilial#Null))
	
	// récupérer le nom du propriétaire
	If (This.GroupeFamilial#Null)
		$sélection:=ds.UtilisateursALV.query("ID = :1"; This.GroupeFamilial.Proprietaire)
		
		$params:=New object
		If ($sélection.length>0)
			$params.param_1:=$sélection[0].Libellé(New object("Options"; 3))
			$params.param_2:=This.GroupeFamilial.Nom
		Else 
			$params.param_1:=" non défini"
			$params.param_2:=This.GroupeFamilial.Nom
		End if 
		This.GroupOwner:=cs._cfct.me.LireLocatedSTR(5044; $params)
	End if 
	
	
	// ----------------------
	// MARK:Formulaire
	// -----------------------
	
Function AfficherEntité()
	// mise à jour du formulaire ouvert
	var $saisissable : Boolean
	
	// pour la locatedSTR
	SET WINDOW TITLE(cs._cfct.me.LireLocatedSTR(5084; New object("param_1"; Form.nav.entitéCourante.LogIn)))
	
	$saisissable:=This.session.user.estMembreDe_Administration
	$saisissable:=$saisissable | (This.session.prefs.Session_Etat ?? 6)  // si debug
	// les membres de groupe sont gérés par un admin
	OBJECT SET VISIBLE(*; "ListeMembresDuGroupe"; $saisissable)
	// les droits sont gérés par un admin
	OBJECT SET ENABLED(*; "ressourceID 65"; $saisissable)
	// création du proprio
	OBJECT SET VISIBLE(*; "ressourceID 182"; $saisissable)
	
	
Function AfficherMembre()
	// afficher les droits
	// saisie
	Form["ressourceID_65"]:=(Form.membre.droits ?? 0)
	// données compl
	Form["ressourceID_66"]:=(Form.membre.droits ?? 1)
	// est proprio
	Form["ressourceID_182"]:=((Form.membre.leGroupe.ID>0) & (Form.GroupeFamilial.Proprietaire=Form.membre.ID))
	
	// LogIn et MdP de l'utilisateur ALV sont accrochés à la licence => il ne peut pas les modifier
	Case of 
		: (Form.listeMembres.length=0)
		: (Form.membre=Null)
		Else 
			// afficher l'utilisateur courant et ses infos
			
			OBJECT SET ENTERABLE(*; "grpMdP@"; This.session.userName#Form.membre.LogIn)
			If (OBJECT Get enterable(*; "grpMdP@"))
				OBJECT SET RGB COLORS(*; "grpMdP@"; Foreground color; Background color none)
			Else 
				OBJECT SET RGB COLORS(*; "grpMdP@"; Dark shadow color; Background color none)
			End if 
	End case 
	
	
Function FixerPrivilègesRole()
	// fixer les privilèges : servent à valider l'acces à la BDD (cf fichier roles.json)
	// fixer le role : sert à définir l'alias 4D de l'utilisateur
	
	If (Form.membre#Null)
		// les privilèges
		Form.membre.privileges:=Choose(Form.membre.droits=0; "ReadRecords"; "CreateRecords")
		
		// le role
		// par défaut
		Form.membre.role:="Visiteur"
		Case of 
			: (Form.membre.droits=1)
				Form.membre.role:="Utilisateur ALV"
				
			: (Form.membre.droits=3)
				Form.membre.role:="Utilisateur ALVplus"
		End case 
		
		// propriétaire d'un groupe
		If (Form.membre.leGroupe.Propriétaire=Form.membre.ID)
			Form.membre.role:="Utilisateur ALVadmin"
		End if 
	End if 
	
	
	// ----------------------
	// MARK:Requêtes externes
	// -----------------------
	
Function getUtilisateurCourant($params : Object)
	var $entité : Object
	
	$params.Utilisateur:=Null
	Case of 
		: (This.session.user=Null)
		Else 
			$params.UtilisateurCourant:=New object
			
			$params.UtilisateurCourant.UserID:=OB Copy(This.session.user)
			
			$entité:=ds.UtilisateursALV.get(This.session.user.ID)
			$params.UtilisateurCourant.Famille:=$entité.AppartenancesAPP()
			$params.UtilisateurCourant.GroupesAPP:=$entité.AppartenancesALV()
	End case 
	
	
Function getGroupesFamiliaux($params : Object)
	$params.GroupesFamiliaux:=ds.wwwGroupes.all().extract("Nom"; "Nom"; "IDfamille"; "IDfamille")
	
	
Function MettreAjourSelection()
	Form.AfficherMembre()

⇧ [class]EncyclopediaPalette - 19/05/2026 08:18:14

      property Items : Collection
property indiceItems : Integer:=-1
property tailleMaxItems : Integer:=30  // en dur !!!
property tache : cs.xSDK.Tache
property nomTache : Text:="Encyclo_EditerSélection"

Class extends $texteEditeur

Class constructor()
	Super()
	
	This.Items:=New collection
	
	
Function getDataClassInfos()->$result : Object
	$result:=Super.getDataClassInfos("Encyclopedia")
	
	
Function FixerParamètres($params : Object)
	// $params = paramètres de menu
	
	Super.FixerParamètres($params)
	This.informations.nomForm:="U_Palette?"+$params.commande
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	var $varName : Text
	
	ASSERT(cs.$trace.me.DebugerEventForm(Current method name; "EventForm"; New object("numEvent"; FORM Event.code; "numTable"; Table(Current form table))))
	
	// traitements génériques
	This.surEvenementFormulaire()
	
	Case of 
			
		: (FORM Event.code=On Load)
			OBJECT SET VISIBLE(*; "grpEdit@"; False)
			
			cs.$processData.me.FixerTache(Current process name; New object("nomTache"; This.nomTache; "activerCurseurHoraire"; True))
			
			This.onEndLoad()
			
		: (FORM Event.code=On Timer)
			cs.$processData.me.AfficherProgressionTache()
			
		: (FORM Event.code=On Data Change)
			$varName:=OBJECT Get name(Object with focus)
			Case of 
				: ($varName=Form.zoneDocumentNom)
					
				: (Form.entité=Null)
					// circuler
					
				: ($varName="@MotCle")
					cs._ds.me.Modifier(cdk Modifier; New collection(Form.entité); Null)
					
					//// plusieurs possibilités : le mot-clé est un patronyme ou non
					//Si (Form.DicoDesNoms.length>0)
					//// le nom du patronyme est changé : répercuter la modif du patronyme sur toutes les entités
					
					//Pour chaque ($entité; Form.DicoDesNoms)
					//$entité.patronyme:=Form.entité.MotCle
					//Modifier BDD(dsk Modifier; Créer collection($entité); Null)
					//Fin de chaque 
					
					//Form.Items[Form.indiceItems]:=Form.entité.MotCle
					//Form.AfficherEnregistrement()
					//Fin de si 
					
					//Sinon 
					//Modifier BDD(dsk Modifier; Créer collection(Form.entité); Null)
			End case 
			
		: (FORM Event.code=On Unload)
			This.process.TuerAvecNumero(Form.numProcess)  // au cas ou
	End case 
	
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection("Selecteur")
	$c.combine(["grpMotCle"; "grpMotCleRechercher"; "EtendreBDD"])
	$c.combine(["grpAjoutMotCle"])
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:FORMevents Page 1
	// ----------------------
	
Function _FORM_grpEditMotCle()
	This._FixerMajuscule()
	
	
Function _FORM_grpEditMotClePluriel()
	This._FixerMajuscule()
	
	
Function _FixerMajuscule()
	var $nomOBJ; $dataTexte : Text
	
	// attribut entité associée
	$nomOBJ:=Replace string(This.nomOBJ; "grpEdit"; "")
	
	Case of 
		: (FORM Event.code=On After Keystroke)
			$dataTexte:=Get edited text
			If (Length($dataTexte)>0)
				$dataTexte[[1]]:=Uppercase($dataTexte[[1]]; *)
				Form.entité[$nomOBJ]:=$dataTexte
			End if 
	End case 
	
	
Function _FORM_Selecteur()
	var $params : Object
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=New object("values"; New collection; "codes"; [1099; 1100; 1101])
			Form[This.nomOBJ].values.push(Localized string("1099"))
			Form[This.nomOBJ].values.push(Localized string("1100"))
			Form[This.nomOBJ].values.push(Localized string("1101"))
			
			Form[This.nomOBJ].index:=0
	End case 
	
	If ((FORM Event.code=On Load) | (FORM Event.code=On Data Change))
		$params:=New object
		$params.menuID:=Form[This.nomOBJ].codes[Form[This.nomOBJ].index]
		$params.numProcessAppelant:=Current process
		
		// pour le retour
		$params.nomProcessAppelant:=Current process name
		$params.CallBack:="AfficherTexte"
		
		This.EditerSélection(cs.$texteTraitement.name; "RechercherSurClasse"; $params)
		
		OBJECT SET VISIBLE(*; "grpAjout@"; Form[This.nomOBJ].index=2)
		// tout ne doit pas être visible !
		This.nomOBJ:="grpAjoutMotCle"
		This._FORM_grpAjoutMotCle()
	End if 
	
	
Function _FORM_grpMotCle()
	var $nomOBJ; $motClé; $texte : Text
	var $nomOBJbtn : Text
	
	
	// attribut entité associée
	$nomOBJ:=Replace string(This.nomOBJ; "grp"; "")
	// btn de l'action associée
	$nomOBJbtn:=This.nomOBJ+"Rechercher"
	
	Case of 
		: (FORM Event.code=On Load)
			Form[$nomOBJ]:=""
			OBJECT SET VISIBLE(*; $nomOBJbtn; False)
			
		: (FORM Event.code=On After Keystroke)
			// écrire dans le titre de la fenêtre ce que l'on cherche
			$motClé:=Get edited text
			$texte:=Char(34)+$motClé+Char(34)
			SET WINDOW TITLE(Localized string("5113")+$texte)
			
			If (Length($motClé)>0)
				OBJECT SET VISIBLE(*; $nomOBJbtn; True)
				
				If ($motClé[[1]]="?")
					$texte:=Replace string($motClé; "?"; ""; *)
					
					If (This.session.prefs.Session_Etat ?? 12)
						SET WINDOW TITLE(Localized string("5115")+$texte)
					Else 
						SET WINDOW TITLE(Localized string("5114")+$texte)
					End if 
				End if 
				
			Else 
				OBJECT SET VISIBLE(*; $nomOBJbtn; False)
			End if 
	End case 
	
	
Function _FORM_grpMotCleRechercher()
	var $params : Object
	
	Case of 
		: (FORM Event.code=On Load)
			// Initialisation de l'historique des items consultées
			Form.InitialiserListe()
			
		: (FORM Event.code=On Clicked)
			$params:=New object
			// mémoriser la commande
			$params.motCle:=Form.MotCle
			
			// pour le retour
			$params.nomProcessAppelant:=Current process name
			$params.CallBack:="AfficherTexte"
			
			// lancer le processus
			Form.EditerSélection(cs.$texteTraitement.name; "RechercherSurMotCle"; $params)
			
			Form.AjouterAliste($params.motCle)
	End case 
	
	
Function _FORM_EtendreBDD()
	
	This.EditerPropriétéObjet(Est une Option binaire; This.session.prefs; "Session_Etat"; 12)
	
	If ((FORM Event.code=On Load) | (FORM Event.code=On Clicked))
		If (This.session.prefs.Session_Etat ?? 12)
			SET WINDOW TITLE(Localized string("5115"))
			
		Else 
			SET WINDOW TITLE(Localized string("5114"))
		End if 
	End if 
	
	
Function _FORM_grpAjoutMotCle()
	var $nomOBJbtn : Text
	
	// btn de l'action associée
	$nomOBJbtn:=This.nomOBJ+"Ajouter"
	
	OBJECT SET VISIBLE(*; $nomOBJbtn; False)
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=""
			
		: (FORM Event.code=On Data Change)
			If (Length(Form[This.nomOBJ])>0)
				OBJECT SET VISIBLE(*; $nomOBJbtn; True)
			End if 
	End case 
	
	
Function _FORM_grpAjoutMotCleAjouter()
	var $data : Object
	var $texte : Text
	
	Case of 
		: (FORM Event.code=On Clicked)
			
			Case of 
				: (Form["grpAjoutMotCle"]="")
				: (Not(Form.ActionUtilisateur("[SaisieAutorisée]")))
					// modifications non autorisées
					Form.AfficherMessageUtilisateur(New object("ID"; 5042))
					
				Else 
					// le retour de Ajouter A DataStore(dsk Encyclopédie; ""; Null; Créer objet) ne fonctionne pas ici
					// on le fait en direct
					$data:=ds.Ajouter(dsk Encyclopédie; Null; Null)
					
					$texte:=Form["grpAjoutMotCle"]
					$data.entitéAjoutée.MotCle:=$texte
					cs._ds.me.Modifier(cdk Modifier; New collection($data.entitéAjoutée); Null)
					
					This.AfficherElement($texte)
					
					Use (Storage.Processes[Current process name].Status)
						Storage.Processes[Current process name].Status.State:=2
					End use 
			End case 
	End case 
	
	
Function _FORM_grpEditValider()
	var $texte : Text
	
	Case of 
		: (FORM Event.code=On Clicked)
			// sélectionner tout le texte de la zone
			$texte:=ST Get plain text(Form.zoneDocument->)
			Case of 
				: (Form.entité=Null)
					// contenu complexe
				: (Form.entité.Description=$texte)
					// pas de modification
				Else 
					// ok on stocke
					Form.entité.Description:=$texte
					cs._ds.me.Modifier(cdk Modifier; New collection(Form.entité); Null)
					
					OBJECT SET VISIBLE(*; This.nomOBJ; False)
			End case 
	End case 
	
	
	// ----------------------
	//  MARK:Gestion formulaire
	// -----------------------
	
Function EditerSélection($dataClassNom : Text; $functionID : Text; $params : Object)
	// lancer la construction ; dans un process à part, ça peut être long
	var $data; $zoneDocument : Object
	
	// passer les UserPrefs (en lecture seule !, par le serveur en particulier)
	$params.UserPrefs:=OB Copy(This.session.prefs)
	This.tache:=This.registreTaches.Inscrire(New object("nomProcess"; Current process name; "nomTache"; This.nomTache; "numProcessAppelant"; $params.numProcessAppelant))
	
	// la construction se fait dans un worker (-> pré-emptif)
	$data:=New object("params"; $params)
	$data.execute:=Formula(cs.$serveurAPP.me.Executer($dataClassNom; $functionID; This.params))
	CALL WORKER("WK_selectionsBDD"; Formula($data.execute()))
	
	// le temps de construction est long,
	OBJECT SET VISIBLE(*; "grpEditMotCle@"; False)
	
	// si un texte existe déjà, le griser
	$zoneDocument:=This.getObjetZoneWP()
	If (Not($zoneDocument=Null))
		WP SET ATTRIBUTES($zoneDocument; wk text color; "LightGray")
	End if 
	// pas de modification
	Form.entité:=Null
	Form.DicoDesNoms:=Null
	
	
Function AfficherTexte($params : Object)
	// call back de la tache
	Super.AfficherTexte($params)
	This.tache.DésInscrire()
	
	
	// ----------------------
	// MARK:Gestion de la liste de mots-clé
	// -----------------------
	
Function InitialiserListe()
	This.Items:=New collection
	
	
Function AjouterAliste($motClé : Text)
	// ajouter $1 à la fin de la liste
	
	Case of 
		: (This.Items.length=0)
			This.Items.push($motClé)
			
		: (This.Items[This.indiceItems]#$motClé)
			This.Items.push($motClé)
	End case 
	
	// réduite la liste à sa taille max
	While (This.Items.length>This.tailleMaxItems)
		This.Items:=This.Items.shift()
	End while 
	
	This.indiceItems:=This.Items.length-1
	
	
Function ElementPrécédent()
	If (This.indiceItems>0)
		This.indiceItems:=This.indiceItems-1
		This.AfficherElement(This.Items[This.indiceItems])
		
	Else 
		BEEP
	End if 
	
	
Function ElementSuivant()
	If (This.indiceItems+1<This.Items.length)
		This.indiceItems:=This.indiceItems+1
		This.AfficherElement(This.Items[This.indiceItems])
		
	Else 
		BEEP
	End if 
	
	
Function AfficherElement($motClé : Text)
	// afficher le mot-clé $motClé
	// si on a appuyé sur Options, passer en édition de l'élément
	var $params : Object
	
	If (Form.ActionUtilisateur("[option]"))
		Form.entité:=ds.Encyclopedia.query("MotCle = :1"; $motClé)[0]
		
		$params:=New object("texteWorké"; Form.entité.Description)
		This.AfficherTexte($params)
		
		// fixer la liste des nom de personnes ayant pour patronyme $motClé
		Form.DicoDesNoms:=Form.entité.lesPatronymes
		OBJECT SET VISIBLE(*; "grpEditMotCle@"; True)
		OBJECT SET ENTERABLE(*; "Zone4DwritePro"; True)
		
	Else 
		$params:=New object
		$params.motCle:=$motClé
		
		// pour le retour
		$params.nomProcessAppelant:=Current process name
		$params.CallBack:="AfficherTexte"
		
		// lancer le processus
		Form.EditerSélection(cs.$texteTraitement.name; "RechercherSurMotCle"; $params)
		
		Form.entité:=Null
		Form.DicoDesNoms:=Null
		Form.grpAjoutMotCle:=""
		OBJECT SET VISIBLE(*; "grpEditMotCle@"; False)
		OBJECT SET ENTERABLE(*; "Zone4DwritePro"; False)
	End if

⇧ [class]$hyperTexteEditeur - 30/01/2026 19:38:36

      property nomObjet : Text:=""

Class extends $texteEditeur

Class constructor($nomObjet : Text)
	Super()
	
	This.nomObjet:=$nomObjet
	
	
Function InformationEntité($params : Object)
	var $texte : Text
	
	// rédiger le texte brut
	Super.InformationEntité($params)
	$texte:=$params.texteWorké
	// créer les liens hypertextes si existent
	$texte:=This.FixerLiensHyperText($texte)
	// retourner le résultat
	$params.texteWorké:=$texte
	
	
	// ----------------------
	//MARK:Affichage
	// -----------------------
	
Function FixerHyperTexte($params : Object)
	// afficher le texte dans la zoneDocument
	var $texte : Text
	
	$texte:=$params.texteWorké
	// écrire le texte balisé
	// pour une zone 4DwritePro, utiliser le nom de l'objet pour une mise à jour du formulaire
	ST SET TEXT(*; This.nomObjet; $texte)
	// afficher l'information
	OBJECT SET VISIBLE(*; This.nomObjet; Length($texte)#0)
	This.AppliquerStylesVisualisation()
	
	
Function AfficherElement($motClé : Text)
	// afficher la palette encyclopédie ; simuler l'appel d'un menu
	
	This.menu.params.motCle:=$motClé
	This.menu.params.commande:="3065"
	This.menu.params.DataClassNom:="Encyclopedia"
	This.menu.params.nomClass:="Visualisateur"
	This.menu.params.type:="Palette"
	This.menu.params.titre:=Localized string("5076")
	This.menu.Exécuter()
	
	
Function AjouterAliste($motClé : Text)
	// bouchonner
	
	
	// ----------------------
	//MARK:Création Texte
	// -----------------------
	
Function TextEncycloSurSelection($sélection : Object; $attribut : Text)->$result : Text
	// pour chaque entité de $sélection, renvoyer son libellé stylé suivi de la description hypertexturée
	var $texte : Text
	var $entité : Object
	
	$result:=""
	If ($sélection.length>0)
		$texte:="<span>"
		// chaque entité est séparée de 2 RC 
		For each ($entité; $sélection)
			$texte:=$texte+Char(Carriage return)
			$texte:=$texte+$entité.LibelléEncyclo($attribut)+Char(Line feed)+Char(Carriage return)
			$texte:=$texte+This.FixerLiensHyperText($entité[$attribut])+Char(Line feed)+Char(Carriage return)
			
			// attention le texte HTML n'aime pas le & du format d'un event fam ; modifier le symbole
			// verrue pour l'instant EN DUR!!!!!
			$texte:=Replace string($texte; " & "; Localized string("1014"))
		End for each 
		$result:=$texte+"</span>"
	End if 
	
	
Function TextEncycloSurMotClé($motClé : Text; $dataClassNom : Text; $attributs : Collection)->$result : Text
	// renvoie un texte avec les attributs $3 de $2 contenant le mot-clé $1
	// attention : $attributs sont des nom ORDA, pas forcément affichable) ; pb géré par les classes entity concernées
	var $sélection : Object
	var $attribut : Text
	
	$result:=""
	For each ($attribut; $attributs)
		$sélection:=ds[$dataClassNom].query(":1%:2 "; $attribut; $motClé)
		$result:=$result+This.TextEncycloSurSelection($sélection; $attribut)
	End for each 
	
	
Function FixerLiensHyperText($texte : Text)->$result : Text
	var $méthode : Object
	$méthode:=New object("formule"; Formula(cs.$texteEditeur.new().FixerLiensHyperText($1)))
	$result:=$méthode.formule($texte)
	
	
Function LibelléEncyclo($attribut : Text; $texte : Text)->$result : Text
	$result:=$attribut+Localized string("1001")+$texte
	$result[[1]]:=Uppercase($result[[1]])
	$result:="<span style='color:darkgreen;font-weight:bold'>"+$result+"</span>"

⇧ [class]$generationAPP - 23/07/2026 11:45:58

      property xml : cs.xSDK.XML
property dossierTravail; dossierDestination; dossierDestinationComponents; dossierMatriceComposants : 4D.Folder
property buildSettings : 4D.File
property tache; DonnéesExportSiteWeb : Object
property VersionDataALV; VersionDataALV_FTP; VersionApplicationALV; IDversionApplicationALV; SystèmeVersion : Text
property pathDossierDestination; pathDossierAPP : Text
property CréerServeur; ExporterMiseAjour; ExporterInstallateur; CréerApplication : Boolean
property listeDossiersMedia : Collection

Class extends $formulaire

// fonctions d'exportation de la BDD mère
Class constructor()
	var $chemin : Text:=""
	
	Super()
	
	This.rsc.SetObjet(Est Ressource APP; "Versionnage/Data/Format_Fichier"; Is text; This; "VersionDataALV")
	This.VersionDataALV_FTP:=Replace string(This.VersionDataALV; "."; "_")
	This.VersionApplicationALV:=This.environnement.LireVersionAPP()
	This.IDversionApplicationALV:=This.environnement.FixerIDversionAPP()
	This.SystèmeVersion:=This.environnement.infoPlateForme().nom
	
	This.xml:=cs.xSDK.XML.me
	
	// créer le dossier de travail
	// lire le nom de la version générée
	$chemin:="ALV "+This.VersionApplicationALV  // nom versionné du dossier de l'application générée
	// pb de compression du dossier quand ce dossier est parmi ceux de Dossier4D (pb de droit d'accès?) pour l'instant on se met dans le compte utilisateur
	This.dossierTravail:=Folder(System folder(Documents folder); fk platform path).folder(This.fct.FormaterHTML($chemin))
	
	
	
Function RenseignerAvancement($temps : Integer; $message : Text)
	
	This.tache.FixerTime($temps)
	This.tache.FixerEtat($message)
	
	Waiting(2)
	
	
	// ----------------------
	//MARK:Création des APP
	// -----------------------
	
Function GénérerSRV_ALV($params : Object)
	// génére une application compilée et fusionnée avec 4Dserveur_engine ou 4D_engine
	// exécute la méthode dans un process externe et renvoie le numéro du process créé
	var $dataTexte : Text:=""
	var $path; $chemin; $structureXML : Text
	var $Progress; $data; $result : Object
	var $boolean : Boolean
	var $dossier : 4D.Folder
	var $service : cs.xSDK.ServicesFTP
	
	Case of 
		: (Not(OB Is defined($params; "numProcessAppelant")))
			// lancer le process externe
			$params.numProcessAppelant:=Current process
			
			If ((This.session.prefs.Session_Etat ?? 6) & Form.ActionUtilisateur("[option]"))
				// utiliser le fichier généré par le dialogue 4D
				$params.buildSettings:=Folder(Get 4D folder(Database folder); fk platform path).folder("Settings").file("buildApp.4DSettings")
			End if 
			
			Case of 
				: (Form.VersionDataALV_FTP="")
					// il faut que la version du fichier de données soit renseignée
					Form.AfficherMessageUtilisateur(New object("ID"; 5150))
					
				: (Not($params.buildSettings.exists))
					cs.$trace.me.Créer(-15042; Current method name; $params.buildSettings.name).LeverException([msgk_event; msgk_log; msgk_user])
					
				Else 
					// c'est ok
					// compléter les paramètres
					This.rsc.SetObjet(Est Ressource APP; "Serveurs_ALV/Dossier_Serveurs_ALV"; Is text; $params; "pathDossierDestination")
					
					// créer le process
					$params.initProcess:=Formula(InitProcessThreadSafe)
					cs.$process.new().NouveauProcess(cs.$servicesEditeur; "GénérerSRV_ALV"; $params)
					
			End case 
			
		Else 
			// exécuter le process
			// * initialisations du process
			This.InitParams($params)
			cs.xSDK.RegistreTaches.me.DésInscrire($params.nomTache)
			This.tache:=cs.xSDK.RegistreTaches.me.Inscrire(New object("nomProcess"; Current process name; "nomTache"; $params.nomTache; "numProcessAppelant"; $params.numProcessAppelant))
			
			// nettoyer au cas ou (pb en debug)
			This.document.ViderLeContenu(This.dossierTravail)
			
			// créer une application fusionnée, versionnée, dans le dossier FTP des applications et dans le dossier FTP des mises à jour
			// gérer les 2 plateformes OSX et Windows
			This.RenseignerAvancement(0; "")
			This.RenseignerAvancement(1000; Localized string("5121"))
			
			// demander l'accès (et les données) au serveur FTP
			If (This.ftp.FixerAccessInstallateurs($params).success)
				// pour mettre à jour de l'application fusionnée sans modifier les données, le fichier de données utilisateur doit être hors du package
				// A l'init de l'application fusionnée ("sur ouverture") ce fichier doit être déplacé dans les documents utilisateur
				// Pour savoir si on est à l'init de l'application, on utilise le mécanisme 4D du "dossier de données par défaut"
				// créer ce dossier "Default Data" au même niveau que le projet
				This.CréerDefaultData()
				
				// lire les préférences de génération de l'application (générée par le Dialogue 4D PUIS RECOPIEE dans le dossier 'Preferences' du projet)
				This.xml.LireFichier(This.buildSettings; ->$structureXML)
				
				// fixer le chemin des applications 4D courante
				$data:=File(Application file; fk platform path).parent
				
				$chemin:="BuildApp/SourcesFiles/RuntimeVL/"
				$dataTexte:=$data.platformPath+"4D Volume Desktop.app"
				This.xml.EcrireLeChemin(->$structureXML; $chemin+"RuntimeVLMacFolder"; ->$dataTexte)
				$chemin:="BuildApp/SourcesFiles/CS/"
				$dataTexte:=$data.platformPath+"4D Server.app"
				This.xml.EcrireLeChemin(->$structureXML; $chemin+"ServerMacFolder"; ->$dataTexte)
				$chemin:="BuildApp/SourcesFiles/CS/"
				$dataTexte:=$data.platformPath+"4D Volume Desktop.app"
				This.xml.EcrireLeChemin(->$structureXML; $chemin+"ClientMacFolderToMac"; ->$dataTexte)
				
				// fixer le nom de l'application
				$chemin:="BuildApp/"
				$dataTexte:=This.environnement.infosApplication(ALV Serveur APP).nomLong
				This.xml.EcrireLeChemin(->$structureXML; $chemin+"BuildApplicationName"; ->$dataTexte)
				
				// ajouter les autres clés de la génération
				$chemin:="BuildApp/CS/"
				$dataTexte:="True"
				This.xml.EcrireLeChemin(->$structureXML; $chemin+"ServerSelectionAllowed"; ->$dataTexte)
				$chemin:="BuildApp/CS/"
				This.rsc.SetVariable(Est Ressource APP; "serveur_URL/Nom_sousDomaine"; Is text; ->$dataTexte)
				This.xml.EcrireLeChemin(->$structureXML; $chemin+"IPAddress"; ->$dataTexte)
				
				$chemin:="BuildApp/Versioning/Common/"
				// *** cas OSX et WIN
				//  version de l'application
				$dataTexte:=This.VersionApplicationALV
				$dataTexte:=Replace string($dataTexte; "v"; "")
				This.xml.EcrireLeChemin(->$structureXML; $chemin+"CommonVersion"; ->$dataTexte)
				//  copyright
				$dataTexte:="Ainsi La Vie™"
				This.xml.EcrireLeChemin(->$structureXML; $chemin+"CommonCopyright"; ->$dataTexte)
				// *** cas OSX seulement
				//  créateur
				$dataTexte:="ALV"
				This.xml.EcrireLeChemin(->$structureXML; $chemin+"CommonCreator"; ->$dataTexte)
				// *** cas WIN seulement
				//  a faire
				
				TEXT TO DOCUMENT(This.buildSettings.platformPath; $structureXML)
				
				// générer l'application avec ce fichier
				// v6.9.7 : signature de l'application via xCode
				// . dans xCode Preferences/Account vérifier que le compte est toujours actif, sinon resaisir le mot de passe du compte Apple developer
				// . dans xCode Preferences/Account : vérifier que quequechose existe dans la liste 'team', sinon le faire (comment?)
				// . dans Trousseau d'accès, vérifier qu'un certificat "Apple Development: philippe.sape@numericable.fr (ZNTG8G6YWQ)" existe
				// . dans 4D générer l'application, saisir le nom de ce certificat
				
				// v6.10.1 : modifier le contenu du package avant la compilation/signature
				// versionner l'application, dans le fichier Releases.xml
				This.environnement.CréerFichierReleaseAPP()
				
				BUILD APPLICATION(This.buildSettings.platformPath)
				// erreur 55 si erreur de compilation
				If (ok=1)
					This.RenseignerAvancement(2000; Localized string("5121")+" - Package")
					
					// créer les fichiers des APP dans le dossier de travail
					// sous dossiers Client et serveur
					$result:=This.CréerFichiersAPP()
					
					This.RenseignerAvancement(3000; "")
					
					// compresser et déplacer les fichiers à l'endroit demandé $3
					Case of 
						: ($result.Error#0)
						: (Not(This.dossierTravail.exists))
						: (Is macOS)
							
							If (This.CréerServeur)
								// on a 2 fichiers : serveur et client
								
								// * dans l'ordre, d'abord le serveur : zipper et transférer dans le dossier $3
								$result.dossierSource:=This.dossierTravail.folders().query("name = :1"; "@Server@")
								If ($result.dossierSource.length>0)
									$result.dossierSource:=$result.dossierSource[0]
									
									// supprimer le dossier par defaut de la MaJ
									If (This.ExporterMiseAjour)
										This.SupprimerDefaultData()
									End if 
									
									// renommer le dossier
									$result.dossierSource:=$result.dossierSource.rename(This.environnement.infosApplication(ALV Serveur APP).nomCourt+" Installer "+This.VersionApplicationALV+$result.dossierSource.extension)  // il faut garder l'extension du dossier
									
									// taguer l'application en serveur Web
									// rappel : 'Serveur_Web/IsServeurWeb' est toujours nécessaire (utilisée par les composants)
									// nécessaire aussi pour les applications type BDDmère et serveur Web ouvert avec 4Dlocal et la licence "4D Web Application Expansion vxx
									$data:=This.dossierTravail.folder($result.dossierSource.fullName).folder("Contents/Server DataBase/Resources").file("Commun.xml")
									$boolean:=True
									This.xml.EcrireLeChemin(->$data; "Serveur_Web/IsServeurWeb"; ->$boolean)
									
									// zipper ce dossier
									This.RenseignerAvancement(3200; Localized string("5089"))
									$data:=This.document.ArchiverEnZIP($result.dossierSource; $result)
									// le resultat est dans $result.fichierZippé
									
									If ($data.success)
										// transférer le fichier
										This.RenseignerAvancement(5000; Localized string("5090"))
										// copie sur disque partagé
										Case of 
											: (Not(This.ExporterInstallateur))
											: (Not(Test path name(This.pathDossierDestination)=Is a folder))
												cs.$trace.me.Créer(-15042; Current method name; This.pathDossierDestination).LeverException([msgk_event; msgk_log; msgk_user])
												// nettoyer
												$result.dossierSource.delete(Delete with contents)
												
											Else 
												$result.fichierZippé.copyTo(Folder(This.pathDossierDestination; fk platform path); fk overwrite)
										End case 
									End if 
									
									// transfert FTP sur hébergeur
									This.RenseignerAvancement(5500; Localized string("5174"))
									Case of 
										: (Not(This.ExporterMiseAjour))
										: (This.session.prefs.Session_Etat ?? 6)
											// on s'arrête ici
										: (Not(This.ftp.FixerAccessMisesAjour($params).success))
											// pas d'accès (et données) au serveur FTP
										Else 
											// le transfert va être long : pour être tranquille, se mettre dans le dossier temporaire
											// déplacer dans un dossier vide et renommer le fichier façon UNIX
											$result.dossierFTP:=Folder(Temporary folder; fk platform path).folder(String(Random)+"_FTP")
											$result.fichierZippé.copyTo($result.dossierFTP; "APP_"+This.SystèmeVersion+"_"+This.IDversionApplicationALV+".zip")
											// envoyer le contenu du dossier sur l'hébergeur à $3 (dans process externe)
											$data:=New object
											$data.dossier:=$result.dossierFTP
											$data.cheminFTP:=$params.urlDossier+This.VersionDataALV_FTP+"/"
											$data.Options:=0x0011
											$data.tache:=This.tache
											This.tache.FixerParamsAvancement(5500; 6500)
											
											// lancer la tâche
											$service:=cs.xSDK.ServicesFTP.new(New object)
											$data.result:=$service.MettreAjourDossier($data)
									End case 
									
									// nettoyer
									$result.fichierZippé.delete(Delete with contents)
									$result.dossierSource.delete(Delete with contents)
								End if 
								
								
								// * puis le client : faire une archive zip (pour une première installation du client ALV)
								This.RenseignerAvancement(6500; Localized string("5121")+" - Archive ZIP")
								
								// comprimer le dossier et transfert
								
								If (This.dossierTravail.folders().query("name = :1"; "@client@").length>0)
									$dossier:=This.dossierTravail.folders().query("name = :1"; "@client@")[0]
									$dossier:=$dossier.rename(This.environnement.infosApplication(ALV Client APP).nomLong+".app")
								End if 
								Case of 
									: (This.ExporterMiseAjour)
										// rappel : la mise à jour du client est dans la mise à jour du serveur
									: (Not(This.document.ArchiverEnZIP(This.dossierTravail; $result).success))
										// erreur de création du zip
									: (This.session.prefs.Session_Etat ?? 6)
										// on s'arrête ici
									: (Not(This.ftp.FixerAccessInstallateurs($params).success))
										// pas d'accès (et données) au serveur FTP
									Else 
										// on envoie sur l'hébergeur
										This.RenseignerAvancement(8000; Localized string("5174"))
										
										// le transfert va être long : pour être tranquille, se mettre dans le dossier temporaire
										// déplacer dans un dossier vide et renommer le fichier façon UNIX
										$dossier:=Folder(Temporary folder; fk platform path).folder(String(Random)+"_FTP")
										$dossier.create()
										$result.fichierZippé.copyTo($dossier; This.SystèmeVersion+"_"+This.IDversionApplicationALV+".zip")
										
										// envoyer le contenu du dossier sur l'hébergeur à $3 (dans process externe)
										$data:=New object
										$data.dossier:=$dossier
										$data.cheminFTP:=$params.urlDossier
										$data.Options:=0x0011
										$data.tache:=This.registreTaches.Inscrire(New object("nomProcess"; Current process name; "nomTache"; "exportCLIENT"; "numProcessAppelant"; $params.numProcessAppelant))
										$data.debutTache:=8000
										$data.finTache:=9000
										
										// lancer la tâche
										$service:=cs.xSDK.ServicesFTP.new(New object)
										$data.result:=$service.MettreAjourDossier($data)
										
										$result.fichierZippé.delete(Delete with contents)
										
								End case 
							End if 
							
							If (This.CréerApplication)
								Use ($Progress)
									$Progress.Etat:=Localized string("5121")+" - Archive DMG"
								End use 
								// OSX : créer une image disk : utiliser le dossier parent (= le volume du disk monté) du dossier du paquet 4D
								
								Case of 
										// créer le dmg, à faire dans le process courant
									: (Not(This.document.ArchiverEnDMG(This).success))
										// erreur
									: (This.session.prefs.Session_Etat ?? 6)
										// on s'arrête ici
									Else 
										// on envoie sur l'hébergeur
										This.RenseignerAvancement(4500)
										
										// ici $params.pathDossierCompressé contient le chemin de l'image disk
										// le transfert va être long : pour être tranquille, se mettre dans le dossier temporaire
										// déplacer dans un dossier vide et renommer le fichier façon UNIX
										$dossier:=Folder(Temporary folder; fk platform path).folder(String(Random)+"_FTP")
										$dossier.create()
										$result.fichierZippé.copyTo($dossier; This.SystèmeVersion+"_"+This.IDversionApplicationALV+".dmg")
										// envoyer le contenu du dossier sur l'hébergeur à $3 (dans process externe)
										$data:=New object
										$data.dossier:=Folder($path; fk platform path)
										$data.cheminFTP:=$params.urlDossier
										$data.Options:=0x0011
										$data.tache:=This.registreTaches.Inscrire(New object("nomProcess"; Current process name; "nomTache"; "exportAPP"; "numProcessAppelant"; $params.numProcessAppelant))
										$data.debutTache:=4500
										$data.finTache:=6000
										
										// lancer la tâche
										$service:=cs.xSDK.ServicesFTP.new(New object)
										$data.result:=$service.MettreAjourDossier($data)
								End case 
								
								This.RenseignerAvancement(5999)
								
								// créer une archive du paquet : utiliser le dossier du paquet 4D
								If (This.ExporterMiseAjour)
									This.RenseignerAvancement(6000; Localized string("5121")+" - Archive ZIP")
									
									// supprimer les 'Default Data'
									Case of 
										: (This.SupprimerDefaultData().Error#0)
										: (Test path name($params.pathDossierAPP)#Is a folder)
										Else 
											// chemin du paquet 4D à zipper
											$path:=This.pathDossierAPP
											
											// le dossier à zipper doit être dans un dossier (cf 'Compresser Dossier'), ici 'tempo'
											$result.dossierSource:=This.dossierTravail.folder("tempo").folder("ALV_"+This.VersionApplicationALV+"_"+This.SystèmeVersion)
											Folder(This.pathDossierAPP; fk platform path).copyTo($result.dossierSource)
											Case of 
													// créer le zip, à faire dans le process courant
												: (Not(This.document.ArchiverEnZIP($result.dossierSource; $result).success))
													// erreur
													
												: (This.session.prefs.Session_Etat ?? 6)
													// on s'arrête ici
												Else 
													// on envoie sur l'hébergeur
													Use ($Progress)
														$Progress.Time:=$Progress.finTache
													End use 
													// ici $pathDossierSource contient le chemin de l'archive => la transférer sur l'hébergeur
													// le nom du .zip doit être du même type que celui du .dmg (pour le tri des versions), regexifié (sur le serveur FTP), et tagué plateforme : dupliquer le dossier du paquet
													// le transfert va être long : pour être tranquille, se mettre dans le dossier temporaire
													$dossier:=Folder(Temporary folder; fk platform path).folder(String(Random)+"_FTP_zip")
													$dossier.create()
													$result.fichierZippé.copyTo($dossier; "APP_"+This.SystèmeVersion+"_"+This.IDversionApplicationALV+".zip")
													
													// créer le nom du chemin sur le serveur FTP
													ErrorNum:=0
													Case of 
															// chemin sur l'hébergeur
														: (Not(OB Is defined($params; "cheminFTP_UpdateFiles")))
															// ajouter la version
														: (Not(This.rsc.SetVariable(Est Ressource APP; "Versionnage/Data/Format_Fichier"; Is text; ->$dataTexte)))
														Else 
															// on a tout, on continue
															$dataTexte:=This.fct.FormaterHTML($dataTexte)
															
															// transférer
															// options demandées : dans un process externe, suppression du dossier de travail
															$data:=New object
															$data.dossier:=$dossier
															$data.cheminFTP:=$params.cheminFTP_UpdateFiles+$dataTexte+"/"
															$data.Options:=0x0011
															$data.tache:=This.tache
															
															// lancer la tâche
															$service:=cs.xSDK.ServicesFTP.new(New object)
															$data.result:=$service.MettreAjourDossier($data)
													End case 
											End case 
									End case 
									
									This.RenseignerAvancement(10000)
								End if 
							End if 
							
						: (Is Windows)
							// Windows
							//a faire
					End case 
					
					// gérer la documentation de cette version
					$params:=New object
					$params.nomProcess:="$ALV_Creer_DOC"
					$params.initProcess:=Formula(InitProcessThreadSafe)
					$params.tache:=This.tache
					// s'il existe, on le laisse terminer
					cs.$process.new().NouveauProcess(cs.$documentation; "CreerDocumentation"; $params)
					
					// purger le dossier de travail
					// remarque : a priori les envois FTP ne seront pas terminés à la fin de ce processus. Cette purge ne les perturbe pas
					If (Not(This.session.prefs.Session_Etat ?? 6))
						This.dossierTravail.delete(Delete with contents)
					End if 
					Waiting(40)  // pour voir la fin de la progession !
					
				Else 
					This.RenseignerAvancement(10000; Localized string("5156"))
					//SUPPRIMER DOCUMENT($path)  // pourquoi?
					// attente pour la lecture du message
					Waiting(10*30)
				End if 
				// nettoyer la BDD mère
				$dossier:=Folder(Get 4D folder(Database folder); fk platform path).folder("Default Data")
				$dossier.delete(Delete with contents)
				
				// c'est fini : exploser le thermomètre d'avancement
				Waiting(3*30)
				
			Else 
				This.tache.FixerEtat(Localized string("5155"))
				Waiting(3*30)
			End if 
			This.tache.DésInscrire()
	End case 
	
	
Function ExporterSRVdebug($params : Object)
	//  pour debug du serveur
	// génére une application serveur, non compilée, exécutable avec 4Dserveur ; le client est un 4D distant
	var $data; $fichier : Object
	
	Case of 
		: (Not(OB Is defined($params; "numProcessAppelant")))
			$params.numProcessAppelant:=Current process
			// c'est ok
			// compléter les paramètres
			This.rsc.SetObjet(Est Ressource APP; "Serveurs_ALV/Dossier_Serveurs_ALV"; Is text; $params; "pathDossierDestination")
			$params.tache:=This.tache
			
			// créer le process
			$params.initProcess:=Formula(InitProcessThreadSafe)
			cs.$process.new().NouveauProcess(cs.$servicesEditeur; "ExporterSRVdebug"; $params)
			
		Else 
			// exécuter le process
			// * initialisations du process
			This.InitParams($params)
			cs.xSDK.RegistreTaches.me.DésInscrire($params.nomTache)
			This.tache:=cs.xSDK.RegistreTaches.me.Inscrire(New object("nomProcess"; Current process name; "nomTache"; $params.nomTache; "numProcessAppelant"; $params.numProcessAppelant))
			
			This.document.ViderLeContenu(This.dossierTravail)
			
			This.RenseignerAvancement(0; "")
			
			// créer le dossier de données par défaut
			This.CréerDefaultData()
			
			This.RenseignerAvancement(2000; Localized string("5121"))
			
			// copier le projet de l'application dans le dossier de travail
			This.dossierDestination.create()
			This.dossierDestination:=Folder(Get 4D folder(Database folder); fk platform path).copyTo(This.dossierTravail; "ALV_Serveur_Projet_"+This.environnement.LireVersionAPP()+".4Dbase")
			
			// nettoyer la destination
			This.dossierDestination.folder("Mobile Projects").delete(Delete with contents)
			// nettoyer la BDD mère
			Folder(Get 4D folder(Database folder); fk platform path).folder("Default Data").delete(Delete with contents)
			
			This.RenseignerAvancement(4000; "")
			
			// ajouter chaque composant ALV installé par son projet ou sa compilation
			This.dossierDestinationComponents:=This.dossierDestination.folder("Components")
			This.document.ViderLeContenu(This.dossierDestinationComponents)
			This.dossierMatriceComposants:=Folder(Get 4D folder(Database folder); fk platform path).parent.folder("Composants").folder("Matrices")
			For each ($fichier; This.dossierMatriceComposants.folders().query("name=:1 or name=:2"; "ALV @"; "4D-@"))
				// résoudre les alias de chemins des composants :
				If ($params.ComposantsCompilés)
					// version composants compilés
					$fichier.original.copyTo(This.dossierDestinationComponents)
					
				Else 
					// version non compilée
					This.dossierMatriceComposants.file($fichier.original.fullName).copyTo(This.dossierDestinationComponents)
				End if 
			End for each 
			
			// zipper et envoyer ce dossier
			This.RenseignerAvancement(6000; Localized string("5089"))
			
			$data:=New object
			This.document.ArchiverEnZIP(This.dossierDestination; $data)
			
			// transférer le fichier
			This.RenseignerAvancement(8000; Localized string("5090"))
			
			// copie sur disque partagé
			Case of 
				: (Not(Test path name(This.pathDossierDestination)=Is a folder))
					cs.$trace.me.Créer(-15042; Current method name; This.pathDossierDestination).LeverException([msgk_event; msgk_log; msgk_user])
					
				Else 
					Folder(This.pathDossierDestination; fk platform path).create()
					$data.fichierZippé.copyTo(Folder(This.pathDossierDestination; fk platform path); fk overwrite)
			End case 
			
			This.RenseignerAvancement(10000; "")
			Waiting(30)  // pour voir la fin de la progession !
			// nettoyer
			This.dossierTravail.delete(Delete with contents)
			This.tache.DésInscrire()
	End case 
	
	
	// ----------------------
	//MARK:Exporter les données
	// -----------------------
	
Function ExporterDATA($params : Object)
	// envoyer vers l'hébergeur le fichier de données courant .4DD et mettre à jour les medias
	
	Case of 
		: (Not(OB Is defined($params; "numProcessAppelant")))
			// créer le process
			$params.initProcess:=Formula(InitProcessThreadSafe)
			$params.numProcessAppelant:=-1
			cs.$process.new().NouveauProcess(cs.$generationAPP; "ExporterDATA"; $params)
			
		Else 
			// exécuter le process
			// * initialisations du process
			This.InitParams($params)
			cs.xSDK.RegistreTaches.me.DésInscrire($params.nomTache)
			This.tache:=cs.xSDK.RegistreTaches.me.Inscrire(New object("nomProcess"; Current process name; "nomTache"; $params.nomTache; "numProcessAppelant"; $params.numProcessAppelant))
			This.RenseignerAvancement(0; "")
			
			// d'abord les documents (media...)
			This.ExporterMedias($params)
			This.RenseignerAvancement(9000; "Export media terminé")
			
			// puis le fichier de données .4DD
			This.ExporterBDD()
			
			This.RenseignerAvancement(10000; "Export BDD terminé")
			Waiting(60)
			This.tache.DésInscrire()
	End case 
	
	
Function ExporterBDD()
	var $dataTexte : Text
	var $fichier; $params : Object
	
	This.RenseignerAvancement(8000; Localized string("5132"))
	// mettre une copie dans un dossier du dossier de travail, et zipper le dossier
	// dossier de travail
	This.dossierTravail:=This.document.GetSessionFolder().folder("ALVtempo_ExporterData")
	// nom horodaté du dossier zippé
	This.dossierTravail:=This.dossierTravail.folder(This.environnement.HorodaterBDD())
	This.dossierTravail.create()
	
	// faire une copie
	// v9.3.9 : sur le serveur le fichier de données de la forme xx.4DZ.4DD
	
	$dataTexte:=This.environnement.infosApplication(ALV Serveur APP).nomLong+".4DZ.4DD"
	$fichier:=File(Data file; fk platform path)
	$fichier.copyTo(This.dossierTravail; $dataTexte)
	
	$dataTexte:=Replace string($dataTexte; ".4DD"; ".4DIndx")
	$fichier:=File(Data file; fk platform path).parent.file($fichier.name+".4DIndx")
	$fichier.copyTo(This.dossierTravail; $dataTexte)
	
	// zipper le dossier
	$params:=New object
	This.document.ArchiverEnZIP(This.dossierTravail; $params)
	This.dossierTravail.delete(Delete with contents)
	
	This.RenseignerAvancement(8500; Localized string("5132"))
	
	// transférer le contenu sur l'hébergeur
	// options demandées : dans le process courant, suppression du dossier de travail
	$params.dossier:=$params.fichierZippé.parent
	$params.Options:=0x0011
	$params.progress:=Storage.Processes[Current process name]
	// créer le process
	$params.initProcess:=Formula(InitProcessThreadSafe)
	$params.numProcessAppelant:=Current process
	$params.nomTache:="TeleverserDossier"
	cs.$process.new().NouveauProcess(cs.$application; "TeleverserDossier"; $params)
	
	CALL WORKER(Worker Services; Formula(traceHandler); [msgk_notif; msgk_event; msgk_log]; "Transfert [OK]"; Current method name; "Transfert FTP du fichier de donnnées terminé"; New object("nomProcess"; Current process name; "numProcess"; Current process))
	
	
Function ExporterMedias($params : Object)->$result : Object
	// mettre à jour sur l'hébergeur les medias
	var $texte : Text
	var $data; $service; $entité : Object
	
	$result:=ds.initResult()
	This.RenseignerAvancement(100; Localized string("5147"))
	
	// demander l'accès (et les données) au serveur FTP
	If (This.ftp.FixerAccessBDDdesMedias($params).success)
		// lister tous les dossiers medias gérés par la BDD
		This.listeDossiersMedia:=cs.$document.new().GetDossiersMedia()
		
		// filtrer certains dossiers
		// les pages de document PDF ne sont pas transférées sur l'hébergeur
		// elles sont régénérées localement (application fusionnée et serveur Web)
		This.listeDossiersMedia:=This.listeDossiersMedia.query("estVolumePagesPDF= :1"; False)
		
		// les fichiers video sont trop volumineux dans cette version
		This.listeDossiersMedia:=This.listeDossiersMedia.query("nomVolume # :1"; "@video@")
		
		$data:=New object
		// options demandées : mettre à jour si plus récent, crypter et encoder les fichiers
		$data.Options:=(0x0007 ?+ 6) ?+ 5
		$data.cryptage:=$params.cryptage
		$data.tache:=This.tache
		
		For each ($entité; This.listeDossiersMedia)
			$data.dossier:=Folder($entité.dossier.path)
			// fixer le dossier de réception
			$data.cheminFTP:=$params.urlDossier+"folder_"+String($entité.volume)+"/"
			
			// lancer la tâche
			This.tache.FixerEtat("Export du dossier "+$entité.dossier.name)
			This.tache.FixerParamsAvancement(This.listeDossiersMedia.indexOf($entité)/This.listeDossiersMedia.length*9000; 9000/This.listeDossiersMedia.length)
			$service:=cs.xSDK.ServicesFTP.new(New object)
			$data.result:=$service.MettreAjourDossier($data)
			// rappel :FTP met à jour l'avancement [0, 1] et le timer du Form lance la calcul et l'affichage du temps / Etat
			
			// on a le résultat dans .Status
			$texte:=Choose($data.result.rapport.length=0; "aucune mise à jour"; String($data.result.rapport.length)+" documents mis à jour")
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_notif; msgk_event; msgk_log]; "ALV transfert des medias"; Current method name; "Transfert FTP de "+$entité.dossier.name+" : "+$texte; New object("nomProcess"; Current process name; "numProcess"; Current process))
		End for each 
		
	Else 
		$result.Error:=-15080
		$result.ErrorDescription:=Localized string("5155")
	End if 
	//End case 
	
	
	// ----------------------
	//MARK:Utilitaires
	// -----------------------
	
Function CréerDefaultData()
	// créer le dossier de données par défaut
	var $dossier : 4D.Folder
	var $fichier : 4D.File
	
	$dossier:=This.document.getStructureFolder().folder("Default Data")
	$dossier.create()
	
	$fichier:=File(Data file; fk platform path)
	$fichier.copyTo($dossier; "Default.4DD"; fk overwrite)
	
	$fichier:=File(Replace string(Data file; ".4DD"; ".4DIndx"); fk platform path)
	$fichier.copyTo($dossier; "Default.4DIndx"; fk overwrite)
	
	$fichier:=File(Replace string(Data file; ".4DD"; ".Match"); fk platform path)
	$fichier.copyTo($dossier; "Default.Match"; fk overwrite)
	
	
Function SupprimerDefaultData()->$result : Object
	// supprimer le dossier de données par défaut de l'APP créée
	var $c : Collection
	var $dossier : 4D.Folder
	
	//  pas d'erreur par défaut
	$result:=ds.initResult()
	
	$c:=This.dossierTravail.folders().query("name = :1"; "@Server@")
	If ($c.length>0)
		$dossier:=$c[0].folder("Contents/Server Database/Default Data")
		$dossier.delete(Delete with contents)
		
	Else 
		$result.Error:=-15042
		$result.ErrorDescription:="dossier 'default data' non trouvé"
	End if 
	
	
Function CréerFichiersAPP()->$result : Object
	// déplacer les packages créés par 4D dans le dossier de travail
	var $dossierSource; $dossier : 4D.Folder
	var $fichier : 4D.File
	var $c : Collection
	
	// erreur par défaut
	$result:=ds.initResult()
	
	// lire les fichiers créés
	$dossierSource:=Folder(Get 4D folder(Database folder); fk platform path).parent
	$c:=$dossierSource.folders().query("name = :1"; "@_Build")
	If ($c.length>0)
		// dans $c[0] un seul dossier créé par 4D contenant les apps serveur et client
		$dossierSource:=$c[0].folders()[0]
		// copier les apps dans le dossier de travail
		For each ($dossier; $dossierSource.folders())
			$dossier.copyTo(This.dossierTravail; fk overwrite)
		End for each 
		// nettoyer
		$dossierSource.parent.delete(Delete with contents)
		
		// ajouter les fichiers Read-me
		// ils sont dans les ressources de la structure courante
		$fichier:=Folder(Get 4D folder(Current resources folder); fk platform path).folder("TemplatesALV/ReadMe").file("Lisez moi.shtml")
		// les fichiers read-me sont des templates (plusieurs langues); on les met à jour
		// recopier au niveau du dossier de l'application
		$result.Error:=cs._cfct.me.TraiterBalisesFichier($fichier; This.dossierTravail; New object)
		
	Else 
		$result.Error:=-15044
		$result.ErrorDescription:="Absence du dossier _Build de 4D"
	End if

⇧ [class]$menus - 18/04/2026 18:30:36

      property fct : cs.xSDK.Outils
property barreMenus; session : Object
property racineXML; refMenu : Text

Class constructor()
	This.racineXML:=""
	This.barreMenus:=Null
	This.fct:=cs.xSDK.Outils.me
	
	This.session:=cs.$session.me
	
	
	// ----------------------
	//MARK:Création
	// -----------------------
	
Function CréerBarreMenus()
	// contruire toutes les barres de menus (1 barre par type de formulaire / contexte user
	
	// lire les données des barres de menus
	This.racineXML:=DOM Parse XML source(Get 4D folder(Current resources folder)+"DataBarresMenus.xml")
	If (ok=1)
		// * créer toutes les barres menus de l'application
		This.barreMenus:=New object
		
		// ** créer le menu standard
		This.refMenu:=This.CréerMenu("BM_Standard")
		This.barreMenus.Standard:=This.refMenu
		// remarque pour la suite: une duplication de menus copie des références : une modification sur un menu s'applique donc donc toutes les copies du menu 
		
		
		// ** créer la barre menus de l'éditeur de personnes
		// *** dupliquer la barre standard
		This.refMenu:=This.barreMenus.Standard
		This.refMenu:=Create menu(This.refMenu)
		// *** ajouter les menus spécifiques
		This.AjouterMenu("BM_01-01-0100"; 3020)
		This.AjouterMenu("BM_01-01-0200"; 3030)
		// *** ajouter la barre
		This.barreMenus["U_Nav?1"]:=This.refMenu
		
		
		// ** créer la barre menus de l'éditeur de lieux
		// *** dupliquer la barre standard
		This.refMenu:=This.barreMenus.Standard
		This.refMenu:=Create menu(This.refMenu)
		// *** ajouter les menus spécifiques
		This.AjouterMenu("BM_01-10-0100"; 3039)
		// *** ajouter la barre
		This.barreMenus["U_Nav?10"]:=This.refMenu
		
		
		// ** créer la barre menus de l'éditeur de medias
		// *** dupliquer la barre standard
		This.refMenu:=This.barreMenus.Standard
		This.refMenu:=Create menu(This.refMenu)
		// *** ajouter les menus spécifiques
		This.AjouterMenu("BM_01-19-0100"; 3044)
		// *** ajouter la barre
		This.barreMenus["U_Nav?19"]:=This.refMenu
		
		
		// ** créer la barre menus de l'éditeur des events
		// * dupliquer la barre standard
		This.refMenu:=This.barreMenus.Standard
		This.refMenu:=Create menu(This.refMenu)
		// *** ajouter les menus spécifiques
		This.AjouterMenu("BM_01-09-0100"; 3030)
		// *** ajouter la barre
		This.barreMenus["U_Nav?9"]:=This.refMenu
		
		
		// ** créer la barre menus de l'éditeur des utilisateurs
		// *** dupliquer la barre standard
		This.refMenu:=This.barreMenus.Standard
		This.refMenu:=Create menu(This.refMenu)
		// *** ajouter les menus spécifiques
		This.AjouterMenu("BM_01-31-0100"; 3075)
		// *** ajouter la barre
		This.barreMenus["U_Nav?31"]:=This.refMenu
		
		
		// créer les mêmes, version développement
		This.AjouterMenuDeveloppement()
		
		DOM CLOSE XML(This.racineXML)
		
		// partager
		Use (Storage)
			// créer l'objet / effacer l'objet existante
			Storage.BarresMenus:=New shared object
		End use 
		sharedObject(This.barreMenus; Storage.BarresMenus)
	End if 
	
	
Function AjouterMenu($IDnomMenu : Text; $ID : Integer)
	var $refMenu; $libelle : Text
	
	$refMenu:=This.CréerMenu($IDnomMenu)
	$libelle:=Localized string(String($ID))
	APPEND MENU ITEM(This.refMenu; $libelle; $refMenu)
	// fixer le lien pour retrouver les propriétés du menu
	SET MENU ITEM PARAMETER(This.refMenu; -1; $IDnomMenu)
	RELEASE MENU($refMenu)
	
	
Function AjouterMenuDeveloppement()
	var $refMenu; $libelle; $IDnomMenu : Text
	var $rang : Integer
	var $c : Collection
	
	// un seul menu à ajouter
	$refMenu:=This.CréerMenu("BM_00-00-0500")
	$libelle:=Localized string("3111")
	// le placer après les menus standard
	$rang:=Count menu items(This.barreMenus.Standard)
	
	$c:=OB Keys(This.barreMenus)
	For each ($IDnomMenu; $c)
		// menu sans dev
		This.refMenu:=This.barreMenus[$IDnomMenu]
		// le dupliquer
		This.refMenu:=Create menu(This.refMenu)  // dupliquer
		// ajouter le menu dev
		INSERT MENU ITEM(This.refMenu; $rang; $libelle; $refMenu)
		This.barreMenus[$IDnomMenu+"?Developpement"]:=This.refMenu
	End for each 
	
	RELEASE MENU($refMenu)
	
	
Function CréerMenu($IDnomMenu : Text)->$result : Text
	var $ElementXML; $Xpath : Text
	var $i; $message; $IDlibelle : Integer
	var $refSousMenu; $commande; $libelle; $menuID; $dataTexte : Text
	var $UserPrefs : Object
	
	$result:=Create menu
	
	// lire les menus de $IDnomMenu
	$ElementXML:=DOM Find XML element by ID(This.racineXML; $IDnomMenu)
	If (ok=1)
		DOM GET XML ELEMENT NAME($ElementXML; $Xpath)
		ARRAY TEXT($tabElements; 0)
		$ElementXML:=DOM Find XML element($ElementXML; $Xpath+"/menu"; $tabElements)
		If (Size of array($tabElements)>0)
			// pour chaque menu
			For ($i; 1; Size of array($tabElements))
				// récupérer les éléments du menu $i
				ARRAY TEXT($tabNoms; 1)
				ARRAY TEXT($tabValeurs; 1)
				// pour les erreurs
				$tabNoms{0}:="#Erreur"
				$tabValeurs{0}:="#Erreur"
				$ElementXML:=DOM Get first child XML element($tabElements{$i}; $tabNoms{1}; $tabValeurs{1})
				While (ok=1)
					INSERT IN ARRAY($tabNoms; 1; 1)
					INSERT IN ARRAY($tabValeurs; 1; 1)
					$ElementXML:=DOM Get next sibling XML element($ElementXML; $tabNoms{1}; $tabValeurs{1})
				End while 
				// lire les données nécessaires
				$libelle:=$tabValeurs{indexTableau(Find in array($tabNoms; "libelle"))}
				$commande:=$tabValeurs{indexTableau(Find in array($tabNoms; "commande"))}
				$menuID:=$tabValeurs{indexTableau(Find in array($tabNoms; "menu_ID"))}
				$message:=Num($tabValeurs{indexTableau(Find in array($tabNoms; "message"))})
				
				// ajouter le menu
				Case of 
						// il faut 2 données
					: ($libelle="#Erreur")
					: ($commande="#Erreur")
					Else 
						// c'est ok : créer le menu
						// son libellé
						$IDlibelle:=Num($libelle)
						Case of 
							: ($IDlibelle=0)
								// une ressource 4D
								$libelle:=Localized string($libelle)
								
							: (Storage.System.Navigation.ZS.EnregistrementLié#-1)
								$libelle:=cs._cfct.me.LireLocatedSTR($IDlibelle; New object("param_1"; Storage.System.Navigation.ZS.EnregistrementLiéLibellé))
								
							Else 
								// une ressource ALV
								$libelle:=cs._cfct.me.LireLocatedSTR($IDlibelle)
						End case 
						
						// avec sous menu?
						$refSousMenu:=$tabValeurs{indexTableau(Find in array($tabNoms; "menu_ID"))}
						// astuce : si pas de sous menu, on cherche un ID = "#Erreur"
						$ElementXML:=DOM Find XML element by ID(This.racineXML; $refSousMenu)
						If (ok=1)
							$refSousMenu:=This.CréerMenu($refSousMenu)
							APPEND MENU ITEM($result; $libelle; $refSousMenu)
							RELEASE MENU($refSousMenu)
							
						Else 
							APPEND MENU ITEM($result; $libelle)
							
							// mémoriser les paramètres de l'action
							SET MENU ITEM PROPERTY($result; -1; "libellé"; $IDlibelle)
							SET MENU ITEM PROPERTY($result; -1; "ALV_Libellé"; $libelle)
							SET MENU ITEM PROPERTY($result; -1; "commande"; $commande)
							SET MENU ITEM PROPERTY($result; -1; "message"; $message)
						End if 
						
						// fixer le lien pour retrouver les propriétés du menu
						SET MENU ITEM PARAMETER($result; -1; $menuID)
						
						// marquer la ligne?
						// principe : lire le mot-clé associé au marquage de ce menu, et lire dans les préférences utilisateur la commande enregistrée
						//   on marque si la commande enregistrée est la commande courante
						$libelle:=$tabValeurs{indexTableau(Find in array($tabNoms; "marquage"))}
						// depuis v6.5.11 $libelle est un chemin dans les UserPreferences
						var $c : Collection
						$c:=Split string($libelle; "?"; sk ignore empty strings)
						
						$UserPrefs:=OB Copy(This.session.prefs)
						// on pointe la propriété demandée
						Case of 
								// il faut une info marquage
							: ($c.length=0)
								// il faut une propriété $c[0] et $c[1]
							: ($UserPrefs[$c[0]]=Null)
							: ($UserPrefs[$c[0]][$c[1]]=Null)
								// et différente de $commande ($commande =xx00
							: ($UserPrefs[$c[0]][$c[1]]=Num($commande))
							Else 
								// c'est ok, préf = xx01 : cocher la ligne
								SET MENU ITEM MARK($result; -1; Char(18))
						End case 
						
						// traitement particulier?, à faire traiter par le formulaire
						If (Form.initPopUpMenu#Null)
							$commande:=$tabValeurs{indexTableau(Find in array($tabNoms; "init_menu"))}
							Form.initPopUpMenu($commande; $result)
						End if 
						
						// classe associée?
						$commande:=$tabValeurs{indexTableau(Find in array($tabNoms; "type"))}
						Case of 
								// il faut un nom de type
							: ($commande="#Erreur")
							Else 
								// c'est ok
								SET MENU ITEM PROPERTY($result; -1; "type"; $commande)
								$commande:=$tabValeurs{indexTableau(Find in array($tabNoms; "Namespace"))}
								SET MENU ITEM PROPERTY($result; -1; "Namespace"; $commande)
								$commande:=$tabValeurs{indexTableau(Find in array($tabNoms; "DataClassNom"))}
								SET MENU ITEM PROPERTY($result; -1; "DataClassNom"; $commande)
								$commande:=$tabValeurs{indexTableau(Find in array($tabNoms; "nomClass"))}
								SET MENU ITEM PROPERTY($result; -1; "nomClass"; $commande)
								$commande:=$tabValeurs{indexTableau(Find in array($tabNoms; "functionID"))}
								SET MENU ITEM PROPERTY($result; -1; "functionID"; $commande)
								$commande:=$tabValeurs{indexTableau(Find in array($tabNoms; "titre"))}
								SET MENU ITEM PROPERTY($result; -1; "titre"; cs._cfct.me.LireLocatedSTR(Num($commande)))
						End case 
						
						// méthode associée?
						$commande:=$tabValeurs{indexTableau(Find in array($tabNoms; "methode"))}
						Case of 
								// il faut un nom de méthode
							: ($commande="#Erreur")
							Else 
								// c'est ok
								SET MENU ITEM METHOD($result; -1; $commande)
						End case 
						
						// paramètres associés à la méthode associée définie avant ou celle dans le code
						$commande:=$tabValeurs{indexTableau(Find in array($tabNoms; "params1"))}
						Case of 
								// il faut un paramètre
							: ($commande="#Erreur")
							Else 
								// c'est ok
								SET MENU ITEM PROPERTY($result; -1; "params1"; $commande)
						End case 
						
						// action standard associée?
						$commande:=$tabValeurs{indexTableau(Find in array($tabNoms; "actionStandard"))}
						Case of 
								// pas d'erreur
							: ($commande="#Erreur")
								// il faut un nombre
							Else 
								// c'est ok
								SET MENU ITEM PROPERTY($result; -1; Associated standard action; $commande)
						End case 
						
						// raccourci associé?
						$commande:=$tabValeurs{indexTableau(Find in array($tabNoms; "raccourci"))}
						$dataTexte:=$tabValeurs{indexTableau(Find in array($tabNoms; "raccourciModifiers"))}
						Case of 
								// il faut un caractère
							: (Not(Match regex("[a-z]"; $commande)))
								// il faut un modifier
							: ($dataTexte="#Erreur")
							Else 
								// c'est ok
								SET MENU ITEM SHORTCUT($result; -1; $commande; Num($dataTexte))
						End case 
						
						// icone associée?
						$commande:=$tabValeurs{indexTableau(Find in array($tabNoms; "icone"))}
						Case of 
								// il faut un nom de méthode
							: ($commande#"file:@")
							Else 
								// c'est ok
								SET MENU ITEM ICON($result; -1; $commande)
						End case 
				End case 
			End for 
			// c'est fini
		End if 
	End if

⇧ [class]PersonnesPalette - 06/05/2026 11:05:06

      Class extends $formulaire

Class constructor()
	// construction commune
	Super()
	
	
Function getDataClassInfos()->$result : Object
	$result:=Super.getDataClassInfos("Personnes")
	
	
Function FixerParamètres($params : Object)
	// $params = paramètres de menu
	
	Super.FixerParamètres($params)
	This.informations.nomForm:="U_Palette?3014"
	
	
	// ----------------------
	//MARK:Sélections
	// -----------------------
	
Function NouvelleSélection()
	var $params : Object
	
	$params:=OB Copy(This.session.prefs.Palettes.Palette_3014)
	$params.index:=Form["listeDico"].index
	
	// pour le retour
	$params.nomProcessAppelant:=Current process name
	$params.CallBack:="AfficherSelection"
	
	// c'est parti (en local ou sur le serveur)
	cs.$serveurAPP.me.Executer(OB Class(This).name; "CréerSélection"; $params)
	
	
Function CréerSélection($params : Object)
	// ici on est sur la BDD mère ou le serveur APP
	var $sélection : cs.PersonnesSelection
	
	// créer la sélection
	Case of 
		: ($params.index=0)
			$sélection:=ds.DicoDesNoms.query("patronyme = :1"; $params.Recherche+"@").lesNoms
			$params.Options:=0x0007
			
		: ($params.index=1)
			$sélection:=ds.Personnes.query("nom = :1"; $params.Recherche+"@")
			$params.Options:=0x0007
			
		: ($params.index=2)
			$sélection:=ds.Personnes.query("prenom = :1"; $params.Recherche+"@")
			$params.Options:=0x000F
	End case 
	
	$sélection.CréerListBox($params)
	
	
Function AfficherSelection($params : Object)
	var $c : Collection
	var $nbreItems : Integer
	// sélectionner la première ligne
	var $itemPos : Integer:=1
	
	If ($params=Null)
		cs.$trace.me.EnvoyerMessages([msgk_user]; "Requête Client non traitée"; Current method name; Localized string("-15084"))
		
	Else 
		Form.nomOBJ:="listeItems"
		Form.listeItems:=$params.liste
		
		LISTBOX SET AUTO ROW HEIGHT(*; Form.nomOBJ; lk row max height; Form.UserPrefs.ParamsForm.HauteurLigneLH; lk pixels)
		
		$nbreItems:=Form[Form.nomOBJ].length
		Form.nbreItems:=String($nbreItems)+" "+cs._cfct.me.LireLocatedSTR(1055; New object("plur"; ($nbreItems>0)))
		
		// initialiser avec les préférences
		$c:=Form[Form.nomOBJ].indices("itemRef = :1"; Form.UserPrefs.SelectionCourante)
		If (($nbreItems>0) & ($c.length=1))
			// l'élément des préférences est là
			$itemPos:=$c[0]+1
		End if 
		LISTBOX SELECT ROW(*; Form.nomOBJ; $itemPos; lk replace selection)
		
		Form.entité:=ds.Personnes.get(Form[Form.nomOBJ][$itemPos-1].itemRef & 0x00FFFFFF)
		This.AfficherEntité()
	End if 
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	var $gauche; $haut; $droite; $bas; $nbrLines : Integer
	var $data : Object
	
	This.surEvenementFormulaire()
	
	$data:=Form.UserPrefs
	
	Case of 
			
		: (FORM Event.code=On Load)
			SHOW PROCESS(Current process)
			
			// charger les objets
			This.onEndLoad()
			
		: (FORM Event.code=On Timer)  // MaJ des IHM
			//Afficher Progression Process  // dans cet ordre
			
		: (FORM Event.code=On Resize)
			OBJECT GET COORDINATES(*; "grpListeRessource 99"; $gauche; $haut; $droite; $bas)  // fixe la taille du formulaire non étendu
			$nbrLines:=$haut  // mémoriser
			// fixer le nombre de lignes de la LH
			OBJECT GET COORDINATES(*; "ListeItems"; $gauche; $haut; $droite; $bas)
			$nbrLines:=Int(($nbrLines-$haut-4)/$data.ParamsForm.HauteurLigneLH)
			If ($nbrLines<$data.ParamsForm.NbrLignesLH)
				$nbrLines:=$data.ParamsForm.NbrLignesLH  // = nombre min de lignes de la LH
			End if 
			$nbrLines:=$haut+($nbrLines*$data.ParamsForm.HauteurLigneLH)  // mémoriser
			OBJECT MOVE(*; "ListeItems"; $gauche; $haut; $droite; $nbrLines; *)
			OBJECT GET COORDINATES(*; "SépareSousFormulaire"; $gauche; $haut; $droite; $bas)  // fixe la taille du formulaire non étendu
			OBJECT MOVE(*; "SépareSousFormulaire"; $gauche; $nbrLines+2; $droite; $nbrLines+3; *)
			
		: (FORM Event.code=On Close Box)
			CANCEL
	End case 
	
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection()
	$c.combine(["listeDico"; "itemSaisi"; "redimensionner"])
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:FORMevents Page 1
	// ----------------------
	
Function _FORM_listeDico()
	var $data : Object
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=New object
			Form[This.nomOBJ].values:=New collection(Localized string("1047"); Localized string("1048"); Localized string("1049"))
			
			Form[This.nomOBJ].index:=1
			Case of 
				: (This.session.prefs.Palettes=Null)
				: (This.session.prefs.Palettes["Palette_3014"]=Null)
				Else 
					// c'est ok
					$data:=This.session.prefs.Palettes["Palette_3014"]
					If (Not($data.quoi=Null))
						Form[This.nomOBJ].index:=$data.quoi
					End if 
			End case 
			
		: (FORM Event.code=On Clicked)
			$data:=This.LirePréférences()
			If ($data#Null)
				Use ($data)
					$data.quoi:=Form[This.nomOBJ].index
				End use 
			End if 
			This.NouvelleSélection()
	End case 
	
	
Function _FORM_itemSaisi()
	var $data : Object
	
	Case of 
		: (FORM Event.code=On Load)
			// initialiser la liste
			Form[This.nomOBJ]:=""
			
			Case of 
				: (This.session.prefs.Palettes=Null)
				: (This.session.prefs.Palettes["Palette_3014"]=Null)
				Else 
					// c'est ok
					$data:=This.session.prefs.Palettes["Palette_3014"]
					If (Not($data.Recherche=Null))
						Form[This.nomOBJ]:=$data.Recherche
					End if 
			End case 
			This.NouvelleSélection()
			
		: (FORM Event.code=On Data Change)
			$data:=This.LirePréférences()
			If ($data#Null)
				Use ($data)
					$data.Recherche:=Form[This.nomOBJ]
				End use 
			End if 
			This.NouvelleSélection()
	End case 
	
	
Function _FORM_listeItems_item()
	var $IDentitéCodée : Integer
	
	Case of 
		: (FORM Event.code=On Begin Drag Over)
			This.glisserDeposer.surDebutGlisserITEM_LB()
			
		: (FORM Event.code=On Clicked)
			$IDentitéCodée:=Form[This.nomOBJ+"ElementCourant"].itemRef
			Use (Form.UserPrefs)
				Form.UserPrefs.SelectionCourante:=$IDentitéCodée
			End use 
			
			This.entité:=ds.Personnes.get($IDentitéCodée & 0x00FFFFFF)
			Form.AfficherEntité()
			
		: (FORM Event.code=On Double Clicked)
			$IDentitéCodée:=Form[This.nomOBJ+"ElementCourant"].itemRef
			cs.$editeur.new().EditerSélection($IDentitéCodée; 0)
	End case 
	
	
Function _FORM_redimensionner()
	var $gauche; $haut; $droite; $bas; $gaucheObjet; $hautObjet; $droiteObjet; $basObjet : Integer
	var $data : Object
	
	$data:=Form.UserPrefs
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=Num($data.ParamsForm.ExtensionEvent)
			FORM SET HORIZONTAL RESIZING(False)
			If ($data.ParamsForm.ExtensionEvent)  // déployé
				FORM SET SIZE("grpDétail"; 16+$data.ParamsForm.MargeForm; $data.ParamsForm.MargeForm)
				FORM SET VERTICAL RESIZING(False)
				
			Else   // contracté
				FORM SET SIZE("grpListeRessource 99"; $data.ParamsForm.MargeForm; $data.ParamsForm.MargeForm)
				FORM SET VERTICAL RESIZING(True)
			End if 
			
		: (FORM Event.code=On Clicked)
			Use ($data.ParamsForm)
				$data.ParamsForm.ExtensionEvent:=(Form[This.nomOBJ]=1)
			End use 
			
			// lire la position actuelle
			GET WINDOW RECT($gauche; $haut; $droite; $bas; Current form window)
			
			If ($data.ParamsForm.ExtensionEvent)
				// déployer
				OBJECT GET COORDINATES(*; "grpDétail"; $gaucheObjet; $hautObjet; $droiteObjet; $basObjet)
				If (($haut+$basObjet+$data.ParamsForm.MargeForm)>Screen height)
					$haut:=Screen height-$basObjet-$data.ParamsForm.MargeForm  // remonter le formulaire
				End if 
				SET WINDOW RECT($gauche; $haut; $gauche+$droiteObjet+16+$data.ParamsForm.MargeForm; $haut+$basObjet+$data.ParamsForm.MargeForm; Current form window)
				FORM SET SIZE("grpDétail"; 16+$data.ParamsForm.MargeForm; $data.ParamsForm.MargeForm)  // pas glop 4D!
				FORM SET VERTICAL RESIZING(False)  // utile, sinon le sous-formulaire peut se superposer à la LH
				
			Else 
				// contracter
				OBJECT GET COORDINATES(*; "grpListeRessource 99"; $gaucheObjet; $hautObjet; $droiteObjet; $basObjet)
				SET WINDOW RECT($gauche; $haut; $gauche+$droiteObjet+$data.ParamsForm.MargeForm; $haut+$basObjet+$data.ParamsForm.MargeForm; Current form window)
				FORM SET SIZE("grpListeRessource 99"; $data.ParamsForm.MargeForm; $data.ParamsForm.MargeForm)
				FORM SET VERTICAL RESIZING(True)
			End if 
	End case 
	
	
	// ----------------------
	// MARK:Affichage
	// -----------------------
	
Function LirePréférences()->$result : Object
	Case of 
		: (This.session.prefs.Palettes=Null)
		: (This.session.prefs.Palettes["Palette_3014"]=Null)
			// ce cas arrive quand la palette n'est pas encore dans les prefs. (on pourrait l'initialiser ici...)
		Else 
			// c'est ok
			$result:=This.session.prefs.Palettes["Palette_3014"]
	End case 
	
	
Function AfficherEntité()
	var $membre : Object
	
	// afficher le détail des pages
	If (This.entité#Null)
		
		// parents
		Form.Père:=""
		Form.Mère:=""
		If (This.entité.LesParents()#Null)
			$membre:=This.entité.LesParents(agk Père)
			If ($membre#Null)
				Form.Père:=$membre.Libellé(New object("Options"; 0x0007))
			End if 
			$membre:=This.entité.LesParents(agk Mère)
			If ($membre#Null)
				Form.Mère:=$membre.Libellé(New object("Options"; 0x0007))
			End if 
		End if 
		
		// charger les events
		Form.events:=This.entité.LesEvenementsPersonnels().or(Form.entité.LesEvenementsFamiliaux())
		Form.events:=Form.events.orderBy("dateNum asc")
		
	End if 
	OBJECT SET VISIBLE(*; "grpDétail@"; (Form.events.length>0))
	
	
Function MettreAjour($param : Object)
	// appel extérieur
	var $itemRef; $index : Integer
	var $nomSaisi : Text
	var $entité : Object
	var $c : Collection
	
	Form.nomOBJ:="listeItems"
	$index:=Form["listeDico"].index
	
	// qu'a t on modifié?
	$itemRef:=$param.refItem
	If (ds.Personnes.estMonID($itemRef))
		// une personne
		// mettre à jour les LH
		
		$entité:=ds.Personnes.get($itemRef & 0x00FFFFFF)
		$nomSaisi:=Form["itemSaisi"]+"@"
		$c:=Form[Form.nomOBJ].indices("itemRef = :1"; $itemRef)
		Case of 
			: ($c.length=1)
				// modification de l'élément affiché
				Form[Form.nomOBJ][$c[0]].itemText:=$entité.Libellé(New object("Options"; 8*Num($index=2)+7))
				Form[Form.nomOBJ]:=Form[Form.nomOBJ]  // rafraichir
				
			: (((($index=0) | ($index=1)) & (Substring($entité.nom; 1; Length($nomSaisi))=$nomSaisi)) | (($index=2) & (Substring($entité.prenom; 1; Length($nomSaisi))=$nomSaisi)))
				// nouvelle entité dont nom ou prénom correspondent aux critères de sélection en cours ($nomSaisi)
				Form[Form.nomOBJ].push(New object("ID"; $entité.ID; "itemText"; $entité.Libellé(New object("Options"; 8*Num($index=2)+7)); "itemRef"; $itemRef))
				Form[Form.nomOBJ]:=Form[Form.nomOBJ].orderBy("itemText asc")
		End case 
	End if 
	
	// mettre à jour les événements, au cas où
	This.entité.reload()
	This.AfficherEntité()
	
	
Function LocatedSTR($ID : Text)->$result : Text
	$result:=Localized string($ID)
	
	
Function LabelEvent($ID : Integer)->$result : Text
	var $entité : Object
	
	$entité:=ds.Events.get($ID)
	$result:=$entité.Libellé(New object("Options"; 0x3000))
	
	
	// ----------------------
	// MARK:Demande actions
	// -----------------------
	
Function getListeHiérarchique($params : Object)
	// un process externe envoie une sélection à éditer
	Form.nomOBJ:="listeItems"
	Form[Form.nomOBJ]:=$params.LH
	Form[Form.nomOBJ]:=Form[Form.nomOBJ].orderBy("itemText asc")
	
	This.AfficherSelection()

⇧ [class]$trace - 18/04/2026 11:45:50

      property cible : cs.xSDK.Traces
property success : Boolean

singleton Class constructor()
	
	This.cible:=cs.xSDK.Traces.new()
	
	
	// -----------------------------
	// MARK:Erreur APP
	// -----------------------------
	
Function set Error($numError : Integer)
	This.cible.Error:=$numError
	
Function get Error()->$result : Integer
	$result:=This.cible.Error
	
	
Function set ErrorDescription($description : Text)
	This.cible.ErrorDescription:=$description
	
Function get ErrorDescription()->$result : Text
	$result:=This.cible.ErrorDescription
	
	
Function Intercepter()
	ErrorNum:=This.cible.Intercepter("APP"; Error; Error method; Error line; Error formula)
	
	
Function Initialiser($nomMethode : Text)->$result : Object
	This.cible.CréerErreur("APP"; 0; $nomMethode; "")
	$result:=This
	
	
Function Créer($Error : Integer; $nomMethode : Text; $ErrorDescription : Text)->$result : cs.$trace
	This.cible.CréerErreur("APP"; $Error; $nomMethode; $ErrorDescription)
	$result:=This
	
	
Function FixerSuccess()
	This.cible.FixerSuccess()
	This.success:=This.cible.success
	
	
Function LeverException($options : Collection)
	
	If (This._aTraiter())
		// renseigner le label de l'erreur
		This.FixerLabel()
		// lancer le traitement de l'erreur
		This.cible.LeverException($options)
	End if 
	
	
Function _aTraiter()->$result : Boolean
	$result:=False
	
	Case of 
		: (Not(OB Is defined(This; "Error")))
		: (Not(OB Is defined(This; "ErrorDescription")))
			
		: (This.cible.Error=0)
			// pas d'erreur
			// filtrer, ne pas encombrer la messagerie
			
		: (This.cible.Error=Fichier en téléchargement)
			// fonctionnement normal
			
		Else 
			// erreur à traiter
			$result:=True
	End case 
	
	
Function FixerLabel()
	Case of 
		: ((This.cible.Error>=9910) & (This.cible.Error<=9915))
			// une erreur SOAP
			This.cible.ErrorLabel:="SOAP"
			
		: ((This.cible.Error>-15000) & (This.cible.Error<15000))
			// une erreur 4D (pas accès au libellé)
			This.cible.ErrorLabel:="4Dimension™"
			
		: ((This.cible.Error>=-15999) & (This.cible.Error<=-15001))
			// une erreur de l'application ALV (les libellés non contextuels sont dans un fichier xliff)
			This.cible.ErrorLabel:=Localized string(String(This.cible.Error))
			
		: ((This.cible.Error>15000) & (This.cible.Error<32000))
			// une erreur d'utilisation ALV (les libellés contextuels sont dans un fichier xliff)
			This.cible.ErrorLabel:=String(This.cible.Error)
			This.cible.ErrorDescription:=Localized string(This.cible.ErrorDescription)
			
		Else 
			// on ne sait pas
			This.cible.ErrorLabel:="Libellé non géré"
	End case 
	
	
	// -----------------------------
	// MARK:Message APP
	// -----------------------------
	
Function EnvoyerMessages($options : Collection; $libellé : Text; $source : Text; $description : Text; $contexte : Object)
	This.cible.EnvoyerMessages($options; "APP"; $libellé; $source; $description; $contexte)
	
	
Function PosterMessagesIHM($message : Object)->$result : Object
	// messagerie de type IHM
	// attention non thread-safe
	cs.xSDK.Outils.me.CopierAttributs($message; This.cible)
	
	// Emettre les messages (actifs selon les options)
	This._EmettreMessageSonore()
	This._AfficherMessage()
	This._EnvoyerEmail()
	This._Notifier()
	$result:=Null
	
	
Function _EmettreMessageSonore()
	// message sonore
	// si on est dans un worker, y a-t-il un auditeur ici?
	Case of 
		: (Not(This.cible.Contexte.Options ?? msgk_alerte))
		: (Storage.System.typeApplication=ALV Serveur APP)
		: (Storage.System.typeApplication=ALV Serveur HTTP)
		: (Process info(Current process).type=Worker process)
			// filtrer ces cas (pas d'auditeur a priori)
			
		Else 
			// on émet
			Form.sonorisation.LireLeCanal("MessageAPP")
	End case 
	
	
Function _AfficherMessage()
	If (This.cible.Contexte.Options ?? msgk_user)
		// messagerie APP
		Appeler_Le_Formulaire(Frontmost process(*); "AfficherMessageUtilisateur"; New object("libelle"; This.cible.Description))
	End if 
	
	
Function _EnvoyerEmail()
	// envoyer un eMail
	var $data : Object
	var $smtp : cs.xMAIL.$eMail
	
	If (This.cible.Contexte.Options ?? msgk_mail)
		// contenu :
		$data:=New object
		$data.subject:="Ainsi La Vie : "+This.cible.Libellé
		$data.textBody:=""
		$data.htmlBody:="<p>"+String(Current date; ISO date GMT; Current time)+" "+Current machine+" - Mode "+("Interprété"*Num(Not(Is compiled mode)))+("Compilé"*Num(Is compiled mode))+" * Process_"+String(This.cible.Contexte.numProcess)+" "+This.cible.Contexte.nomProcess+"</p>"
		$data.htmlBody:="<h4>"+This.cible.Description+"</h4>"+$data.htmlBody
		$data.htmlBody:="<h1>"+"méthode "+This.cible.Source+"</h1>"+$data.htmlBody
		// destinataire
		$data.to:=ds.UtilisateursALV.get(1001).Adresse_eMail
		// c'est parti
		$smtp:=cs.xMAIL.$eMail.new()
		$smtp.EnvoyerQuickMail($data)
	End if 
	
	
Function _Notifier()
	If (This.cible.Contexte.Options ?? msgk_notif)
		DISPLAY NOTIFICATION(This.cible.Source; This.cible.Description; 5)
	End if 
	
	
	// -----------------------------
	// MARK:Debug APP
	// -----------------------------
	
Function DebugerMethode($libellé : Text; $source : Text; $description : Text)->$result : Boolean
	$result:=This.cible.DebugerMethode(cs.$session.me.prefs; "APP"; $libellé; $source; $description)
	
	
Function DebugerVariables($libellé : Text; $source : Text; $data : Object)->$result : Boolean
	$result:=This.cible.DebugerVariables(cs.$session.me.prefs; "APP"; $libellé; $source; $data)
	
Function DebugerEventForm($libellé : Text; $source : Text; $data : Object)->$result : Boolean
	$result:=This.cible.DebugerEventForm(cs.$session.me.prefs; "APP"; $libellé; $source; $data)
	
	
Function GetGarbageDossier($chemin : Text)->$result : 4D.Folder
	$result:=This.cible.GetGarbageDossier().folder($chemin)

⇧ [class]$menuContextuel - 18/04/2026 18:20:47

      Class extends $menu

Class constructor()
	
	Super()
	
	
Function MontrerPopUpMenu($nomMenu : Text)->$result : Boolean
	// montrer et fixer la commande
	This.CréerPopUpMenu($nomMenu)
	// exécuter la commande
	$result:=This.ExécuterCommande()
	
	
Function CréerPopUpMenu($nomMenu : Text)
	var $barreMenus : Text
	
	// créer le menu
	$barreMenus:=This.CréerPopUp($nomMenu)
	// valider les menus contextuels 
	This.ValiderPopUp($barreMenus)
	
	// demander le menu
	This.menuID:=Dynamic pop up menu($barreMenus)
	// récupérer les paramètres avant de purger le menu
	This.LireParamètresMenu(This.menuID; $barreMenus)
	// le menu peut être lié à une ZS
	This.params.deQui:=New object("sélection"; New collection(Storage.System.Navigation.ZS.EnregistrementLié); "index"; 0)
	// nettoyer
	RELEASE MENU($barreMenus)
	
	
Function ExécuterCommande()->$result : Boolean
	$result:=True
	Case of 
		: (This.params.numLigne=0)
			// ok pas d'action à faire
			
		: (This.FixerPréférences())
			// ok, traitée localement
			
		: (This.Exécuter())
			// ok, traitée par $menu
			
		Else 
			// pas traité pas fait ici, passer la main
			$result:=False
	End case 
	
	
Function FixerPréférences()->$result : Boolean
	var $numMenu : Integer
	
	$result:=True  // traitée par défaut
	
	$numMenu:=This.params.numCommande
	Use (This.session.prefs)
		Case of 
			: ($numMenu=110)
				This.session.prefs.Navigation.ParPere:=$numMenu+Num(This.session.prefs.Navigation.ParPere=$numMenu)
				This.session.prefs.Navigation.ParMere:=120+Num(This.session.prefs.Navigation.ParPere=$numMenu)
				
			: ($numMenu=120)
				This.session.prefs.Navigation.ParMere:=$numMenu+Num(This.session.prefs.Navigation.ParMere=$numMenu)
				This.session.prefs.Navigation.ParPere:=110+Num(This.session.prefs.Navigation.ParMere=$numMenu)
				
			: ($numMenu=130)
				This.session.prefs.Navigation.ParMari:=$numMenu+Num(This.session.prefs.Navigation.ParMari=$numMenu)
				This.session.prefs.Navigation.ParFemme:=140+Num(This.session.prefs.Navigation.ParMari=$numMenu)
				
			: ($numMenu=140)
				This.session.prefs.Navigation.ParFemme:=$numMenu+Num(This.session.prefs.Navigation.ParFemme=$numMenu)
				This.session.prefs.Navigation.ParMari:=130+Num(This.session.prefs.Navigation.ParFemme=$numMenu)
				
			: ($numMenu=200)
				This.session.prefs.PartageALV.Activation:=$numMenu+Num(This.session.prefs.PartageALV.Activation=$numMenu)
				If (This.session.prefs.PartageALV.Activation=201)
					cs.$journalALV.me.Ecrire(New object("actionID"; cdk Ouvrir Journal; "Description_Action"; "Ouverture du Journal"))
				Else 
					cs.$journalALV.me.Ecrire(New object("actionID"; cdk Fermer Journal; "Description_Action"; "Fermeture du Journal"))
				End if 
				
			: ($numMenu=1100)
				This.session.prefs.Visualisation.InformationsZS:=$numMenu+Num(This.session.prefs.Visualisation.InformationsZS=$numMenu)
				
			: ($numMenu=1200)
				This.session.prefs.Visualisation.InformationsDiapo:=$numMenu+Num(This.session.prefs.Visualisation.InformationsDiapo=$numMenu)
				
			: ($numMenu=1300)
				This.session.prefs.Visualisation.SelectionPersonnes:=$numMenu+Num(This.session.prefs.Visualisation.SelectionPersonnes=$numMenu)
				
			: ($numMenu=1400)
				This.session.prefs.Visualisation.SelectionEvents:=$numMenu+Num(This.session.prefs.Visualisation.SelectionEvents=$numMenu)
				
			: ($numMenu=1500)
				This.session.prefs.Visualisation.SelectionLieux:=$numMenu+Num(This.session.prefs.Visualisation.SelectionLieux=$numMenu)
				
			: ($numMenu=1600)
				This.session.prefs.Visualisation.InformationsAG:=$numMenu+Num(This.session.prefs.Visualisation.InformationsAG=$numMenu)
				
			: ($numMenu=1700)
				This.session.prefs.Sonorisation.Activation:=$numMenu+Num(This.session.prefs.Sonorisation.Activation=$numMenu)
				
			Else 
				$result:=False
		End case 
	End use 
	
	
Function CréerPopUp($nomMenu : Text)->$result : Text
	This.racineXML:=DOM Parse XML source(Get 4D folder(Current resources folder)+"DataPopUpMenus.xml")
	If (ok=1)
		$result:=This.CréerMenu($nomMenu)
	Else 
		$result:=""
		cs.$trace.me.Créer(-15075; Current method name; "dans le fichier 'DataPopUpMenus.xml'. "+ErrorDescription).LeverException([msgk_event; msgk_log])
	End if 
	DOM CLOSE XML(This.racineXML)
	
	
Function ValiderPopUp($refMenu : Text)
	// ce menu peut être lié à une ZS ; valider les commandes contextuelles avec l'entité associée à la ZS
	This.deQui:=Storage.System.Navigation.ZS.EnregistrementLié
	This.ValiderVisualisateurs($refMenu)
	
	// autre

⇧ [class]$glisserDeposer - 30/04/2026 14:34:51

      // rappel : l'instance est unique pour un process
property nomObjet : Text
property nomObjetCtrl : Text:=""
property estActifDeplacement : Boolean:=False
property pointeurX; pointeurY : Real
property status : Boolean
property session; paramsMessage : Object
// propriétés du glisser/déposer
property nomObjetSource : Text
property numProcessAppelant; refItem : Integer
property texte : Text

singleton Class constructor()
	
	This.session:=cs.$session.me
	
	
	
	// ----------------------
	// MARK:Debut Glisser ITEM 
	// -----------------------
	
Function surDebutGlisserITEM_LB()->$result : Boolean
	var $itemRef : Integer
	var $itemText : Text
	var $params : Object
	var $pict : Picture
	
	This.surDebutGlisser()
	$result:=(OBJECT Get type(*; This.nomObjet)=Object type listbox)
	
	If ($result)
		$itemText:=Form[This.nomObjet+"ElementCourant"].itemText
		$itemRef:=Form[This.nomObjet+"ElementCourant"].itemRef
		Use (Storage.System.GlisserDéposer)
			Storage.System.GlisserDéposer.refItem:=$itemRef
			Storage.System.GlisserDéposer.texte:=$itemText
		End use 
		
		// créer l'icone du pointeur
		// limiter la taille de la chaine iconisée
		$itemText:=Substring($itemText; 1; 32)
		$itemText:=Choose(Length($itemText)>30; Substring($itemText; 1; 30)+"..."; $itemText)
		
		// fixer le paramètre du template SVG
		$params:=New object("texte"; $itemText; "width"; "200"; "height"; "20"; "fontSize"; "1em"; "couleurPP"; "black"; "Format"; Copy XML data source)
		cs._cfct.me.TraiterTemplateSVG("IconeDeTexte.xml"; ->$pict; $params)
		SET DRAG ICON($pict)
		
		$result:=This._estDebutGlisserFICHIER(This.nomObjet)
	End if 
	
	
Function surDebutGlisserITEM_LH()->$result : Boolean
	var $SourceElem; $itemRef : Integer
	var $itemText : Text
	var $params : Object
	var $pict : Picture
	
	This.surDebutGlisser()
	$result:=(OBJECT Get type(*; This.nomObjet)=Object type hierarchical list)
	
	If ($result)
		$SourceElem:=Selected list items(*; This.nomObjet)
		GET LIST ITEM(*; This.nomObjet; $SourceElem; $itemRef; $itemText)
		Use (Storage.System.GlisserDéposer)
			Storage.System.GlisserDéposer.refItem:=$itemRef
			Storage.System.GlisserDéposer.texte:=$itemText
		End use 
		
		// créer l'icone du pointeur
		// limiter la taille de la chaine iconisée
		$itemText:=Substring($itemText; 1; 32)
		$itemText:=Choose(Length($itemText)>30; Substring($itemText; 1; 30)+"..."; $itemText)
		
		// fixer le paramètre du template SVG
		$params:=New object("texte"; $itemText; "width"; "200"; "height"; "20"; "fontSize"; "1em"; "couleurPP"; "black"; "Format"; Copy XML data source)
		cs._cfct.me.TraiterTemplateSVG("IconeDeTexte.xml"; ->$pict; $params)
		SET DRAG ICON($pict)
		
		$result:=This._estDebutGlisserFICHIER(This.nomObjet)
	End if 
	
	
Function surDebutGlisserIMAGE_LH($nomObjet : Text)->$result : Boolean
	var $SourceElem; $itemRef : Integer
	var $itemText : Text
	
	This.surDebutGlisser()
	// hypothèse : l'image est associée à une liste hiérarchique
	$result:=(OBJECT Get type(*; $nomObjet)=Object type hierarchical list)
	
	If ($result)
		$SourceElem:=Selected list items(*; $nomObjet)
		GET LIST ITEM(*; $nomObjet; $SourceElem; $itemRef; $itemText)
		Use (Storage.System.GlisserDéposer)
			Storage.System.GlisserDéposer.refItem:=$itemRef
			Storage.System.GlisserDéposer.texte:=$itemText
		End use 
		
		$result:=This._estDebutGlisserFICHIER($nomObjet)
	End if 
	
	
Function surDebutGlisserCODED_ID($IDcodé : Integer)->$result : Boolean
	var $entité : Object
	var $pict : Picture
	
	$result:=(($IDcodé >> 24)#0)
	
	Case of 
		: (Not($result))
		: (cs._cfct.me.estIDcodeDeClasses($IDcodé; [ds.Medias]))
			$entité:=cs._ds.me.EntitéAvecIDcodé($IDcodé)
			
			Use (Storage.System.GlisserDéposer)
				Storage.System.GlisserDéposer.refItem:=$IDcodé
				Storage.System.GlisserDéposer.texte:=$entité.Libellé()
				Storage.System.GlisserDéposer.typeMedia:=$entité.type
				Storage.System.GlisserDéposer.cheminDocument:=$entité.LeFichier().platformPath
			End use 
			
			CREATE THUMBNAIL($entité.vignette; $pict)
			SET DRAG ICON($pict)
	End case 
	
	
Function _estDebutGlisserFICHIER($nomObjet : Text)->$result : Boolean
	// cas des items medias (image associée à LH ou item de LH)
	// ajouter les informations complémentaires
	var $media : cs.$media
	var $itemRef; $typeMedia : Integer
	var $cheminFichier : Text
	var $pict : Picture
	
	// élément courant de la LH $nomObjet
	$itemRef:=Selected list items(*; $nomObjet; *)
	
	// ses paramètres
	ARRAY TEXT($Elements; 0)
	GET LIST ITEM PARAMETER ARRAYS(*; $nomObjet; $itemRef; $Elements)
	Case of 
		: ($itemRef=0)
			// erreur sur la LH ou pas d'élément courant
			$result:=False
			
		: (Size of array($Elements)=0)
			// a priori ce n'est pas une liste de media
			// on valide ce qui précède
			$result:=True
			// il faut les paramètres du média
		: (Find in array($Elements; "cheminDocument")=-1)
		: (Find in array($Elements; "typeMedia")=-1)
		Else 
			// c'est ok
			Use (Storage.System.GlisserDéposer)
				GET LIST ITEM PARAMETER(*; $nomObjet; $itemRef; "cheminDocument"; $cheminFichier)
				Storage.System.GlisserDéposer.cheminDocument:=$cheminFichier
				GET LIST ITEM PARAMETER(*; $nomObjet; $itemRef; "typeMedia"; $typeMedia)
				Storage.System.GlisserDéposer.typeMedia:=$typeMedia
				
				$result:=Not(($typeMedia=0) | ($cheminFichier=""))
			End use 
			
			// glisser une icone de l'image (48 x 48, proportionnelle centrée, par défaut)
			Case of 
				: (Not($result))
				: ($typeMedia<1)
					$media:=cs.$media.me
					$media.LireAvecChemin($cheminFichier; 1)
					CREATE THUMBNAIL($media.imagePageMedia; $pict)
					SET DRAG ICON($pict)
					
				: ($typeMedia=mdk Est un Dossier externe)
					$pict:=cs._rsc.me.image(15020)
					CREATE THUMBNAIL($pict; $pict)  // 48 x 48
					SET DRAG ICON($pict)
					
				Else 
					$result:=False
			End case 
	End case 
	
	
Function surDebutGlisser()
	// construite le contexte source (on est dans le process source)
	// rappel cette classe n'est pas forcément dans la chaine d'héritage ; fixer this.nomObjet
	This.nomObjet:=Form.nomOBJ
	
	Use (Storage.System.GlisserDéposer)
		// identifier l'objet source
		Storage.System.GlisserDéposer.nomObjetSource:=Form.nomOBJ
		// en interprocess, on pourrait glisser/déposer sur le même objet
		Storage.System.GlisserDéposer.numProcessAppelant:=Current process
		// pas de données sources reconnues par défaut
		Storage.System.GlisserDéposer.refItem:=-1
		Storage.System.GlisserDéposer.texte:=""
	End use 
	
	
	// ----------------------
	// MARK:Glisser ITEM 
	// -----------------------
	
Function surGlisserENTITE($classesGlissables : Collection)->$result : Integer
	// on veut une entité codée
	// $classesGlissables = liste des DataClass autorisées
	var $itemRef : Integer
	
	// refus par défaut
	$result:=-1
	Case of 
		: (Not(This.estGlisserAutorisé()))
		: (Not(This.estGlisserValide()))
		Else 
			// ok, on a une EntitéCodée
			$itemRef:=Storage.System.GlisserDéposer.refItem
			This.status:=cs._cfct.me.estIDcodeDeClasses($itemRef; $classesGlissables)
			$result:=-Num(Not(This.status))
			
			This.FixerParamsMessage()
	End case 
	
	
Function surGlisserIMAGE()->$result : Integer
	// refus par défaut
	$result:=-1
	Case of 
		: (Not(This.estGlisserAutorisé()))
		: (Not(This.estGlisserValide()))
		: (Storage.System.GlisserDéposer.cheminDocument=Null)
		Else 
			$result:=0
			// mémoriser l'attribut qui doit recevoir l'image
			This.FixerParamsMessage()
	End case 
	
	
Function surGlisserFICHIER()->$result : Integer
	// refus par défaut
	$result:=-1
	Case of 
		: (Not(This.estGlisserAutorisé()))
		: (Not(This.status))
		Else 
			$result:=-Num(CodeEnreg(Storage.System.GlisserDéposer.refItem; [mdk Est un Document externe])#1)
			
			This.FixerParamsMessage()
	End case 
	
	
Function surGlisserDOSSIER()->$result : Integer
	//This.estGlisserAutorisé() NON , on n'est pas interprocess 
	$result:=-Num(Not(CodeEnreg(Storage.System.GlisserDéposer.refItem; [mdk Est un Dossier externe])=1))
	
	
Function estGlisserAutorisé()->$result : Boolean
	// autorisé par défaut
	This.status:=True
	Case of 
		: (Storage.System.GlisserDéposer.numProcessAppelant#Current process)
			// interproces, ok
		: (Storage.System.GlisserDéposer.nomObjetSource#This.nomObjet)
			// objets différents, ok
		Else 
			// refuser le glisser
			This.status:=False
	End case 
	$result:=This.status
	
	
Function estGlisserValide()->$result : Boolean
	$result:=False
	Case of 
		: (Not(This.status))
		: (Storage.System.GlisserDéposer.refItem=Null)
		: (Storage.System.GlisserDéposer.refItem=-1)
		Else 
			$result:=True
	End case 
	
	
Function FixerParamsMessage()
	// fixer les params d'une chaine localisée
	This.paramsMessage:=New object
	This.paramsMessage.param_1:=Storage.System.GlisserDéposer.texte
	This.paramsMessage.param_2:=Form.entité.Libellé()
	
	
Function FixerDepotSurLH($ptrObjetCourant : Pointer)->$result : Integer
	// initialiser sur quoi on dépose
	// détail sur le dépot courant
	var $itemPos; $itemRef : Integer
	var $itemText : Text
	
	$itemRef:=-1
	
	Case of 
		: (Not((Type($ptrObjetCourant->)=Is longint) | (Type($ptrObjetCourant->)=Is real)))
			// il faut une liste hiérarchique
		: (Is a list($ptrObjetCourant->))
			
			$itemPos:=Drop position
			If ($itemPos#-1)
				// on a déposé sur un élément existant :
				GET LIST ITEM($ptrObjetCourant->; $itemPos; $itemRef; $itemText)
				// 2 cas : dépot sur un élément de liste, sur un parent
			End if 
	End case 
	
	Use (Storage.System.GlisserDéposer)
		Storage.System.GlisserDéposer.depot:=$itemRef
	End use 
	$result:=$itemRef
	
	
Function FixerDepotSurLB($nomOBJ : Text)
	// initialiser sur quoi on dépose
	// détail sur le dépot courant
	var $numLigne; $colnum; $itemRef : Integer
	var $data : Object
	
	$itemRef:=-1
	
	$numLigne:=Drop position($colnum)
	If ($numLigne>0)
		$data:=Form[$nomOBJ][$numLigne-1]
		$itemRef:=$data.IDcodé
	End if 
	
	Use (Storage.System.GlisserDéposer)
		Storage.System.GlisserDéposer.depot:=$itemRef
	End use 
	
	
	// ----------------------
	// MARK:Déposer ITEM 
	// -----------------------
	
Function surDéposerILLUSTRATION($objetCourant : Object)
	var $data; $entité : Object
	
	$data:=OB Copy(Storage.System.GlisserDéposer)
	
	If (CodeEnreg($data.refItem; [mdk Est un Document externe])=1)
		// l'illustration vient de l'extérieur
		$entité:=Null
	Else 
		// l'illustration vient de la BDD
		$entité:=cs._ds.me.EntitéAvecIDcodé($data.refItem)
	End if 
	// renseigner le deQui
	$data.deQui:=Form.entité
	// 'numPage' et 'type' sont définis en amont
	Case of 
		: (Not(cs._ds.me.Ajouter(imk Illustration; $objetCourant; $entité; $data)))
			// ajout non fait
		: (Not(OB Is defined($data; "numProcessAppelant")))
			// rien demandé
		Else 
			// prévenir l'envoyeur
			Appeler_Le_Formulaire($data.numProcessAppelant; "MettreAjour"; $data)
	End case 
	
	
Function surDéposerIMAGE($objetCourant : Object; $attributCourant : Text)
	var $media : cs.$media:=cs.$media.me
	var $path : Text
	
	// lire l'image
	$path:=Storage.System.GlisserDéposer.cheminDocument
	$media.LireAvecChemin($path; 1)
	// ici le fichier doit être effacé
	File($path; fk platform path).delete()
	
	// modifier l'entité
	$objetCourant[$attributCourant]:=$media.imagePageMedia
	cs._ds.me.Modifier(cdk Modifier; New collection($objetCourant); Null)
	
	
	// ----------------------
	// MARK:Déplacer OBJ 
	// -----------------------
	
Function onReRize()
	// restaurer la position de This.nomObjet
	// cet objet n'est peut-être pas encore connu
	Case of 
		: (FORM Event.code=On Resize)
			This.FixerPosition()
	End case 
	
	
Function onMouseMoveOBJ()->$result : Boolean
	// renvoyer vrai si la commande est exécutée
	
	$result:=False
	Case of 
		: (Not(This.estActifDeplacement))
		: (FORM Event.code=On Mouse Move)
			SET CURSOR(9001)
			$result:=True
			
		: (FORM Event.code=On Mouse Leave)
			SET CURSOR()
	End case 
	
	
Function ActiverDeActiverDeplacer()->$result : Boolean
	// renvoyer vrai si la commande est exécutée
	$result:=False
	Case of 
		: (FORM Event.code#On Clicked)
		: (Not(Macintosh option down))
			
		: (This.estActifDeplacement)
			This.estActifDeplacement:=False
			SET CURSOR()
			
			$result:=True
			
		Else 
			This.estActifDeplacement:=True
			This.DebutDeplacer()
			
			$result:=True
	End case 
	
	
Function DebutDeplacer()
	var $sourisX; $sourisY : Real
	var $SourisBtn : Integer
	
	MOUSE POSITION($sourisX; $sourisY; $SourisBtn)
	This.pointeurX:=$sourisX
	This.pointeurY:=$sourisY
	
	
Function Deplacer()
	var $sourisX; $sourisY; $moveX; $moveY : Real
	var $gauche; $haut; $droite; $bas; $largeur; $hauteur; $SourisBtn : Integer
	
	If (This.estActifDeplacement)
		MOUSE POSITION($sourisX; $sourisY; $SourisBtn)
		$moveX:=$sourisX-This.pointeurX
		$moveY:=$sourisY-This.pointeurY
		
		If (Not(($sourisX=This.pointeurX) & ($sourisY=This.pointeurY)))
			GET WINDOW RECT($gauche; $haut; $droite; $bas)
			$largeur:=$droite-$gauche
			$hauteur:=$bas-$haut
			OBJECT GET COORDINATES(*; This.nomObjet; $gauche; $haut; $droite; $bas)
			
			$moveX:=Choose($gauche+$moveX<0; -$gauche; $moveX)
			$moveX:=Choose($droite+$moveX>$largeur; $largeur-$droite; $moveX)
			$moveY:=Choose($haut+$moveY<0; -$haut; $moveY)
			$moveY:=Choose($bas+$moveY>$hauteur; $hauteur-$bas; $moveY)
			
			OBJECT SET COORDINATES(*; This.nomObjet; $gauche+$moveX; $haut+$moveY)
			This.FixerPrefsPosition()
			
			// replacer l'objet ctrl
			OBJECT GET COORDINATES(*; This.nomObjetCtrl; $gauche; $haut; $droite; $bas)
			$largeur:=$droite-$gauche
			$hauteur:=$bas-$haut
			OBJECT GET COORDINATES(*; This.nomObjet; $gauche; $haut; $droite; $bas)
			OBJECT SET COORDINATES(*; This.nomObjetCtrl; $droite-$largeur; $bas-$hauteur)
			
			This.DebutDeplacer()
		End if 
	End if 
	
	
Function FixerPrefsPosition($gauche : Integer; $haut : Integer; $droite : Integer; $bas : Integer)
	var $c : Collection
	
	If (This.session.prefs.Objets[This.nomObjet]=Null)
		Use (This.session.prefs.Objets)
			This.session.prefs.Objets[This.nomObjet]:=New shared object
		End use 
	End if 
	If (This.session.prefs.Objets[This.nomObjet].Position=Null)
		Use (This.session.prefs.Objets[This.nomObjet])
			This.session.prefs.Objets[This.nomObjet].Position:=New shared collection
		End use 
	End if 
	
	OBJECT GET COORDINATES(*; This.nomObjet; $gauche; $haut; $droite; $bas)
	$c:=New shared collection($gauche; $haut; $droite; $bas)
	
	Use (This.session.prefs.Objets[This.nomObjet])
		This.session.prefs.Objets[This.nomObjet].Position:=$c
	End use 
	
	
Function FixerPosition()
	var $c : Collection
	
	If (This.session.prefs.Objets[This.nomObjet].Position#Null)
		$c:=This.session.prefs.Objets[This.nomObjet].Position
		OBJECT SET COORDINATES(*; This.nomObjet; Int($c[0]); Int($c[1]); Int($c[2]); Int($c[3]))
	End if 
	
	
	// ----------------------
	// MARK:Redimensionner OBJ 
	// -----------------------
	
Function onMouseMoveOBJctrl()
	Case of 
		: (FORM Event.code=On Mouse Move)
			SET CURSOR(9005)
			
		: (FORM Event.code=On Begin Drag Over)
			This.DebutReDimensionner()
			
		: (FORM Event.code=On Drag Over)
			This.Dimensionner()
			
		: (FORM Event.code=On Drop)
			This.DeActiverDimensionner()
	End case 
	
	
Function ActiverDimensionner()->$result : Boolean
	// renvoyer vrai si la commande est exécutée
	$result:=False
	Case of 
		: (FORM Event.code#On Clicked)
		: (Not(Macintosh control down))
		Else 
			OBJECT SET VISIBLE(*; This.nomObjetCtrl; True)
			
			$result:=True
	End case 
	
	
Function DeActiverDimensionner()->$result : Boolean
	OBJECT SET VISIBLE(*; This.nomObjetCtrl; False)
	
	
Function DebutReDimensionner()
	// pas de return (acceptation implicite du Début Glisser)
	var $pict : Picture
	
	$pict:=cs._rsc.me.image(15122)
	CREATE THUMBNAIL($pict; $pict; 16; 16)
	SET DRAG ICON($pict)
	
	
Function Dimensionner()
	// pas de return (acceptation implicite du Glisser Sur)
	var $sourisX; $sourisY : Real
	var $SourisBtn; $gauche; $haut; $droite; $bas; $demiLargeur; $demiHauteur : Integer
	
	// position courante du pointeur
	MOUSE POSITION($sourisX; $sourisY; $SourisBtn)
	
	// faire suivre le controleur
	OBJECT GET COORDINATES(*; This.nomObjetCtrl; $gauche; $haut; $droite; $bas)
	$demiLargeur:=($droite-$gauche)/2
	$demiHauteur:=($bas-$haut)/2
	OBJECT MOVE(*; This.nomObjetCtrl; $sourisX-$demiLargeur; $sourisY-$demiHauteur; $sourisX+$demiLargeur; $sourisY+$demiHauteur; *)
	
	// redimensionner l'objet accroché
	OBJECT GET COORDINATES(*; This.nomObjet; $gauche; $haut; $droite; $bas)
	OBJECT SET COORDINATES(*; This.nomObjet; $gauche; $haut; $sourisX+$demiLargeur; $sourisY+$demiHauteur)

⇧ [class]$requeteHTTP - 23/07/2026 16:56:40

      property connexionHTTPactive : Boolean:=False
property reqRetour : Object
property cookie : Object:=Null
property origineCookie : Text:="servicesAPP"

shared singleton Class constructor()
	cs.$trace.me.EnvoyerMessages([msgk_event]; "Constructeur"; Current method name; "Création de la classe")
	
	
	// ----------------------
	//MARK:Requête serveur HTTP
	// -----------------------
	
Function Requeter($url : Text; $méthodeHTTP : Text; $body : Object; $typeData : Text)->$result : Integer
	// méthode principale (et partagée avec les composants) pour requêter le serveur HTTP
	var $requeteHTTP : Object
	ALERT("toto "+Current process name+". "+Current method name+String(This.connexionHTTPactive))
	
	If (This.connexionHTTPactive)
		$requeteHTTP:=This._RequeterServeurHTTP($url; $méthodeHTTP; OB Copy($body); $typeData)
		
		If (This.TraitementRequete($requeteHTTP).success)
			// rappel This.reqRetour est un objet partagé ; faire une copie non partagée
			$body.reqRetour:=OB Copy(This.reqRetour)
		Else 
			$body.reqRetour:=Null
			cs.$trace.me.Créer(-15084; Current method name; JSON Stringify($result)).LeverException([msgk_log; msgk_user])
		End if 
		$result:=$requeteHTTP.requestHTTP.response.status
		
	Else 
		$result:=505
		$body.reqRetour:=Null
		cs.$trace.me.Créer(-15084; Current method name; "le serveur HTTP est inactive").LeverException([msgk_event; msgk_log])
	End if 
	
	
Function _RequeterServeurHTTP($url : Text; $méthodeHTTP : Text; $body : Object; $typeData : Text)->$result : Object
	// méthode de base pour lancer la requête
	ALERT("toto "+Current process name+". "+Current method name+Storage.RessourcesAPP.URLserveurAPP)
	$result:=New object
	$result.optionsHTTP:=cs.$requeteHTTPoptions.new($méthodeHTTP; $body; $typeData)
	$result.requestHTTP:=4D.HTTPRequest.new(Storage.RessourcesAPP.URLserveurAPP+$url; $result.optionsHTTP)
	$result.requestHTTP.wait(60)
	ALERT("toto "+Current process name+". "+Current method name+JSON Stringify($result.optionsHTTP; *))
	
	// les données reçues
	Use (This)
		This.reqRetour:=OB Copy($result.optionsHTTP.reqRetour; ck shared; This)
	End use 
	
	
Function TraitementRequete($requeteHTTP : Object)->$result : cs.$trace
	// renvoie .success=Vrai si pas d'erreur
	$result:=cs.$trace.new().Créer(-15080; Current method name; "")
	
	Case of 
		: ($requeteHTTP.requestHTTP.errors.length>0)
			$result.ErrorDescription:="Erreurs connexions au serveur (voir logs)"
			cs.$trace.new().Créer(-15080; Current method name; JSON Stringify($requeteHTTP.requestHTTP.errors)).LeverException([msgk_log])
			
		: (Not(OB Is defined($requeteHTTP.requestHTTP; "response")))
			$result.ErrorDescription:="Connexion impossible au serveur (voir logs)"
			cs.$trace.new().Créer(-15080; Current method name; JSON Stringify($requeteHTTP.requestHTTP)).LeverException([msgk_log])
			
		: (Int($requeteHTTP.requestHTTP.response.status/100)=4)
			// il faut une réponse
			$result.ErrorDescription:="Err "+String($requeteHTTP.requestHTTP.response.status)+" "+$requeteHTTP.requestHTTP.response.statusText+" - Réponse incorrecte de <"+$requeteHTTP.requestHTTP.url+">"
			
		: (Int($requeteHTTP.requestHTTP.response.status/100)=5)
			// il faut une réponse
			$result.ErrorDescription:="Err "+String($requeteHTTP.requestHTTP.response.status)+" "+$requeteHTTP.requestHTTP.response.statusText+" - Erreur interne serveur sur <"+$requeteHTTP.requestHTTP.url+">"
			
		Else 
			// c'est ok
			$result.Error:=0
	End case 
	$result.FixerSuccess()
	$result.LeverException([msgk_event])
	
	
	// ----------------------
	//MARK:Etat serveur HTTP
	// -----------------------
	
Function ActiverConnexion()->$result : Boolean
	// renvoie vrai si la connexion au serveur APP doit être établie
	// Vrai si on est clientAPP
	$result:=Storage.System.estClientAPP
	// Vrai si la console SRV est allumée
	$result:=$result | (Process activity(Processes only).processes.query("name = :1"; "@Logs serveur ALV").length=1)
	
	
Function FixerEtatConnexion()
	// ici on est dans un worker
	var $attente; $temps : Integer
	var $status : Boolean:=False
	
	InitProcessThreadSafe
	
	// initialiser l'URL du serveur Web
	cs.$requeteHTTPoptions.new().FixerUrlServeurWeb()
	
	$attente:=5000  // ms
	While (This.ActiverConnexion())
		$temps:=Milliseconds
		
		Case of 
			: (This._estLiaisonInternetActive())
				// pb liaison internet
				$status:=False
				
			: (This._estServeurWebDemarre())
				// pb la machine hote est éteinte
				$status:=False
				
			: (This.estServeurWebActif())
				// le serveur n'a pas répondu
				$status:=False
				
			Else 
				// c'est ok
				$status:=True
		End case 
		
		// rappel important : ici on est singleton : This.connexionHTTPactive est visible par tous
		Use (This)
			This.connexionHTTPactive:=$status
		End use 
		// attendre  ; pour éviter d'attendre $attente en cas de KILL, on fait une sous boucle plus rapide
		
		Repeat 
			DELAY PROCESS(Current process; 6)  // 10 ticks
		Until (((Milliseconds-$temps)>$attente) | Not(This.ActiverConnexion()))
	End while 
	KILL WORKER
	
	
Function _estLiaisonInternetActive()->$result : Boolean
	// tester si la machine courante est connectée à internet (chaine Wifi / ethernet - FAI...)
	// renvoie faux si pas d'erreurs
	var $options : Object
	var $transporter : 4D.SMTPTransporter
	
	$options:=New object
	cs.xSDK.ResourceALV.me.SetObjet(Est Ressource APP; "Serveur_SMTP/nom_Hote"; Is text; $options; "host")
	$transporter:=SMTP New transporter($options)
	$result:=Not($transporter.checkConnection().success)
	
	cs.$trace.me.Créer(-15084*Num($result); Current method name; "la connexion internet semble inactive").LeverException([msgk_event; msgk_log])
	
	
Function _estServeurWebDemarre()->$result : Boolean
	// tester si la machine hôte du serveur ALV est allumée (le serveur Apache doit être en route)
	// => on demande une page servie par Apache mais pas par 4D
	// renvoie faux si pas d'erreurs
	var $requeteHTTP : 4D.HTTPRequest
	var $URLserveur; $ErrorDescription : Text
	
	$result:=True
	
	// l'adresse du serveur (la valeur est dynamique, rafraichir)
	$URLserveur:=Storage.RessourcesAPP.URLserveurAPP
	If ($URLserveur="")
		// pb de debug ! (storage a dû être re-initialisé
		$ErrorDescription:="l'adresse du serveur hote est inconnue"
		
	Else 
		// il faut une URL qui pointe ici, et une page neutre de test
		$requeteHTTP:=4D.HTTPRequest.new($URLserveur+"/pageTest.html").wait(10)
		Case of 
			: (Not($requeteHTTP.terminated))
				// pas trouvé
				$ErrorDescription:="serveur Web hôte [KO], pas de réponse à la requête HTTP sur la page "+$URLserveur+"/pageTest.html"
				
			: ($requeteHTTP.response.body#"<!DOCTYPE html PUBLIC@")
				// texte non reconnu
				$ErrorDescription:="le contenu de la page 'pageTest.html' n'est pas reconnu"
				
			Else 
				// c'est ok
				$result:=False
		End case 
	End if 
	
	cs.$trace.me.Créer(-15084*Num($result); Current method name; $ErrorDescription).LeverException([msgk_event])
	
	
Function estServeurWebActif()->$result : Boolean
	// le serveur HTTP est actif s'il répond à une requête
	// renvoie false si pas d'erreur
	var $requeteHTTP : Object
	var $cookie; $ErrorDescription : Text
	
	$result:=True
	
	$requeteHTTP:=This._RequeterServeurHTTP("/4DHTTP/APP/$serveurWEB/EtatServeurAPP"; "Get"; New object; "blob")
	// traiter la réponse : erreur si un code supérieur 400
	// si c'est ok, $Error = 200
	Case of 
		: (Not(This.TraitementRequete($requeteHTTP).success))
			// erreur traitée
			
		: (Not(OB Is defined(This.reqRetour; "EstActif")))
			$ErrorDescription:="La réponse à la requête doit contenir 'EstActif'"
			
		: (Not(This.reqRetour.EstActif))
			$ErrorDescription:="Application ALV serveur (4D) non lancée"
			
		Else 
			// c'est ok
			$result:=False
			
			//lire le cookie reçu
			$cookie:=Split string($requeteHTTP.requestHTTP.response.headers["set-cookie"]; ";")[0]
			$requeteHTTP.optionsHTTP.FixerCookie("servicesAPP"; $cookie)
	End case 
	
	cs.$trace.me.Créer(-15080*Num($result); Current method name; $ErrorDescription).LeverException([msgk_event])
	cs.$trace.me.Créer(-15080*Num($result); Current method name; JSON Stringify($requeteHTTP.requestHTTP.errors)).LeverException([msgk_log])

⇧ [class]$zoneSensible - 17/03/2026 14:46:47

      Class extends $menuContextuel

Class constructor()
	
	Super()
	
	
	
	// ----------------------
	//MARK:Survol
	// -----------------------
	
Function SurvolZSarbre($paramsArbre : Object)
	// un élément sensible de l'arbre est survolé ; simuler le survol d'une ZS
	// rappel le composant est multi application (APP, WEB, MOB) ; les IDcodés peuvent être différents selon le contexte
	// il ne gère que des UUID
	var $entité : Object
	
	// par défaut, il n'y pas de ZSsurvolée
	Use (Storage.System.Navigation.ZS)
		Storage.System.Navigation.ZS.ZoneSurvolée:=-1
	End use 
	
	Case of 
		: ($paramsArbre.Navigation=Null)
		: ($paramsArbre.Navigation.ZS=Null)
		: ($paramsArbre.Navigation.ZS.numTable<1)
		: ($paramsArbre.Navigation.ZS.UUID_BDD="")
			// hors zones
		Else 
			
			// c'est ok, un objet de la BDD est survolé
			// renseigner .EnregistrementLié (passer de UUID à ID ou numEnreg)
			$entité:=ds[Table name($paramsArbre.Navigation.ZS.numTable)].query("IDunique=:1"; $paramsArbre.Navigation.ZS.UUID_BDD)[0]
			// mémoriser pour son utilisation par la messagerie Utilisateur
			
			// mémoriser pour une action survol ou clic Utilisateur
			Use (Storage.System.Navigation.ZS)
				Storage.System.Navigation.ZS.ZoneSurvolée:=1
				Storage.System.Navigation.ZS.EnregistrementLié:=$entité.IDcodé()
				Storage.System.Navigation.ZS.EnregistrementLiéLibellé:=$entité.Libellé()
			End use 
	End case 
	
	
	// ----------------------
	//MARK:Action
	// -----------------------
	
Function ActionZS()->$result : Boolean
	// click dans une ZS systeme (accueil essentiellement) ou une ZS utilisateur [Zones] (formulaire utilisateur)
	// par principe, l'appel est toujours généré par l'evenementFormulaire 'clic' d'une image de formulaire
	
	// chercher ce qu'il faut faire
	$result:=True
	Case of 
		: (Not(Storage.System.Navigation.ZS.ZoneSurvolée>0))
			// pas clic dans ZS
			$result:=False
			
		: (cs.CommandesEditeur.new().ActionClicZS(Storage.System.Navigation.ZS.EnregistrementLié))
			// action système traitée
			
		: (This.ActionMenuContextuel())
			// action de menu contextuel traité
			
		: (This.ActionClicZS())
			// action utilisateur traitée
			
		Else 
			// non traitable ici
			$result:=False
	End case 
	
	
Function ActionMenuContextuel()->$result : Boolean
	// renvoie Vrai si une commande a été exécutée
	var $nom : Text
	
	$result:=False
	Case of 
		: (Not(Contextual click | Right click))
		: (Storage.System.Navigation.ZS.ZoneSurvolée=-1)
		Else 
			// clic droit dans ZS : appeler le MC correspondant, type "ZS_NomProc-NumTableDuLien"
			// que veut-on faire?
			$nom:=Current process name
			$nom:=This.fct.PropriétariserNomProcess($nom)
			$nom:="ZS_"+$nom+"-"+String(CodeEnreg(Storage.System.Navigation.ZS.EnregistrementLié))
			// exécuter le menu contextuel
			$result:=This.MontrerPopUpMenu("MC_"+$nom)
	End case 
	
	
Function ActionClicZS()->$result : Boolean
	// clic dans une zone sensible utilisateur [Zones]
	// depuis un éditeur ou un visualisateur , on ne sait pas
	var $nomProc; $commande; $ErrorDescription : Text
	var $menuData; $data : Object
	var $Error : Integer
	
	$result:=True
	
	$commande:=""
	$Error:=0
	// trouver la commande associée à cette action et l'exécuter
	// lire l'action associée au clic (ou clic option) dans cette ZS de ce process
	$nomProc:=Current process name
	$nomProc:=This.fct.PropriétariserNomProcess($nomProc)
	$menuData:=New object("IDobjetCodé"; Storage.System.Navigation.ZS.EnregistrementLié; "action"; cs.$formulaire.new().ActionUtilisateur("[option]"))
	// rappel : le survol de la ZS a stocké les paramètres de l'action dans les userPrefs
	This.LireParamètresZS($nomProc; $menuData)
	
	// RAZ, sinon tous les clic souris du debug sont filtrés ici
	Use (Storage.System.Navigation.ZS)
		Storage.System.Navigation.ZS.ZoneSurvolée:=-1
	End use 
	
	// exécuter l'action demandée
	$menuData:=This.params
	Case of 
		: ($menuData=Null)
			// peut arriver
		: ($menuData.DataClassNom="")
			// tant pis
			
		: (OB Is defined(cs; $menuData.DataClassNom))
			// ok, cette classe existe ; on a tout
			$data:=cs[$menuData.DataClassNom].new()
			$data.params.deQui:=New object("sélection"; New collection(Storage.System.Navigation.ZS.EnregistrementLié); "index"; 0)
			$data.params.Contexte:=$data.informations.Contexte
			$data.params.numTable:=$data.informations.numTable
			This.process.LancerVisualisateur($data)
			
		Else 
			// commande inconnue
			$Error:=-15007
			$result:=False
	End case 
	cs.$trace.me.Créer($Error; Current method name; $ErrorDescription).LeverException([msgk_event; msgk_log])
	
	
	// ----------------------
	//MARK:Utilitaires
	// -----------------------
	
Function LireParamètresZS($nomProc : Text; $data : Object)
	var $menuID; $refMenu : Text
	var $Error : Integer
	// renvoie dans $2 les paramètres de l'action de la ZS du process $1 et liée à l'objet $2.IDobjetCodé associée à l'action $2.action clic ou clic+opt
	// rappel : $1 est donc la forme "U_Nav?xxx{+?numéro}" car il peut y voir plusieurs process du même type
	// remarque : en passant distinctement $2 on peut appeler la commande n'importe où dans le code (indépendamment d'une action utilisateur)
	
	// principe : comme l'action peut être définie par l'utilisateur, elle est lue dans les userPrefs
	// à défaut elle est lue dans les MC en ressources : construire le menu contractuel et lit les paramètres de l'action demandée
	
	// nom du menu contextuel de cette action
	// rappel : clic appelle ID menu 'x-0100'
	$nomProc:=This.fct.PropriétariserNomProcess($nomProc)
	// virer le rang du process
	$nomProc:=Split string($nomProc; "-").slice(0; 3).join("-")
	$menuID:=$nomProc+"-"+String(CodeEnreg($data.IDobjetCodé))+"-0100"
	
	// commencer par voir si l'action est dans les UserPrefs
	$Error:=-15007
	Case of 
		: (Storage.System.Navigation.ZS=Null)
		: (Storage.System.Navigation.ZS.menus=Null)
		: (Storage.System.Navigation.ZS.menus[$menuID]=Null)
			// info pas encore programmée
			
		Else 
			// commande existante
			$Error:=0
	End case 
	
	If ($Error#0)
		// pas encore initialisé, lire l'action préprogrammée dans les MC en ressource
		$refMenu:=This.CréerPopUp("MC_ZS_"+$nomProc+"-"+String(CodeEnreg($data.IDobjetCodé)))
		This.LireParamètresMenu("MC_ZS_"+$menuID; $refMenu)
		
		Case of 
			: (This.params.refMenu="")
			Else 
				// c'est ok
				// mémoriser les paramètres de l'action dans les userPrefs (pour une future lecture)
				// au chemin 'Navigation.NomTypeProc-IDtypeProc.ZS.refMenu'
				If (Storage.System.Navigation.ZS.menus[$menuID]=Null)
					Use (Storage.System.Navigation.ZS.menus)
						Storage.System.Navigation.ZS.menus[$menuID]:=New shared object
					End use 
				End if 
				sharedObject(This.params; Storage.System.Navigation.ZS.menus[$menuID])
				
				$Error:=0
		End case 
	End if 
	
	// on recommence
	If (Storage.System.Navigation.ZS.menus[$menuID]=Null)
		// cela veut dire que le menu n'existe pas
		// menu inconnu, renvoyer une erreur
		This.params:=New object("libellé"; ""; "commande"; ""; "message"; 0; "Erreur"; $Error; "ErreurDescription"; "le menu contextuel "+$menuID+" n'est pas connu")
	Else 
		// commande existante, renvoyer une copie (non partagée)
		This.params:=OB Copy(Storage.System.Navigation.ZS.menus[$menuID])
	End if 
	
	This.params.menuID:=$menuID
	This.params.Erreur:=$Error

⇧ [class]MediasVisualisateur - 08/05/2026 17:27:22

      property hyperTexteEditeur : cs.$hyperTexteEditeur
property entité : cs.MediasEntity
property image : cs.$image
property functionID; nomOBJ : Text
property ZoneActive : Integer
property RacineHtml : 4D.Folder
property navigation : cs.$navigation

Class extends $visualisateur

Class constructor()
	// construction commune
	Super()
	
	// taguer le type du visualisation
	This.informations.Contexte:="_diaporama_"
	
	// fixer les données du formulaire (surcharge les valeurs par défaut)
	This.grandEcran:=True
	This.mémoTaille:=False
	This.ZoneActive:=0
	
	// gestion de l'image
	This.image:=cs.$image.me
	This.image.nomObjet:="BDDimage"
	This.image.MediaHSpoté:=True
	
	// gestion de la zone texte
	This.hyperTexteEditeur:=cs.$hyperTexteEditeur.new("WParea")
	
	// gestion du glisser deposer OBJ
	This.glisserDeposer.nomObjet:="WParea"
	This.glisserDeposer.nomObjetCtrl:="WPareaCtrl"
	
	// passer au SF la classe nav pour avoir accès au variable des objets
	This.navigation:=This.nav
	
	
	
Function getDataClassInfos()->$result : Object
	$result:=Super.getDataClassInfos("Medias")
	
	
	// ----------------------
	// MARK:Gestion formulaire 
	// -----------------------
	
Function OuvrirFormulaire()
	// méthode du process U_Nav?Diaporama
	var $wndNum : Integer
	
	This.RacineHtml:=Folder(fk database folder).folder("tempo_diaporama")
	This.RacineHtml.create()
	
	// rappel : contraste des HS (0 = transparent, -1 = noir)
	
	// ici il faut garder l'écran large en permanence pour masquer le reste => pas de boucle 'Repeter' comme en Edition
	If (Is Windows)
		$wndNum:=Open window(0; 25; Screen width; Screen height-30; 2; "Diaporama")
		MAXIMIZE WINDOW($wndNum)
		DIALOG("Visualiser Le Diaporama"; This)
		CLOSE WINDOW
		CLEAR VARIABLE($wndNum)
		
	Else 
		cs.$dialogue_3001.new().Ouvrir("Visualiser Le Diaporama"; Plain form window; ""; This)
	End if 
	
	// c'est fini : on purge
	cs.EncyclopediaVisualisateur.new().Tuer()
	This.RacineHtml.delete(Delete with contents)
	
	
Function Charger()
	// init des variables
	Form.WParea:=WP New
	
	// créer les canaux sonores
	This.sonorisation.AjouterCanal("DiaporamaAmbiance"; Est Ressource Media; ""; This.session.prefs.SonorisationPrefs.Ambiance)
	This.sonorisation.AjouterCanal("DiaporamaSynthese"; Is text; ""; This.session.prefs.SonorisationPrefs.SyntheseVocale)
	This.sonorisation.AjouterCanal("DiaporamaAction"; Est Ressource APP; This.session.prefs.SonorisationPrefs.Action.Son; This.session.prefs.SonorisationPrefs.Action)
	
	// lancer le fond sonore
	Form.sonorisation.LirePlayList("DiaporamaAmbiance")
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	// Pour que le formulaire converti en v11 se comporte comme un formulaire créé en v2004, il faut cocher les propriétés "Ajustement dynamique" et "Avec contrainte" du formulaire
	var $gauche; $haut; $droite; $bas; $largeurOptimale; $hauteurOptimale : Integer
	
	// attention : 'Table du formulaire courant' donne nil pour un formulaire projet
	ASSERT(cs.$trace.me.DebugerEventForm(Current method name; "EventForm"; New object("numEvent"; FORM Event.code; "numTable"; Table(->[Medias]))))
	
	// traitements génériques
	Super.surEvenementFormulaire()
	This.nav.TraiterFORMevent()
	
	Case of 
		: (FORM Event.code=On Load)
			Form.Charger()
			This.onEndLoad()
			
			// ici il faut de la réactivité ; modifier le réglage par défaut
			SET TIMER(10)
			
			
		: (FORM Event.code=On Resize)
			OBJECT GET COORDINATES(*; "Page Vidéo"; $gauche; $haut; $droite; $bas)
			ZoneWeb_Largeur:=String($droite-$gauche)+"px"  //pixel
			ZoneWeb_Hauteur:=String($bas-$haut)+"px"
			
			This.glisserDeposer.onReRize()
			
		: (FORM Event.code=On Activate)
			HIDE MENU BAR
			
		: (FORM Event.code=On Timer)
			// mettre à jour les thermomètres
			Afficher Progression Process
			
			// traiter les effets
			This.image.AppliquerTransformation()
			// mettre à jour l'IHM (dans cette version, uniquement la règle)
			Form.visibiliteZS:=This.image.LireContraste()
			
			// positionner le champ information media
			Form.glisserDeposer.Deplacer()
			
			// positionner l'information de la ZS
			OBJECT GET BEST SIZE(*; "InformationZS"; $largeurOptimale; $hauteurOptimale; Screen width-10)
			OBJECT GET COORDINATES(*; "InformationZS"; $gauche; $haut; $droite; $bas)
			$bas:=$haut+$hauteurOptimale
			OBJECT MOVE(*; "InformationZS"; $gauche; $haut; $droite; $bas; *)
			
		: (FORM Event.code=On Unload)
			// à faire ici! où Form est encore disponible
			Form.sonorisation.StopSonorisation()
	End case 
	
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection("visibiliteZS"; "WPareaCtrl")
	Super.onEndEventForm($c)
	
	
Function _FORM_visibiliteZS()
	Case of 
		: (FORM Event.code=On Load)
			Form.visibiliteZS:=This.image.LireContraste()
			
		: (FORM Event.code=On Clicked)
			This.image.FixerContraste(Form.visibiliteZS)
	End case 
	
	
Function _FORM_BDDimage()
	Case of 
		: (FORM Event.code=On Mouse Move)
			// fixer .ZoneSurvolée (-1 pas de ZS, sinon ID zone)
			//    et .EnregistrementLié (objet du lien)
			This.image.existeZoneSensibleActiveinMedia()
			
			// gérer le curseur en fonction des ZS et des touches clavier
			// dans l'ordre :
			Case of 
				: (Form.SurvolZSimage())
					
				: (Num(OBJECT Get format(*; This.image.nomObjet))=Truncated non centered)
					// afficher la main
					SET CURSOR(9013)
					
				Else 
					// tout RAZer
					SET CURSOR  // RAZ pointeur
					Form.EffacerMessageUtilisateur()
			End case 
			
			// afficher les informations de l'objet lié (si demande utilisateur)
			Form.AfficherInformations()
			
			
		: (FORM Event.code=On Clicked)
			Case of 
				: (Form.zoneSensible.ActionZS())
					// action traitée
					
				: ((Macintosh option down) & (Shift down))
					This.image.ZoomMoins()
					
				: (Macintosh option down)
					Form.image.ZoomPlus()
					
				Else 
					Super.surEvenementFormulaire()
			End case 
			
		: (FORM Event.code=On Mouse Leave)
	End case 
	
	
Function _FORM_zoomPlus()
	This.image.ZoomPlus()
	
	
Function _FORM_zoomMoins()
	This.image.ZoomMoins()
	
	
Function _FORM_contrastePlus()
	This.image.ContrastePlus()
	// mettre à jour la règle
	Form.visibiliteZS:=This.image.LireContraste()
	
	
Function _FORM_contrasteMoins()
	This.image.ContrasteMoins()
	// mettre à jour la règle
	Form.visibiliteZS:=This.image.LireContraste()
	
	
Function _FORM_WParea()
	Case of 
		: (Form.glisserDeposer.ActiverDeActiverDeplacer())
		: (Form.glisserDeposer.onMouseMoveOBJ())
			// le déplacement a été fait
			
		: (Form.glisserDeposer.ActiverDimensionner())
			
		: (FORM Event.code#On Clicked)
		: (This.hyperTexteEditeur.ActiverLienHyperText())
			// affichage de la référence encyclo du lien cliqué
	End case 
	
	
Function _FORM_WPareaCtrl()
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=cs._rsc.me.image(15121)
			
		Else 
			Form.glisserDeposer.onMouseMoveOBJctrl()
			// le redimensionnement a été fait
	End case 
	
	
Function _FORM_previousPage()
	This.AfficherPagePrécédente()
	
	
Function _FORM_nextPage()
	This.AfficherPageSuivante()
	
	
	// ----------------------
	//MARK:Affichage 
	// -----------------------
	
Function estAffichable($params : Object)->$result : Boolean
	// renvoie vrai si ???
	
	
Function AfficherEntité()
	// mémoriser les infos media
	Form.entité:=This.nav.entitéCourante
	
	Form.numPageMedia:=1
	Use (Storage.System.Navigation.ZS)
		Storage.System.Navigation.ZS.ZoneSurvolée:=-1
	End use 
	This.AfficherLaPage()
	
	
Function AfficherLaPage()
	// afficher l'entité courante dans la page
	var $fichier : 4D.File
	var $mediaPath; $CodeSource : Text
	var $sélectionEntités : Object
	
	// ici on a un fichier présent sur le DD
	$mediaPath:=Form.entité.LeFichier().platformPath
	
	This.image.estReconnu($mediaPath)
	If (This.image.typeObjet=3)
		// une vidéo
		FORM GOTO PAGE(2)
		// renseigner les paramètres de la page html
		This.image.AfficherVideo($mediaPath)
		
		// créer la page html
		$fichier:=Folder(fk resources folder).folder("TemplatesPagesWeb").file("pageVideo.html")
		If ($fichier.exists)
			$CodeSource:=$fichier.getText()
			// remplacer les variables 4D par leur valeurs courantes
			PROCESS 4D TAGS($CodeSource; $CodeSource)
			
			$fichier:=This.RacineHtml.file("PageVidéo"+".html")
			If ($fichier.exists)
				$fichier.delete()
			End if 
			$fichier.setText($CodeSource)
			
			WA OPEN URL(*; "Page Vidéo"; $fichier.platformPath)
		End if 
		
	Else 
		// afficher page noire (claquer le beignet d'une vidéo précédente)
		WA SET PAGE CONTENT(*; "Page Vidéo"; "<html><head><style type="+Char(Double quote)+"text/css"+Char(Double quote)+">body{background-color:#000}</style></head><body><h1>Bye</h1></body></html>"; "file:///")
		
		FORM GOTO PAGE(1)
		// afficher l'image
		This.image.AfficherPageMedia(Form.entité.ID)
		
		// afficher le titre de la page
		// supprimer les liens vers des illustrés
		$sélectionEntités:=Form.entité.LesZonesDeLaPage(Form.numPageMedia).query("not(type = 2)")
		Form.titre:=""
		If ($sélectionEntités.length>0)
			Form.titre:=$sélectionEntités[0].Libellé()
		End if 
		
		// afficher le commentaire du média (si demande utilisateur)
		This.AfficherHyperTexte()
	End if 
	
	
Function AfficherPagePrécédente()
	If (Form.numPageMedia>1)
		Form.numPageMedia:=Form.numPageMedia-1
		This.AfficherLaPage()
	Else 
		BEEP
	End if 
	
	
Function AfficherPageSuivante()
	If (Form.numPageMedia<[Medias]NombreDePages)
		Form.numPageMedia:=Form.numPageMedia+1
		This.AfficherLaPage()
	Else 
		BEEP
	End if 
	
	
	// ----------------------
	//MARK:ZoneHyperTexte 
	// -----------------------
	
Function AfficherHyperTexte()
	var $data; $params : Object
	
	// préparer les paramètres du worker
	$params:=New object
	// formulaire d'affichage
	$params.Formulaire:=Current form window
	// options de mise en forme
	// masquer par défaut les informations
	$params.params:=0x0007
	// entité à informer
	$params.DataClassNom:="Medias"
	$params.IDunique:=""
	If (This.session.prefs.Visualisation.InformationsDiapo=1201)
		// enregistrement dont on demande le commentaire
		$params.IDunique:=This.entité.IDunique
	End if 
	// pour la suite des opérations, le worker appellera le callBack du process numProcessAppelant : "FixerHyperTexte"
	$params.nomProcessAppelant:=Current process name
	$params.CallBack:="CallBackFixerHyperTexte"
	
	// données de la class / function à utiliser
	$data:=New object("params"; $params)
	$data.execute:=Formula(cs.$serveurAPP.me.Executer(cs.$hyperTexteEditeur.name; "InformationEntité"; This.params))
	CALL WORKER("WK_selectionsBDD"; Formula($data.execute()))
	
	
Function CallBackFixerHyperTexte($params : Object)
	This.hyperTexteEditeur.FixerHyperTexte($params)
	
	
Function AfficherElement($motClé : Text)
	This.hyperTexteEditeur.AfficherElement($motClé)
	
	
Function AjouterAliste($motClé : Text)
	This.hyperTexteEditeur.AjouterAliste($motClé)

⇧ [class]$serveurAPP - 23/07/2026 17:14:40

      // Traitement des requêtes APP

shared singleton Class constructor()
	
	
	// ----------------------
	//MARK:Requête serveur APP
	// -----------------------
	
Function Executer($className : Text; $functionID : Text; $params : Object; $appID : Text)
	// exécute sur le serveur APP la function $class.$functionID() avec les paramètres $params
	var $class : Object:=Null
	var $url : Text
	var $duréeReq : Integer
	
	If (Count parameters=3)
		$appID:="APP"
	End if 
	
	Case of 
		: (OB Is defined(ds; $className))
			$class:=ds[$className]
			
			// BDDmère
		: ($appID="APP")
			If (OB Is defined(cs; $className))
				$class:=cs[$className].new()
			End if 
			
			// un composant
		: (OB Is defined(cs[$appID]; $className))
			$class:=cs[$appID][$className].new()
	End case 
	
	Case of 
		: ($class=Null)
			cs.$trace.me.Créer(-15068; Current method name; "Classe '"+$className+Choose($appID=""; "APP"; "' (du composant '"+$appID+"')")+" non reconnue").LeverException([msgk_event; msgk_log])
		: (Not(OB Is defined($class; $functionID)))
			cs.$trace.me.Créer(-15068; Current method name; "Function '"+$functionID+"' de la classe '"+$className+Choose($appID="APP"; ""; "' (du composant '"+$appID+"')")+" non reconnue").LeverException([msgk_event; msgk_log])
			
		: (Storage.System.estClientAPP)
			// ici on est client APP (ou en debug sur BDDmère) exécuter sur le serveur
			This.ActiverEtatConnexionServeur()
			
			$duréeReq:=Milliseconds
			
			$url:=New collection("/4DHTTP"; $appID; OB Class($class).name; $functionID).join("/")
			ALERT("toto1 "+Current process name+". "+Current method name+$url)
			cs.$requeteHTTP.me.Requeter($url; "Get"; $params; "blob")
			
			$duréeReq:=Milliseconds-$duréeReq
			// le résultat est dans $params.reqRetour
			ALERT("toto2 "+Current process name+". "+Current method name+JSON Stringify($params.reqRetour))
			
			cs.$trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Requête Client traité "+Choose($params.reqRetour=Null; "[KO]"; "[OK]"); Current method name; "< "+$className+"."+$functionID+" >, durée : "+String($duréeReq)+" ms")
			ASSERT(cs.$trace.me.DebugerMethode($className+"."+$functionID; Current method name; JSON Stringify($params.reqRetour)))
			
		Else 
			// ici on est sur la BDDmère ou le serveur APP ; exécuter en direct
			$class[$functionID]($params)
			$params.reqRetour:=OB Copy($params)  // on copie sinon ça semble boucler
			// le résultat est dans .reqRetour
	End case 
	
	// dans tous les cas le résultat est dans .reqRetour
	
	Case of 
		: (Storage.System.typeApplication=ALV Serveur APP)
			// rien de plus
		: (Not(OB Is defined($params; "nomProcessAppelant")))
		: (Not(OB Is defined($params; "CallBack")))
		Else 
			// retour par callBack, transmettre au process demandeur le résultat
			// attention ici on doit être thread-safe
			
			cs.$process.new().AppelerFormulaire($params.nomProcessAppelant; $params.CallBack; $params.reqRetour)
	End case 
	
	
Function ActiverEtatConnexionServeur()
	// informer qu'une requête au serveur a eu lieu
	Use (Storage.System)
		Storage.System.TémoinRequeteServeur:=True
		Storage.System.TémoinRequeteServeurTimeOut:=Milliseconds+(2*1000)
	End use

⇧ [class]$userPreferences - 27/04/2026 12:19:54

      property userName : Text:=""
property prefs; System : Object

// contenu du fichier Prefs
//property SonorisationPrefs : Object
//property Session_Etat : Integer

shared Class constructor()
	
	This.prefs:=New shared object("Session_Etat"; 0)
	
	
	
	// -----------------------------
	// MARK:Requetes serveur
	// -----------------------------
	
Function LirePrefs()
	// ici on est toujours dans BDDmère ou le clientAPP
	var $params : Object
	
	$params:=New object("LogIn"; This.userName)
	cs.$serveurAPP.me.Executer(OB Class(This).name; "FixerSessionPrefs"; $params)
	// le résultat est dans .reqRetour
	
	// on a toujours quelque chose, mettre ici
	Use (This.prefs)
		This.prefs:=OB Copy($params.reqRetour.prefs; ck shared; This.prefs)
	End use 
	
	// finir
	This._PersonaliserIHM()
	
	
Function FixerSessionPrefs($params : Object)
	// ici on est toujours dans BDDmère ou le serveurAPP (où la session existe)
	//•••••  Lire les Préférences  •••••
	
	Case of 
		: ($params.LogIn=Null)
		: ($params.LogIn="")
		Else 
			
			$params.prefs:=This.LireFichier($params.LogIn)
			
			If ($params.prefs#Null)
				Use (Session.storage)
					If (Session.storage.prefs=Null)
						Session.storage.prefs:=New shared object
					End if 
					
					Session.storage.prefs:=OB Copy($params.prefs; ck shared; Session.storage.prefs)
				End use 
			End if 
	End case 
	
	
Function MemoriserPrefs()
	//•••••  Ecrire les Préférences  •••••
	var $params; $userPrefs : Object
	
	$userPrefs:=OB Copy(This.prefs)
	
	// virer les options de debug
	$userPrefs.Session_Etat:=$userPrefs.Session_Etat ?- 2
	$userPrefs.Session_Etat:=$userPrefs.Session_Etat ?- 3
	$userPrefs.Session_Etat:=$userPrefs.Session_Etat ?- 8
	$userPrefs.Session_Etat:=$userPrefs.Session_Etat ?- 16
	
	$params:=New object("LogIn"; This.userName; "prefs"; $userPrefs)
	
	// c'est parti, enregistrer
	cs.$serveurAPP.me.Executer(cs.$userPreferences.name; "EcrireFichier"; $params)
	
	
shared Function _PersonaliserIHM()
	// personnaliser l'IHM en fonction des userPrefs
	var $SessionStatus; $partageALV; $i : Integer
	var $dataTexte : Text
	var $data : Object
	
	// lire la langue de l'utilisateur
	$dataTexte:=This.prefs.Apparence.Formulaire.CodeLangue
	// fixer la langue de l'IHM
	SET DATABASE LOCALIZATION($dataTexte)
	// créer les menus utilisateur
	cs.$menus.new().CréerBarreMenus()
	
	// lire les préférences session de l'utilisateur
	$SessionStatus:=This.prefs.Session_Etat
	// re-init des options
	$SessionStatus:=$SessionStatus ?- 7  // Diaporama : afficher les infos ZS
	$SessionStatus:=$SessionStatus ?- 6  // pas de mode Debug
	
	// fixer l'option Partage : transmission du journal au serveur Web, et mises à jour
	$partageALV:=This.prefs.PartageALV.Activation
	Case of 
		: (This.System.typeApplication=ALV Client APP)
			// application client
			// lire le choix utilisateur
			If (Not($SessionStatus ?? 13))
				// souhait utilisateur pas encore connu
				// ben on demande : autorisation ou non de publier les journaux?
				$data:=New object("titre"; Localized string("89"); "message"; cs._cfct.me.LireLocatedSTR(5154); "numPageForm"; 3)
				$i:=Num(Not(cs.$dialogue_3001.new().Lancer($data)))  // 0 (non) ou 1 (ok)
				$partageALV:=200+$i
				
				// mémoriser que la demande a été faite
				$SessionStatus:=$SessionStatus ?+ 13
			End if 
			// ici pas recherches de mises à jour
			$SessionStatus:=$SessionStatus ?- 14  // application
			$SessionStatus:=$SessionStatus ?- 15  // données
			
		: (This.System.estServeur)
			// application Serveur 
			$partageALV:=200  // on désactive!
			// application Serveur  : mise à jour des données (la mise à jour de l'application se fait par l'export)
			$SessionStatus:=$SessionStatus ?- 14  // application
			$SessionStatus:=$SessionStatus ?+ 15  // données
			
		: (This.System.typeApplication=ALV BDD mère)
			// BDD mère : ici, n'a pas de sens (la sauvegarde est désactivée)
			$partageALV:=200  // on désactive!
			
			// BDD mère : les mises à jour sont sans objet
			$SessionStatus:=$SessionStatus ?- 14  // application
			$SessionStatus:=$SessionStatus ?- 15  // données
	End case 
	
	Use (This.prefs)
		This.prefs.Session_Etat:=$SessionStatus
		This.prefs.PartageALV.Activation:=$partageALV
	End use 
	
	
	// -----------------------------
	// MARK:Fichier
	// -----------------------------
	
Function LireFichier($LogIn : Text)->$result : Object
	// lire les prefs mémorisées
	// attention : la géométrie des fenêtres n'est plus mémorisée dans les prefs, mais par 4D dans le dossier "Application Support:ALV:4D Window Bounds vxx"
	var $fichier : 4D.File
	var $trace : cs.$trace
	var $dataTexte : Text
	var $data : Object
	
	$trace:=cs.$trace.me.Initialiser(Current method name)
	
	If ($LogIn#"")
		
		// gestion de version : lire la version courante du fichier pref
		$dataTexte:=Folder(fk resources folder).folder("TemplatesALV").file("TemplatePréférences.json").platformPath
		$dataTexte:=Document to text($dataTexte; "UTF-8")
		$data:=JSON Parse($dataTexte; Is object)
		
		// lire le ficher des préférences utilisateur (ici serveur APP ou BDDmère)
		$fichier:=This.GetCheminFichier($LogIn)
		
		// ouvrir le fichier 
		If ($fichier.exists)
			$dataTexte:=$fichier.getText("UTF-8")
			$result:=JSON Parse($dataTexte; Is object)
			
			$trace.Error:=-15087
			$trace.ErrorDescription:=Localized string("-15087")
			
			// vérifier le format du fichier
			Case of 
					// il faut un champ "version" (existe depuis v6.7)
				: (Not(OB Is defined($result; "Version")))
					$trace.ErrorDescription:=$trace.ErrorDescription+" Version du fichier Préférences inconnue, ré-initialisation"
					$fichier.delete()
					
					// la version doit être au moins 740
				: ($result.Version<$data.Version)
					$trace.ErrorDescription:=$trace.ErrorDescription+" Version du fichier Préférences trop ancienne, ré-initialisation"
					$fichier.delete()
					
				Else 
					// c'est ok
					$trace.Error:=0
					$trace.ErrorDescription:="Lecture du fichier Préférences : "+$fichier.platformPath
			End case 
			
		Else 
			$trace.Error:=-15044
			$trace.ErrorDescription:=$trace.ErrorDescription+" Le fichier n'existe pas, nouveau fichier "+$fichier.platformPath
		End if 
		
		If ($trace.Error#0)
			// nouvelles prefs
			$result:=This.InitialiserPrefs()
		End if 
		
	Else 
		$trace.Error:=-15068
		$trace.ErrorDescription:="Absence du paramètre 'LogIn'"
	End if 
	
	$trace.FixerSuccess()
	$trace.LeverException([msgk_event; msgk_log])
	
	
Function EcrireFichier($params : Object)
	// enregistrer les prefs dans un fichier
	var $fichier : 4D.File
	var $dataTexte : Text
	
	Case of 
		: (Not(OB Is defined($params; "LogIn")))
		: (Not(OB Is defined($params; "prefs")))
		Else 
			
			$fichier:=This.GetCheminFichier($params.LogIn)
			$dataTexte:=JSON Stringify($params.prefs; *)
			$fichier.setText($dataTexte; "UTF-8")
	End case 
	
	
Function GetCheminFichier($userLogIn : Text)->$result : 4D.File
	// du type :  .../user/Preferences/profil app.json
	$result:=cs.$document.new().GetUserFolderOnServer($userLogIn).folder(cs._cfct.me.LireLocatedSTR_APP(83)).file(cs._cfct.me.LireLocatedSTR_APP(69)+".json")
	
	
Function InitialiserPrefs()->$result : Object
	// renseigner les préférences par défaut
	var $dataTexte : Text
	var $data : Object
	
	// elles sont dans un fichier ressources (pas de données dans le code)
	$dataTexte:=Folder(fk resources folder).folder("TemplatesALV").file("TemplatePréférences.json").platformPath
	$dataTexte:=Document to text($dataTexte; "UTF-8")
	$data:=JSON Parse($dataTexte; Is object)
	
	$result:=New object
	// identifier
	$result.NomUtilisateur:=This.userName
	$result.Version:=$data.Version
	
	// initialiser les préférences
	$result.Session_Etat:=0
	$result.Session_ClesTri:=0
	$result.Chemins:=New object
	$result.Chemins.DossierDocumentsUtilisateur:=""
	$result.Chemins.DossierImportMedias:=""
	
	// créer les structures vides
	$result.Objets:=New object
	$result.Selections_Courantes:=New object
	
	// écrire les préférences par défaut
	// navigations
	$result.Navigation:=OB Copy($data.Navigation)
	// sonorisation
	$result.Sonorisation:=$data.Sonorisation
	$result.SonorisationPrefs:=OB Copy($data.SonorisationPrefs)
	// journalisation ALV
	$result.PartageALV:=$data.PartageALV
	// apparences
	// * formulaire
	$result.Apparence:=New object
	$result.Apparence.Formulaire:=New object
	$result.Apparence.Formulaire:=OB Copy($data.Apparence.Formulaire)
	// * arbre
	$result.Apparence.AG:=OB Copy($data.Apparence.AG)
	// visualisations
	$result.Visualisation:=New object
	$result.Visualisation:=OB Copy($data.Visualisation)
	// palettes
	$result.Palettes:=New object
	$result.Palettes:=OB Copy($data.Palettes)
	
	
	
	//// -----------------------------
	//// MARK:Modifications
	//// -----------------------------
	
	//shared Function Modifier($prefs : Object; $attribut : Text; $value : Variant)
	//var $data : Object
	//var $item : Text
	
	////For each ($item; $attributs)
	////$prefs:=$prefs[$item]
	////End for each 
	
	//Case of 
	//: (Not(OB Is defined($prefs; $attribut)))
	//: (Value type($value)=Is object)
	//// valeur objet
	
	//: (Value type($value)=Is collection)
	//$data:=New object($attribut; $value)
	////This.prefs.Bureau:=OB Copy($data; ck shared; This.prefs)
	////Use ($prefs)
	//This.prefs.Bureau:=OB Copy($data; ck shared; This.prefs.Bureau)
	////End use 
	
	//Else 
	//// valeur scalaire
	//$prefs[$attribut]:=$value
	//End case 
	
	
	// -----------------------------
	// MARK:Sélection
	// -----------------------------
	
Function LireSélectionTable($numTable : Integer)->$result : Object
	// renvoyer une sélection d'entités de la table $ptrTable
	var $DataClassNom; $dataTexte : Text
	var $data : Object
	
	$result:=New object
	
	$DataClassNom:=Table name($numTable)
	If (This.prefs.Selections_Courantes["Table_"+$DataClassNom]=Null)
		// si pas de sélection trouvée, prendre la sélection par défaut
		$dataTexte:=Folder(fk resources folder).folder("TemplatesALV").file("TemplatePréférences.json").platformPath
		$dataTexte:=Document to text($dataTexte; "UTF-8")
		$data:=JSON Parse($dataTexte)
		$data:=$data.Selections_Defaut["Table_"+$DataClassNom]
		
		$result.sélection:=ds[$DataClassNom].query(Field name($numTable; $data.numChamp)+" = :1"; $data.valeurChamp)
		
	Else 
		// c'est ok
		$data:=This.prefs.Selections_Courantes["Table_"+$DataClassNom]
		
		// créer la sélection entités
		$result:=New object
		// en cas d'erreur :
		$result.sélection:=ds[$DataClassNom].query("ID = 1")
		Case of 
			: (Not(OB Is defined($data; "SelectionID")))
			: ($data.SelectionID.length=0)
			Else 
				$result.sélection:=ds[$DataClassNom].query("ID in :1"; $data.SelectionID)
		End case 
		
		// index dans la sélection
		// au cas où erreur
		$result.index:=0
		Case of 
			: (Not(OB Is defined($data; "SelectionIndex")))
			: ($data.SelectionIndex+1>$result.sélection.length)
			Else 
				$result.index:=$data.SelectionIndex
		End case 
	End if 
	
	
shared Function EcrireSélectionTable($dataNav : Object)
	// enregistrer la sélection de la table $ptrTable dans les prefs
	var $DataClassNom : Text
	var $data : Object
	
	// mémoriser la sélection
	$data:=New object
	$data.SelectionID:=$dataNav.sélectionCourante.extract("ID")
	$data.SelectionIndex:=$dataNav.entitéCourante.indexOf($dataNav.sélectionCourante)
	
	$DataClassNom:=$dataNav.sélectionCourante.getDataClass().getInfo().name
	If (Not(OB Is defined(This.prefs.Selections_Courantes; "Table_"+$DataClassNom)))
		Use (This.prefs.Selections_Courantes)
			This.prefs.Selections_Courantes["Table_"+$DataClassNom]:=New shared object
		End use 
	End if 
	
	Use (This.prefs.Selections_Courantes["Table_"+$DataClassNom])
		This.prefs.Selections_Courantes["Table_"+$DataClassNom]:=OB Copy($data; ck shared; This.prefs.Selections_Courantes["Table_"+$DataClassNom])
	End use 
	
	
	// -----------------------------
	// MARK:Fenêtres
	// -----------------------------
	
shared Function InitialiserPalettes($nom : Text)
	// relire les données de la palette $nom
	var $dataTexte : Text
	var $data : Object
	
	// elles sont dans un fichier ressources (pas de données dans le code)
	$dataTexte:=Folder(fk resources folder).folder("TemplatesALV").file("TemplatePréférences.json").platformPath
	$dataTexte:=Document to text($dataTexte; "UTF-8")
	$data:=JSON Parse($dataTexte)
	
	Use (This.prefs.Palettes)
		This.prefs.Palettes["Palette_"+$nom]:=OB Copy($data.Palettes["Palette_"+$nom]; ck shared; This.prefs.Palettes["Palette_"+$nom])
	End use 
	
	
Function InfosPalettes($nom : Text)->$result : Object
	// renvoyer les données de la palette $nom
	
	Case of 
			// il faut des user données
		: (Not(OB Is defined(This.prefs.Palettes; "Palette_"+$nom)))
		: (This.prefs.Palettes["Palette_"+$nom]=Null)
		Else 
			// lire les données
			$result:=This.prefs.Palettes["Palette_"+$nom]
	End case

⇧ [class]$document - 18/04/2026 18:47:46

      property environnement : cs.xSDK.EnvironnementALV
property rsc : cs.xSDK.ResourceALV
property fichier : 4D.File
property dossier : 4D.Folder
property exists : Boolean
property session : Object

Class constructor($type : Integer; $chemin : Text; $chemins : Collection)
	// tous les paramètres sont optionnels
	
	This.dossier:=Null
	This.fichier:=Null
	This.exists:=False
	
	This.environnement:=cs.xSDK.EnvironnementALV.new()
	This.rsc:=cs.xSDK.ResourceALV.me
	This.session:=cs.$session.me
	
	// créer les objets
	If (Count parameters>0)
		This.Créer($type; $chemin; $chemins)
	End if 
	
	
Function Créer($type : Integer; $chemin : Text; $chemins : Collection)
	// créer un path, type dossier ou document ; $3 est optionnel
	var $path : Text
	
	$path:=""
	// un chemin absolu
	If (($chemin[[1]]="/"))
		$path:=$chemin
	Else 
		$path:=Convert path system to POSIX($chemin)
	End if 
	
	Case of 
		: (Count parameters<3)
		: ($chemins.length=0)
		Else 
			$path:=$path+$chemins.join("/")
	End case 
	
	// ici on a un chemin POSIX
	Case of 
		: ($type=Est un document ALV)
			This.fichier:=File($path; fk posix path)
			This.exists:=This.fichier.exists
			
		: (($type=Est un dossier ALV) | ($type=Créer un dossier ALV))
			This.dossier:=Folder($path+"/"; fk posix path)
			Case of 
				: ($type#Créer un dossier ALV)
				: (This.dossier.create())
				Else 
					// dossier existant ou chemin invalide
			End case 
			This.exists:=This.dossier.exists
			
		Else 
			// commande inconnue
			This.exists:=False
	End case 
	
	
Function LireLeContenu($data : Object)->$result : Object
	// mettre le contenu du fichier this dans $data
	var $dataTexte : Text
	
	$result:=ds._InitResult(-15068; ""; False)
	
	Case of 
		: (Not(This.exists))
			$result.ErrorDescription:="Le fichier '"+This.fichier.platformPath+"' n'existe pas"
		: (Not(OB Is defined($1)))
			$result.ErrorDescription:="$1 est un objet non défini"
		Else 
			// ok, on a tout
			$data.fichierDocument:=New object
			$data.fichierDocument.nom:=This.fichier.name+This.fichier.extension
			
			SET BLOB SIZE($dataBlob; 0)
			$dataBlob:=This.fichier.getContent()
			$dataTexte:=""
			BASE64 ENCODE($dataBlob; $dataTexte)
			$result.Error:=-15046*Num(ok=0)
			$result.ErrorDescription:="fichier "+This.fichier.platformPath+" - blob "+String(BLOB size($dataBlob))+" - texte "+String(Length($dataTexte))
			
			$data.fichierDocument.contenu:=$dataTexte
	End case 
	This._nettoyerResult($result)
	
	
Function EcrireLeContenu($data : Object)->$result : Object
	// mettre le contenu de $data dans un fichier du dossier this
	// $data contient le nom du fichier
	var $dataTexte : Text
	
	$result:=ds._InitResult(-15068; ""; False)
	
	Case of 
		: (Not(This.exists))
			$result.ErrorDescription:="Le dossier "+This.dossier.platformPath+" n'existe pas"
		: (Not(OB Is defined($data; "fichierDocument")))
			$result.ErrorDescription:="$params n'a pas l'attribut 'fichierDocument'"
		: (Not(OB Is defined($data.fichierDocument; "nom")))
			$result.ErrorDescription:="$params.fichierDocument n'a pas l'attribut 'nom'"
		: (Not(OB Is defined($data.fichierDocument; "contenu")))
			$result.ErrorDescription:="$params.fichierDocument n'a pas l'attribut 'contenu'"
		Else 
			// c'est ok
			$result.Error:=0
			
			// fichier d'enregistrement
			This.fichier:=This.dossier.file($data.fichierDocument.nom)
			
			$dataTexte:=$data.fichierDocument.contenu
			SET BLOB SIZE($dataBlob; 0)
			BASE64 DECODE($dataTexte; $dataBlob)
			This.fichier.setContent($dataBlob)
			
			// renseigner le chemin de stockage
			$data.cheminDocument:=This.fichier.platformPath
	End case 
	This._nettoyerResult($result)
	
	
Function ViderLeContenu($dossier : 4D.Folder)
	$dossier.create()
	$dossier.delete(Delete with contents)
	$dossier.create()
	
	
	// -----------------------------
	// Mark:APP
	// -----------------------------
	
Function getStructureFolder()->$result : 4D.Folder
	Case of 
		: ((Structure file(*)="@.4DProject") & (Application type=4D Server))
			// serveur HTTP
			$result:=Folder(Path to object(Structure file(*)).parentFolder; fk platform path).parent
			
		: (Application type=4D Server)
			// serveur APP
			$result:=Folder(Application file; fk platform path).folder("Contents/Server Database")
		Else 
			// BDDmère
			$result:=Folder(Path to object(Structure file(*)).parentFolder; fk platform path).parent
	End case 
	
	
Function getDataServeurFolder()->$result : Object
	$result:=This.GetAppWorkSpace().folder("Data")
	
	
Function GetDataFileFolder()->$result : 4D.Folder
	$result:=This.getDataServeurFolder().folder("DataFiles")
	
	
Function getHistoricFile()->$result : 4D.File
	// renvoyer le fichier d'historique
	//dans la langue de l'application
	$result:=Folder(fk data folder).file(Localized string("101"))
	
	
	// -----------------------------
	// Mark:Serveur Web hôte
	// -----------------------------
	
Function GetRacineHTMLFolder()->$result : Object
	var $texte : Text:=""
	
	Case of 
		: (Not(This.rsc.SetVariable(Est Ressource APP; "Serveur_Web/nomDossier_RacineWebHote"; Is text; ->$texte)))
		: (Storage.System.typeApplication=ALV Client APP)
			// filtrer (pas concerné pour l'instant)
			
		: (Storage.System.typeApplication=ALV Serveur HTTP)
			// ouverture du projet avec un 4D serveur non compilé
			$result:=Folder(fk documents folder).parent.folder("Sites").folder($texte)
			
		: (Storage.System.typeApplication=ALV Serveur APP)
			// ouverture de l'APP serveur
			// v9.5.9 : mettre un chemin interne par 4D : .../Server Database/, c'est-à-dire à côté des ressources
			$result:=Folder(Get 4D folder(Current resources folder; *); fk platform path).parent.folder($texte)
			
		: (Storage.System.typeApplication=ALV BDD mère)
			// dossier dans les document utilisateur
			$result:=Folder(System folder(Documents folder); fk platform path).parent.folder("Sites").folder($texte)
			
		Else 
			$result:=Null
	End case 
	// au besoin, créer le dossier
	If (Not($result=Null))
		$result.create()
	End if 
	
	
Function GetCertificatSSLRessourcesFolder($texte)->$result : Object
	$result:=Folder(Get 4D folder(Current resources folder; *); fk platform path).folder("SSL").folder($texte)
	
	
Function GetCertificatSSLFolderForWebServer()->$result : Object
	// certificat ssl du serveur Web hote
	var $texte : Text:=""
	
	Case of 
			// ne sert pas
		: (Not(This.rsc.SetVariable(Est Ressource APP; "Serveur_Web/nomDossier_CertificatSSLHote"; Is text; ->$texte)))
		: (Storage.System.typeApplication=ALV Client APP)
			// filtrer (pas concerné pour l'instant)
			
		: (Storage.System.typeApplication=ALV Serveur HTTP)
			// ouverture du projet avec un 4D serveur non compilé
			// le dossier est à côté des ressources
			$result:=Folder(Get 4D folder(Current resources folder; *); fk platform path).parent
			
		Else 
			// ouverture de l'APP serveur ou BDDmère
			// v9.5.9 : le dossier n'est pas modifiable ($webServer.start($data) ne fonctionne pas
			// mettre le chemin attendu par 4D : .../Server Database/, soit à côté des ressources
			$result:=Folder(Get 4D folder(Current resources folder; *); fk platform path).parent
	End case 
	
	
Function GetCertificatSSLFolderForAppServer()->$result : Object
	// certificat ssl du serveur App
	Case of 
		: (Storage.System.typeApplication=ALV BDD mère)
			$result:=Folder(Get 4D folder(Current resources folder; *); fk platform path).parent
			
		: (Storage.System.typeApplication=ALV Serveur APP)
			// serveur en production (app fusionnée)
			$result:=Folder(Get 4D folder(Current resources folder; *); fk platform path).parent.parent.folder("Resources")
			
		: (Storage.System.typeApplication=ALV Serveur HTTP)
			// test BDDmère avec 4D serveur
			$result:=Folder(Get 4D folder(Current resources folder; *); fk platform path).parent
		Else 
			// ne sert pas ailleurs
			$result:=Null
	End case 
	
	
	// -----------------------------
	// Mark:Dossiers Media
	// -----------------------------
	
Function GetMobileMediaFolder()->$result : Object
	Case of 
		: (Storage.System.typeApplication=ALV Serveur APP)
			// cas oéprationnel
			$result:=This.getDataServeurFolder().folder("MediasMobile")
			$result.create()
			
		: (Storage.System.typeApplication=ALV BDD mère)
			// pour test local
			$result:=cs.xSDK.Traces.new().GetGarbageDossier().folder("ALVdebug").folder("mediaMOB")
			$result.create()
			
		Else 
			// rien
			$result:=Null
	End case 
	
	
Function GetMediaFolder($IDvolume : Integer)->$result : Object
	var $chemin : Text:=""
	
	$result:=Null
	Case of 
		: ($IDvolume=Dossier Media importés)
			// fixer le dossier d'import des media
			$chemin:=This.session.prefs.Chemins.DossierImportMedias
			If ((Length($chemin)=0) | (Test path name($chemin)#Is a folder))  // créer le dossier
				$result:=This.GetUserFolder()
			Else 
				$result:=Folder($chemin; fk platform path)
			End if 
			
		: ($IDvolume=Dossier Media Client)
			// fixer et créer le dossier des medias du serveur APP / HTTP, Client ALV et de l'application ALV
			// dans le dossier Documents utilisateur
			$result:=This.getDataServeurFolder().folder("Medias")
			$result.create()
			
		: (Storage.System.typeApplication=ALV BDD mère)
			// BDD uniquement
			This.rsc.SetVariable(Est Ressource APP; "Ressources_Communes/Chemins_Dossiers_Medias/OS_ID_"+String(This.environnement.infoPlateForme().ID)+"/Volume_ID_"+String($IDvolume); Is text; ->$chemin)
			If ($chemin#"")
				$result:=Folder($chemin; fk platform path)
			End if 
	End case 
	
	
Function SetMediaFolder($IDvolume : Integer; $path : Text)
	var $chemin : Text:=""
	
	$chemin:=$path  // on va utiliser un pointeur
	If ($IDvolume=Dossier Media importés)
		// import media ; user préférence
		Use (This.session.prefs.Chemins)
			This.session.prefs.Chemins.DossierImportMedias:=$chemin
		End use 
		
	Else 
		// BDD mère uniquement
		If (Storage.System.Status ?? 0)
			// structure non verrouillé, on peut écrire dans les ressources
			This.rsc.SetResourceALV(Est Ressource APP; "Ressources_Communes/Chemins_Dossiers_Medias/OS_ID_"+String(This.environnement.infoPlateForme().ID)+"/Volume_ID_"+String($IDvolume); ->$chemin)
		End if 
	End if 
	
	
Function GetDossiersMedia()->$result : Collection
	// lister les dossiers medias de la BDD
	var $texte : Text:=""
	var $sélection; $entité; $dossier; $data : Object
	
	$result:=New collection
	// extension au nom de dossier ; le  dossier $entité.nom+$texte contient les pages des fichiers PDF
	This.rsc.SetVariable(Est Ressource APP; "Ressources_Communes/Suffixe_Dossier_ImagesPDF"; Is text; ->$texte)
	
	$sélection:=ds.Dossiers.query("volume > :1 AND volume < :2"; -1; 80).orderBy("volume asc")
	If ($sélection.length>0)
		For each ($entité; $sélection)
			$dossier:=This.GetMediaFolder($entité.volume)
			If ($dossier#Null)
				If ($dossier.exists)
					
					If ($result.query("nomVolume = :1"; $entité.nom).length=0)
						$data:=New object
						// chemin complet du dossier media source
						$data.dossier:=$dossier.folder($entité.nom)
						// nom et ID du volume
						$data.nomVolume:=$entité.nom
						$data.volume:=$entité.volume
						$data.estVolumePagesPDF:=False
						$result:=$result.push($data)
					End if 
					
					// passer au dossier des images des pages de fichiers PDF
					$dossier:=$dossier.folder($entité.nom+$texte)
					If ($dossier.exists)
						If ($result.query("nomVolume = :1"; $dossier.name).length=0)
							$data:=New object
							// chemin complet du dossier media source
							$data.dossier:=$dossier
							// nom et ID du volume
							$data.nomVolume:=$entité.nom+$texte
							$data.volume:=$entité.volume
							$data.estVolumePagesPDF:=True
							$result:=$result.push($data)
						End if 
						
					End if 
				End if 
			End if 
		End for each 
	End if 
	
	
Function GetCompressedMediaFile($fichier : 4D.File)->$result : 4D.File
	$result:=This.GetCompressedMediaFolder().file(Char(126)+$fichier.fullName)
	
	
Function GetCompressedMediaFolder()->$result : 4D.Folder
	// renvoie le chemin du dossier des fichiers media compressés
	var $fichier : Text:=""
	
	$result:=This.GetPrivateResourcesFolder().parent
	This.rsc.SetVariable(Est Ressource APP; "Ressources_Communes/Dossier_Medias_Compressed"; Is text; ->$fichier)  // initialiser la variable
	// idem ASCII / unicode
	$result:=$result.folder(Char(126)+$fichier)
	$result.create()  // au cas où
	
	
	// -----------------------------
	// Mark:Document PDF
	// -----------------------------
	
Function CréerDocumentPDF($data)->$result : Integer
	var $dossier : 4D.Folder
	var $fichier : 4D.File
	var $pagePDF; $pathPDF : Text
	
	$result:=0
	Case of 
		: (Not(OB Is defined($data; "cheminDocument")))
			
		: (Test path name($data.cheminDocument)=Is a folder)
			$dossier:=Folder($data.cheminDocument; fk platform path)
			ARRAY TEXT($pages; 0)
			For each ($fichier; $dossier.files(fk ignore invisible))
				APPEND TO ARRAY($pages; $fichier.platformPath)
			End for each 
			SORT ARRAY($pages; >)
			// nom du dossier (-> nom du pdf)
			$pagePDF:=$dossier.name
			// dossier parent
			$dossier:=$dossier.parent
			
		: (Test path name($data.cheminDocument)=Is a document)
			$fichier:=File($data.cheminDocument; fk platform path)
			ARRAY TEXT($pages; 1)
			$pages{1}:=$fichier.platformPath
			// nom du fichier (-> nom du pdf)
			$pagePDF:=$fichier.name
			// dossier parent
			$dossier:=$fichier.parent
			
		Else 
			$result:=-15068
	End case 
	
	If ($result=0)
		// nom du dossier (-> nom du pdf)
		$data.nomFichierPDF:=$pagePDF
		// chemin du fichier PDF
		$pagePDF:=$pagePDF+".pdf"
		$pathPDF:=$dossier.file($pagePDF).platformPath
		
		$result:=cs.$wrapperPlugIn.me.CréerPDFmultiPages(->$Pages; $pathPDF)
		
		$data.cheminFichierPDF:=$pathPDF
	End if 
	// $result sert pour un appel direct
	$data.Error:=$result
	
	
	// -----------------------------
	// Mark:Documents utilisateur locaux
	// -----------------------------
	
Function GetSessionFolder()->$result : Object
	// retourner le dossier des fichiers temporaires de la session
	
	If (Process activity(Processes only).processes.query("number = :1"; Current process)[0].type=Web process with no context)
		// cas du serveur Web : un dossier dans la session Web
		// ne pas tester un [UtilisateursALV], il existe aussi en application fusionnée
		$result:=Folder(fk web root folder).folder(cs._cfct.me.LireLocatedSTR_APP(129)).folder(wwwSessionID)
		
	Else 
		// cas général : on utilise le dossier des documents de l'utilisateur courant
		$result:=This.GetUserFolder().folder(cs._cfct.me.LireLocatedSTR_APP(245))
		$result.create()
	End if 
	
	
Function GetMediaImportFolder()->$result : Object
	// fixer le dossier d'import des media
	var $chemin : Text
	
	$chemin:=This.session.prefs.Chemins.DossierImportMedias
	If ((Length($chemin)=0) | (Test path name($chemin)#Is a folder))
		// dossier par défaut
		$result:=This.GetUserFolder()
		
	Else 
		$result:=Folder($chemin; fk platform path)
	End if 
	
	
Function SetMediaImportFolder($chemin : Text)
	Case of 
		: ($chemin="")
		: (Test path name($chemin)#Is a folder)
		Else 
			Use (This.session.prefs.Chemins)
				This.session.prefs.Chemins.DossierImportMedias:=$chemin
			End use 
	End case 
	
	
Function GetUserFolder()->$result : Object
	// il s'agit du dossier système perso du client
	// attention : ne pas utiliser sur le serveur (pb UserIDentification?)
	
	$result:=Null
	Case of 
		: (Storage.System.typeApplication=ALV Serveur APP)
		: (Storage.System.typeApplication=4D Remote mode)
			// filtrer, non concerné
		: (Storage.System.typeApplication=ALV Client APP)
			// on est dans le dossier document utilisateur
			$result:=This.GetAppWorkSpace()
			
		: (Not(OB Is defined(This.session; "userName")))
		: (This.session.userName="")
		Else 
			// cas BDD mère; potentiellement plusieurs utilisateurs à gérer
			// utiliser le dossier par défaut (le créer au besoin)
			$result:=This.GetUserFolderOnServer(This.session.userName)
	End case 
	
	
Function GetPrivateUserFolder()->$result : Object
	// il s'agit du dossier système perso du client (particularisé)
	// attention : ne pas utiliser sur le serveur (pb UserIDentification?)
	
	// l'utilisateur courant peut avoir défini un dossier particulier : le lire
	Case of 
		: (This.session.prefs=Null)
		: (This.session.prefs.Chemins.DossierDocumentsUtilisateur="")
		Else 
			This.Créer(Est un dossier ALV; This.session.prefs.Chemins.DossierDocumentsUtilisateur)
	End case 
	
	If (This.exists)
		// on a un dossier particulier
		$result:=This.dossier
		
	Else 
		// utiliser le dossier par défaut (le créer au besoin)
		$result:=This.GetUserFolder()
	End if 
	
	
Function GetPrivateResourcesFolder()->$result : 4D.Folder
	// ce dossier a le même nom que le dossier ressources de l'application ("resources"), son emplacement dépend de l'installation
	// rappel : il n'est pas importé dans les ressources des applications publiques (ex applications fusionnées)
	Case of 
		: (Application type=4D Volume desktop)
			// dans le dossier document utilisateur
			$result:=This.getDataServeurFolder().folder("Resources")
			$result.create()
			
		: (Storage.System.typeApplication=ALV Serveur APP)
			// dans les resources  de l'application
			$result:=Folder(Get 4D folder(Current resources folder; *); fk platform path)
			
		: (Storage.System.typeApplication=ALV Client APP)
			// dans le dossier document utilisateur
			$result:=This.getDataServeurFolder().folder("Resources")
			$result.create()
			
		Else 
			// BDD mère : dans le dossier du fichier de données de l'APP
			$result:=Folder(Folder(fk data folder).platformPath; fk platform path).folder("Resources")
	End case 
	
	
Function GetPrivateResourcesSonFolder()->$result : 4D.Folder
	var $dossier : Text:=""
	
	This.rsc.SetVariable(Est Ressource APP; "Ressources_Communes/Dossier_Sons_Private"; Is text; ->$dossier)
	$result:=This.GetPrivateResourcesFolder().folder($dossier)
	
	
Function GetAppWorkSpace()->$result : Object
	// renvoyer le chemin du dossier utilisateurs
	// dans tous les cas (BDD, client APP, serveur APP, APP fusionnée), le dossier est dans les documents utilisateur / nom de l'application /
	// remarque : serveur HTTP géré par le composant
	var $sousDossier : Text
	
	$sousDossier:=This.environnement.infosApplication().nomLong
	$result:=Folder(fk documents folder).folder($sousDossier)
	
	
	// -----------------------------
	// Mark:Documents utilisateur sur serveur
	// -----------------------------
	
Function GetSessionFolderOnServer($userLogIn : Text)->$result : Object
	// retourner le dossier des fichiers temporaires de la session sur serveur
	// quelque soit la session (BDDmère, clientAPP, WEB), le dossier est le même
	
	$result:=This.GetUserFolderOnServer($userLogIn).folder(cs._cfct.me.LireLocatedSTR_APP(245))
	$result.create()
	
	
Function GetUserFolderOnServer($userLogIn : Text)->$result : Object
	// ici on est sur le serveur ou la BDDmère
	// il s'agit du dossier système commun à tous les users
	$result:=This.GetAppWorkSpace().folder(cs._cfct.me.LireLocatedSTR_APP(103)).folder($userLogIn)
	$result.create()
	
	
	// -----------------------------
	// Mark:Compression
	// -----------------------------
	
Function ArchiverEnZIP($dossier : 4D.Folder; $data : Object)->$result : Object
	// créer une archive zip de $dossier
	var $fichierZippé : 4D.File
	
	// pas d'erreur par défaut
	$result:=ds.initResult()
	
	$fichierZippé:=$dossier.parent.file($dossier.name+".zip")
	$result:=ZIP Create archive($dossier; $fichierZippé)
	
	If ($result.success)
		$data.fichierZippé:=$fichierZippé
		
	Else 
		$data.fichierZippé:=Null
	End if 
	
	
Function DeArchiverZIP($fichier : 4D.File; $data : Object)->$result : Object
	// pas d'erreur par défaut
	var $archive : 4D.ZipArchive
	var $dossier; $dossierTempo : 4D.Folder
	
	$result:=ds.initResult()
	
	$archive:=ZIP Read archive($fichier)
	$dossier:=$fichier.parent
	//$dossier:=$fichier.parent.folder($archive.root.name)
	$dossierTempo:=$archive.root.copyTo($dossier; "tempoZIP"; fk overwrite)
	$data.dossier:=$dossierTempo.folders(fk ignore invisible)[0].copyTo($dossier)
	$dossierTempo.delete(Delete with contents)
	// toujours ok
	$result.success:=True
	
	
Function ArchiverEnDMG($data : Object)->$result : Object
	// créer une archive dmg du dossier de travail
	var $stdIn; $stdOut; $commande; $pathDossierSource; $stdErreurs : Text
	ALERT(Current method name+"  NON TESTÉ")
	
	// pas d'erreur par défaut
	$result:=ds.initResult()
	
	// créer un alias pour glisser - déposer directement l'application fusionnée dans le dossier des applications
	CREATE ALIAS(System folder(Applications or program files); $data.dossierTravail.platformPath+"Applications")
	// créer une image de fond (doit être dans le dossier caché "background")
	Folder(fk resources folder).folder("Images").file("16204.png").copyTo($data.dossierTravail.folder(".background").file("ALVfond.png"))
	// le dossier doit être invisible (à faire, comment?)
	
	// le fichier compressé porte le nom du dossier compressé
	$stdIn:=$data.dossierTravail.name
	
	// crée une image disque à la mode OSX
	// si une image de fond, mettre le dossier invisible
	If ($data.dossierTravail.folder("background").isFolder)
		$commande:="mv background .background"
		SET ENVIRONMENT VARIABLE("_4D_OPTION_CURRENT_DIRECTORY"; $data.dossierTravail.platformPath)  // doit être équivalent à une commande UNIX "cd ..." ?
		LAUNCH EXTERNAL PROCESS($commande; $stdIn; $stdOut; $stdErreurs)
		SET ENVIRONMENT VARIABLE("_4D_OPTION_CURRENT_DIRECTORY"; "")
	End if 
	// créer les chemins
	$pathDossierSource:=Convert path system to POSIX($data.dossierTravail.platformPath; *)
	
	// créer le fichier
	$commande:="hdiutil create -ov -srcfolder "+$pathDossierSource+" "+$pathDossierSource+$stdIn+".dmg"
	LAUNCH EXTERNAL PROCESS($commande; $stdIn; $stdOut; $stdErreurs)
	
	// si ok, renvoyer le chemin du fichier créé
	If (ok=1)
		$data.pathDossierCompressé:=$data.dossierTravail.file($stdIn+".dmg")
		
	Else 
		$data.pathDossierCompressé:=""
		
		$result.Error:=-15046
		$result.ErrorDescription:="Erreur compression DMG de "+$data.dossierTravail.platformPath
	End if 
	
	
	// -----------------------------
	// Mark:Utilitaires
	// -----------------------------
	
Function _nettoyerResult($result : Object)
	$result.success:=($result.Error=0)
	$result.ErrorDescription:=$result.ErrorDescription*Num(Not($result.success))
	
	
Function estDossierVerrouillé($dossier : 4D.Folder)->$result : Boolean
	var $fichier : 4D.File
	
	$fichier:=$dossier.file("testVerroullage.txt")
	$result:=$fichier.create()
	// $result = vrai si fichier créé
	If ($result)
		$fichier.delete()
	End if 
	
	$result:=Not($result)

⇧ [class]$requeteHTTPoptions - 18/04/2026 18:37:29

      property method; dataType; URLserveurWeb : Text
property headers; body; serverAuthentication; reqRetour : Object

Class constructor($méthode : Text; $body : Object; $typeData : Text)
	
	// paramètres de la classe 4D.HTTPRequest
	This.method:=$méthode
	This.headers:=Null
	This.body:=$body
	
	If (Count parameters>2)
		This.dataType:=$typeData
	End if 
	
	This.FixerHeaders()
	This.FixerAuthentification()
	
	
	// -----------------------------
	// MARK:Paramètres
	// -----------------------------
	
Function FixerHeaders()
	This.headers:=New object()
	This.headers["X-VERSION"]:="HTTP/1.0"
	This.headers["X-STATUS"]:="200 OK"
	This.headers["Server"]:="ALV_Application"
	This.headers["Cookie"]:=This.LireCookie("servicesAPP")
	This.headers["User-Agent"]:="ALV/11.3.4"
	
	
Function FixerAuthentification()
	// fixer .serverAuthentication (est undefined par défaut)
	// v9.1.9 : on n'utilise plus l'ID de l'utilisateur courant, mais l'ID d'un user ayant droit d'accès au serveur
	// v11.6.5 : on utilise un user ayant droit d'accès au serveur, et à la DataStore (l'ID de l'utilisateur courant)
	var $data : Object
	
	//$data:=ds.GroupesAPP.query("nom = :1"; "Administration BDD").first().lesMembres.leMembre
	$data:=ds.UtilisateursALV.query("Name = :1"; "Administrateur Data")
	If ($data.length>0)
		// ok on prend le premier membre
		This.serverAuthentication:=New object
		This.serverAuthentication.name:=$data[0].LogIn
		This.serverAuthentication.password:=$data[0].Password
	End if 
	
	cs.$trace.me.Créer(-15057*Num($data.length=0); Current method name; "Aucun membre trouvé dans le groupe 'Administration BDD'").LeverException([msgk_event; msgk_log])
	
	
Function FixerUrlServeurWeb()
	
	Case of 
		: (This.FixerUrlServeurWeb_clientALV())
		: (This.FixerUrlServeurWeb_appALV())
	End case 
	
	CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "URL du serveur Web fixée"; Current method name; "Serveur Web utilisé <"+Storage.RessourcesAPP.URLserveurAPP+">"; New object("nomProcess"; Current process name; "numProcess"; Current process))
	
	
Function FixerUrlServeurWeb_clientALV()->$result : Boolean
	// fixer Storage.RessourcesAPP.URLserveurAPP
	// appel depuis le client4D
	var $URLserveur : Text:=""
	var $c : Collection
	
	$result:=(Storage.System.typeApplication=ALV Client APP)
	
	If ($result)
		// l'adresse IP du serveur HTTP est récupéré dans le nom du dossier log
		$URLserveur:=Folder(fk logs folder).platformPath
		
		$c:=Split string($URLserveur; "_")
		// supprimer le nom de l'APP
		$c.shift()
		// récupérer l'IP
		Repeat 
		Until (($c.pop()="8813") | ($c.length=0))
		$URLserveur:=$c.join(".")
		// l'URL
		$URLserveur:="https://"+$URLserveur
		
		Use (Storage.RessourcesAPP)
			Storage.RessourcesAPP.URLserveurAPP:=$URLserveur
		End use 
	End if 
	
	
Function FixerUrlServeurWeb_appALV()->$result : Boolean
	// fixer Storage.RessourcesAPP.URLserveurAPP
	// appel depuis la BDD mère
	var $URLserveur : Text:=""
	
	$result:=(Storage.System.typeApplication=ALV BDD mère)
	
	If ($result)
		// fonctionnement en mode test / debug
		Case of 
			: (cs.$session.me.prefs.Session_Etat ?? 16)
				// utilisation du serveur Web d'un serveur installé sur une plateforme de test
				cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Serveurs_test/Adresse_serveur"; Is text; ->$URLserveur)
				
			: (cs.$session.me.prefs.Session_Etat ?? 18)
				// utilisation du serveur Web de la BDD mère
				cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Serveurs_BDDmere/Adresse_serveur"; Is text; ->$URLserveur)
				$URLserveur:=cs.xSDK.EnvironnementALV.new().infosSystème().IPadresse
				$URLserveur:="http://"+$URLserveur
				
			Else 
				// cas opérationnel
				// utilisation du serveur Web du serveurAPP
				cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Serveurs_ALV/Adresse_serveur"; Is text; ->$URLserveur)
		End case 
		
		Use (Storage.RessourcesAPP)
			Storage.RessourcesAPP.URLserveurAPP:=$URLserveur
		End use 
	End if 
	
	
Function LireCookie($origineCookie : Text)->$result : Text
	// principe à la première connexion le cookie est tagué "init" ; le cookie renvoyé est stocké
	// les connexions suivantes utilisent ce cookie
	var $dataTexte : Text
	var $data : Object
	
	If (Not(OB Is defined(Storage.System.Navigation; "Cookies")))
		// créer la liste des cookies
		Use (Storage.System.Navigation)
			Storage.System.Navigation.Cookies:=New shared object
		End use 
	End if 
	
	If (Not(OB Is defined(Storage.System.Navigation.Cookies; $origineCookie)))
		// créer le cookie $1
		// nom / ID par défaut du cookie
		WEB GET OPTION(Web session cookie name; $dataTexte)
		$data:=New shared object
		Use ($data)
			$data.ID:="init"
			$data.nom:=$dataTexte+"="+$data.ID
			$data.origine:=$origineCookie
		End use 
		$data:=New shared object($origineCookie; $data)
		
		// mémoriser
		Use (Storage.System.Navigation)
			Storage.System.Navigation.Cookies[$origineCookie]:=New shared object
		End use 
		sharedObject($data; Storage.System.Navigation.Cookies)
	End if 
	
	// renvoyer le cookie enregistré
	$result:=Storage.System.Navigation.Cookies[$origineCookie].nom
	//$result:=This.cookie.nom
	
	
Function FixerCookie($origineCookie : Text; $cookie : Text)
	Use (Storage.System.Navigation.Cookies[$origineCookie])
		Storage.System.Navigation.Cookies[$origineCookie].nom:=$cookie
		Storage.System.Navigation.Cookies[$origineCookie].ID:=Substring($cookie; Position("="; $cookie)+1)
	End use 
	
	
	// -----------------------------
	// MARK:Functions CallBack
	// -----------------------------
	
Function onTerminate($request : 4D.HTTPRequest; $event : Object)
	// récupérer les données reçues à la fin de la requête (synchrone ou pas)
	var $data : Variant
	var $blob : Blob
	
	Case of 
		: ($event.type#"terminate")
			// pas normal
			
		: ($request.dataType="blob")
			// lire la réponse blob
			$blob:=$request.response.body
			BLOB TO VARIABLE($blob; $data)
			This.reqRetour:=$data
			
		: ($request.dataType="text")
	End case 
	
	
Function onError($request : 4D.HTTPRequest; $event : Object)
	//Méthode onError, si vous souhaitez traiter la requête de manière asynchrone
	
Function onResponse($request : 4D.HTTPRequest; $event : Object)
	//Méthode onResponse, si vous souhaitez traiter la requête de manière asynchrone

⇧ [class]$formulaire_3004 - 19/05/2026 08:17:26

      property hyperTexteEditeur : cs.$hyperTexteEditeur
property sauvegarde : cs.$sauvegarde

Class extends $formulaire

Class constructor($params : Object)
	
	Super($params)
	
	This.sauvegarde:=cs.$sauvegarde.new()
	// gestion de la zone texte "PartageInformation"
	This.hyperTexteEditeur:=cs.$hyperTexteEditeur.new("PartageInformation")
	
	
	
Function FixerParamètres($params : Object)
	// $params = paramètres de menu
	
	Super.FixerParamètres($params)
	This.informations.nomForm:="U_Formulaire?3004"
	
	
Function ListerFichiersSon()
	var $item : Object
	var $selection : cs.FichiersSelection
	var $fichier : cs.FichiersEntity
	var $c : Collection
	var $etat : Integer
	var $f : 4D.File
	
	Form[This.nomOBJ]:=New collection
	// un fichier qui n'existe pas a une couleur 'Dark shadow color'
	
	// liste des morceaux disponibles en BDD ALV
	$selection:=ds.Fichiers.query("dossier = :1"; 292)
	For each ($fichier; $selection)
		$f:=$fichier.LeFichier()
		$etat:=Choose($f.exists; Foreground color; Dark shadow color)
		Form[This.nomOBJ].push(New object("IDson"; String($fichier.leMedia.ID); "Morceau"; $fichier.leMedia.titre; "Valide"; False; "Ordre"; 1000; "Exists"; $fichier.LeFichier().exists; "Etat"; $etat))
	End for each 
	
	// liste des morceaux disponibles en ressources privées
	$c:=This.document.GetPrivateResourcesSonFolder().files(fk ignore invisible)
	For each ($item; $c)
		Form[This.nomOBJ].push(New object("IDson"; $item.fullName; "Morceau"; $item.name; "Valide"; False; "Ordre"; 1000; "Exists"; True; "Etat"; Foreground color))
	End for each 
	// trier les patates
	Form[This.nomOBJ]:=Form[This.nomOBJ].orderBy("Ordre asc")
	
	
Function LirePreferencesFichiersSon()
	// tester la présence des fichiers
	var $c; $sons : Collection
	var $data : Object
	
	// cocher dans la liste les morceaux préférés et trier
	// préférences courantes :
	$c:=This.session.prefs.SonorisationPrefs.Ambiance.PlayList
	If ($c.length>0)
		// trier (ils arrivent dans l'ordre inverse!)
		$c:=$c.orderBy("numéro asc")
		
		// renseigner la présence et l'ordre
		For each ($data; $c)
			$sons:=Form[This.nomOBJ].query("IDson = :1"; $data.IDson)
			If ($sons.length=1)
				$sons[0].Valide:=True
				$sons[0].Ordre:=$data.Ordre
			End if 
		End for each 
	End if 
	
	
	// ----------------------
	// MARK:Demande actions 
	// -----------------------
	
Function MettreAjourSelection()
	// actualiser la liste des sons
	This.ListerFichiersSon()
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	
	Super.surEvenementFormulaire()
	
	Case of 
		: (FORM Event.code=On Load)
			SET WINDOW TITLE(Localized string("5013")+Localized string("1001")+This.session.userName)
			OBJECT SET VISIBLE(*; "grpInstal@"; Storage.System.Status ?? 0)
			OBJECT SET VISIBLE(*; "grpOSX@"; Storage.System.Status ?? 24)
			
			cs.$processData.me.FixerTache(Current process name; New object("nomTache"; "VérifierBDDmedia"; "activerThermometre"; True))
			
			// charger les objets
			This.onEndLoad()
			
			
		: (FORM Event.code=On Timer)
			cs.$processData.me.AfficherProgressionTache()
			
			
		: (FORM Event.code=On Close Box)
			CANCEL
			
		: (FORM Event.code=On Unload)
			This.sonorisation.StopSonorisation()
			
	End case 
	
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection("choix")
	$c.combine(["ParPere"; "ParMere"; "ParMari"; "ParFemme"; "EtendreSelectionPersonnes"; "EtendreSelectionEvents"; "EtendreSelectionLieux"; "InformationLien"; "InformationEntite"])
	$c.combine(["IconeOS"; "ChoisirLangue"; "PictSize"; "SeparerPersonConjoint"; "SeparerDateLieu"; "FormaterDate"; "FormaterHeure"; "FormaterGeo"; "VisibiliteHotSpot"])
	$c.combine(["SonoriserAPP"; "CheminsFichiersSon"; "grpOSXniveauAmbiance"; "grpOSXsyntheLecturePause"; "grpOSXniveauSyntheseVocale"; "AlerteAPP"; "grpOSXniveauAlerte"])
	$c.combine(["CheminAjoutMedia"; "CheminsVolumesMedias"; "CheminsSauvegardeBDD"; "DossierDocumentsUtilisateur"; "DossierFichiersAide"])
	$c.combine(["PartageData"; "PartageInformation"])
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:FORMevents Page Fond
	// ----------------------
	
Function _FORM_choix()
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=New object
			
			Case of 
				: (This.session.prefs.Session_Etat ?? 6)
					Form[This.nomOBJ].values:=New collection(Localized string("10600"); Localized string("10601"); Localized string("10602"); Localized string("10603"); Localized string("10604"))
					Form.Pages:=New collection(1; 2; 3; 4; 5)
					
				: ((Form.environnement.typeApplication()=ALV BDD mère) | (Form.environnement.estServeur()))
					// pour la BDD mère et le serveur Web, les options de partage / mises à jour (10604) n'existent pas
					Form[This.nomOBJ].values:=New collection(Localized string("10600"); Localized string("10601"); Localized string("10602"); Localized string("10603"))
					Form.Pages:=New collection(1; 2; 3; 4)
					
				Else 
					Form[This.nomOBJ].values:=New collection(Localized string("10600"); Localized string("10601"); Localized string("10602"); Localized string("10603"); Localized string("10604"))
					Form.Pages:=New collection(1; 2; 3; 4; 5)
			End case 
			// ici la page courante est mémorisée par 4D
			Form[This.nomOBJ].index:=FORM Get current page-1
			FORM GOTO PAGE(Form.Pages[Form[This.nomOBJ].index])
			
		: (FORM Event.code=On Clicked)
			// en réalité, pas utile. Il existe une action4D gotopage
			FORM GOTO PAGE(Form.Pages[Form[This.nomOBJ].index])
	End case 
	
	
Function _FORM_InitPrefs()
	If (FORM Event.code=On Clicked)
		// dans l'ordre, fermer la session avec les prefs actuelles
		This.session.OuvrirAvecPrefs()
	End if 
	
	
	// ----------------------
	//MARK:FORMevents Page Utilisation
	// ----------------------
	
Function _FORM_ParPere()
	// synchroniser les objets (= propriétés de UserPrefs) ParPere et ParMere
	This.EditerPropriétéObjet(Est une Option saisie radio; This.session.prefs.Navigation; "ParPere"; 110; New object("attribut"; "ParMere"; "valeur"; 120))
	
	
Function _FORM_ParMere()
	// synchroniser les objets (= propriétés de UserPrefs) ParPere et ParMere
	This.EditerPropriétéObjet(Est une Option saisie radio; This.session.prefs.Navigation; "ParMere"; 120; New object("attribut"; "ParPere"; "valeur"; 110))
	
	
Function _FORM_ParMari()
	// synchroniser les objets (= propriétés de UserPrefs) ParMari et ParFemme
	This.EditerPropriétéObjet(Est une Option saisie radio; This.session.prefs.Navigation; "ParMari"; 130; New object("attribut"; "ParFemme"; "valeur"; 140))
	
Function _FORM_ParFemme()
	// synchroniser les objets (= propriétés de UserPrefs) ParMari et ParFemme
	This.EditerPropriétéObjet(Est une Option saisie radio; This.session.prefs.Navigation; "ParFemme"; 140; New object("attribut"; "ParMari"; "valeur"; 130))
	
	
Function _FORM_EtendreSelectionPersonnes()
	This.EditerPropriétéObjet(Est une Option booléenne; This.session.prefs.Visualisation; "SelectionPersonnes"; 1300)
	
	
Function _FORM_EtendreSelectionEvents()
	This.EditerPropriétéObjet(Est une Option booléenne; This.session.prefs.Visualisation; "SelectionEvents"; 1400)
	
	
Function _FORM_EtendreSelectionLieux()
	This.EditerPropriétéObjet(Est une Option booléenne; This.session.prefs.Visualisation; "SelectionLieux"; 1500)
	
	
Function _FORM_InformationLien()
	This.EditerPropriétéObjet(Est une Option booléenne; This.session.prefs.Visualisation; "InformationsDiapo"; 1200)
	
	
Function _FORM_InformationEntite()
	This.EditerPropriétéObjet(Est une Option booléenne; This.session.prefs.Visualisation; "InformationsAG"; 1600)
	
	
	// ----------------------
	//MARK:FORMevents Page Apparence
	// ----------------------
	
Function _FORM_IconeOS()
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=cs._rsc.me.image(15018+Num(Is Windows))
	End case 
	
	
Function _FORM_ChoisirLangue()
	var $code : Text:=""
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=cs.xSDK.Outils.me.ListerLanguesApplication()
			
			// sélectionner la langue de l'application
			cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Ressources_Communes/CodeLangue_Application"; Is text; ->$code)
			// sélectionner $nom
			Form[This.nomOBJ].index:=Form[This.nomOBJ].codes.indexOf($code)
			
		: (FORM Event.code=On Data Change)
			If (Form[This.nomOBJ].index>-1)
				$code:=Form[This.nomOBJ].codes[Form[This.nomOBJ].index]
				cs.xSDK.ResourceALV.me.SetResourceALV(Est Ressource APP; "Ressources_Communes/CodeLangue_Application"; ->$code)
			End if 
	End case 
	
	
Function _FORM_PictSize()
	var $dossier : 4D.Folder
	
	This.EditerPropriétéObjet(Est une Option saisie; This.session.prefs.Apparence.Formulaire; "TailleMaxMedia")
	
	Case of 
		: (FORM Event.code=On Data Change)
			// RAZ du dossier de medias compressés
			$dossier:=This.document.GetCompressedMediaFolder()
			$dossier.delete(Delete with contents)
			$dossier.create()
	End case 
	
	
Function _FORM_SeparerPersonConjoint()
	This.EditerPropriétéObjet(Est une Option saisie; This.session.prefs.Apparence.Formulaire; "SymbolConjoints")
	
	
Function _FORM_SeparerDateLieu()
	This.EditerPropriétéObjet(Est une Option saisie; This.session.prefs.Apparence.Formulaire; "SymbolDateLieu")
	
	
Function _FORM_FormaterDate()
	This.EditerPropriétéObjet(Est une Option sélectionDate; This.session.prefs.Apparence.Formulaire; "FormatDate")
	
	
Function _FORM_FormaterHeure()
	This.EditerPropriétéObjet(Est une Option sélectionHeure; This.session.prefs.Apparence.Formulaire; "FormatHeure")
	
	
Function _FORM_FormaterGeo()
	This.EditerPropriétéObjet(Est une Option sélectionLatLong; This.session.prefs.Apparence.Formulaire; "FormatGeoLoc")
	
	
Function _FORM_VisibiliteHotSpot()
	This.EditerPropriétéObjet(Est une Option saisie; This.session.prefs.Apparence.Formulaire; "VisibiliteZS")
	
	
	// ----------------------
	//MARK:FORMevents Page Sonorisation
	// ----------------------
	
Function _FORM_SonoriserAPP()
	This.EditerPropriétéObjet(Est une Option booléenne; This.session.prefs.Sonorisation; "Activation"; 1700)
	
	// tout event :
	If (This.session.prefs.Sonorisation.Activation=1700)
		// tout fermer
		This.sonorisation.demanderAction("stopSonorisation")
		LISTBOX SELECT ROW(*; "ListBoxTableau"; 0; lk remove from selection)
		
		Form["grpOSXsyntheLecturePause"]:=0
	End if 
	
	
Function _FORM_CheminsFichiersSon()
	var $data : Object
	
	Case of 
		: (FORM Event.code=On Load)
			This.sonorisation.AjouterCanal("TestLecteur"; Est Ressource Media; ""; This.session.prefs.SonorisationPrefs.Ambiance)
			
			This.ListerFichiersSon()
			This.LirePreferencesFichiersSon()
			
		: (FORM Event.code=On Selection Change)
			$data:=This.sonorisation.getCanal("TestLecteur")
			Case of 
				: (Form.CheminsFichiersSonCourant=Null)
				: ($data.IDnomFichier=Form.CheminsFichiersSonCourant.IDson)
					//  normal et inutile, ce n'est pas une nouvelle sélection
					
				: (Form.CheminsFichiersSonCourant.Etat=Dark shadow color)
					// fichier absent - demander le téléchargement
					cs.$media.me.getCheminSurDD(Num(Form.CheminsFichiersSonCourant.IDson))
					
				Else 
					This.sonorisation.LireLeCanal("TestLecteur"; Form.CheminsFichiersSonCourant.IDson)
			End case 
	End case 
	
	
Function _FORM_CheminsFichiersSon_Valide()
	var $data; $son : Object
	var $c : Collection
	
	Case of 
		: (FORM Event.code=On Data Change)
			// morceau sélectionné : Form.CheminsFichiersSonCourant
			
			// le fichier doit exister pour être utilisé !
			If (Form.CheminsFichiersSonCourant.Exists)
				// mettre à jour les userprefs
				// supprimer la liste (traitement global)
				Use (This.session.prefs.SonorisationPrefs.Ambiance)
					This.session.prefs.SonorisationPrefs.Ambiance.PlayList:=New shared collection
				End use 
				// re créer la liste
				$c:=Form.CheminsFichiersSon.query("Valide = :1"; True)
				$data:=This.session.prefs.SonorisationPrefs.Ambiance
				Use ($data)
					For each ($son; $c)
						$data.PlayList.push(New shared object("Ordre"; $data.PlayList.length+1; "IDson"; $son.IDson))
					End for each 
					
					// réinitialisr la playList au début
					$data.indexPlay:=0
				End use 
				
			Else 
				// refuser
				Form.CheminsFichiersSonCourant.Valide:=False
			End if 
	End case 
	
	
Function _FORM_CheminsFichiersSon_Morceau()
	var $data : cs.$canalAudio
	
	Case of 
		: (FORM Event.code=On Clicked)
			$data:=This.sonorisation.getCanal("TestLecteur")
			
			Case of 
				: (Form.CheminsFichiersSonCourant=Null)
				: ($data.IDnomFichier#Form.CheminsFichiersSonCourant.IDson)
					
				Else 
					// mettre en pause le fichier en cours
					$data.FixerLecturePause(-1)
					
					// désélectionner la ligne sinon un nouveau clic n'est pas pris en compte
					LISTBOX SELECT ROW(*; This.nomOBJ; 0; lk remove from selection)
					$data.IDnomFichier:=""
			End case 
	End case 
	
	
Function _FORM_grpOSXsyntheLecturePause()
	var $canal : cs.$canalAudio
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=0
			
			This.sonorisation.AjouterCanal("TestSynthese"; Is text; ""; This.session.prefs.SonorisationPrefs.SyntheseVocale)
			
		: (FORM Event.code=On Clicked)
			$canal:=This.sonorisation.getCanal("TestSynthese")
			
			If ($canal.estEnLecture())
				$canal.FixerLecturePause(0)
			Else 
				// lecture non démarrée ou en pause
				
				// relancer la lecture (au cas ou en pause)
				$canal.FixerLecturePause(1)
				
				// quel est l'état de la lecture?
				Waiting(10)  // ralentir, ça va trop vite pour le synthé...
				If ($canal.estEnLecture())
					// c'est reparti
				Else 
					// lecture non initialisée
					$canal.IDnomFichier:=Localized string("5193")
					$canal.AVniveau:=$canal.préférences.Niveau
					$canal.LireSon()
					
				End if 
			End if 
	End case 
	
	
Function _FORM_AlerteAPP()
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=0
			
			This.sonorisation.AjouterCanal("TestAction"; Est Ressource APP; This.session.prefs.SonorisationPrefs.Action.Son; This.session.prefs.SonorisationPrefs.Action)
			
		: (FORM Event.code=On Clicked)
			This.sonorisation.LireLeCanal("TestAction")
	End case 
	
	
Function _FORM_grpOSXniveauAmbiance()
	This.EditerPropriétéObjet(Est une Option saisie; This.session.prefs.SonorisationPrefs.Ambiance; "Niveau")
	
	Case of 
		: (FORM Event.code=On Data Change)
			This.sonorisation.demanderAction("FixerNiveaux")
	End case 
	
	
Function _FORM_grpOSXniveauSyntheseVocale()
	This.EditerPropriétéObjet(Est une Option saisie; This.session.prefs.SonorisationPrefs.SyntheseVocale; "Niveau")
	
	Case of 
		: (FORM Event.code=On Data Change)
			This.sonorisation.demanderAction("FixerNiveaux")
	End case 
	
	
Function _FORM_grpOSXniveauAlerte()
	This.EditerPropriétéObjet(Est une Option saisie; This.session.prefs.SonorisationPrefs.Action; "Niveau")
	
	Case of 
		: (FORM Event.code=On Data Change)
			This.sonorisation.demanderAction("FixerNiveaux")
	End case 
	
	
	// ----------------------
	//MARK:FORMevents Page Installation
	// ----------------------
	
Function _FORM_CheminAjoutMedia()
	var $data; $dossier; $selection : Object
	var $path : Text
	var $menuID : Integer
	
	
	Case of 
		: (FORM Event.code=On Load)
			// dossier medias trouvé
			$data:=New object
			If (Storage.System.Status ?? 2)
				$data.entité:=ds.Dossiers.query("volume = 0")[0]
				$data.chemin:=This.document.GetMediaFolder(0).platformPath
				$data.verrouillé:=Not(Storage.System.Status ?? 3)  //  dossier medias verrouillé
				
			Else 
				$data.chemin:=cs._cfct.me.LireLocatedSTR(5080; New object("param_1"; "Ajout des Media"))
			End if 
			Form[This.nomOBJ]:=$data
			// cette liste ne peut être modifiée qu'en BDD mère
			OBJECT SET VISIBLE(*; "ressourceID 84"; Storage.System.typeApplication=ALV BDD mère)
			OBJECT SET VISIBLE(*; This.nomOBJ; Storage.System.typeApplication=ALV BDD mère)
			
		: ((Right click) | (Contextual click))  // Clic droit ou Control+clic
			// gestion des modifications
			// définir la suite de la saisie
			Form.Commande:=""
			$data:=New object
			Case of 
				: (Form.menuContextuel.MontrerPopUpMenu("MC_OptionsLHmedia"))
					// la commande a été traitée (bizarre)
				Else 
					$menuID:=Form.menuContextuel.params.numCommande
					Case of 
						: ($menuID=mck Montrer Volume)
							SHOW ON DISK(Form[This.nomOBJ].chemin)
							
						: ($menuID=mck Fixer Chemin)
							// fixer un chemin de volume
							$path:=Form.SélectionnerUnDossier(Localized string("1053"); 81)
							If ($path#"")
								// ok pas annulé
								
								// changer le chemin du dossier
								This.document.SetMediaFolder(0; $path)
								Form[This.nomOBJ].chemin:=$path
								
								If (Form.Commande="MettreAjour")
									cs._main.new().FixerEtatDossiersMedias()
									cs.$application.new().VérifierBDDmedia(New object)
								End if 
							End if 
							
						: ($menuID=mck Ajouter Volume)
							// reconstruction complète
							// fixer un chemin de volume
							$path:=Form.SélectionnerUnDossier(Localized string("1053"); 81)
							Case of 
								: ($path="")
								Else 
									// ok pas annulé
									$dossier:=Folder($path; fk platform path)
									// mettre à jour les ressources
									cs._ds.me.Ajouter(imk Volume; Null; Null; New object("dossier"; $dossier; "IDvolume"; 0))
							End case 
							
						: ($menuID=mck Supprimer Volume)
							$selection:=ds.Dossiers.query("ID = :1"; Form[This.nomOBJ].entité.ID)
							Supprimer De DataStore(imk Dossier; $selection)
					End case 
			End case 
	End case 
	
	If (Length(Form[This.nomOBJ].chemin)>255)
		Form[This.nomOBJ].chemin:=Substring(Form[This.nomOBJ].chemin; 1; 250)+" ..."
	End if 
	
	
Function _FORM_CheminsVolumesMedias()
	var $path : Text
	var $i; $j; $menuID : Integer
	var $selection; $entité; $dossier; $data : Object
	
	Case of 
		: (FORM Event.code=On Load)
			// initialiser
			Form[This.nomOBJ]:=New collection
			// cette liste ne peut être modifiée qu'en BDD mère
			OBJECT SET VISIBLE(*; "ressourceID 210"; Not(Storage.System.typeApplication=ALV BDD mère))
			OBJECT SET VISIBLE(*; "ressourceID 85"; Storage.System.typeApplication=ALV BDD mère)
			OBJECT SET VISIBLE(*; This.nomOBJ; Storage.System.typeApplication=ALV BDD mère)
			
		: ((Right click) | (Contextual click))  // Clic droit ou Control+clic
			// gestion des modifications
			// définir la suite de la saisie
			Form.Commande:=""
			
			// où a-t-on cliqué?
			LISTBOX GET CELL POSITION(*; This.nomOBJ; $j; $i)  // colonne, ligne
			
			$data:=New object
			Case of 
				: (Storage.System.typeApplication=ALV Client APP)
					// passer le chemin
				: (Form.menuContextuel.MontrerPopUpMenu("MC_OptionsLHmedia"))
					// la commande a été traitée (bizarre)
				Else 
					$menuID:=Form.menuContextuel.params.numCommande
					Case of 
						: ($menuID=mck Montrer Volume)
							If ($i>0)
								SHOW ON DISK(Form[This.nomOBJ][$i-1]["chemin"])
							End if 
							
						: ($menuID=mck Fixer Chemin)
							// fixer un chemin de volume
							$path:=Form.SélectionnerUnDossier(Localized string("1053"); 81; True)
							If ($path#"")
								// ok pas annulé
								$dossier:=Folder($path; fk platform path)
								
								// on teste tous les volumes , car certains utilisent le même dossier physique du DD
								// mettre a jour tous les volumes qui sont dans $dossier.parent
								For each ($data; Form[This.nomOBJ])
									// Pour chacun, lire son dossier parent et rechercher tous les volumes qui sont dedans
									Case of 
										: ($data.valide=True)
											// chemin de volume ok
										: (Not(Folder($dossier.parent.platformPath+$data.entité.nom; fk platform path).exists))
											// ce volume n'est pas dans ce dossier
										Else 
											// c'est ok
											// on a une ressource invalide et un chemin de dossier valide pour ce volume
											$path:=$dossier.parent.platformPath+$data.entité.nom+Folder separator
											// changer le chemin du dossier
											This.document.SetMediaFolder($data.entité.volume; $path)
											$data.chemin:=$path
											
											// commander la mise à jour
											Form.Commande:="MettreAjour"
									End case 
								End for each 
								
								If (Form.Commande="MettreAjour")
									cs._main.new().FixerEtatDossiersMedias()
									cs.$application.new().VérifierBDDmedia(New object)
								End if 
							End if 
							
						: ($menuID=mck Ajouter Volume)
							// reconstruction complète
							// fixer un chemin de volume
							$path:=Form.SélectionnerUnDossier(Localized string("1053"); 81)
							Case of 
								: ($path="")
								: ($i=0)
								Else 
									// ok pas annulé
									$dossier:=Folder($path; fk platform path)
									// mettre à jour les ressources
									cs._ds.me.Ajouter(imk Volume; Null; Null; New object("dossier"; $dossier))
							End case 
							
						: ($menuID=mck Supprimer Volume)
							$selection:=ds.Dossiers.query("ID = :1"; Form[This.nomOBJ][$i-1].entité.ID)
							Supprimer De DataStore(imk Dossier; $selection)
					End case 
					
			End case 
	End case 
	
	// créer / rafraichir la LB
	// remarque : l'état des ligne ne se met pas a jour après la modification d'une ligne (ou comment relancer "FixerCouleurLigne"?)
	If ((FORM Event.code=On Load) | ((Right click) | (Contextual click)))
		$data:=New object("chemins"; New collection)
		// lister les volumes de media
		$selection:=ds["Dossiers"].query("volume > 0")
		// Pour chacun, lire son dossier parent et rechercher tous les volumes qui sont dedans
		For each ($entité; $selection)
			$dossier:=This.document.GetMediaFolder($entité.volume)
			Case of 
				: (Not(OB Is defined($dossier)))
					$data.chemins.push(New object("chemin"; cs._cfct.me.LireLocatedSTR(5080; New object("param_1"; $dossier.platformPath)); "valide"; False; "entité"; $entité))
					// pas normal
					
				: ($dossier.folder($entité.nom).exists)
					// c'est ok
					$data.chemins.push(New object("chemin"; $dossier.platformPath+$entité.nom; "valide"; True; "entité"; $entité))
					
				Else 
					// ressource pas trouvée
					$data.chemins.push(New object("chemin"; cs._cfct.me.LireLocatedSTR(5080; New object("param_1"; $dossier.platformPath)); "valide"; False; "entité"; $entité))
			End case 
		End for each 
		$data.chemins:=$data.chemins.orderBy("chemin")
		Form[This.nomOBJ]:=$data.chemins
		// rappel (voir propriétés de la LB) : "FixerCouleurLigne" fixe la couleur de chaque ligne
	End if 
	
	
Function _FORM_CheminsSauvegardeBDD()
	var $data : Object
	var $i; $j : Integer
	var $menu; $path : Text
	var $fichier : 4D.File
	
	Case of 
		: (FORM Event.code=On Load)
			
			Form[This.nomOBJ]:=New collection(New object("chemin"; ""; "miseAjour"; ""))
			$data:=New object
			
			Case of 
				: (This.sauvegarde.LireParamètres($data)#0)
				: (Not(OB Is defined($data; "chemins")))
				: ($data.chemins.length=0)
				Else 
					// c'est ok
					Form[This.nomOBJ]:=$data.chemins
			End case 
			OB REMOVE($data; "fichier")
			
			// cette liste ne peut être visible qu'en BDD mère
			OBJECT SET VISIBLE(*; "ressourceID 110"; Storage.System.typeApplication=ALV BDD mère)
			OBJECT SET VISIBLE(*; This.nomOBJ; Storage.System.typeApplication=ALV BDD mère)
			
		: ((Right click) | (Contextual click))  // Clic droit ou Control+clic
			// gestion des modifications
			LISTBOX GET CELL POSITION(*; This.nomOBJ; $j; $i)  // colonne, ligne
			
			// actions possibles
			$menu:=Localized string("1095")+";"+Localized string("1096")+";"+Localized string("1097")
			$j:=Pop up menu($menu)
			
			$data:=New object
			Case of 
				: ($j=1)
					// ajouter un chemin de sauvegarde
					$path:=Form.SélectionnerUnDossier(Localized string("1054"); 84)
					Case of 
						: ($path="")
							// annulation
						: (Form[This.nomOBJ].query("chemin = :1"; $path).length>0)
							// le chemin existe déjà
						Else 
							// ok on a quelque chose
							Form[This.nomOBJ].push(New object("chemin"; $path; "miseAjour"; ""))
							
							// récupérer le nom du fichier des paramètres de sauvegarde
							Case of 
								: (This.sauvegarde.LireParamètres($data)#0)
								: ($data.fichier.exists)
									// ok
									$fichier:=$data.fichier
								Else 
									// initialiser le fichier
									$fichier:=$data.fichier
									This.sauvegarde.xml.EcrireLeChemin(->$fichier; "structureDeDonnees")
							End case 
							
							// mémoriser les chemins
							ARRAY OBJECT($tabChemins; 0)
							COLLECTION TO ARRAY(Form[This.nomOBJ]; $tabChemins)
							This.sauvegarde.xml.EcrireLeChemin(->$fichier; "Sauvegarde/ListeChemins"; ->$tabChemins)
					End case 
					
				: ($j=2)
					// montrer un chemin de sauvegarde
					// la ligne $i est sélectionnnée (element $i-1)
					If ($i>0)
						SHOW ON DISK(Form[This.nomOBJ][$i-1]["chemin"])
					End if 
					
				: ($j=3)
					// supprimer un chemin de sauvegarde
					// la ligne $i est sélectionnnée (element $i-1)
					If ($i>0)
						Form[This.nomOBJ]:=Form[This.nomOBJ].query("chemin # :1"; Form[This.nomOBJ][$i-1]["chemin"])
						// mémoriser
						Case of 
							: (This.sauvegarde.LireParamètres($data)#0)
							: ($data.fichier.exists)
								// ok
								$fichier:=$data.fichier
							Else 
								// initialiser le fichier
								$fichier:=$data.fichier
								This.sauvegarde.xml.EcrireLeChemin(->$fichier; "structureDeDonnees")
						End case 
						
						ARRAY OBJECT($tabChemins; 0)
						COLLECTION TO ARRAY(Form[This.nomOBJ]; $tabChemins)
						This.sauvegarde.xml.EcrireLeChemin(->$fichier; "Sauvegarde/ListeChemins"; ->$tabChemins)
					End if 
			End case 
	End case 
	
	
Function _FORM_DossierDocumentsUtilisateur()
	var $fichier : Text
	
	Case of 
		: (FORM Event.code=On Load)
			$fichier:=This.session.prefs.Chemins.DossierDocumentsUtilisateur
			Form[This.nomOBJ]:=Substring($fichier; 1; Length($fichier)-1)  // chemin du dossier des documents utilisateur
			
		: (FORM Event.code=On Double Clicked)
			// chemin d’accès mémorisé par 4D en "1"
			$fichier:=Form.SélectionnerUnDossier(cs._cfct.me.LireLocatedSTR(5178; New object("param_1"; This.session.userName)); 1; True)
			If (Length($fichier)>0)
				Form[This.nomOBJ]:=Substring($fichier; 1; Length($fichier)-1)
				
				Use (This.session.prefs.Chemins)
					This.session.prefs.Chemins.DossierDocumentsUtilisateur:=$fichier
				End use 
			End if 
	End case 
	
	
Function _FORM_DossierFichiersAide()
	var $fichier : Text:=""
	
	Case of 
		: (FORM Event.code=On Load)
			cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Aide/Chemin_Dossier"; Is text; ->$fichier)
			Form[This.nomOBJ]:=Substring($fichier; 1; Length($fichier)-1)  // chemin du dossier des documents utilisateur
			
		: (FORM Event.code=On Double Clicked)
			$fichier:=cs._cfct.me.LireLocatedSTR(1050)
			$fichier:=Lowercase($fichier; *)
			$fichier[[1]]:=Uppercase($fichier[[1]])
			
			// chemin d’accès mémorisé par 4D en 3
			$fichier:=Form.SélectionnerUnDossier($fichier; 3; True)
			If (Length($fichier)>0)
				Form[This.nomOBJ]:=Substring($fichier; 1; Length($fichier)-1)
				cs.xSDK.ResourceALV.me.SetResourceALV(Est Ressource APP; "Aide/Chemin_Dossier"; ->$fichier)
				cs.$documentation.new().CréerPageConnexionServeurWeb()
			End if 
	End case 
	
	If ((FORM Event.code=On Load) | (FORM Event.code=On Double Clicked))
		OBJECT SET RGB COLORS(*; This.nomOBJ; This.EtatChemin(Form[This.nomOBJ]).stroke)
	End if 
	
	
Function EtatChemin($chemin : Text)->$result : Object
	// calculer la couleur de la ligne courante de la ListBox This
	// on renvoie une propriété attendue d'une ListBox
	
	$result:=New object
	$result.stroke:="red"
	
	If (Folder($chemin; fk platform path).exists)
		// c'est ok
		$result.stroke:=Storage.System.schemaCouleurPolice
	End if 
	
	// ----------------------
	//MARK:FORMevents Page Partage
	// ----------------------
	
Function _FORM_PartageData()
	// 200 = partage refusé, 201 = partage autorisé
	
	This.EditerPropriétéObjet(Est une Option booléenne; This.session.prefs.PartageALV; "Activation"; 200)
	
	Case of 
		: (FORM Event.code=On Clicked)
			If (This.session.prefs.PartageALV.Activation=201)
				cs.$journalALV.me.Ecrire(New object("actionID"; cdk Ouvrir Journal; "Description_Action"; "Ouverture du Journal"))
				
			Else 
				cs.$journalALV.me.Ecrire(New object("actionID"; cdk Fermer Journal; "Description_Action"; "Fermeture du Journal"))
			End if 
	End case 
	
	
Function _FORM_PartageInformation()
	var $data : Object
	var $class : cs.$texteEditeur
	
	Case of 
		: (FORM Event.code=On Load)
			$data:=New object("texteWorké"; cs._cfct.me.LireLocatedSTR(142))
			This.hyperTexteEditeur.FixerHyperTexte($data)
			
		: (FORM Event.code=On Clicked)
			// se mettre dans le contexte d'une WP
			$class:=cs.$texteEditeur.new()
			$class.zoneDocumentNom:="PartageInformation"
			
			$class.ActiverLienHyperText()
	End case

⇧ [class]MediasEditeur - 30/04/2026 14:24:20

      property zonesEditeur : cs.ZonesEditeur
property image : cs.$image
property functionID; nomOBJ : Text
property structureSVG : Text:=""
property fichierMedia : 4D.File
property cheminMedia : Text
// données de process
// peuvent ne pas existées : chaque réaffichage de la page appelle le constructeur, donc pas d'initialisation des données de process dans le constructeur
// mémorise la zone en cours d'édition
property positionListeDesIllustres : Integer

Class extends $editeur

Class constructor()
	// construction commune
	Super()
	
	This.zonesEditeur:=cs.ZonesEditeur.new()
	This.image:=cs.$image.me
	This.image.MediaHSpoté:=False
	
	
	
Function getDataClassInfos()->$result : Object
	$result:=Super.getDataClassInfos("Medias")
	
	
	// ----------------------
	// MARK:Sélections 
	// ----------------------
	
Function CréerLaListeDesZones($params : Object)
	// ici on est toujours sur BDDmère ou ServeurAPP
	var $sélection : Object
	
	// créer la sélection de zones DU media
	$sélection:=ds.Medias.get($params.entitéID)
	$sélection:=$sélection.LesZonesDeLaPage($params.numPageMedia)
	
	// demander la liste
	$params.liste:=$sélection.CréerLaListe()
	// le résultat est dans $params
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	ASSERT(cs.$trace.me.DebugerEventForm(Current method name; "EventForm"; New object("numEvent"; FORM Event.code; "numTable"; Table(Current form table))))
	
	// traitements génériques
	This.surEvenementFormulaire()
	
	// traitements particuliers
	Case of 
		: (FORM Event.code=On Load)
			OBJECT SET VISIBLE(*; "avancement"; False)
			// v14 : la mémorisation de la géométrie du formulaire est activée. Dans ce cas la position des objets est vraie après "sur chargement"
			
			// charger les objets
			This.onEndLoad()
			
		: (FORM Event.code=On Resize)
			// page 1 :
			This.image.RafraichirImage()
			// page 2 :
			This.zonesEditeur.RedimensionnerStructureSVG()
			
		: (FORM Event.code=On Activate)
			// autorise modif. par le formulaire
			This.FixerVisibilitéPalettes(True)
			
		: (FORM Event.code=On Timer)
			This.zonesEditeur.surDéplacementAncre()
			
		: (FORM Event.code=On Data Change)
			// rappel : le traitement est commun à tous les objets (qui le demande)
			cs._ds.me.Modifier(cdk Modifier; New collection(This.entité; Form.PrivateData; Form.ZoneSélectionnée); Null)
			// au cas ou...
			This.Titrer()
			
		: (FORM Event.code=On Deactivate)
			This.image.nonExisteZoneSensibleActive()
			
		: (FORM Event.code=On Unload)
			This.image.nonExisteZoneSensibleActive()
			This.onEndUnLoad()
	End case 
	
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection("choix")
	// attention grpZSgrpBDDListeTypeMedia d'abord
	$c.combine(["dateChaine"; "private"; "grpZSgrpBDDListeTypeLien"; "grpBDDimage"])
	$c.combine(["modifierMedia"])
	Super.onEndEventForm($c)
	
	
Function onEndUnLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection("choix")
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:FORMevents Page fond
	// ----------------------
	
Function _FORM_choix()
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=New object
			Form[This.nomOBJ].values:=New collection(Localized string("10500"); Localized string("10501"))
			Form[This.nomOBJ].index:=This.indexPageForm
			
			Form.Pages:=New collection(1; 2)
			FORM GOTO PAGE(Form.Pages[This.indexPageForm])
			
		: (FORM Event.code=On Clicked)
			// en réalité, pas utile. Il existe une action4D gotopage
			Form.indexPageForm:=Form[This.nomOBJ].index
			FORM GOTO PAGE(Form.Pages[This.indexPageForm])
			
		: (FORM Event.code=On Unload)
			Form.indexPageForm:=Form[This.nomOBJ].index
	End case 
	
	
Function _FORM_btnNavPreviousPage()
	Case of 
			// v7.1.6 : en scrolling cet objet est masqué (action clavier non prise en compte ici)
		: (FORM Event.code#On Clicked)
			// en scroll, passer
		: (Form.numPageMedia=1)
			BEEP
			
		Else 
			Form.numPageMedia:=Form.numPageMedia-1
			This.AfficherLaPage()
	End case 
	
	
Function _FORM_btnNavNextPage()
	// v7.1.6 : en scrolling cet objet est masqué (action clavier non prise en compte ici)
	Case of 
		: (FORM Event.code#On Clicked)
		: (Form.numPageMedia=This.entité.NombreDePages)
			BEEP
			
		Else 
			Form.numPageMedia:=Form.numPageMedia+1
			This.AfficherLaPage()
	End case 
	
	
Function _FORM_actionFormulaire()->$result : Integer
	$result:=Super.surActionFormulaire([ds.Personnes; ds.Communes; ds.Medias])
	
	
	// ----------------------
	//MARK:FORMevents Page Visionneuse
	// ----------------------
	
Function _FORM_dateChaine()
	Case of 
		: ((FORM Event.code=On Load) | (FORM Event.code=On Losing Focus))
			OBJECT SET RGB COLORS(*; This.nomOBJ; (Foreground color*Num(This.entité.dateNumValid))+(0x00777777*Num(Not(This.entité.dateNumValid))))
			
		: (FORM Event.code=On Data Change)
			cs.xSDK.Outils.me.getDateNum(This.entité)
			cs._ds.me.Modifier(cdk Modifier; [This.entité]; Null)
			
		Else 
			// traitement générique
			This._FORM()
	End case 
	
	
Function _FORM_private()
	var $UserGroupID; $Error : Integer
	var $fichier; $nomFichier; $Path : Text
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=Num(This.entité.private#0)
			
		: (FORM Event.code=On Clicked)
			// récupérer le groupe familial de l'utilisateur courant
			$UserGroupID:=This.session.user.IDfamille
			
			If (This.session.user.estMembreDe_Developpement & (This.session.prefs.Session_Etat ?? 6))
				// (dé)finir un media système, visible et modifiable par le groupe développement ( = bibi)
				Form.entité.private:=$UserGroupID*Num(Form[This.nomOBJ]=1)
				
			Else 
				$fichier:=This.entité.LeFichier().platformPath
				// fixer la privatisation du media par un utilisateur autorisé
				// par principe les user de la BDD mère n'appartiennent à aucun groupe familial
				// => la privatisation n'est possible que par un client ALV
				$Error:=-15058
				Case of 
					: (Form.environnement.typeApplication()=ALV BDD mère)
					: (Form.environnement.estServeur())
						// rmk : les users de la BDDmère n'ont pas de groupe (0). Ces tests ne sont pas hyper utiles
						// pas concernés
						
					: ((Form.entité.private=0) & ($UserGroupID#0))
						// le user privatise
						$Error:=0
						// un media privé est associé à un groupe familial
						Form.entité.private:=$UserGroupID
						// taguer le nom du fichier (sert de marqueur pour la gestion des fichier)
						$nomFichier:=Replace string(Form.entité.leFichier[0].nom; "."; ".alvprv.")
						
					: ((Form.entité.private=$UserGroupID) & ($UserGroupID#0))
						// le propriétaire du media le déprivatise
						$Error:=0
						Form.entité.private:=0
						// de-taguer le nom du fichier
						$nomFichier:=Replace string(Form.entité.leFichier[0].nom; ".alvprv."; ".")
				End case 
				
				// changer le nom du fichier
				If ($Error=0)
					$Path:=Form.entité.leFichier[0].nom  // mémoriser l'ancien nom
					Form.entité.leFichier[0].nom:=$nomFichier
					// nouveau chemin du fichier
					$Path:=Replace string($fichier; $Path; $nomFichier)
					MOVE DOCUMENT($fichier; $Path)
					
					// forcer l'appel
					cs._ds.me.Modifier(cdk Modifier; New collection(Form.entité; Form.entité.leFichier[0]); Null)
					
					// mettre à jour le formulaire
					Appeler_Le_Formulaire(Current process; "AfficherSélection")
					
				Else 
					// annuler
					Form[This.nomOBJ]:=Num(This.entité.private#0)
				End if 
			End if 
	End case 
	
	
Function _FORM_grpBDDimage()
	Case of 
		: (FORM Event.code=On Load)
			This.AfficherLaPage()
			
		: (FORM Event.code=On Mouse Move)
			This.image.existeZoneSensibleActiveinMedia()
			// Storage.System.Navigation.ZS est renseigné
	End case 
	This._ActiverLien()
	
	
Function _FORM_grpWEBGoToLien()
	Case of 
		: (FORM Event.code=On Mouse Move)
			This.image.existeZoneSensibleActiveinZoneWeb()
	End case 
	This._ActiverLien()
	
	
Function _ActiverLien()
	var $data : Object
	
	Case of 
		: (FORM Event.code=On Mouse Move)
			// rafraichir le curseur
			If (Storage.System.Navigation.ZS.ZoneSurvolée>0)  // le curseur est sur une zone
				SET CURSOR(9000)
				// lire les données à l'action si on clique sur le lien
				$data:=New object("IDobjetCodé"; Storage.System.Navigation.ZS.EnregistrementLié; "action"; This.ActionUtilisateur("[option]"))
				Form.zoneSensible.LireParamètresZS(Current process name; $data)
				// créer le message 
				$data.ID:=Form.zoneSensible.params.message
				$data.param_1:=Storage.System.Navigation.ZS.EnregistrementLiéLibellé
				This.AfficherMessageUtilisateur($data)
				
			Else 
				SET CURSOR  // RAZ pointeur
				This.EffacerMessageUtilisateur()
			End if 
			
		: (FORM Event.code=On Clicked)
			This.zoneSensible.ActionZS()
			
		: (FORM Event.code=On Mouse Leave)
			// rien à faire de plus
	End case 
	
	
Function _FORM_zoomPlusImage()
	This.image.ZoomPlus()
	
	
Function _FORM_zoomMoinsImage()
	This.image.ZoomMoins()
	
	
	// ----------------------
	//MARK:FORMevents Page Illustrés
	// ----------------------
	
Function _FORM_ImageSVG()->$result : Integer
	var $IDcodé : Integer
	var $gauche; $haut; $droite; $bas; $sourisX; $sourisY; $SourisBtn; $margeG; $margeH; $largeur; $hauteur : Integer
	var $zoom : Real
	var $ID_SVG : Text
	var $params : Object
	
	Case of 
			// ajout d'une ZS
			
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserENTITE([ds.Personnes; ds.Lieux; ds.Medias; ds.Commandes])
			This.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5041; This.glisserDeposer.paramsMessage)))
			
		: (FORM Event.code=On Drop)
			If (This.ActionUtilisateur("[ModificationAutorisée]"))
				// préparer les données d'ajout d'une zone sensible
				$params:=New object
				$IDcodé:=Storage.System.GlisserDéposer.refItem  // typer EntierLong !
				$params.deQui:=cs._ds.me.EntitéAvecIDcodé($IDcodé)
				
				// fixer la position de la ZS créée
				MOUSE POSITION($sourisX; $sourisY; $SourisBtn)  // par rapport à la fenêtre
				OBJECT GET COORDINATES(*; This.nomOBJ; $gauche; $haut; $droite; $bas)
				// position du "drop" par rapport à l'objet :
				$sourisX:=$sourisX-$gauche
				$sourisY:=$sourisY-$haut
				// position du "drop" par rapport à l'image :
				$zoom:=-Scaled to fit prop centered
				$margeG:=0
				$margeH:=0
				// attention : ce zoom suppose l'image non zoomée !
				PICTURE PROPERTIES(This.image.imagePageMedia; $largeur; $hauteur)
				cs.xSDK.Outils.me.CalculerRectangleMedia(->$gauche; ->$haut; ->$droite; ->$bas; $largeur; $hauteur; ->$zoom; ->$margeG; ->$margeH)
				// lire le zoom actuel de l'image
				This.zonesEditeur.LireValeurZoom(->$zoom)
				//ZonesSensibles Modifier(->StructureSVG; ZS Lire valeur Zoom; ->$zoom)
				$sourisX:=$sourisX-$margeG
				$sourisY:=$sourisY-$margeH
				// position relative du "drop" par rapport à l'image :
				$params.PositionX:=$sourisX/$largeur/$zoom
				$params.PositionY:=$sourisY/$hauteur/$zoom
				
				$params.numPage:=Form.numPageMedia  // transformer type "numerique" en "entier"
				$params.typeZone:=2
				cs._ds.me.Ajouter(imk Zone; This.entité; Null; $params)
			End if 
			
		: (FORM Event.code=On Mouse Move)
			$ID_SVG:=SVG Find element ID by coordinates(*; This.nomOBJ; MouseX; MouseY)
			
			If ($ID_SVG="@Ancre@")
				SET CURSOR(9013)
			Else 
				SET CURSOR
			End if 
			
		: (FORM Event.code=On Clicked)
			This.zonesEditeur.surDébutDéplacementAncre()
			SET CURSOR(9014)
	End case 
	
	
Function _FORM_zoomPlusZS()
	// Zoom "+" de la ZS
	This.ZoomerZone(1)
	
	
Function _FORM_zoomMoinsZS()
	// Zoom "-" de la ZS
	This.ZoomerZone(-1)
	
	
Function _FORM_listeDesIllustres()
	var $ID : Integer
	
	Case of 
		: (FORM Event.code=On Selection Change)
			$ID:=-1
			If (Not(Form.ListeDesIllustresElementCourant=Null))
				$ID:=Form.ListeDesIllustresElementCourant.IDzone
				// mémoriser (en particulier en cas de mise à jour de la page
				Form.positionListeDesIllustres:=Form.ListeDesIllustresPositionElementCourant
			End if 
			This.AfficherZone($ID)
	End case 
	
	
Function _FORM_listeDesIllustres_entity()->$result : Integer
	//rappel : l'event drop n'existe pas sur la LB ; on utilise la colonne 'entity'
	var $entité : Object
	var $ID : Integer
	
	Case of 
		: (FORM Event.code=On Drag Over)
			// on n'accepte que des personnes
			$result:=-1
			
			If (This.glisserDeposer.surGlisserENTITE([ds.Personnes; ds.Events; ds.Lieux; ds.Medias])=0)
				// l'entité qu'on dépose doit être de la même table que celle de l'entité liée à la zone du dépot
				
				// entité liée à la zone du dépot
				This.glisserDeposer.FixerDepotSurLB("listeDesIllustres")
				$entité:=cs._ds.me.EntitéAvecIDcodé(Storage.System.GlisserDéposer.depot).LeLien()
				
				Case of 
					: ($entité=Null)
					: ($entité.getDataClass().getInfo().tableNumber#CodeEnreg(Storage.System.GlisserDéposer.refItem))
					Else 
						$result:=0
				End case 
			End if 
			This.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5111; This.glisserDeposer.paramsMessage)))
			
		: (FORM Event.code=On Drop)
			If (Form.ActionUtilisateur("[ModificationAutorisée]"))
				// zone à modifier
				$entité:=cs._ds.me.EntitéAvecIDcodé(Storage.System.GlisserDéposer.depot)
				// fixer le nouveau lien
				$ID:=Storage.System.GlisserDéposer.refItem & 0x00FFFFFF
				$entité:=$entité.FixerLeLien($ID)
				// enregistrer $entité (c'est une table de transition)
				cs._ds.me.Modifier(cdk Modifier; New collection($entité); Null)
			End if 
	End case 
	
	
Function _FORM_grpZSgrpBDDListeTypeLien()
	var $typeLien : Integer
	var $entité : cs.ZonesEntity
	
	Case of 
		: (FORM Event.code=On Load)
			// initialiser la liste
			Form[This.nomOBJ]:=New object
			Form[This.nomOBJ].ID:=New collection(70000; 70100; 70200)
			// ajouter le [zones]type 
			//  ref xx000 => 2 : ZS [zones]type = 2, ref xx100 => 1 : illustration [zones]type = 1, ref xx200 => 3 : document [zones]type = 3
			Form[This.nomOBJ].typeLien:=New collection(2; 1; 3)
			Form[This.nomOBJ].index:=0
			// .values est créé plus tard
			
		: (FORM Event.code=On Clicked)
			$typeLien:=Form[This.nomOBJ].typeLien[Form[This.nomOBJ].index]
			Case of 
				: (This.entité.lesZones.length=0)
				: (Form.ZoneSélectionnée=Null)
				: (Form.ZoneSélectionnée.type=$typeLien)
				Else 
					// ok modifier le type
					$entité:=ds.Zones.get(Form.ZoneSélectionnée.ID)
					$entité.type:=$typeLien
					cs._ds.me.Modifier(cdk Modifier; New collection($entité); Null)
			End case 
	End case 
	
	
	// ----------------------
	// MARK:InformationsAutres 
	// -----------------------
	
Function _FORM_modifierMedia()->$result : Integer
	var $data : Object
	
	Case of 
		: (FORM Event.code=On Load)
			Form.titre:=Localized string("5088")
			
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserFICHIER()
			This.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5040; This.glisserDeposer.paramsMessage)))
			
		: (FORM Event.code=On Drop)
			If (This.ActionUtilisateur("[ModificationAutorisée]"))
				$data:=OB Copy(Storage.System.GlisserDéposer)
				// ici, on modifie le fichier de l'entité courante
				// envoyer l'entité dans qui pour empêcher la création d'un nouveau media
				cs._ds.me.Ajouter(imk Fichier; This.entité; This.entité; $data)
			End if 
			
		: (FORM Event.code=On Mouse Leave)
			// effacer
			This.EffacerMessageUtilisateur()
	End case 
	
	
	// ----------------------
	// MARK:Affichage 
	// -----------------------
	
Function AfficherEntité()
	// point d"entrée de l'affichage du formulaire ; appelé sur 'onLoad'
	var $params : Object
	
	This.Titrer()
	
	This.fichierMedia:=This.entité.LeFichier()
	This.cheminMedia:=This.entité.leFichier[0].CheminDuFichier()
	
	// si on charge un nouveau media, il peut ne pas y avoir de page n° Form.numPageMedia
	Form.numPageMedia:=(1*(Num(Form.numPageMedia>This.entité.NombreDePages)))+(Form.numPageMedia*(Num(Form.numPageMedia<=This.entité.NombreDePages)))
	
	// barre menu "event" : vérifier qu'il y a quelque chose pour le diaporama ou la cartographie
	$params:=New object("IDnomMenu"; "BM_01-19-0106")
	This.menu.LireRefMenu($params)
	This.menu.ValiderBarreMenus($params.refMenu)
	
	//This.AfficherLaPage()
	
	// il semble que la taille des objets du FORM n'est pas définitive au FormEvent 'onLoad' 
	// le FormEvent 'resize' n'est pas appelé au chargemnt de la page
	// => on force FormEvent 'resize' pour redimensionner l'image 
	RESIZE FORM WINDOW(1; 1)
	
	
Function AfficherLaPage()
	// afficher les objets en fonction du media (en BDD ou lien WEB)
	OBJECT SET VISIBLE(*; "@grpBDD@"; This.entité.type<200)
	OBJECT SET VISIBLE(*; "@grpWEB@"; This.entité.type=200)
	
	// v7.1.5 : utilisation de "$image" pour gérer les zoom, scrolls...
	Case of 
		: (This.entité.type<200)
			// fixer le lien avec l'objet formulaire
			This.image.nomObjet:="grpBDDimage"
			This.image.AfficherPageMedia(This.entité.ID)
			
		: (This.entité.type=200)
			// fixer le lien avec l'objet formulaire
			This.image.nomObjet:="grpWEBZoneWeb"
			WA OPEN URL(*; This.image.nomObjet; This.cheminMedia)
			WA SET PREFERENCE(*; This.image.nomObjet; WA enable Web inspector; This.session.prefs.Session_Etat ?? 6)
		Else 
	End case 
	
	This.MettreAjourLaPage()
	
	// construire l'image SVG
	This.zonesEditeur.AfficherIHS(This.fichierMedia.platformPath; "ImageSVG")
	// construire la liste des illustrés de la page
	This.AfficherListeDesIllustres()
	
	
Function AfficherListeDesIllustres()
	var $params : Object
	var $nomOBJ : Text:="listeDesIllustres"
	var $ID : Integer
	
	$params:=New object
	$params.entitéID:=This.entité.ID
	$params.numPageMedia:=Form.numPageMedia
	This.CréerLaListe(cs.MediasEditeur.name; "CréerLaListeDesZones"; $params)
	
	$params.liste:=$params.liste.orderBy("membre asc, itemText asc")
	Form[$nomOBJ]:=$params.liste
	
	// pas de zone sélectionnée
	$ID:=-1
	Case of 
		: (Not(OB Is defined(This; "positionListeDesIllustres")))
		: (This.positionListeDesIllustres>LISTBOX Get number of rows(*; $nomOBJ))
		Else 
			LISTBOX SELECT ROW(*; $nomOBJ; This.positionListeDesIllustres)
			$ID:=Form[$nomOBJ][This.positionListeDesIllustres-1].IDzone
	End case 
	
	This.AfficherZone($ID)
	
	
Function AfficherZone($ID : Integer)
	var $entité; $options : Object
	var $nomObjet : Text:="grpZSgrpBDDListeTypeLien"
	
	This.zonesEditeur.SélectionnerZone($ID)
	// ici Form.ZoneSélectionnée a une valeur
	
	// il faut sélectionner l'enregistrement pour l'affichage du formulaire
	If (Form.ZoneSélectionnée#Null)
		// il y a une ZS à sélectionner
		$entité:=ds.Zones.query("ID = :1"; Form.ZoneSélectionnée.ID)[0]
		
		// mettre à jour les libellés de "grpZSgrpBDDListeTypeMedia" en fonction de l'élément sélectionné
		$options:=New object("param_1"; $entité.Libellé())
		Form[$nomObjet].values:=New collection
		For each ($ID; Form[$nomObjet].ID)
			Form[$nomObjet].values[Form[$nomObjet].ID.indexOf($ID)]:=cs._cfct.me.LireLocatedSTR($ID; $options)
		End for each 
		
		// enfin sélectionner le bon type de la ZS
		For each ($ID; Form[$nomObjet].typeLien)
			If ($ID=$entité.type)
				Form[$nomObjet].index:=Form[$nomObjet].typeLien.indexOf($ID)
			End if 
		End for each 
	End if 
	
	// masquer l'inutile (dans l'ordre !)
	OBJECT SET VISIBLE(*; "@grpBDD@"; This.entité.type<200)  // le nom de cet objet est grpZSgrpBDD...
	OBJECT SET VISIBLE(*; "grpZS@"; Form.ZoneSélectionnée#Null)
	
	
Function Titrer()
	SET WINDOW TITLE(Localized string("5004")+" - "+This.entité.titre)
	
	
Function ZoomerZone($Zoom : Integer)
	This.zonesEditeur.ZoomerImage($Zoom)
	
	
	// ----------------------
	// MARK:Demande actions 
	// -----------------------
	
Function MettreAjourLaPage()
	// mettre à jour le formulaire
	OBJECT SET VISIBLE(*; "BtnNav@"; Num(OBJECT Get format(*; This.image.nomObjet))=Scaled to fit prop centered)
	OBJECT SET VISIBLE(*; "btnNav@Page@"; (Character code(OBJECT Get format(*; This.image.nomObjet))=Scaled to fit prop centered) & (This.entité.NombreDePages>1))

⇧ [class]$texteTraitement - 09/06/2026 10:51:58

      
Class constructor()
	
	
	// ----------------------
	// MARK:Encyclopédie
	// -----------------------
	
Function RechercherSurClasse($params : Object)
	// construire le texte en fonction du menuID
	// la construction se fait dans un worker / process externe
	var $sélection : Object
	var $c : Collection
	var $texte : Text
	
	InitProcessThreadSafe
	
	$texte:=""
	Case of 
		: ($params.menuID=1099)
			$sélection:=ds.DicoDesNoms.all().lePatronyme.orderBy("MotCle asc")
			$texte:=$sélection.CréerTexteDeMotsClé()
			
		: ($params.menuID=1100)
			$sélection:=ds.Personnes.all().leMotCle.orderBy("MotCle asc")
			$texte:=$sélection.CréerTexteDeMotsClé()
			
		: ($params.menuID=1101)
			$sélection:=ds.DicoDesNoms.all().lePatronyme
			// ajouter les prénoms
			$sélection:=$sélection.or(ds.Personnes.all().leMotCle)
			$c:=$sélection.extract("ID")
			// sélectionner le reste
			$sélection:=ds.Encyclopedia.query("NOT(ID IN :1)"; $c).orderBy("MotCle asc")
			$texte:=$sélection.CréerTexteDeMotsClé()
			
		Else 
			
	End case 
	$params.texteWorké:=$texte
	
	
Function RechercherSurMotCle($params : Object)
	// construire le texte en fonction du motclé
	// la construction se fait dans un worker / process externe
	var $motClé; $texte : Text
	var $sélection : Object
	
	InitProcessThreadSafe
	
	$texte:=""
	Case of 
		: (Not(OB Is defined($params; "motCle")))
		: ($params.motCle="")
		Else 
			$motClé:=$params.motCle
			// sélectionner des entités [Encyclopedia]
			$sélection:=ds.Encyclopedia.query("MotCle = :1 or formePlurielle = :2"; $motClé; $motClé)
			
			Case of 
				: ($sélection.length=0)
					// mot-clé inconnu dans l'encyclopédie
					$texte:=Char(Double quote)+$motClé+Char(Double quote)+Localized string("5172")+Char(Carriage return)
					
					// ajouter les champs en BDD contenant ce mot-clé
					If ($params.UserPrefs.Session_Etat ?? 12)
						$texte:=$texte+ds.Personnes.TextEncycloSurMotClé($motClé)
						$texte:=$texte+ds.Events.TextEncycloSurMotClé($motClé)
						$texte:=$texte+ds.Lieux.TextEncycloSurMotClé($motClé)
						$texte:=$texte+ds.Medias.TextEncycloSurMotClé($motClé)
						
					Else 
						$texte:=Char(Double quote)+$texte+Localized string("5173")+Char(Double quote)+Localized string("105")+Char(Double quote)+"."
					End if 
					
				: ($sélection.length=1)
					// un seul mot-clé ; son entité
					$texte:=$sélection[0].CréerTexteDeMotClé($params)
					
				Else 
					// on garde cette sélection ; écrire la liste de mots-clé
					$texte:=$sélection.CréerTexteDeMotsClé()
			End case 
	End case 
	$params.texteWorké:=$texte
	
	
	// ----------------------
	// MARK:Correction Orthographique
	// -----------------------
	
Function MettreAjourDictionnaire()
	// a faire dans un process non thread-safe
	var $params : Object
	
	$params:=New object
	$params.nomProcess:="$SYS_MettreAjourDictionnaire"
	$params.initProcess:=Formula(InitProcessCooperative)
	cs.$process.new().NouveauProcess(cs.$texteTraitement; "MettreAjourDictionnaireProcess"; $params)
	
	
Function MettreAjourDictionnaireProcess()
	This.MettreAjourDictionnaireDeDataClass("Encyclopedia"; "MotCle")
	This.MettreAjourDictionnaireDeDataClass("Communes"; "nom")
	
	
Function MettreAjourDictionnaireDeDataClass($dataClassNom : Text; $attribut : Text)
	var $c : Collection
	
	$c:=ds[$dataClassNom].all().extract($attribut)
	
	ARRAY TEXT($tabTexte; 0)
	COLLECTION TO ARRAY($c; $tabTexte)
	SPELL ADD TO USER DICTIONARY($tabTexte)

⇧ [class]LieuxEditeur - 20/04/2026 18:23:56

      property carto : cs.xCarto.$carte
property tousLieux : Boolean

Class extends $editeur

Class constructor()
	// construction commune
	Super()
	
	This.tousLieux:=False
	
	// classe de gestion de la carto
	This.carto:=cs.xCarto.$carte.new()
	var Carto_LatitudeCentre; Carto_LongitudeCentre : Text
	var ZoneWeb_ZoomMin : Text:=""
	var ZoneWeb_ZoomMax : Text:=""
	
	// init cartographie
	This.rsc.SetVariable(Est Ressource APP; "Site_Web/Carto_ZoomMin_OL"; Is text; ->ZoneWeb_ZoomMin)
	This.rsc.SetVariable(Est Ressource APP; "Site_Web/Carto_ZoomMax_OL"; Is text; ->ZoneWeb_ZoomMax)
	Carto_LatitudeCentre:=""
	Carto_LongitudeCentre:=""  // ça va mieux comme cela
	
	
Function getDataClassInfos()->$result : Object
	$result:=Super.getDataClassInfos("Lieux")
	
	
	// ----------------------
	// MARK:Sélections
	// -----------------------
	
Function CréerLaListeDesSites($params : Object)
	// ici on est toujours sur BDDmère ou ServeurAPP
	var $sélection : cs.LieuxEntity
	
	$sélection:=ds.Lieux.query("ID = :1"; $params.entitéID)[0]
	// créer la collection hiérarchique des lieux de $sélection
	$sélection.CréerListeDeroulanteSites($params)
	
	
Function CréerLaListeDesSitesLieux($params : Object)
	// ici on est toujours sur BDDmère ou ServeurAPP
	var $sélection : cs.LieuxEntity
	
	$sélection:=ds.Lieux.query("ID = :1"; $params.entitéID)[0]
	// créer la collection hiérarchique des lieux de $sélection
	$sélection.CréerListBoxLieux($params)
	
	
Function CréerLaListeDesEvenements($params : Object)
	// ici on est toujours sur BDDmère ou ServeurAPP
	var $selection : cs.EventsSelection
	
	$selection:=ds.Lieux.get($params.entitéID).lesEvenements.orderBy("type asc")
	// créer la collection LB des events de $sélection
	$selection.CréerListBox($params)
	// le résultat est dans $params
	
	
Function FixerParamètresSélectionVisualisable()->$result : Object
	// paramètres de filtrage des lieux de la sélection courante
	$result:=New object
	$result.tousLesLieux:=False
	$result.géolocalisés:=False
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	var $gauche; $haut; $droite; $bas : Integer
	var $itemText : Text
	
	ASSERT(cs.$trace.me.DebugerEventForm(Current method name; "EventForm"; New object("numEvent"; FORM Event.code; "numTable"; Table(Current form table))))
	
	// traitements génériques
	This.surEvenementFormulaire()
	
	// traitements particuliers
	Case of 
		: (FORM Event.code=On Load)
			// impératif ici (sinon parfois des events "Sur données modifiées" se produisent sans raison
			GOTO OBJECT(*; "AjoutMedia")
			
			// afficher la map
			OBJECT GET COORDINATES(*; "zoneCartographie"; $gauche; $haut; $droite; $bas)
			ZoneWeb_Largeur:=String($droite-$gauche)+"px"  // pixel
			ZoneWeb_Hauteur:=String($bas-$haut)+"px"
			
			// charger les objets
			This.onEndLoad()
			
		: (FORM Event.code=On Activate)
			This.FixerVisibilitéPalettes(True)
			//Rmk : les illustrations sont toujours affichées dans un autre process
			
			$itemText:=Choose(This.session.prefs.Apparence.Formulaire.FormatGeoLoc-1; "DD"; "DMS")
			OBJECT SET FORMAT(*; "saisie_latitude_lieu"; "|latitude_format_"+$itemText)
			OBJECT SET FORMAT(*; "saisie_longitude_lieu"; "|longitude_format_"+$itemText)
			
		: (FORM Event.code=On Data Change)
			Case of 
				: (OBJECT Get name(Object with focus)="noChange@")
					// passer (sinon on peut avoir un message "vous n'avez pas les droits..."
				Else 
					cs._ds.me.Modifier(cdk Modifier; New collection(Form.entité; Form.entité.leSite; Form.entité.leSite.laCommune; Form.entité.leSite.laCommune.leDepartement; Form.entité.leSite.laCommune.leDepartement.laRegion; Form.entité.leSite.laCommune.leDepartement.laRegion.lePays); Null)
					// au cas ou...
					SET WINDOW TITLE(Localized string("5003")+" - "+Form.entité.leSite.laCommune.Libellé(New object("Options"; 0x00020000)))
			End case 
			
		: (FORM Event.code=On Unload)
			// charger les objets
			This.onEndUnLoad()
	End case 
	
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection("choix"; "listeSites"; "listeSitesLieux"; "listeTypeSite"; "listeTypeLieu")
	$c.combine(["listeIllustrations"; "listeEvenements"; "mediasEnLien"; "choixAdmin"])
	Super.onEndEventForm($c)
	
	
	// décharger les objets
Function onEndUnLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection("choix"; "listeTypeSite"; "listeTypeLieu")
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:FORMevents Page fond
	// ----------------------
	
Function _FORM_choix()
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=New object
			Form[This.nomOBJ].values:=New collection(Localized string("10200"); Localized string("10201"); Localized string("10202"))
			Form[This.nomOBJ].index:=This.indexPageForm
			
			Form.Pages:=New collection(1; 2; 3)
			FORM GOTO PAGE(Form.Pages[This.indexPageForm])
			
			This.InitialiserPage()
			
		: (FORM Event.code=On Clicked)
			// en réalité, pas utile. Il existe une action4D gotopage
			Form.indexPageForm:=Form[This.nomOBJ].index
			FORM GOTO PAGE(Form.Pages[This.indexPageForm])
			
			This.InitialiserPage()
			
		: (FORM Event.code=On Unload)
			Form.indexPageForm:=Form[This.nomOBJ].index
	End case 
	
	
Function InitialiserPage()
	var $data : Object
	
	$data:=New object("IDnomMenu"; "BM_01-10-0104")  // menu "ajouter coordonnées géo"
	Chercher refMenu($data)
	
	If ($data.refMenu#"")  // le menu existe
		If (Form.indexPageForm=2)
			ENABLE MENU ITEM($data.refMenu; $data.numLigne)
		Else 
			DISABLE MENU ITEM($data.refMenu; $data.numLigne)
		End if 
	End if 
	
	// en page 2, le sous formulaire ne masque pas le groupe
	OBJECT SET VISIBLE(*; "GrpGéoLoc@"; Form.indexPageForm#1)
	
	Case of 
		: (Form.indexPageForm=1)
			OBJECT SET ENABLED(*; "btnTri@"; True)
			OBJECT SET ENABLED(*; "btnTri"+String(This.session.prefs.Session_ClesTri & 0x0007); False)
			
		: (Form.indexPageForm=2)
			GOTO OBJECT(*; "liste site et lieu")
	End case 
	
	
Function _FORM_actionFormulaire()->$result : Integer
	$result:=Super.surActionFormulaire([ds.Communes; ds.Sites; ds.Lieux; ds.Personnes; ds.Medias])
	
	
Function _FORM_listeSites()
	var $params : Object
	var $sélectionEntités : cs.SitesSelection
	Case of 
		: (FORM Event.code=On Load)
			// liste des sites
			// exécuter
			$params:=New object
			$params.entitéID:=Form.entité.ID
			$params.tousLieux:=Form.tousLieux
			This.CréerLaListe(OB Class(This).name; "CréerLaListeDesSites"; $params)
			
			Form[This.nomOBJ]:=$params.liste
			
		: (FORM Event.code=On Clicked)
			// par construction, Form.entité.LesSites et menuSites sont synchrones
			// index = 0 : la commune
			// position > 1 : position - 2 est l'index d'un lieu dans la sélection courante d'entités
			If (Form[This.nomOBJ].index=0)
				Form.tousLieux:=True
				$sélectionEntités:=Form.entité.LesSites().lesLieux.orderBy("nom")
				Form.nav.AfficherNouvelleSélection($sélectionEntités; 0)
				
			Else 
				Form.tousLieux:=False
				$sélectionEntités:=Form.entité.LesSites()[Form[This.nomOBJ].index-1].lesLieux.orderBy("nom")
				Form.nav.AfficherNouvelleSélection($sélectionEntités; 0)
			End if 
	End case 
	
	
Function _FORM_listeSitesLieux()
	var $params : Object
	var $colonne; $ligne : Integer
	
	Case of 
		: (FORM Event.code=On Load)
			// exécuter
			$params:=New object
			$params.entitéID:=Form.entité.ID
			$params.tousLieux:=Form.tousLieux
			This.CréerLaListe(OB Class(This).name; "CréerLaListeDesSitesLieux"; $params)
			
			Form[This.nomOBJ]:=$params.liste
			LISTBOX SELECT ROW(*; This.nomOBJ; (Form[This.nomOBJ].indices("ID = :1"; Form.entité.ID)[0])+1; lk replace selection)
			
		: (FORM Event.code=On Selection Change)
			// pointer la nouvelle entité
			LISTBOX GET CELL POSITION(*; This.nomOBJ; $colonne; $ligne)
			If ($ligne>0)
				// attention index de sélection = rang de LB - 1
				// relancer l'affichage du formulaire
				Form.nav.entitéCourante:=Form.nav.sélectionCourante[$ligne-1]
				ACCEPT
			End if 
	End case 
	
	
	// ----------------------
	//MARK:FORMevents Page 1
	// ----------------------
	
Function _FORM_listeIllustrations()
	var $params : Object:=New object
	Super._FORM_listeIllustrations($params)
	
	
Function _FORM_listeIllustrations_photo()
	Super._FORM_listeIllustrations_photo()
	
	
Function _FORM_nomSite()->$result : Integer
	var $IDcodé : Integer
	var $entité : Object
	
	Case of 
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserENTITE([ds.Sites])
			
			// renseigner param_3 pour le UserMessage
			If ($result=0)
				// on a reçu un site, trouver le nom de sa commune
				$IDcodé:=Storage.System.GlisserDéposer.refItem  // typer $1
				$entité:=cs._ds.me.EntitéAvecIDcodé($IDcodé)
				This.glisserDeposer.paramsMessage.param_3:=$entité.laCommune.Libellé()
			End if 
			Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5030; This.glisserDeposer.paramsMessage)))
			
		: (FORM Event.code=On Drop)
			// on a reçu un site : faire le lien
			$IDcodé:=Storage.System.GlisserDéposer.refItem
			cs._ds.me.Modifier(cdk Lier; New collection(Form.entité); New object("params"; New object("attribut"; "site"; "valeur"; $IDcodé)))
			
		Else 
			// traitement générique
			This._FORM()
	End case 
	
	
Function _FORM_listeTypeSite()
	var $itemRef : Integer
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=cs._cfct.me.LireLocatedSTR_LH(50000; 50999)
			// sélectionner l'élément de liste
			$itemRef:=Form.entité.leSite.type
			SELECT LIST ITEMS BY REFERENCE(Form[This.nomOBJ]; $itemRef)
			// affichage Form
			GET LIST ITEM(*; This.nomOBJ; Selected list items(*; This.nomOBJ); $itemRef; $itemText)
			Form.typeSite:=$itemText
			OBJECT SET VISIBLE(*; This.nomOBJ; (Form.ActionUtilisateur("[SaisieAutorisée]")) & (Form.entité.LesLieux().length#0) & (Form.entité.type#60700))
			
		: (FORM Event.code=On Clicked)
			$itemRef:=Selected list items(*; This.nomOBJ; *)
			If ($itemRef#0)
				If (Form.entité.leSite.type#$itemRef)
					Form.entité.leSite.type:=$itemRef
				End if 
			End if 
			
		: (FORM Event.code=On Unload)
			CLEAR LIST(Form[This.nomOBJ]; *)
	End case 
	
	
Function _FORM_listeTypeLieu()
	var $itemRef : Integer
	var $itemText : Text
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=cs._cfct.me.LireLocatedSTR_LH(60000; 60999)
			// sélectionner l'élément de liste
			$itemRef:=Form.entité.type
			SELECT LIST ITEMS BY REFERENCE(Form[This.nomOBJ]; $itemRef)
			// affichage Form
			GET LIST ITEM(*; This.nomOBJ; Selected list items(*; This.nomOBJ); $itemRef; $itemText)
			Form.typeLieu:=$itemText
			OBJECT SET VISIBLE(*; This.nomOBJ; (Form.ActionUtilisateur("[SaisieAutorisée]")) & (Form.entité.LesLieux().length#0) & (Form.entité.type#60700))
			
		: (FORM Event.code=On Clicked)
			$itemRef:=Selected list items(*; This.nomOBJ; *)
			If ($itemRef#0)
				If (Form.entité.type#$itemRef)
					Form.entité.type:=$itemRef
				End if 
			End if 
			
		: (FORM Event.code=On Unload)
			CLEAR LIST(Form[This.nomOBJ]; *)
	End case 
	
	
Function _FORM_nomCommune()->$result : Integer
	Case of 
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserENTITE([ds.Communes])
			This.glisserDeposer.paramsMessage.param_3:=Form.entité.Le("Sites").Libellé()
			Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5031; This.glisserDeposer.paramsMessage); "userMessageTime"; 30))
			
		: (FORM Event.code=On Drop)
			// on a reçu une commune : faire le lien
			cs._ds.me.Modifier(cdk Lier; New collection(Form.entité.Le("Sites")); New object("params"; New object("attribut"; "commune"; "valeur"; Storage.System.GlisserDéposer.refItem)))
			
		Else 
			// traitement générique
			This._FORM()
	End case 
	
	
Function _FORM_nomDepartement()->$result : Integer
	Case of 
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserENTITE([ds.Departements])
			This.glisserDeposer.paramsMessage.param_3:=Form.entité.Le("Communes").Libellé()
			Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5032; This.glisserDeposer.paramsMessage); "userMessageTime"; 30))
			
		: (FORM Event.code=On Drop)
			// on a reçu un département : faire le lien
			cs._ds.me.Modifier(cdk Lier; New collection(Form.entité.Le("Communes")); New object("params"; New object("attribut"; "departement"; "valeur"; Storage.System.GlisserDéposer.refItem)))
			
		Else 
			// traitement générique
			This._FORM()
	End case 
	
	
Function _FORM_nomRegion()->$result : Integer
	Case of 
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserENTITE([ds.Regions])
			This.glisserDeposer.paramsMessage.param_3:=Form.entité.Le("Departements").Libellé()
			Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5033; This.glisserDeposer.paramsMessage); "userMessageTime"; 30))
			
		: (FORM Event.code=On Drop)
			// on a reçu une région : faire le lien
			cs._ds.me.Modifier(cdk Lier; New collection(Form.entité.Le("Departements")); New object("params"; New object("attribut"; "region"; "valeur"; Storage.System.GlisserDéposer.refItem)))
			
		Else 
			// traitement générique
			This._FORM()
	End case 
	
	
Function _FORM_nomPays()->$result : Integer
	Case of 
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserENTITE([ds.Pays])
			This.glisserDeposer.paramsMessage.param_3:=Form.entité.Le("Regions").Libellé()
			Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5034; This.glisserDeposer.paramsMessage); "userMessageTime"; 30))
			
		: (FORM Event.code=On Drop)
			// on a reçu un pays: faire le lien
			cs._ds.me.Modifier(cdk Lier; New collection(Form.entité.Le("Regions")); New object("params"; New object("attribut"; "pays"; "valeur"; Storage.System.GlisserDéposer.refItem)))
			
		Else 
			// traitement générique
			This._FORM()
	End case 
	
	
Function _FORM_blasonCommune()->$result : Integer
	var $entité : Object
	
	Case of 
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserIMAGE()
			This.glisserDeposer.paramsMessage.param_3:=Form.entité.Le("Communes").Libellé()
			Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5035; This.glisserDeposer.paramsMessage); "userMessageTime"; 30))
			
		: (FORM Event.code=On Drop)
			If (Form.ActionUtilisateur("[ModificationAutorisée]"))
				$entité:=Form.entité.Le("Communes")
				This.glisserDeposer.surDéposerIMAGE($entité; ds.Communes.blason.name)
			End if 
	End case 
	
	
Function _FORM_blasonDepartement()->$result : Integer
	var $entité : cs.DepartementsEntity
	
	Case of 
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserIMAGE()
			This.glisserDeposer.paramsMessage.param_3:=Form.entité.Le("Departements").Libellé()
			Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5036; This.glisserDeposer.paramsMessage); "userMessageTime"; 30))
			
		: (FORM Event.code=On Drop)
			If (Form.ActionUtilisateur("[ModificationAutorisée]"))
				$entité:=Form.entité.Le("Departements")
				This.glisserDeposer.surDéposerIMAGE($entité; ds.Departements.blason.name)
			End if 
	End case 
	
	
Function _FORM_blasonRegion()->$result : Integer
	var $entité : cs.RegionsEntity
	
	Case of 
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserIMAGE()
			This.glisserDeposer.paramsMessage.param_3:=Form.entité.Le("Regions").Libellé()
			Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5037; This.glisserDeposer.paramsMessage); "userMessageTime"; 30))
			
		: (FORM Event.code=On Drop)
			If (Form.ActionUtilisateur("[ModificationAutorisée]"))
				$entité:=Form.entité.Le("Regions")
				This.glisserDeposer.surDéposerIMAGE($entité; ds.Regions.blason.name)
			End if 
	End case 
	
	
Function _FORM_blasonPays()->$result : Integer
	var $entité : Object
	
	Case of 
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserIMAGE()
			This.glisserDeposer.paramsMessage.param_3:=Form.entité.Le("Pays").Libellé()
			Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5145; This.glisserDeposer.paramsMessage); "userMessageTime"; 30))
			
		: (FORM Event.code=On Drop)
			If (Form.ActionUtilisateur("[ModificationAutorisée]"))
				$entité:=Form.entité.Le("Pays")
				This.glisserDeposer.surDéposerIMAGE($entité; ds.Pays.Drapeau.name)
			End if 
	End case 
	
	
Function _FORM_ajoutMedia()->$result : Integer
	var $entité : Object
	
	Case of 
		: (FORM Event.code=On Drag Over)
			// dépot d'un media du Disque Dur?
			$result:=This.glisserDeposer.surGlisserFICHIER()
			Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5039; This.glisserDeposer.paramsMessage)))
			
			If ($result=-1)
				// non, dépot d'un media de la BDD?
				$result:=This.glisserDeposer.surGlisserENTITE([ds.Medias])
				Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5038; This.glisserDeposer.paramsMessage)))
			End if 
			ASSERT(cs.$trace.me.DebugerVariables("état"; Current method name; New object("Événement formulaire"; On Drag Over; "$result"; $result)))
			
		: (FORM Event.code=On Drop)
			If (Form.ActionUtilisateur("[ModificationAutorisée]"))
				$entité:=Form.entité
				// ici, on importe une illustration
				Use (Storage.System.GlisserDéposer)
					Storage.System.GlisserDéposer.numPage:=1
					Storage.System.GlisserDéposer.typeZone:=1
				End use 
				This.glisserDeposer.surDéposerILLUSTRATION($entité)
			End if 
			
		: (FORM Event.code=On Mouse Leave)
			// effacer
			Form.EffacerMessageUtilisateur()
	End case 
	
	
	// ----------------------
	//MARK:FORMevents Page 2
	// ----------------------
	
	
Function _FORM_listeEvenements()
	var $params : Object
	
	Case of 
		: (FORM Event.code=On Load)
			// exécuter
			$params:=New object
			$params.entitéID:=Form.entité.ID
			$params.tag:="lieuEvent"
			$params.formats:=OB Copy(This.session.prefs.Apparence.Formulaire)
			
			This.CréerLaListe(OB Class(This).name; "CréerLaListeDesEvenements"; $params)
			
			Form[This.nomOBJ]:=$params.liste
	End case 
	
	
Function _FORM_listeEvenements_date()
	This._EditerSélection()
	
	
Function _FORM_listeEvenements_Membre1()
	This._EditerSélection()
	
	
Function _FORM_listeEvenements_Membre2()
	This._EditerSélection()
	
	
Function _EditerSélection()
	var $IDentitéCodée : Integer
	
	Case of 
		: (FORM Event.code=On Clicked)
			If (Form[This.nomOBJ+"PositionElementCourant"]#0)
				// typer
				$IDentitéCodée:=Form[This.nomOBJ+"ElementCourant"].IDcodé
				Form.EditerSélection($IDentitéCodée)
			End if 
	End case 
	
	
Function _FORM_trierEvénementsParType()
	This._trierEvénements(1; 0)
	
	
Function _FORM_trierEvénementsParDate()
	This._trierEvénements(5; 1)
	
	
Function _FORM_trierEvénementsParPersonne()
	This._trierEvénements(3; 2; 4; 3)
	
	
Function _FORM_trierEvénementsParCouple()
	This._trierEvénements(4; 3; 3; 2)
	
	
Function _trierEvénements($numCol1 : Integer; $option1 : Integer; $numCol2 : Integer; $option2 : Integer)
	var $sensDeTri1; $sensDeTri2 : Integer
	
	Case of 
		: (FORM Event.code=On Clicked)
			$sensDeTri1:=This._SensDeTri($option1)
			
			If (Count parameters=2)
				If ($sensDeTri1=1)
					LISTBOX SORT COLUMNS(*; "listeEvenements"; $numCol1; >)
				Else 
					LISTBOX SORT COLUMNS(*; "listeEvenements"; $numCol1; <)
				End if 
				
			Else 
				$sensDeTri2:=This._SensDeTri($numCol2-1)
				Case of 
					: (($sensDeTri1=1) & ($sensDeTri2=1))
						LISTBOX SORT COLUMNS(*; "listeEvenements"; $numCol1; >; $numCol2; >)
					: (($sensDeTri1=1) & ($sensDeTri2=0))
						LISTBOX SORT COLUMNS(*; "listeEvenements"; $numCol1; >; $numCol2; <)
					: (($sensDeTri1=0) & ($sensDeTri2=0))
						LISTBOX SORT COLUMNS(*; "listeEvenements"; $numCol1; <; $numCol2; <)
					: (($sensDeTri1=0) & ($sensDeTri2=1))
						LISTBOX SORT COLUMNS(*; "listeEvenements"; $numCol1; <; $numCol2; >)
				End case 
			End if 
	End case 
	
	
Function _SensDeTri($numBit : Integer)->$result : Integer
	// renvoie 'asc' ou 'desc'
	var $clésDeTri : Integer
	
	// renvoyer l'état inverse du bouton $quoi
	$clésDeTri:=This.session.prefs.Session_ClesTri
	$clésDeTri:=$clésDeTri ^| (2^$numBit)
	Use (This.session.prefs)
		This.session.prefs.Session_ClesTri:=$clésDeTri
	End use 
	// renvoie le nouvel état
	$result:=Choose($clésDeTri ?? $numBit; dk descending; dk ascending)
	
	
Function _FORM_mediasEnLien()
	var $i; $j : Integer
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=ds.Paysages.query("lieu = :1"; Form.entité.ID).laZone.query("type = :1"; 2).leMedia
			Form[This.nomOBJ]:=Form[This.nomOBJ].orderBy("dateNum asc")
			
		: (FORM Event.code=On Selection Change)
			// lire la ligne sélectionnée
			LISTBOX GET CELL POSITION(*; This.nomOBJ; $j; $i)  // colonne, ligne
			Case of 
				: ($i=0)
				: ($i>Form[This.nomOBJ].length)
					
				Else 
					// ok, aller à la sélection
					Form.EditerSélection(Form[This.nomOBJ]; Form[This.nomOBJ][$i-1].IDcodé())
			End case 
	End case 
	
	
	// ----------------------
	//MARK:InformationsAutres
	// ----------------------
	
Function _FORM_choixAdmin()
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=New object
			Form[This.nomOBJ].values:=New collection(Localized string("10400"); Localized string("10401"); Localized string("10402"))
			Form[This.nomOBJ].index:=0
			
			Form.titre:=Localized string("5087")
	End case 
	
	
	// ----------------------
	// MARK:Gestion formulaire
	// -----------------------
	
Function AfficherEntité()
	var $sélectionEntités; $params : Object
	
	SET WINDOW TITLE(Localized string("5003")+" - "+Form.entité.Le("Communes").Libellé(New object("Options"; 0x00020000)))
	
	$params:=New object
	Case of 
		: (Form.tousLieux)
			// pour "listeSitesLieux", fixer le point de nav
			$params.itemRef:=Form.entité.leSite.IDcodé()
			$params.index:=Form.entité.indexOf(Form.sélectionCourante)
			$params.Options:=0x00313333
			
		Else 
			// pour la navigation, fixer la sélection d'entités
			$sélectionEntités:=Form.entité.LesLieux()
			Form.nav.FixerSélectionNavigation($sélectionEntités; Form.entité.indexOf($sélectionEntités))
			
			// pour la "listeSitesLieux", fixer la sélection d'entités
			$params.itemRef:=Form.entité.IDcodé()
			$params.index:=Form.entité.indexOf($sélectionEntités)
			$params.Options:=0x00333333
	End case 
	
	OBJECT SET VISIBLE(*; "@ Site"; Form.entité.LesSites().length#0)
	OBJECT SET VISIBLE(*; "@ Lieu"; Form.entité.LesLieux().length#0)
	
	OBJECT SET VISIBLE(*; "illustration"; Records in selection([Medias])#0)
	
	// barre menu "event" : vérifier qu'il y a quelque chose pour le diaporama ou la cartographie
	$params.IDnomMenu:="BM_01-10-0100"
	Form.menu.LireRefMenu($params)
	Form.menu.ValiderBarreMenus($params.refMenu)
	
	This.AfficherLaCarto()
	
	
Function AfficherLaCarto()
	// v7.2 utilisation de OpenLayer ; rappel : pas d'authentification nécessaire : ouvrir l'URL dans le formulaire
	var $params : Object
	var $URL : Text
	var $fichier : 4D.File
	
	// créer les données de la carte
	$params:=New object
	// entité à cartographier (entité réduite, mais de type collection)
	$params.sélection:=New collection(New object("DataClassNom"; Form.entité.getDataClass().getInfo().name; "IDs"; New collection(Form.entité.ID)))
	$params.région:=New collection(New object("DataClassNom"; Form.entité.leSite.getDataClass().getInfo().name; "IDs"; New collection(Form.entité.leSite.ID)))
	// créer le dossier où mettre les fichiers
	$params.cheminRacineHTML:=This.document.GetSessionFolder().folder(Localized string("235")).platformPath
	// dossier de sessions
	$params.SessionID:="CartoEditeur"
	$params.cheminSessionFolder:=Folder($params.cheminRacineHTML; fk platform path).folder($params.SessionID).platformPath
	$params.sousDossierImages:="images"
	// pour les URL de la page Web des sous-dossiers
	$params.dossierCartoURL:=$params.SessionID
	$params.nomFichierMarkers:="dataGP_"+Form.entité.IDunique+".js"
	// formats pour éditeur
	$params.Apparence:=New object("LieuxIconeURL"; "markerIcon.png"; "CodeLangue"; "fr"; "SymbolConjoints"; " & "; "SymbolDateLieu"; " - "; "FormatDate"; 5; "FormatHeure"; 2; "FormatLieu"; 1; "FormatGeoLoc"; 1)
	$params.PopUpOptions:=New object("Lieux"; 0x00040000; "Communes"; 0x00C80000; "Departements"; 0x00C80000; "Regions"; 0x00880000; "Pays"; 0x0000)
	$params.PopUpLiens:=False
	
	// fixer les variables process type www
	This.FixerHTTPvars($params)
	
	// générer les données de la carte
	// données de la class / function à utiliser
	cs.$serveurAPP.me.Executer(cs.LieuxEditeur.name; "CréerDonnéesCarto"; $params)
	// les données sont dans .reqRetour
	// restituer les données
	$params.data:=CoDecBase64_Objet($params.reqRetour.dataB64)
	OB REMOVE($params; "reqRetour")
	
	// installer les ressources carto ici 
	This.carto.InstallerRessources($params.cheminRacineHTML)
	This.carto.InstallerRessourcesAPP()
	// créer les fichiers
	This.carto.InstallerDonnées($params)
	
	// fixer les variables process
	This.RestaurerHTTPvars($params.data.HTTPvars)
	vs4D:="_editer_"  // utile ?
	
	// créer le fichier .shtml
	$fichier:=Folder(fk resources folder).folder("TemplatesPagesWeb").file("cartographieEditeur.shtml")
	$URL:=$params.cheminRacineHTML
	cs._cfct.me.TraiterBalisesFichier($fichier; Folder($URL; fk platform path); New object)
	
	$URL:=$URL+"cartographieEditeur.shtml"
	WA OPEN URL(*; "zoneCartographie"; $URL)
	WA SET PREFERENCE(*; "zoneCartographie"; WA enable Web inspector; This.session.prefs.Session_Etat ?? 6)
	CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "AfficherURL"; Current method name; $URL; New object("nomProcess"; Current process name; "numProcess"; Current process))
	
	
Function CréerDonnéesCarto($params : Object)
	// générer les données de la carte
	// ici on est dans la BDDmère ou le serveur ALV
	This.carto.getCarteData($params)
	// encoder (nécessaire si serveur)
	$params.dataB64:=CoDecBase64_Objet($params.data)
	OB REMOVE($params; "data")
	
	
	// ----------------------
	// MARK:Demande actions
	// -----------------------
	
Function surEvenementFormulaire()
	var $c : Collection
	var $result : Boolean
	var Carto_LatitudeLieu : Text:=""
	var Carto_LongitudeLieu : Text:=""
	
	// menus particuliers Lieux (les paramètres de 'Ajouter A BDD' ne sont pas standards)
	$c:=New collection("3041"; "3042"; "3043"; "3066"; "3067"; "3068")
	This.menu.LireParamètresMenu(Get selected menu item parameter)
	// sinon traiter les events FORM génériques
	
	$result:=True  // event FORM générique
	Case of 
		: (FORM Event.code#On Menu Selected)
		: ($c.indexOf(This.menu.params.commande)>-1)
			// ici on a le nom de la DS qui doit faire l'ajout
			cs._ds.me.Ajouter(This.menu.params.numCommande; Form.entité.Le(This.menu.params.params1); Null)
			$result:=False
			
		: (Get selected menu item parameter="BM_01-10-0104")  // modifier coordonnées géographiques
			WA EXECUTE JAVASCRIPT FUNCTION(*; "zoneCartographie"; "lire_latitude_lieu"; Carto_LatitudeLieu)
			This.entité.latitude:=Num(Carto_LatitudeLieu)  //Num(Remplacer chaîne(Carto_LatitudeLieu; "."; ","))
			WA EXECUTE JAVASCRIPT FUNCTION(*; "zoneCartographie"; "lire_longitude_lieu"; Carto_LongitudeLieu)
			This.entité.longitude:=Num(Carto_LongitudeLieu)  //Num(Remplacer chaîne(Carto_LongitudeLieu; "."; ","))
			WA EXECUTE JAVASCRIPT FUNCTION(*; "zoneCartographie"; "lire_Zoom"; ZoneWeb_Zoom)
			cs._ds.me.Modifier(cdk Modifier; New collection(This.entité); Null)
			$result:=False
	End case 
	
	If ($result)
		Super.surEvenementFormulaire()
	End if

⇧ [class]PersonnesEditeur - 20/05/2026 09:12:35

      property IDunionCourante : Integer
property RngEnfant : Integer
property arbre : cs.xARB.$arbre
property nomTacheAsc : Text:="tacheAscendance"
property nomTacheDesc : Text:="tacheDescendance"

Class extends $editeur

Class constructor()
	// construction commune
	Super()
	
	// initialisation particulière à cette classe
	This.IDunionCourante:=-1
	
	
Function getDataClassInfos()->$result : Object
	$result:=Super.getDataClassInfos("Personnes")
	
	
	// ----------------------
	// MARK:Sélections 
	// -----------------------
	
Function CréerLaListeDesEventsPerso($params : Object)
	// ici on est toujours sur BDDmère ou ServeurAPP
	var $selection : cs.EventsSelection
	
	$selection:=ds.Personnes.get($params.entitéID).LesEvenementsPersonnels().orderBy("type asc")
	// créer la collection LB des témoinages de $sélection
	$selection.CréerListBoxPerso($params)
	// le résultat est dans $params
	
	
Function CréerLaListeDesUnions($params : Object)
	// ici on est toujours sur BDDmère ou ServeurAPP
	var $selection : cs.UnionsSelection
	
	$selection:=ds.Personnes.get($params.entitéID).LesUnions()
	// créer la collection LB des events de $sélection
	$selection.CréerListBoxUnions($params)
	// le résultat est dans $params
	
	
Function CréerHiérarchiePersonne($params : Object)
	// ici on est toujours sur BDDmère ou ServeurAPP
	var $selection : Object
	
	// créer la sélection
	$selection:=ds.Personnes.query("ID = :1"; $params.entitéID)
	$selection.CréerHiérarchie($params)
	// le résultat est dans $params
	
	
Function CréerLaListeDesDocuments($params : Object)
	// ici on est toujours sur BDDmère ou ServeurAPP
	var $selection : cs.PersonnesSelection
	
	$selection:=ds.Personnes.query("ID = :1"; $params.entitéID)
	// créer la collection LB des documents personnels de $sélection
	$selection.CréerListBoxMedia($params)
	// le résultat est dans $params
	
	
Function CréerLaListeDesTémoinages($params : Object)
	// ici on est toujours sur BDDmère ou ServeurAPP
	var $selection : cs.RelationsSelection
	
	$selection:=ds.Personnes.query("ID = :1"; $params.entitéID).lesRelations
	// créer la collection LB des témoinages de $sélection
	$selection.CréerListBoxEvents($params)
	// le résultat est dans $params
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	
	ASSERT(cs.$trace.me.DebugerEventForm(Current method name; "EventForm"; New object("numEvent"; FORM Event.code; "numTable"; Table(Current form table))))
	
	// traitements génériques
	Super.surEvenementFormulaire()
	
	// traitements particuliers
	Case of 
		: (FORM Event.code=On Load)
			cs.$processData.me.FixerTache(Current process name; New object("nomTache"; This.nomTacheAsc; "activerCurseurHoraire"; True))
			cs.$processData.me.FixerTache(Current process name; New object("nomTache"; This.nomTacheDesc; "activerCurseurHoraire"; True))
			
			// charger les objets
			This.onEndLoad()
			
		: (FORM Event.code=On Activate)
			This.FixerVisibilitéPalettes(True)
			
		: (FORM Event.code=On Timer)
			cs.$processData.me.AfficherProgressionTache()
			
		: (FORM Event.code=On Data Change)
			// rappel : si un objet a une function, cet event n'est plus appelé au niveau du FORM : le mettre dans la function
			cs._ds.me.Modifier(cdk Modifier; New collection(Form.entité; Form.entité.lePatronyme; Form.PrivateData); Null)
			
		: (FORM Event.code=On Unload)
			This.onEndUnLoad()
			
		: (FORM Event.code=On Clicked)
			Form.zoneSensible.ActionZS()
			
	End case 
	
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection("choix")
	$c.combine(["listeIllustrations"; "listeEventsPerso"; "Père"; "Mère"; "listeEventsFam"; "listeTemoignages"; "listeDocuments"])
	$c.combine(["infoAutreOrphelin"; "infoSexe"; "infoCommentaire_prive"])
	Super.onEndEventForm($c)
	
	// autre info
	Form.titre:=cs._cfct.me.LireLocatedSTR(5005; New object("param_1"; Form.entité.Libellé()))
	
	
Function onEndUnLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection("choix")
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:FORMevents Page fond
	// ----------------------
	
Function _FORM_choix()
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=New object
			Form[This.nomOBJ].values:=New collection(Localized string("10100"); Localized string("10101"); Localized string("10102"))
			Form[This.nomOBJ].index:=This.indexPageForm
			
			Form.Pages:=New collection(1; 2; 3)
			FORM GOTO PAGE(Form.Pages[This.indexPageForm])
			This.AfficherLaPage()
			
		: (FORM Event.code=On Clicked)
			// en réalité, pas utile. Il existe une action4D gotopage
			Form.indexPageForm:=Form[This.nomOBJ].index
			FORM GOTO PAGE(Form.Pages[This.indexPageForm])
			This.AfficherLaPage()
			
		: (FORM Event.code=On Unload)
			Form.indexPageForm:=Form[This.nomOBJ].index
	End case 
	
	
Function AfficherLaPage()
	var $params : Object:=New object
	
	Case of 
		: (Form.indexPageForm=1)
			This._FORM_arbre()
			
		: (Form.indexPageForm=2)
			$params.tache:=This.registreTaches.Inscrire(New object("nomProcess"; Current process name; "nomTache"; This.nomTacheDesc; "numProcessAppelant"; Current process))
			This.CreerDescendance($params)
			
			$params.tache:=This.registreTaches.Inscrire(New object("nomProcess"; Current process name; "nomTache"; This.nomTacheAsc; "numProcessAppelant"; Current process))
			This.CreerAscendance($params)
	End case 
	
	
Function _FORM_actionFormulaire()->$result : Integer
	$result:=Super.surActionFormulaire([ds.Personnes; ds.Communes; ds.Medias])
	
	
Function _FORM_ToucheF2()
	// afficher le conjoint sélectionné
	var $itemRef : Integer
	
	// refaire la même chose que "Événement formulaire=Sur clic"
	$itemRef:=Form["listeEventsFamElementCourant"].itemRef
	Case of 
		: (FORM Event.code=On Clicked)
			Case of 
				: ($itemRef=0)
				: (cs._cfct.me.estIDcodeDe($itemRef; 128))
					// fixer le rang de l'union suivante
					Form.indexUnion:=(($itemRef & 0x1F000000) >> 24)-1
					// fixer l'IDunion
					Form.IDunionCourante:=Form.entité.LesUnions()[Form.indexUnion].ID
					Form.AfficherLesConjoints()
			End case 
	End case 
	
	
Function _FORM_ToucheOptionF2()
	Case of 
		: (FORM Event.code=On Clicked)
			Form.AfficherUnionSuivante()
	End case 
	
	
	// ----------------------
	//MARK:FORMevents Page famille
	// ----------------------
	
Function _FORM_listeIllustrations()
	// à la demande de Guillaume :
	var $params : Object:=New object("cléTri"; "dateNum desc, heure desc")
	Super._FORM_listeIllustrations($params)
	
	
Function _FORM_listeIllustrations_photo()
	Super._FORM_listeIllustrations_photo()
	
	
Function _FORM_nom()
	Case of 
		: (FORM Event.code=On After Keystroke)
			Form.entité.nom:=Uppercase(Get edited text; *)
			
		Else 
			// traitement générique
			This._FORM()
	End case 
	
	
Function _FORM_patronyme()
	Case of 
		: (FORM Event.code=On After Keystroke)
			Form[This.nomOBJ]:=Uppercase(Get edited text; *)
			
		Else 
			// traitement générique
			This._FORM()
	End case 
	
	
Function _FORM_prenom()
	var $dataTexte : Text
	
	Case of 
		: (FORM Event.code=On After Keystroke)
			// mettre la première lettre en majuscule
			$dataTexte:=Get edited text
			If ($dataTexte#"")
				$dataTexte[[1]]:=Uppercase(Get edited text[[1]]; *)
				Form.entité.prenom:=$dataTexte
			End if 
			
		Else 
			// traitement générique
			This._FORM()
	End case 
	
	
Function _FORM_listeEventsPerso()
	var $params; $data : Object
	
	Case of 
		: (FORM Event.code=On Load)
			// exécuter
			$params:=New object
			$params.entitéID:=Form.entité.ID
			$params.tag:="EventPerso"
			$params.styleEvent:="'font-weight:bold;font-size:14pt'"
			This.CréerLaListe(OB Class(This).name; "CréerLaListeDesEventsPerso"; $params)
			
			For each ($data; $params.liste)
				$data["iconeEventPerso"]:=CoDecBase64_Objet($data["pictEventPerso"])
				$data["typeEventPerso"]:=Replace string($data["typeEventPerso"]; "codeColorScheme"; Storage.System.schemaCouleurPolice)
			End for each 
			
			Form[This.nomOBJ]:=$params.liste
			OBJECT SET VISIBLE(*; This.nomOBJ; $params.liste.length>0)
	End case 
	
	
Function _FORM_listeEventsPerso_EventPerso()
	var $sélection : cs.EventsSelection
	
	Case of 
		: (Not(FORM Event.code=On Clicked))
		: (Form[This.nomOBJ+"PositionElementCourant"]=0)
		Else 
			$sélection:=ds.Personnes.get(Form.entité.ID).LesEvenementsPersonnels().orderBy("type asc")
			Form.EditerSélection($sélection; Form[This.nomOBJ+"PositionElementCourant"]-1)
	End case 
	
	
Function _FORM_navPreviousItem()
	Case of 
		: (FORM Event.code=On Clicked)
			This.AfficherLesParents()
	End case 
	
	
Function _FORM_navNextItem()
	Case of 
		: (FORM Event.code=On Clicked)
			This.RngEnfant:=1
			This.AfficherLesEnfants()
	End case 
	
	
Function _FORM_Père()->$result : Integer
	var $sélection; $membre; $params : Object
	var $entité : cs.Personnes
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=""
			If (Form.entité.LesParents()#Null)
				$membre:=Form.entité.LesParents(agk Père)
				If ($membre#Null)
					Form[This.nomOBJ]:=$membre.Libellé()
				End if 
			End if 
			
			// menu "ajout père"
			$params:=New object("IDnomMenu"; "BM_01-01-0101")
			This.menu.LireRefMenu($params)
			If (Form[This.nomOBJ]="")
				ENABLE MENU ITEM($params.refMenu; $params.numLigne)
			Else 
				DISABLE MENU ITEM($params.refMenu; $params.numLigne)
			End if 
			
			
		: (FORM Event.code=On Clicked)
			// créer une sélection
			$sélection:=Form.entité.LesParents(agk Tout)
			// relancer l'affichage du formulaire
			Form.nav.AfficherNouvelleSélection($sélection; 0)
			
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserENTITE([ds.Personnes])
			
			If ($result=0)
				If (Form[This.nomOBJ]="")
					// on peut ajouter le père
					Form.AfficherMessageUtilisateur(New object("libelle"; cs._cfct.me.LireLocatedSTR(5018; This.glisserDeposer.paramsMessage)))
					
				Else 
					// il y a déjà un père ; refuser le glisser
					Form.AfficherMessageUtilisateur(New object("libelle"; cs._cfct.me.LireLocatedSTR(5016; This.glisserDeposer.paramsMessage)))
					$result:=-1
				End if 
			End if 
			
		: (FORM Event.code=On Drop)
			// le déposé devient le père de l'entité courante
			If (Form.ActionUtilisateur("[ModificationAutorisée]"))
				$entité:=cs._ds.me.EntitéAvecIDcodé(Storage.System.GlisserDéposer.refItem)
				cs._ds.me.Ajouter(agk Père; Form.entité; $entité)
			End if 
	End case 
	
	
Function _FORM_Mère()->$result : Integer
	var $sélection; $membre; $params : Object
	var $entité : cs.Personnes
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=""
			If (Form.entité.LesParents()#Null)
				$membre:=Form.entité.LesParents(agk Mère)
				If ($membre#Null)
					Form[This.nomOBJ]:=$membre.Libellé()
				End if 
			End if 
			
			// menu "ajout mère"
			$params:=New object("IDnomMenu"; "BM_01-01-0102")
			This.menu.LireRefMenu($params)
			If (Form[This.nomOBJ]="")
				ENABLE MENU ITEM($params.refMenu; $params.numLigne)
			Else 
				DISABLE MENU ITEM($params.refMenu; $params.numLigne)
			End if 
			
			
		: (FORM Event.code=On Clicked)
			// créer une sélection
			$sélection:=Form.entité.LesParents(agk Tout)
			// relancer l'affichage du formulaire (attention il peut n'y avoir qu'un parent)
			Form.nav.AfficherNouvelleSélection($sélection; 1*Num($sélection.length=2))
			
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserENTITE([ds.Personnes])
			
			If ($result=0)
				If (Form[This.nomOBJ]="")
					// on peut ajouter la mère
					Form.AfficherMessageUtilisateur(New object("libelle"; cs._cfct.me.LireLocatedSTR(5019; This.glisserDeposer.paramsMessage)))
					
				Else 
					// il y a déjà une mère ; refuser le glisser
					Form.AfficherMessageUtilisateur(New object("libelle"; cs._cfct.me.LireLocatedSTR(5017; This.glisserDeposer.paramsMessage)))
					$result:=-1
				End if 
			End if 
			
		: (FORM Event.code=On Drop)
			// le déposé devient la mère de l'entité courante
			If (Form.ActionUtilisateur("[ModificationAutorisée]"))
				$entité:=cs._ds.me.EntitéAvecIDcodé(Storage.System.GlisserDéposer.refItem)
				cs._ds.me.Ajouter(agk Mère; Form.entité; $entité)
			End if 
	End case 
	
	
Function _FORM_listeEventsFam()->$result : Integer
	var $params; $data; $membre : Object
	var $itemRef : Integer
	
	Case of 
		: (FORM Event.code=On Load)
			Case of 
				: (Not(Form.entité.LesUnions()=Null))
					// exécuter
					$params:=New object
					$params.entitéID:=Form.entité.ID
					$params.tag:="EventFam"
					$params.FormatPersonne:=0x0007
					$params.FormatConjoint:=0x0003
					$params.FormatEnfant:=0x0006
					$params.FormatLieu:=0x00010000
					$params.styleEvent:="'font-style: italic;font-size:14pt'"
					$params.stylePersonne:="'font-weight:bold;font-size:14pt'"
					This.CréerLaListe(OB Class(This).name; "CréerLaListeDesUnions"; $params)
					
					For each ($data; $params.liste)
						// peut ne pas exister
						$data["iconeEventFam"]:=CoDecBase64_Objet($data["pictEventFam"])
						If (OB Is defined($data; "typeEventFam"))
							$data["typeEventFam"]:=Replace string($data["typeEventFam"]; "codeColorScheme"; Storage.System.schemaCouleurPolice)
						End if 
					End for each 
					Form[This.nomOBJ]:=$params.liste
					
				: (Form.entité.célibataire)
					$params:=New object
					$params.typeEventFam:=Localized string("1003")
					$params.EventFam:=Localized string("1003")
					$params.itemRef:=CodeEnreg(0; [Table(->[Events])])
					Form[This.nomOBJ]:=[$params]
					
				Else 
					// raz
					Form[This.nomOBJ]:=New collection
			End case 
			
			// Rappel : quand il y a des remariages et qu'on navigue entre conjoints, IDunionCourante définit l'union en cours
			// Rappel : indexUnion est l'index de l'union courante dans la sélection d'unions courante (pas le même si des remariages existent)
			// fixer l'index de l'union à afficher (un index de sélection entités commence à 0)
			$itemRef:=-1  // itemRef cliqué
			Case of 
				: (Form.entité.LesUnions()=Null)
					Form.indexUnion:=-1
					Form.IDunionCourante:=-1
					//: (OB Est vide(Form.InformationsEntité.LesConjoints)) // v8.2.2 utilie?
					// pas de conjoint, filtrer
					
				: ((Form.IDunionCourante<0) | (Form.entité.LesUnions().query("ID = :1"; Form.IDunionCourante).length=0))
					// init de la navigation : fixer la première union
					Form.indexUnion:=0
					Form.IDunionCourante:=Form.entité.LesUnions()[Form.indexUnion].ID
					// attention le conjoint n'existe pas forcément
					$membre:=Form.entité.LesUnions()[Form.indexUnion].LeConjoint(Form.entité)
					If ($membre#Null)
						$itemRef:=cs._cfct.me.CoderID($membre.ID; (128+Form.indexUnion+1))
					End if 
					
				: (Form.indexUnion<0)
					// ici IDunionCourante n'a pas changé, mais il peut correspondre à un indexUnion différent (cf remariage)
					// retrouver indexUnion
					For each ($membre; Form.entité.LesUnions())
						If ($membre.ID=Form.IDunionCourante)
							Form.indexUnion:=$membre.indexOf(Form.entité.LesUnions())
						End if 
					End for each 
					$itemRef:=cs._cfct.me.CoderID(Form.entité.LesUnions()[Form.indexUnion].LeConjoint(Form.entité).ID; (128+Form.indexUnion+1))
					
				Else 
					// l'index union a peut-être changé : fixer le ID union
					Form.IDunionCourante:=Form.entité.LesUnions()[Form.indexUnion].ID
					$itemRef:=cs._cfct.me.CoderID(Form.entité.LesUnions()[Form.indexUnion].LeConjoint(Form.entité).ID; (128+Form.indexUnion+1))
			End case 
			
			This.SélectionnerLeConjoint($itemRef)
			
			// menu "event fam"
			$params:=New object("IDnomMenu"; "BM_01-01-0202")
			This.menu.LireRefMenu($params)
			If (Form.entité.LesUnions()=Null)
				DISABLE MENU ITEM($params.refMenu; $params.numLigne)  // interdire ajouter d'event familial
			Else 
				ENABLE MENU ITEM($params.refMenu; $params.numLigne)  // il y a des unions
			End if 
			
			// barre menu "event" : vérifier qu'il y a quelque chose pour le diaporama ou la cartographie
			This.menu.ValiderBarreMenus($params.refMenu)
			
			// rappel : les LB n'ont pas de propriétés "Aide". Un tip par colonne !
		: (FORM Event.code=On Mouse Leave)
			OBJECT SET HELP TIP(*; This.nomOBJ; "")
	End case 
	
	
Function _FORM_listeEventsFam_EventFam()->$result : Integer
	var $itemRef; $draggedVariable : Integer
	var $entité; $qui : Object
	
	Case of 
		: (FORM Event.code=On Clicked)
			If (Not(Form[This.nomOBJ+"ElementCourant"]=Null))
				$itemRef:=Form[This.nomOBJ+"ElementCourant"].itemRef
				
				Case of 
					: ($itemRef=0)
						Form.indexUnion:=-1
					: (($itemRef & 0x00FFFFFF)=0)
						Form.indexUnion:=-1
						
					: (cs._cfct.me.estIDcodeDeClasses($itemRef; [ds.Events]))
						This.EditerSélection(Form.entité.LesEvenementsFamiliaux(); $itemRef)
						
					: (cs._cfct.me.estIDcodeDeClasses($itemRef; [ds.Lieux]))
						// trouver la sélection des lieux du site de $itemRef
						$entité:=ds.Lieux.get($itemRef & 0x00FFFFFF).leSite.lesLieux.orderBy("nom")
						This.EditerSélection($entité; $itemRef)
						
					: (cs._cfct.me.estIDcodeDe($itemRef; 128))
						// fixer le rang de l'union suivante
						Form.indexUnion:=(($itemRef & 0x1F000000) >> 24)-1
						// fixer l'IDunion
						Form.IDunionCourante:=Form.entité.LesUnions()[Form.indexUnion].ID
						Form.AfficherLesConjoints()
						
					: (cs._cfct.me.estIDcodeDe($itemRef; 160))
						Form.IDunionCourante:=$itemRef & 0x00FFFFFF
						Form.RngEnfant:=($itemRef >> 24)-160
						Form.AfficherLesEnfants()
				End case 
			End if 
			
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserENTITE([ds.Personnes])
			ASSERT(cs.$trace.me.DebugerVariables("état"; Current method name; New object("Événement formulaire"; On Drag Over; "$result"; $result; "$itemRef"; $itemRef)))
			
			This.glisserDeposer.FixerDepotSurLB("listeEventsFam")
			$itemRef:=Storage.System.GlisserDéposer.depot
			Case of 
				: ($result=-1)
					// refus
				: ($itemRef=-1)
					// dépose hors élément (sur la liste) : ajouter une union
					Form.AfficherMessageUtilisateur(New object("libelle"; cs._cfct.me.LireLocatedSTR(5020; This.glisserDeposer.paramsMessage)))
					
				: (cs._cfct.me.estIDcodeDe($itemRef; 128))
					// dépose sur un conjoint : ajouter un enfant
					// mémoriser pour son utilisation par la messagerie Utilisateur
					This.glisserDeposer.paramsMessage.param_2:=ds.Unions.get(Form.entité.LesUnions()[(($itemRef & 0x1F000000) >> 24)-1].ID).Libellé(New object("Options"; 3))
					Form.AfficherMessageUtilisateur(New object("libelle"; cs._cfct.me.LireLocatedSTR(5021; This.glisserDeposer.paramsMessage)))
					
				Else 
					// effacer le message
					Form.EffacerMessageUtilisateur()
			End case 
			
		: (FORM Event.code=On Drop)
			$result:=Num(Form.ActionUtilisateur("[ModificationAutorisée]"))
			// qu'a-t-on déposé?
			$draggedVariable:=Storage.System.GlisserDéposer.refItem
			// sur quoi dépose-t-on?
			$itemRef:=Storage.System.GlisserDéposer.depot
			
			Case of 
				: ($result=-1)
				: ($itemRef=0)
					// cas où dépose sur un enfant, filtrer
				: ($itemRef=-1)
					// dépose hors élément (sur la liste) : ajouter une union
					If ($result=1)
						$entité:=cs._ds.me.EntitéAvecIDcodé($draggedVariable)
						cs._ds.me.Ajouter(agk Conjoint; Form.entité; $entité)
					End if 
					
				: (cs._cfct.me.estIDcodeDe($itemRef; 128))
					// dépose sur un conjoint : ajouter un enfant
					If ($result=1)
						// (recopie de ce qui est fait dans 'Ajouter a DataStore)'
						If ((Form.entité.LesUnions()=Null) | (Form.indexUnion=-1))
							// il n'y a pas d'unions, ou aucune union sélectionnée
							$entité:=Form.entité
						Else 
							// utiliser l'union sélectionnée
							$entité:=Form.entité.LesUnions()[Form.indexUnion]
						End if 
						$qui:=cs._ds.me.EntitéAvecIDcodé($draggedVariable)
						cs._ds.me.Ajouter(agk Enfant; $entité; $qui)
					End if 
			End case 
			
		: (FORM Event.code=On Mouse Move)
			OBJECT SET HELP TIP(*; This.nomOBJ; Localized string("524"))
	End case 
	
	
Function _FORM_listeTemoignages()->$result : Integer
	var $params : Object
	
	Case of 
		: (FORM Event.code=On Load)
			// exécuter
			$params:=New object
			$params.entitéID:=Form.entité.ID
			$params.tag:=""
			This.CréerLaListe(OB Class(This).name; "CréerLaListeDesTémoinages"; $params)
			
			Form[This.nomOBJ]:=$params.liste
			OBJECT SET VISIBLE(*; This.nomOBJ; $params.liste.length>0)
	End case 
	
	
Function _FORM_listeTemoignages_temoignage()->$result : Integer
	var $IDentitéCodée : Integer
	
	Case of 
		: (FORM Event.code=On Clicked)
			If (Form[This.nomOBJ+"PositionElementCourant"]#0)
				// typer
				$IDentitéCodée:=Form[This.nomOBJ+"ElementCourant"].itemRef
				Form.EditerSélection($IDentitéCodée)
			End if 
	End case 
	
	
Function _FORM_listeDocuments()->$result : Integer
	var $data; $params : Object
	
	Case of 
		: (FORM Event.code=On Load)
			// données de la class / function à utiliser
			$params:=New object
			$params.entitéID:=Form.entité.ID
			$params.typeZone:=3
			$params.IDgroupe:=This.session.user.IDfamille
			$params.attribut:="icone"
			
			// exécuter
			This.CréerLaListe(OB Class(This).name; "CréerLaListeDesDocuments"; $params)
			
			For each ($data; $params.liste)
				$data.icone:=CoDecBase64_Objet($data.pict)
			End for each 
			Form[This.nomOBJ]:=$params.liste
			
		: (FORM Event.code=On Drag Over)
			// dépot d'un media du Disque Dur?
			$result:=This.glisserDeposer.surGlisserFICHIER()
			
			Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5065; This.glisserDeposer.paramsMessage)))
			If ($result=-1)
				// non, dépot d'un media de la BDD?
				$result:=This.glisserDeposer.surGlisserENTITE([ds.Medias])
				Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5066; This.glisserDeposer.paramsMessage)))
			End if 
	End case 
	
	
Function _FORM_listeDocuments_document()
	//rappel : l'event drop n'existe pas sur la LB ; on utilise une colonne
	var $sélection : cs.MediasSelection
	var $entité : Object
	
	Case of 
		: (FORM Event.code=On Clicked)
			If (Form[This.nomOBJ+"PositionElementCourant"]#0)
				$sélection:=ds.Personnes.query("ID = :1"; Form.entité.ID).LesMedias(New object("typeZone"; 3; "IDgroupe"; This.session.user.IDfamille))
				Form.EditerSélection($sélection; Form[This.nomOBJ+"PositionElementCourant"]-1)
			End if 
			
		: (FORM Event.code=On Drop)
			If (Form.ActionUtilisateur("[ModificationAutorisée]"))
				$entité:=Form.entité
				// ici, on importe un document
				Use (Storage.System.GlisserDéposer)
					Storage.System.GlisserDéposer.numPage:=1
					Storage.System.GlisserDéposer.typeZone:=3
				End use 
				This.glisserDeposer.surDéposerILLUSTRATION($entité)
			End if 
	End case 
	
	
Function _FORM_ajoutMedia()->$result : Integer
	var $entité : Object
	
	Case of 
		: (FORM Event.code=On Drag Over)
			// dépot d'un media du Disque Dur?
			$result:=This.glisserDeposer.surGlisserFICHIER()
			Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5023; This.glisserDeposer.paramsMessage)))
			
			If ($result=-1)
				// non, dépot d'un media de la BDD?
				$result:=This.glisserDeposer.surGlisserENTITE([ds.Medias])
				Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5022; This.glisserDeposer.paramsMessage)))
			End if 
			ASSERT(cs.$trace.me.DebugerVariables("état"; Current method name; New object("Événement formulaire"; On Drag Over; "$result"; $result)))
			
		: (FORM Event.code=On Drop)
			If (Form.ActionUtilisateur("[ModificationAutorisée]"))
				$entité:=Form.entité
				// ici, on importe une illustration
				Use (Storage.System.GlisserDéposer)
					Storage.System.GlisserDéposer.numPage:=1
					Storage.System.GlisserDéposer.typeZone:=1
				End use 
				This.glisserDeposer.surDéposerILLUSTRATION($entité)
			End if 
			
		: (FORM Event.code=On Mouse Leave)
			// effacer
			Form.EffacerMessageUtilisateur()
	End case 
	
	
	// ----------------------
	//MARK:FORMevents Page arbre
	// ----------------------
	
Function _FORM_arbre()
	var $paramsArbre : Object
	
	Case of 
		: (Not((FORM Event.code=On Load) | (FORM Event.code=On Clicked)))
		: (Form.indexPageForm=1)
			
			Use (Storage.System.Navigation.ZS)
				Storage.System.Navigation.ZS.ZoneSurvolée:=-1
			End use 
			// instancer le sous formulaire
			Form.paramsArbre:=New object
			$paramsArbre:=Form.paramsArbre
			// rappel IMPORTANT : $paramsArbre va fixer Form du formulaire, qui fixe la variable "Form.paramsArbre" associée au sous formulaire "AffichageArbre"
			
			// fixer le ID user (pour le chemin de la BDD_AG)
			$paramsArbre.LogIn:=This.session.user.LogIn
			
			// fixer les paramètres
			// utiliser l'enregistrement courant de [personnes]
			$paramsArbre.IDpersonne:=This.entité.IDcodé()
			// user paramètres
			$paramsArbre.NmaxAscendance:=This.session.prefs.Apparence.AG.Mode_10611.NmaxAscendance
			$paramsArbre.NmaxDescendance:=This.session.prefs.Apparence.AG.Mode_10611.NmaxDescendance
			$paramsArbre.Modele:=This.session.prefs.Apparence.AG.Mode_10611.Modele
			// gérer le mode "light" / "dark" du système
			$paramsArbre.Modele:=Replace string($paramsArbre.Modele; ".xml"; " "+Storage.System.schemaCouleur+".xml")
			$paramsArbre.FormatImage:=Scaled to fit prop centered
			$paramsArbre.Session_Etat:=This.session.prefs.Session_Etat
			// données arbre
			$paramsArbre.IDarbre:=This.entité.ID
			$paramsArbre.nomBDD:="Navigation"
			// paramètres de construction
			$paramsArbre.functionID:=cagk Construire
			$paramsArbre.Options:=1
			$paramsArbre.optionsMsg:=[msgk_event]
			
			This.document.Créer(Créer un dossier ALV; This.document.GetSessionFolder().path; New collection("debug"; "AG Edit"))
			$paramsArbre.CheminDossierExport:=This.document.dossier.platformPath
			
			$paramsArbre.EtatProcessus:=New object
			$paramsArbre.EtatProcessus.SaisieAutorisée:=False
			$paramsArbre.EtatProcessus.Params:=This.session.prefs.Apparence.AG.ChoixDebug*Num(This.session.prefs.Session_Etat ?? 6)
			
			// debug
			//$paramsArbre.EtatProcessus.Params:=$paramsArbre.EtatProcessus.Params ?+ 25
			
			// la tache associée (ne semble pas servir)
			$paramsArbre.tache:=This.registreTaches.Inscrire(New object("nomProcess"; Current process name; "nomTache"; "EditerArbre"; "numProcessAppelant"; Current process))
			
			//fixer le retour
			$paramsArbre.nomProcessAppelant:=Current process name
			$paramsArbre.CallBack:="AfficherArbre"
			
			// c'est parti
			cs.$serveurAPP.me.Executer(cs.xARB.$arbre.name; "Imager_AG"; $paramsArbre; "xARB")
	End case 
	
	
	// events générés par le sous formulaire du composant xARB
	
Function onSurVolElement()
	// on survole qque chose ?
	// utiliser les paramètres du sous formulaire
	This.zoneSensible.SurvolZSarbre(This.arbre)
	
	// gérer le curseur en fonction des ZS et des touches clavier
	This.SurvolZSimage()
	
	
	// ----------------------
	//MARK:FORMevents Page Xcendance
	// ----------------------
	// se remplit sur activation de la page
	
Function _FORM_listeDescendance($params : Object)
	var $item; $itemRef : Integer
	
	Case of 
		: (FORM Event.code=On Double Clicked)
			$item:=Selected list items(*; This.nomOBJ; *)
			$itemRef:=0
			
			Case of 
				: ($item=0)
				: (($item & 0x00FFFFFF)=0)
					
				: (ds.Events.estMonID($item))
					$itemRef:=$item
					
				: (cs._cfct.me.estIDcodeDe($item; 128))
					$itemRef:=ds.Personnes.CoderID($item & 0x000FFFFF)
					
				: (cs._cfct.me.estIDcodeDe($item; 160))
					// chercher l'enfant de rang $itemRef s de l'union $itemRef
					$item:=ds.Unions.get($item).LesEnfants()[(($item & 0x1F000000) >> 24)-1].ID
					$itemRef:=ds.Personnes.CoderID($item)
			End case 
			
			If ($itemRef#0)
				Form.EditerSélection($itemRef; 0)
			End if 
			
		: (Not((FORM Event.code=On Load)))
		: (Form.indexPageForm=2)
			This.CreerDescendance($params)
	End case 
	
	
Function _FORM_listeAscendance($params : Object)
	var $item; $itemRef : Integer
	
	Case of 
		: (FORM Event.code=On Double Clicked)
			$item:=Selected list items(*; This.nomOBJ; *)
			$itemRef:=0
			
			Case of 
				: ($item=0)
				: (($item & 0x00FFFFFF)=0)
					
				: (ds.Events.estMonID($item))
					$itemRef:=$item
					
				: ((cs._cfct.me.estIDcodeDe($item; 145)) | (cs._cfct.me.estIDcodeDe($item; 146)))
					// transcodé $itemRef pour lancer correctement la navigation
					// chercher le membre 14x de l'union $itemRef
					$item:=ds.Unions.get($item & 0x00FFFFFF)._lesMembres(agk Tout)[($item >> 24)-145].ID
					$itemRef:=ds.Personnes.CoderID($item)
			End case 
			
			If ($itemRef#0)
				Form.EditerSélection($itemRef; 0)
			End if 
			
		: (Not((FORM Event.code=On Load)))
		: (Form.indexPageForm=2)
			This.CreerAscendance($params)
	End case 
	
	
Function CreerDescendance($params : Object)
	// créer l'ascendance avec : biodata, union, conjoint, unionData
	
	$params.nomLH:="listeAscendance"
	$params.Options:=0x40100D3F
	This.AfficherXcendance($params)
	OBJECT SET VISIBLE(*; $params.nomLH; False)
	
	
Function CreerAscendance($params : Object)
	// créer la descendance avec : biodata, union, conjoint, unionData
	
	$params.nomLH:="listeDescendance"
	$params.Options:=0xC0100D3F
	This.AfficherXcendance($params)
	OBJECT SET VISIBLE(*; $params.nomLH; False)
	
	
Function AfficherXcendance($params : Object)
	// dans un process externe
	var $data : Object
	var $numProc : Integer
	var $nomProc : Text
	
	// compléter les params
	$params.numGénérationMax:=20
	$params.génération:=0
	$params.FormatPersonne:=0x0007
	$params.FormatParent:=0x0007
	$params.FormatConjoint:=0x0027
	$params.FormatEnfant:=0x0007
	$params.FormatEvent:=0x00100D00  // avec lieu
	$params.FormatLieu:=0x00010200
	$params.FormatDate:=This.session.prefs.Apparence.Formulaire.FormatDate
	
	CLEAR LIST(Get pointer($params.nomLH)->)
	
	$data:=New object
	$data.className:=OB Class(This).name
	$data.functionID:="CréerHiérarchiePersonne"
	$params.entitéID:=Form.entité.ID
	// exécuter sur le serveur
	This.CréerHiérarchie($data; $params)
	
	// créer la LH sur le client
	$params.déployée:=True
	// pour le retour, exécuter :
	$params.nomProcessAppelant:=Current process name
	$params.CallBack:="getListeHiérarchique"
	
	$nomProc:="$ALV_process_"+$params.nomLH
	This.process.TuerAvecNom($nomProc)
	
	$numProc:=New process(Formula(Créer Liste Hiérarchique).source; 0; $nomProc; $params)
	
	
Function getListeHiérarchique($params : Object)
	var $ptr : Pointer
	
	$ptr:=Get pointer($params.nomLH)
	// un process externe a renvoyé une sélection : l'éditer
	// afficher la liste triée
	$ptr->:=$params.LH
	OBJECT SET VISIBLE(*; $params.nomLH; True)
	
	
	// ----------------------
	//MARK:InformationsAutres
	// ----------------------
	
Function _FORM_infoOrphelin()
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=(Form.entité.parents=0)
			
		: (FORM Event.code=On Clicked)
			Form.entité.parents:=0
	End case 
	
	OBJECT SET ENABLED(*; This.nomOBJ; Not(Form[This.nomOBJ]))
	
	
Function _FORM_infoSexe()
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=cs._rsc.me.image(15011+Num(Form.entité.sexe))
			
		: (FORM Event.code=On Clicked)
			Form.entité.sexe:=Not(Form.entité.sexe)
			Form[This.nomOBJ]:=cs._rsc.me.image(15011+Num(Form.entité.sexe))
	End case 
	
	
Function _FORM_infoCommentaire_prive()
	
	Case of 
		: (FORM Event.code=On Load)
			// commentaire à moi seul
			OBJECT SET VISIBLE(*; This.nomOBJ; This.session.user.estMembreDe_SaisieComplementaire | (This.session.prefs.Session_Etat ?? 6))
	End case 
	
	
Function _FORM_btnValider()
	Case of 
		: (FORM Event.code=On Clicked)
			cs._ds.me.Modifier(cdk Modifier; [Form.entité]; Null)
	End case 
	
	
Function _FORM_btnAnnuler()
	Case of 
		: (FORM Event.code=On Clicked)
			Form.entité.reload()
	End case 
	
	
	// ----------------------
	// MARK:Gestion formulaire
	// -----------------------
	
Function Titrer()
	SET WINDOW TITLE(Localized string("5001")+Form.entité.Libellé())
	
	
Function AfficherEntité()
	// mise à jour du formulaire ouvert
	var $dateMariageParent; $dateNaissance : Date
	var $commande : Text
	var $sélectionEntités : Object
	
	// ici Form contient les informations de la personne à afficher
	
	// *** page 1 : données techniques
	This.Titrer()
	
	// fixer la légimité
	CLEAR VARIABLE($dateMariageParent)
	CLEAR VARIABLE($dateNaissance)
	// rechercher la date de mariage des parents
	Case of 
		: (Form.entité.LesParents()=Null)
			// pas de parent
		: (Form.entité.LesParents().LeMariage()=Null)
			// on ne sait pas quand ils se sont mariés
		Else 
			$dateMariageParent:=Form.entité.LesParents().LeMariage().dateNum
	End case 
	// rechercher la date de naissance
	$sélectionEntités:=Form.entité.Naissance()
	If (Not($sélectionEntités=Null))
		$dateNaissance:=$sélectionEntités.dateNum
	End if 
	// calculer la légitimité
	Form.légitimité:=""
	Case of 
		: (Form.entité.adopté)
			Form.légitimité:=Localized string("16")+Localized string("1001")
			
		: (Form.entité.adulterin)
			If (($dateMariageParent>$dateNaissance) & ($dateMariageParent>!1000-01-01!) & ($dateNaissance>!1000-01-01!))
				Form.légitimité:=Localized string("1005")
			End if 
			Form.légitimité:=Localized string("17")+Form.légitimité+Localized string("1001")
			
		: (Form.entité.parents=0)
			Form.légitimité:=Localized string("18")  //orphelin
			
		Else 
			If ($dateMariageParent=!100-01-01!)
				//pas de mariage => enfant naturel
				Form.légitimité:=Localized string("1009")+Localized string("1001")
				
			Else 
				If ($dateNaissance#!00-00-00!)
					If (($dateMariageParent<$dateNaissance))
						// enfant légitime
						Form.légitimité:=Localized string("1006")+Localized string("1001")
						
					Else 
						//enfant naturel légitimé
						Form.légitimité:=Localized string("1009")+Localized string("1005")+Localized string("1001")
					End if 
				End if 
			End if 
	End case 
	
	Form.age:=Form.entité.Age().âgeSTR
	
	// commentaire ALV : créer un message d'aide sur le champ 'Commentaire' si un 'commentaire privé' existe
	$commande:=Num(Length(Form.entité.commentaire_prive)#0)*cs._cfct.me.LireLocatedSTR(24)
	$commande:=OBJECT Get title(*; "ressourceID 23")+$commande
	OBJECT SET TITLE(*; "ressourceID 23"; $commande)
	
	
Function AfficherArbre($params : Object)
	// retour du serveur APP
	// afficher l'arbre dans le formulaire
	This.arbre:=cs.xARB.$arbre.new($params; This)
	This.arbre.Afficher_AG_dansFormulaire($params.arbreXML)
	
	
	// ----------------------
	// MARK:Demande actions
	// -----------------------
	
Function AfficherLesParents()
	var $sélection : Object
	
	// créer une sélection triée (rang 0 = père, rang 1 = mère)
	$sélection:=Form.entité.LesParents(agk Tout)
	// relancer l'affichage du formulaire
	// v7.4.6 remarque importante : 110 = nav par le père (active si 111), 120 nav par la mère (active si 121)
	Case of 
		: (This.session.prefs.Navigation.ParPere=111)
			Form.nav.AfficherNouvelleSélection($sélection; 0)
			
		: (This.session.prefs.Navigation.ParMere=121)
			Form.nav.AfficherNouvelleSélection($sélection; 1)
			
		Else 
			// rien
	End case 
	
	
Function AfficherLesConjoints()
	// afficher la sélection des conjoints
	var $sélection : Object
	
	Case of 
		: (Form.entité.LesUnions()=Null)
		: (Form.indexUnion<0)
		: (Form.entité.LesUnions()[Form.indexUnion].LeConjoint(Form.entité)=Null)
		Else 
			// lister les conjoints
			$sélection:=ds.Personnes.newSelection(dk keep ordered)
			// le conjoint de l'union courant
			$sélection.add(Form.entité.LesUnions()[Form.indexUnion].LeConjoint(Form.entité))
			// la personne affichée
			$sélection.add(Form.entité)
			// pour mise à jour
			Form.indexUnion:=-1
			
			// relancer l'affichage du formulaire
			Form.nav.AfficherNouvelleSélection($sélection)
	End case 
	
	
Function AfficherUnionSuivante()
	// naviguer dans la sélection des différents conjoints
	var $itemRef : Integer
	
	Case of 
		: (Form.entité.LesUnions()=Null)
		: (Form.entité.LesUnions().length=0)  // ?
		Else 
			// calculer le rang de l'union suivante
			// on boucle sur la liste
			Form.indexUnion:=Mod(Form.indexUnion+1; Form.entité.LesUnions().length)
			// fixer l'IDunion
			Form.IDunionCourante:=Form.entité.LesUnions()[Form.indexUnion].ID
			
			// le conjoint courant
			$itemRef:=cs._cfct.me.CoderID(Form.entité.LesUnions()[Form.indexUnion].LeConjoint(Form.entité).ID; (128+Form.indexUnion+1))
			This.SélectionnerLeConjoint($itemRef)
	End case 
	
	
Function AfficherLesEnfants()
	// afficher l'enfant .RngEnfant de enfants de l'union .IDunionCourante
	var $sélection : Object
	
	Case of 
		: (Form.IDunionCourante<1)
		: (Form.RngEnfant<1)
			// ici, pas normal
		Else 
			// ok
			// récupérer la liste des enfants
			$sélection:=Form.entité.LesUnions().query("ID = :1"; Form.IDunionCourante)[0].LesEnfants()
			
			// relancer l'affichage du formulaire
			Form.nav.AfficherNouvelleSélection($sélection; Form.RngEnfant-1)
	End case 
	
	
Function SélectionnerLeConjoint($itemRef : Integer)
	var $nomOBj : Text:="listeEventsFam"
	var $c : Collection
	
	
	// sélectionner la ligne de $itemRef
	$c:=Form[$nomOBj].query("itemRef = :1"; $itemRef)
	Case of 
		: ($itemRef=-1)
		: ($c.length=0)
		Else 
			LISTBOX SELECT ROW(*; $nomOBj; Form[$nomOBj].indexOf($c[0])+1; lk replace selection)
	End case 
	
	
	// ----------------------
	// MARK:Gestion des menus
	// -----------------------
	
Function initPopUpMenu($commande : Text; $refMenu : Text)
	// traiter les particularités du popUp menu du formulaire
	// rappel : $refMenu créé par "Menus Créer", programmé par le fichier DataPopUpMenus.xml"
	
	Case of 
			// gestion du nombre d'enfants
		: ($commande="init_400")
			Case of 
					// d'un couple marié
				: (Form.nav.entitéCourante.LesUnions()=Null)
					DELETE MENU ITEM($refMenu; -1)
					// connus pour avoir d'enfants
				: (Form.nav.entitéCourante.LesUnions()[Form.indexUnion].SansEnfant)
					// qui ont des enfants
				: (Form.nav.entitéCourante.LesUnions()[Form.indexUnion].LesEnfants()=Null)
				Else 
					// un couple marié avec des enfants : ce menu n'est pas utile
					DELETE MENU ITEM($refMenu; -1)
			End case 
			
		: ($commande="init_410")
			Case of 
				: (Form.nav.entitéCourante.LesUnions()=Null)
					DELETE MENU ITEM($refMenu; -1)
				: (Form.nav.entitéCourante.LesUnions()[Form.indexUnion].SansEnfant)
					SET MENU ITEM MARK($refMenu; -1; Char(18))
			End case 
			
		: ($commande="init_420")
			Case of 
				: (Form.nav.entitéCourante.LesUnions()=Null)
					DELETE MENU ITEM($refMenu; -1)
				: (Form.nav.entitéCourante.LesUnions()[Form.indexUnion].SansEnfant)
				Else 
					SET MENU ITEM MARK($refMenu; -1; Char(18))
			End case 
	End case

⇧ [class]$formulaire_3072 - 16/04/2026 09:25:32

      Class extends $formulaire

Class constructor()
	
	Super()
	
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	ASSERT(cs.$trace.me.DebugerEventForm(Current method name; "EventForm"; New object("numEvent"; FORM Event.code; "numTable"; Table(Current form table))))
	
	// traitements génériques
	This.surEvenementFormulaire()
	
	Case of 
		: (FORM Event.code=On Load)
			
			// charger les objets
			This.onEndLoad()
	End case 
	
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection("choix")
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:FORMevents Page Fond
	// ----------------------
	
Function _FORM_choix()
	var $nomOBJ : Text
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=New object
			
			Form[This.nomOBJ].values:=New collection("Groupes"; "Utilisateurs")
			Form.Pages:=New collection(1; 2)
			
			// ici la page courante est mémorisée par 4D
			Form[This.nomOBJ].index:=FORM Get current page-1
			FORM GOTO PAGE(Form.Pages[Form[This.nomOBJ].index])
			
		: (FORM Event.code=On Clicked)
			// en réalité, pas utile. Il existe une action4D gotopage
			FORM GOTO PAGE(Form.Pages[Form[This.nomOBJ].index])
			
		: (FORM Event.code=On Selection Change)
			// appel par d'autres functions
			$nomOBJ:=Split string(Current method name; "_").last()
			Case of 
				: (Form[$nomOBJ].index=0)
					This.SelectionnerUtilisateurs()
					
				: (Form[$nomOBJ].index=1)
					This.SelectionnerGroupes()
			End case 
	End case 
	
	If ((FORM Event.code=On Load) | (FORM Event.code=On Clicked))
		This["Afficher"+Form[This.nomOBJ].values[Form[This.nomOBJ].index]]()
	End if 
	
	
	// ----------------------
	//MARK:FORMevents page 1
	// ----------------------
	
Function _FORM_listBox1()
	Case of 
		: (FORM Event.code=On Selection Change)
			This._FORM_choix()
	End case 
	
	
	// ----------------------
	//MARK:Selection
	// ----------------------
	
Function AfficherGroupes()
	var $entité : Object
	var $pict : Picture
	var $c : Collection
	
	// première liste : les groupes
	Form.listBox1:=ds.GroupesAPP.all().extract("ID"; "ID"; "nom"; "itemText")
	Form.listBox1:=Form.listBox1.orderBy("itemText asc")
	
	$pict:=cs._rsc.me.image(15013)
	CREATE THUMBNAIL($pict; $pict; 16; 16; Scaled to fit prop centered)
	For each ($entité; Form.listBox1)
		$entité.icone:=$pict
	End for each 
	
	// seconde liste : les utilisateurs ET les groupes
	Form.listBox2:=ds.UtilisateursALV.query("Groupe = 0").extract("ID"; "ID"; "LogIn"; "itemText")
	Form.listBox2:=Form.listBox2.orderBy("itemText asc")
	
	$pict:=cs._rsc.me.image(15014)
	CREATE THUMBNAIL($pict; $pict; 16; 16; Scaled to fit prop centered)
	For each ($entité; Form.listBox2)
		$entité.icone:=$pict
	End for each 
	
	Form.listBox2:=Form.listBox2.combine(Form.listBox1)
	
	$c:=Form.listBox1
	For each ($entité; Form.listBox2)
		$entité.valide:=False
	End for each 
	
	
	
Function AfficherUtilisateurs()
	var $entité : Object
	var $pict : Picture
	
	// première liste : les groupes
	Form.listBox1:=ds.UtilisateursALV.query("Groupe = 0").extract("ID"; "ID"; "LogIn"; "itemText")
	Form.listBox1:=Form.listBox1.orderBy("itemText asc")
	
	$pict:=cs._rsc.me.image(15014)
	CREATE THUMBNAIL($pict; $pict; 16; 16; Scaled to fit prop centered)
	For each ($entité; Form.listBox1)
		$entité.icone:=$pict
	End for each 
	
	// seconde liste : les groupes
	Form.listBox2:=ds.GroupesAPP.all().extract("ID"; "ID"; "nom"; "itemText")
	Form.listBox2:=Form.listBox2.orderBy("itemText asc")
	
	$pict:=cs._rsc.me.image(15013)
	CREATE THUMBNAIL($pict; $pict; 16; 16; Scaled to fit prop centered)
	For each ($entité; Form.listBox2)
		$entité.icone:=$pict
		$entité.valide:=False
	End for each 
	
	
Function SelectionnerUtilisateurs()
	// afficher les membres du groupe courant
	var $membres; $groupes : Collection
	var $entité : Object
	
	Form.ID:=Form.listBox1ElementCourant.ID
	
	// ID de tous les membres du groupe sélectionné
	$membres:=ds.GroupesAPP.get(Form.ID).lesMembres.leMembre.extract("ID")
	// ID de tous les groupes du groupe sélectionné
	$groupes:=ds.GroupesAPP.get(Form.ID).lesMembres.leSurGroupe.extract("ID")
	
	For each ($entité; Form.listBox2)
		If ($entité.ID<15000)
			// ce user est membre d'un des groupes?
			$entité.valide:=($membres.indexOf($entité.ID)>-1)
		Else 
			// ce groupe est dans l'un des groupes
			$entité.valide:=($groupes.indexOf($entité.ID)>-1)
		End if 
	End for each 
	
	Form.listBox2:=Form.listBox2
	
	
Function SelectionnerGroupes()
	// afficher les groupes auxquels l'utilisateur courant appartient
	var $groupes : Collection
	var $entité : Object
	
	Form.ID:=Form.listBox1ElementCourant.ID
	
	// ID de tous les groupes auxquels adhère le sélectionné
	$groupes:=ds.UtilisateursALV.get(Form.ID).lesGroupes.leGroupe.extract("ID")
	
	For each ($entité; Form.listBox2)
		// ce user est membre d'un des groupes?
		$entité.valide:=($groupes.indexOf($entité.ID)>-1)
	End for each 
	
	Form.listBox2:=Form.listBox2

⇧ [class]PersonnesEntity - 27/04/2026 10:01:59

      Class extends Entity

Function IDcodé()->$ID : Integer
	$ID:=cs._ds.me.IDcodé(This)
	
	
Function Libellé($userFormats : Object)->$libellé : Text
	// renvoie le nom formaté suivant les options $formats
	// $formats
	// .Options
	//   bit  0 = ajouter le nom
	//   bit  1 = ajouter le prénom
	//   bit  2 = ajouter les autres prénoms
	//   bit  3 = d'abord le prénom
	//   bit  5 = est un conjoint
	var $formats : Object
	var $options : Integer
	
	$libellé:=""
	$formats:=New object("Options"; 3)
	Case of 
		: (Count parameters=0)
		: (OB Is defined($userFormats; "Options"))
			$formats:=$userFormats
	End case 
	
	If (This#Null)
		$options:=$formats.Options
		
		$libellé:=(This.prenom)*Num($options ?? 1)  //  bit 1 = ajouter le prénom
		$libellé:=$libellé+(Num($options ?? 2)*(" "+This.autres_prenoms))  //  bit 2 = ajouter les autres prénoms
		
		If ($options ?? 3)  // d'abord le prénom
			$libellé:=$libellé+((" "*Num($options ?? 1))+This.nom)*Num($options ?? 0)  //  bit 0 = ajouter le nom
		Else 
			$libellé:=(This.nom+(" "*Num($options ?? 1)))*Num($options ?? 0)+$libellé  //  bit 0 = ajouter le nom
		End if 
		$libellé:=(Localized string("1013")*Num($options ?? 5))+$libellé  // bit 5 =  conjoint
	End if 
	
	
Function LibelléEncyclo($attribut : Text)->$result : Text
	var $texte; $attributAffiché : Text
	
	$texte:="<span style="+Char(Double quote)+"-d4-ref-user:'"+String(cs._ds.me.IDcodé(This))+"'"+Char(Double quote)+">"+This.Libellé(New object("Options"; 3))+"</span>"
	// verrue temporaire, on peut peut-être faire plus classe !
	$attributAffiché:=Choose($attribut="metier"; "métier"; $attribut)
	$result:=cs.$hyperTexteEditeur.new().LibelléEncyclo($attributAffiché; $texte)
	
	
Function RédigerCommentaire($formats : Object)->$result : Text
	var $c : Collection
	
	$result:=""
	$c:=New collection
	Case of 
		: (Not($formats.params ?? 0))
		: (Not(OB Is defined($formats; "séparateurComments")))
		: (Not(OB Is defined($formats; "débutComment")))
		: (Not(OB Is defined($formats; "finComment")))
		Else 
			$c.push(This.metier; This.commentaire)
			$result:=$c.join($formats.séparateurComments; ck ignore null or empty)
	End case 
	$result:=($formats.débutComment+$result+$formats.finComment)*Num(Length($result)#0)
	
	
Function Age($aLaDate : Date)->$data : Object
	// Calcul de l'âge de this à :
	// . à aujourd'hui (si pas mort)
	// . à sa mort (si $1 est absent)
	// . à la date $1
	// Sortie
	// . $0 = 0 si calcul ok, ou -1 si absence de naissance, -2  si absence de décès, -3 si décédé avant $2.date
	// . $data.âge
	// . $data.âgeSTR
	
	var $Event : Object
	var $dateNaissance; $dateDécès : Date
	var $age; $result : Integer
	
	$result:=0  // pas d'erreur par défaut
	$data:=New object
	
	$Event:=This.Naissance()
	Case of 
		: ($Event=Null)
			// pas de naissance
			$result:=-1
		Else 
			
			// date de naissance
			$dateNaissance:=$Event.dateNum
			
			// date de décès
			$Event:=This.Décès()
			If (Not($Event=Null))
				$dateDécès:=$Event.dateNum
			End if 
			
			Case of 
				: (Count parameters=1)
					// calculer l'âge à la date demandée
					Case of 
						: ($dateDécès=!00-00-00!)
							$result:=-2
							
						: ($dateDécès<$aLaDate)
							$result:=-3
						Else 
							$dateDécès:=$aLaDate
					End case 
					
				: ($dateDécès=!00-00-00!)
					$dateDécès:=Current date
			End case 
			
			If ($result=0)
				// on peut calculer quelque chose
				$age:=Year of($dateDécès)-Year of($dateNaissance)-1
				If ((Month of($dateDécès)>Month of($dateNaissance)) | (((Month of($dateDécès)=Month of($dateNaissance)) & (Day of($dateDécès)>=Day of($dateNaissance)))))
					$age:=$age+1
				End if 
			End if 
			
			$data.âge:=$age*Num($result=0)
			$data.âgeSTR:=String($age)+cs._cfct.me.LireLocatedSTR(1002; New object("plur"; $age>1))
	End case 
	$data.Contexte:=$result
	
	
	// ----------------------
	//MARK:Sélections
	// -----------------------
	
Function Naissance()->$result : Object
	// renvoie un objet _EvenementPersonnel
	$result:=This._EvenementPersonnel(22000)
	
	
Function Baptême()->$result : Object
	// renvoie un objet _EvenementPersonnel
	$result:=This._EvenementPersonnel(22300)
	
	
Function Décès()->$result : Object
	// renvoie un objet _EvenementPersonnel
	$result:=This._EvenementPersonnel(22100)
	
	
Function _EvenementPersonnel($type : Integer)->$result : Object
	// renvoie l'entité events perso de type $1
	var $sélection : Object
	
	$result:=Null
	$sélection:=This.LesEvenementsPersonnels().query("type = :1"; $type)
	If ($sélection.length>0)
		// en principe first() est inutile
		$result:=$sélection.first()
	End if 
	
	
Function LesEvenementsPersonnels()->$result : Object
	// renvoie la sélection d'entités d'events perso triée par date
	$result:=This.lesEventsPersonnels.leEvent.orderBy("dateNum asc")
	
	
Function LesParents($Qui : Integer)->$result : Object
	// envoie la sélection d'entités [Personnes] membres de l'union parentale, triée par sexe
	// peut ne pas exister
	$result:=Null
	
	Case of 
		: (This.lesParents=Null)
		: (Count parameters=0)
			// ici c'est un renommage :
			$result:=This.lesParents
			
		Else 
			// on veut un membre :
			$result:=This.lesParents._lesMembres($1)
	End case 
	
	
Function LesUnions()->$result : Object
	// entités unions de la personne
	var $sélection : cs.UnionsSelection
	
	$sélection:=This.lesRelations.leGroupe.lesUnions
	If ($sélection.length>0)
		// trier les unions par date de mariage
		$result:=$sélection.trierParDate()
	Else 
		$result:=Null
	End if 
	
	
Function LesEvenementsFamiliaux()->$result : Object
	var $sélection : Object
	
	// sélectionner les évènements familiaux, triés par la date
	$sélection:=This.lesRelations.leGroupe.lesUnions.lesEventsFamiliaux.leEvent
	// filtrer les events mariage (a priori pas utile)
	$sélection:=$sélection.query("type > :1 & type < :2"; 33000; 39999).orderBy("dateNum asc, heure asc")
	$result:=$sélection
	
	
	// ----------------------
	//MARK:Modification DataStore
	// -----------------------
	
Function Ajouter($quoi : Integer; $qui : Object; $params : Object)->$result : Object
	// créer un parent, conjoint, enfant, patronyme, event Personnel, media de this
	// $1 = code de la création, $2 = entité (peut-être null), $3 paramètres
	ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "Début de l'ajout à ["+This.getDataClass().getInfo().name+"]"))
	
	$result:=ds.initResult()
	
	// fixer Qui
	If ($qui=Null)
		// créer qui
		$result:=ds.Créer($quoi; ""; $params)
		$qui:=$result.entitéAjoutée
	End if 
	
	// fixer les données contextuelles de $qui
	Case of 
		: ($qui=Null)
			// il y a eu une erreur
		: (($quoi=agk Père) | ($quoi=agk Enfant))
			// ont le nom de this
			$qui.nom:=This.nom
			$qui.save()
			
		: ($quoi=agk Conjoint)
			// a le sexe opposé de this
			$qui.sexe:=Not(This.sexe)
			$qui.save()
	End case 
	
	// créer le lien entre $qui et this
	Case of 
		: ($qui=Null)
		: (($quoi=agk Père) | ($quoi=agk Mère))
			// est-ce que $aQui a déjà des parents ?
			If (This.LesParents()=Null)
				// aucun parent
				// est-ce que $qui est déjà marié?
				Case of 
					: ($qui.LesUnions()=Null)
						// pas marié, marier $qui
						$result.Union:=ds.Créer(agk Union; ""; $params)
						$result.Union.entitéAjoutée.SansEnfant:=False
						$result.Union.entitéAjoutée.save()
						$result.Error:=$result.Union.Error
						
						// ajouter $qui à l'union
						If ($result.Union.entitéAjoutée#Null)
							$result.Conjoint:=$result.Union.entitéAjoutée.Ajouter(agk Conjoint; $qui; $params)
							$result.Error:=$result.Conjoint.Error
						End if 
						
					: ($qui.LesUnions().length=1)
						// 1 mariage
						$result.Union.entitéAjoutée:=$qui.LesUnions()[0]
						
					Else 
						// plusieurs mariages, on ne peut pas choisir
						$result.Union.entitéAjoutée:=Null
						CALL WORKER(Worker Services; Formula(traceHandler); [msgk_log; msgk_son]; "Message Utilisateur"; Current method name; Localized string("5109"); New object("nomProcess"; Current process name; "numProcess"; Current process; "numErreur"; 0; "méthodeErreurs"; Method called on error))
				End case 
				
				If ($result.Union.entitéAjoutée#Null)
					// on a une union parentale, l'associer à this
					This.parents:=$result.Union.entitéAjoutée.ID
					This.save()
				End if 
				
			Else 
				// ajouter le second conjoint
				$result:=This.LesParents().Ajouter(agk Conjoint; $qui; $params)
			End if 
			// $qui n'est plus célibataire
			$qui.célibataire:=False
			$qui.save()
			
			// pour le journal
			$params.Description_Action:=Localized string(String(3021+Num($quoi=agk Mère)))
			
		: ($quoi=agk Conjoint)
			// ajouter le conjoint $qui à this
			// marier this
			$result.Union:=ds.Créer(agk Union; ""; $params)
			$result.Error:=$result.Union.Error
			
			// ajouter les conjoints à l'union
			If ($result.Union.Error=0)
				$result.Conjoint1:=$result.Union.entitéAjoutée.Ajouter(agk Conjoint; This; $params)
				$result.Conjoint2:=$result.Union.entitéAjoutée.Ajouter(agk Conjoint; $qui; $params)
				$result.Error:=-15004*Num(($result.Conjoint1.Error#0) | ($result.Conjoint2.Error#0))
			End if 
			
			// this n'est plus célibataire
			This.célibataire:=False
			This.save()
			// pour le journal
			$params.Description_Action:=Localized string("3023")+" "+Localized string("1013")+$qui.Libellé()
			
		: ($quoi=agk Enfant)
			// ajouter un enfant à this
			// on ne connait pas le conjoint : créer une union
			$result.Union:=ds.Créer(agk Union; ""; $params)
			$result.Union.entitéAjoutée.SansEnfant:=False
			$result.Union.entitéAjoutée.save()
			$result.Error:=$result.Union.Error
			
			// ajouter this à l'union
			If ($result.Error=0)
				$result.Conjoint:=$result.Union.entitéAjoutée.Ajouter(agk Conjoint; This; $params)
				$result.Error:=$result.Conjoint.Error
			End if 
			
			// lier $qui à l'union
			If ($result.Error=0)
				$qui.parents:=$result.Union.entitéAjoutée.ID
				// $qui a le nom de this
				$qui.nom:=This.nom
				$qui.save()
			End if 
			// pour le journal
			$params.Description_Action:=Localized string("3024")+Localized string("33")+$result.Union.entitéAjoutée.Libellé(New object("Options"; 3))
			
		: ($quoi=agk EventPersonnel)
			Case of 
				: ($result.Error#0)
				: (This._EvenementPersonnel($qui.leEvent.type)#Null)
					$result.Error:=-15010
					// l'event perso doit être unique
				Else 
					// faire le lien
					$result.entitéAjoutée.personne:=This.ID
					$result.entitéAjoutée.save()
					$result.entitéAjoutée:=$result.entitéAjoutée.leEvent
			End case 
			// pour le journal
			$params.Description_Action:=Localized string("3031")+" ("+Localized string(String($qui.leEvent.type))+")"+Localized string("33")+This.Libellé()
			
		: ($quoi=imk Illustration)
			// $qui est un media (qui a été créé s'il n'existait pas) ; le lier à this
			// attention pour ajouter la zone il faut un aQui de type entité
			$params.aQui:=This
			$result:=$qui.Ajouter(imk Zone; Null; $params)
			$result.entitéAjoutée:=$qui
			// pour le journal, passer en pseudoEntité
			$params.aQui:=New object("DataClassNom"; This.getDataClass().getInfo().name; "IDunique"; This.IDunique)
			$params.Description_Action:=Localized string("3045")+Localized string("33")+This.Libellé()+", fichier '"+$params.cheminDuMediaAjouté+"'"
			
		: ($quoi=imk Document)
			// on a un media (qui a été créé  s'il n'existait pas) ; le lier à this
			$params.typeZone:=3
			
		: ($quoi=dsk Private)
			// on a dans $qui , le lier à this
			// créer le lien
			$qui.IDunique:=This.IDunique
			$qui.save()
			// pour le journal
			// surcharger l'UUID créé par le traitement standard des ajouts
			$params["JALV_UUID_"+String($quoi)]:=This.IDunique
			// ainsi, le traitement standard d'import par le journal fera bien le lien avec this
			$params.Description_Action:=Localized string("3113")+Localized string("33")+This.Libellé()
			
	End case 
	
	$result.success:=($result.Error=0)
	ds.NotifierResultat(This; $quoi; $result)
	
	
Function _FixerDonnées($quoi : Integer; $params : Object)->$result : Object
	// une personne a été créée : on initialise ses données suivant 2 cas
	// ajout dans BDD mère : données déduites de aQui, ou ajout par le serveur WEB : données lues dans le journal $params
	// dans les 2 cas on complète le journal
	
	$result:=ds._FixerDonnées(This; $quoi; $params)
	
	// fixer le nom et le sexe de this
	If ($result.LectureJournal)
		// cas ajout par lecture du journal
		// les données sont dans $params
		This.nom:=$params.Personne_nom
		This.prenom:=$params.Personne_prenom
		This.sexe:=$params.Personne_sexe
		This.adopté:=False
		This.adulterin:=False
		This.célibataire:=($quoi#agk Enfant)
		This.créateur:=$params.UserID.ID
		
	Else 
		// cas ajout par BDD mère ou par les serveurs. Par défaut :
		This.prenom:=Localized string("3")
		This.sexe:=False
		This.adopté:=False
		This.adulterin:=False
		This.célibataire:=($quoi#agk Enfant)
		This.créateur:=$params.UserID.ID
		
		// les particularités
		Case of 
			: ($quoi=agk Père)
				This.nom:=Localized string("1010")
				This.sexe:=False
			: ($quoi=agk Mère)
				This.nom:=Localized string("1011")
				This.sexe:=True
			: ($quoi=agk Conjoint)
				This.nom:=Localized string("1040")
			: ($quoi=agk Enfant)
				This.nom:=Localized string("1041")
			: ($quoi=agk Temoin)
				This.nom:=cs._cfct.me.LireLocatedSTR(1044+Num($params.liste="Groupe2"); New object("genre"; False; "plur"; False))
			Else 
				This.nom:=Localized string("1046")
		End case 
		
		// renseigner le journal
		$params.Personne_nom:=This.nom
		$params.Personne_prenom:=This.prenom
		$params.Personne_sexe:=This.sexe
		$params.Personne_parents:=This.parents
		$params.Description_Action:=Localized string("3025")  // init du comment; sauf ex-nihilo, va être surchargé
	End if 
	This.save()
	// ici, pour les 2 cas "Ajout DataStore" ou "Modifier DataStore_Extérieur", $params a les mêmes informations
	
	
Function _TriggerCreer()
	This._Trigger()
	
	
Function _TriggerModifier()
	This._Trigger()
	
	
Function _Trigger()
	// créer une entité dans le dico des noms
	var $selection; $entité : Object
	
	$selection:=ds.DicoDesNoms.query("nom = :1"; This.nom)
	If ($selection.length=0)
		$entité:=ds.DicoDesNoms.new()
		ds._TriggerHoroDater($entité)
		
		// fixer l'identifiant
		ds.FixerIDentification($entité)
		$entité.nom:=This.nom
		$entité.patronyme:=This.nom
		// appeler le trigger du dico
		$entité._TriggerCreer()
		$entité.save()
	End if 
	
	// mettre à jour le dico des prénoms
	$selection:=ds.Encyclopedia.query("MotCle = :1"; This.prenom)
	If ($selection.length=0)
		$entité:=ds.Encyclopedia.new()
		ds.FixerIDentification($entité)
		$entité.MotCle:=This.prenom
		$entité.save()
	End if 
	
	
Function ModifierAutre()->$result : Object
	// Edition / modification des autres informations par FORM
	$result:=New object
	// pas de contexte
	$result.Contexte:=New object
	// attributs modifiables
	$result.Modifications:=New collection
	
	
	// ----------------------
	//MARK:Interface externe
	// -----------------------
	
Function CopierVersObjet($entitéExt : Object)
	// recopier les attributs de this dans $entitéExt (pour une utilisation hors BDD mère)
	var $sélection; $entité; $objet : Object
	ALERT(Current method name+" 2026-04-13 toujours utile?")
	
	$entitéExt.ID:=This.ID
	$entitéExt.IDunique:=This.IDunique
	
	$entitéExt.nom:=This.nom
	$entitéExt.prenom:=This.prenom
	$entitéExt.autres_prenoms:=This.autres_prenoms
	$entitéExt.sexe:=This.sexe
	
	// renvoyer les liens
	
	// les events perso
	$entitéExt.lesEvents:=New collection
	For each ($objet; This.lesEventsPersonnels)
		// demander à l'appelant sa classe Events
		$entité:=OB Copy($entitéExt.protoEvent)
		// faire compléter
		$objet.CopierVersObjet($entité)
		// recopier le sexe (en particulier pour les chaines localisées)
		$entité.genre:=This.sexe
		$entitéExt.lesEvents.push($entité)
		
		// nommer la collection d'appartenance
		$entité.relationNom:="lesEvents"
	End for each 
	
	// remarque : ici on ne peut pas créer des objets unions (rebouclerait sur cette classe)
	// l'union parentale
	$entitéExt.parents:=This.parents
	
	// la liste des unions
	$sélection:=This.LesUnions()
	If ($sélection=Null)
		$entitéExt.lesUnions:=New collection
	Else 
		$entitéExt.lesUnions:=$sélection.extract("ID")
	End if 
	
	
	// ----------------------
	//MARK:APP mobile
	// -----------------------
	
exposed local Function get nomComplet($event : Object)->$result : Text
	
	$result:="Nom complet"
	
	Case of 
		: ((This.nom=Null) & (This.prenom=Null))
			$event.result:=Null  //utiliser le résultat pour retourner Null
		: (This.nom=Null)
			$result:=This.prenom
		: (This.prenom=Null)
			$result:=This.nom
			
		Else 
			$result:=This.nom+" "+This.prenom
	End case 
	
	
exposed local Function get prenomComplet($event : Object)->$result : Text
	
	$result:="Prénom complet"
	
	If (estAppelMobile)
		$result:=This.prenom+" "+This.autres_prenoms
	End if 
	
	
exposed local Function get photo($event : Object)->$result : Picture
	var $sélection : Object
	
	If (estAppelMobile)
		$sélection:=This.lesIllustrations.laZone.query("type = :1"; 1).leMedia.orderBy("dateNum desc")
		
		Case of 
			: ($sélection.length>0)
				$result:=$sélection[0].vignetteMedia
				
			: (This.sexe)
				// icone femelle
				$result:=cs._rsc.me.image(17101)
				
			Else 
				// icone male
				$result:=cs._rsc.me.image(17102)
		End case 
	End if 
	
	
exposed local Function get datesDeVie($event : Object)->$result : Text
	var $naissance; $décès : Object
	
	$result:="[ - ]"
	
	If (estAppelMobile)
		$result:=""
		
		$naissance:=This.Naissance()
		$naissance:=This.lesEventsPersonnels.leEvent.query("type = :1"; 22000).first()
		Case of 
			: ($naissance=Null)
			: ($naissance.dateChaine="")
			Else 
				// on a une date, pas forcément valide
				$result:=$naissance.dateChaine
		End case 
		
		$result:=$result+" - "
		
		$décès:=This.Décès()
		$décès:=This.lesEventsPersonnels.leEvent.query("type = :1"; 22100).first()
		Case of 
			: ($décès=Null)
			: ($décès.dateChaine="")
			Else 
				// on a une date, pas forcément valide
				$result:=$result+$décès.dateChaine
		End case 
	End if 
	
	
exposed local Function get biographie($event : Object)->$result : Text
	var $data : Object
	var $texte : Text
	
	$result:="La biographie..."
	
	If (estAppelMobile)
		OB SET($data; "entité"; This)
		OB SET($data; "params"; 0x000D)
		
		// créer et afficher les informations
		$texte:=cs.$texteEditeur.new().EcrireInformationEntité($data)
		$result:=$texte+ds._FinirTexteFormDetail()
	End if 
	
	
exposed local Function get rechercheSurNom($event : Object)->$result : Text
	$result:=This.nomComplet
	
	
exposed local Function get rechercheSurPrenom($event : Object)->$result : Text
	Case of 
		: ((This.nom=Null) & (This.prenom=Null))
			$event.result:=Null  //utiliser le résultat pour retourner Null
		: (This.nom=Null)
			$result:=This.prenom
		: (This.prenom=Null)
			$result:=This.nom
			
		Else 
			$result:=This.prenom+" "+This.nom
	End case 
	
	
exposed Function get estDansMobile->$result : Text
	$result:="PersonneMajeure"

⇧ [class]$journalALV - 07/05/2026 11:44:35

      property nomBDD; sql_BDDpath : Text
property dossierBDD : 4D.Folder
property session; parametresBDD : Object
property actions : Collection

singleton Class constructor()
	
	This.session:=cs.$session.me
	
	
	
Function Requeter($params : Object)->$result : Object
	// ici on est sur la BDDmère ou le clientAPP
	var $url : Text
	var $trace : cs.$trace
	
	$result:=New object
	$trace:=cs.$trace.me.Créer(-15068; Current method name; "")
	
	Case of 
		: (Not(OB Is defined($params; "functionID")))
			$trace.ErrorDescription:="'functionID' n'est pas défini dans $params"
		: (Not(OB Is defined(This; $params.functionID)))
			$trace.ErrorDescription:="'"+$params.functionID+"' n'est pas une function de la classe "+OB Class(This).name
		: (Not(OB Is defined($params; "journal")))
			$trace.ErrorDescription:="'journal' n'est pas défini dans $params"
			
		: ($params.journal=ack Journal Serveur)
			// faire exécuter sur le serveur
			$trace.Error:=0
			
			// sur le serveur ce sera local
			$params.journal:=ack Journal Local
			
			$url:=New collection("/4DHTTP/APP"; OB Class(This).name; Split string(Current method name; ".").last()).join("/")
			cs.$requeteHTTP.me.Requeter($url; "Get"; $params; "blob")
			// le résultat est dans .reqRetour
			// restaurer le seveur
			$params.reqRetour.journal:=ack Journal Serveur
			$result:=$params.reqRetour
			
			
		: ($params.journal=ack Journal Local)
			// rappel, 2 cas de "local" : serveurAPP (ou BDDmère pour test) , sur suite à une requête client
			$trace.Error:=0
			
			This.DebutTransaction()
			
			This[$params.functionID]($params)
			
			This.FinTransaction()
			// le résultat est dans .data (pour les requêtes HTTP)
			
			// mettre le résultat dans $result (pour un traitement local)
			$result:=$params
			// recopier l'erreur
			$trace.Error:=$params.Error
			$trace.ErrorDescription:=$params.ErrorDescription
			
			
		Else 
			$trace.ErrorDescription:="le contexte '"+$params.journal+" n'est pas reconnu"
	End case 
	
	$trace.FixerSuccess()
	$trace.LeverException([msgk_event; msgk_log])
	
	// appeler la suite
	Case of 
		: (Storage.System.typeApplication=ALV Serveur APP)
			
			// post traitement local optionnel
		: (OB Is defined(This; $params.functionID+"PostTraitement"))
			This[$params.functionID+"PostTraitement"]($result)
			
		: (Not(OB Is defined($params; "nomProcessAppelant")))
		: (Not(OB Is defined($params; "CallBack")))
		Else 
			cs.$process.new().AppelerFormulaire($params.nomProcessAppelant; $params.CallBack; $result)
	End case 
	// c'est fini
	
	
Function ListerLesActionsPostTraitement($params : Object)
	// fixe EtatAction de chaque action de $2 . EtatAction est une couleur, utilise les codes couleur système :
	// "ack action traitée" (désactivé) = modif déjà passée ou sans objet, "ack action en attente" (sombre) = modif en attente, "ack action à traiter" (premier plan) = modif peut être faite, rouge si erreur
	// on est dans un worker
	var $c : Collection
	var $action; $aQui; $Qui : Object
	var $sélection : cs.PersonnesSelection
	
	// récupérer les actions
	$c:=OB Get($params; "data"; Is collection)
	// fixer leur état
	If ($c.length>0)
		For each ($action; $c)
			// lire les données de l'action $i
			
			// fixer l'état de l'action
			Case of 
				: ($action.ActionEtat=ack action traitée)
					// déjà traitée, ne rien faire
					
					// journal
				: (($action.ActionID=cdk Ouvrir Journal) | ($action.ActionID=cdk Fermer Journal))
					$action.ActionEtat:=ack action traitée  // commande non utilisée
					
					
					// aQui existe toujours, ici il doit être non vide
				: ($action.aQui="")
					// **************
					// ajout ex nihilo
					// **************
					
					Case of 
						: ($action.ActionID=agk Individu)
							$action.ActionEtat:=Choose((ds.Personnes.query("IDunique = :1"; $action.Data.entitéAjoutée.IDunique).length>0); ack action traitée; ack action à traiter)
							
						: ($action.ActionID=imk Media)
							// il faut un chemin de fichier
							$action.ActionEtat:=ack action non connue
							If (OB Is defined($action.Data; "cheminDuMediaAjouté"))
								$action.ActionEtat:=ack action à traiter
							End if 
					End case 
					
				: ($action.aQuiUUID="")
					
				Else 
					// *********************
					// ajout aQUI, sans qui
					// *********************
					
					// trouver l'entité modifiée
					$aQui:=ds[$action.aQui].query("IDunique = :1"; $action.aQuiUUID)
					Case of 
						: ($aQui.length=0)
							// entité pas encore créée
							$action.ActionEtat:=ack action en attente
							
						: ($action.ActionID=cdk Modifier)
							Case of 
								: ($action.Data.Contexte=ALV BDD mère)
									$action.ActionEtat:=ack action traitée  // ici la modification a été faite
									
								: ([cs.Personnes.name; cs.Events.name; cs.Pays.name; cs.Regions.name; cs.Departements.name; cs.Communes.name; cs.Sites.name; cs.Lieux.name; cs.Medias.name; cs.Zones.name; cs.PrivateData.name; cs.UtilisateursALV.name].indexOf(cs[$action.aQui].name)=-1)
									// cas non concerné; rmk cs[$action.aQui].name = $action.aQui ! (on teste ainsi la valeur de $action.aQui)
									$action.ActionEtat:=ack action non connue
									
								: ($action.QuiUUID="")
									// il faut la donnée modifiée
									$action.ActionEtat:=ack action non connue
									
								Else 
									// on garde
									$action.ActionEtat:=ack action à traiter
									// récupérer la donnée
									$action.Data.SaisieData:=JSON Parse($action.QuiUUID; Is object)
							End case 
							
							// tester une création sans Qui
						: ($action.Qui="")
							Case of 
									// * Ajout A Mediathèque
								: ($action.ActionID=imk Illustration)
									// il faut un chemin de fichier
									$action.ActionEtat:=ack action non connue
									If (OB Is defined($action.Data; "cheminDuMediaAjouté"))
										$action.ActionEtat:=ack action à traiter
									End if 
									
								: ($action.ActionID=imk URL)
									// il faut un chemin de fichier
									$action.ActionEtat:=ack action non connue
									If (OB Is defined($action.Data; "cheminDocument"))
										$action.ActionEtat:=ack action à traiter
									End if 
									
								: ($action.ActionID=imk Ressource)
									$action.ActionEtat:=ack action à traiter
									
								: ($action.ActionID=imk Zone)
									If (OB Is defined($action.Data; "aQui"))
										$action.ActionEtat:=ack action à traiter
									End if 
									
								: (Not(OB Is defined($action.Data; "entitéAjoutée")))
									// pas normal
									$action.ActionEtat:=ack action non connue
									
								: (ds[$action.Data.entitéAjoutée.DataClassNom].query("IDunique =:1"; $action.Data.entitéAjoutée.IDunique).length>0)
									// l'ajout a été fait
									$action.ActionEtat:=ack action traitée
									
								Else 
									// ajout à faire
									$action.ActionEtat:=ack action à traiter
							End case 
							
							
							// *********************
							// ajout aQUI, un qui
							// *********************
							// pour la suite on a besoin d'un Qui non null
							// typiquement un glisser-déposer
						: ($action.QuiUUID="")
							$action.ActionEtat:=ack action non connue
							
						Else 
							// trouver l'entité ajoutée
							$Qui:=ds[$action.Qui].query("IDunique = :1"; $action.QuiUUID)
							Case of 
								: ($Qui.length=0)
									// entité pas encore créée
									$action.ActionEtat:=ack action en attente
									
								: ($action.Data.Contexte=ALV BDD mère)
									$action.ActionEtat:=ack action traitée  // ici l'ajout a été fait
									
									// * Ajout A Mediathèque
								: ($action.ActionID=agk EventPersonnel)
									Case of 
										: (ds.Personnes.query("IDunique = :1"; $action.aQuiUUID).length=0)
											// invalide, la personne n'existe pas
											$action.ActionEtat:=ack action en attente
										: (ds.Events.query("IDunique = :1"; $action.QuiUUID).length>0)
											// invalide l'event existe déjà
											$action.ActionEtat:=ack action traitée
										Else 
											// on garde
											$action.ActionEtat:=ack action à traiter
									End case 
									
								: ($action.ActionID=agk EventFamilial)
									// valide si la personne existe déjà
									If (ds.Unions.query("IDunique = :1"; $action.aQuiUUID).length>0)
										$action.ActionEtat:=ack action à traiter
									Else 
										$action.ActionEtat:=ack action en attente
									End if 
									
									// * Ajout A Géographie
									Case of 
										: ($action.ActionID=geok Commune)
											Case of 
												: (ds.Departements.query("IDunique = :1"; $action.aQuiUUID).length=0)
													$action.ActionEtat:=ack action en attente
												: (ds.Communes.query("IDunique = :1"; $action.QuiUUID).length=0)
													$action.ActionEtat:=ack action à traiter
												Else 
													// déjà fait
													$action.ActionEtat:=ack action traitée
											End case 
											
										: ($action.ActionID=geok Site)
											If (ds.Communes.query("IDunique = :1"; $action.aQuiUUID).length=0)
												$action.ActionEtat:=ack action en attente
											Else 
												$action.ActionEtat:=ack action à traiter
											End if 
											
										: ($action.ActionID=geok Lieu)
											If (ds.Sites.query("IDunique = :1"; $action.aQuiUUID).length=0)
												$action.ActionEtat:=ack action en attente
											Else 
												$action.ActionEtat:=ack action à traiter
											End if 
											
										Else 
											// gestion de l'administration
											$action.ActionEtat:=ack action à traiter
									End case 
									
									// * Ajout A Médiathèque
									Case of 
										: ($action.ActionID=imk Zone)
											// valide si le media existe déjà
											If (ds.Medias.query("IDunique = :1"; $action.aQuiUUID).length>0)
												$action.ActionEtat:=ack action à traiter
											Else 
												$action.ActionEtat:=ack action en attente
											End if 
									End case 
									
									// * Ajout A Utilisateurs
								: ($action.ActionID=dsk Groupe)
									$action.ActionEtat:=ack action traitée  // action impossible (les groupes seront uniquement gérés en BDD mère)
									
									// * Ajout A Utilisateurs
								: ($action.ActionID=dsk Utilisateur)
									// invalide si ce user existe déjà
									If (ds.UtilisateursALV.query("IDunique = :1"; $action.QuiUUID).length=1)
										$action.ActionEtat:=ack action traitée
									Else 
										$action.ActionEtat:=ack action à traiter
									End if 
									
								Else 
									// * Ajout A Généalogie, le reste 
									$sélection:=ds.Personnes.query("IDunique = :1"; $action.QuiUUID)
									Case of 
										: (($action.ActionID=agk Enfant) & ($sélection.length>0))
											// cas particulier du glisser déposer : $QuiIDunique existe
											$action.ActionEtat:=ack action à traiter
											
										Else 
											// cas normal : une personne a été ajoutée => elle n'existe pas ici
											// invalide si la personne existe déjà
											If ($sélection.length>0)
												$action.ActionEtat:=ack action traitée
											Else 
												$action.ActionEtat:=ack action à traiter
											End if 
									End case 
									
							End case 
					End case 
			End case 
		End for each 
	End if 
	
	// enregistrer les états dans la BDD externe
	$params.functionID:=cdk Mettre A Jour Action
	cs.$process.new().ExecuterDansWorker(cs.$journalALV; "Requeter"; $params)
	
	
	// ----------------------
	// MARK:Ecriture
	// -----------------------
	
Function Ecrire($params : Object; $aQuiObjet : Object; $quiObjet : Object)
	
	// faire exécuter cette function dans le WK
	This.FixerContexte($params)
	$params.aQui:=$aQuiObjet
	$params.qui:=$quiObjet
	
	$params.functionID:=Split string(Current method name; ".").last()+"_process"
	
	cs.$process.new().AppelerWorker("WK_Services"; cs.$journalALV; "Requeter"; $params)
	
	
Function Ecrire_process($params : Object)
	var $entité : Object
	var $ID; $UserNom; $actionDate; $aQui; $aQuiUUID; $Qui; $QuiUUID; $dataTexte : Text
	var $UserID; $actionID; $aQuiCreator; $QuiCreator : Integer
	var $trace : cs.$trace
	
	$trace:=cs.$trace.me.Initialiser(Current method name)
	
	$trace.Error:=-15068
	Case of 
		: ($params=Null)
			$trace.ErrorDescription:="$params est Null"
		: ($params.UserID=Null)
			$trace.ErrorDescription:="UserID n'est pas défini dans $params"
		: (Not(OB Is defined($params.UserID; "ID")))
			$trace.ErrorDescription:="ID n'est pas défini dans $params.UserID"
		: (Not(OB Is defined($params.UserID; "LogIn")))
			$trace.ErrorDescription:="LogIn n'est pas défini dans $params.UserID"
		: (Not(OB Is defined($params; "actionID")))
			$trace.ErrorDescription:="actionID n'est pas défini dans $params"
		: (Not(OB Is defined($params; "PartageALV")))
			$trace.ErrorDescription:="PartageALV n'est pas défini dans $params"
		Else 
			
			// fixer les données de la BDD
			$ID:=Generate UUID
			// identification utilisateur
			$UserID:=$params.UserID.ID
			$UserNom:=$params.UserID.LogIn
			// le user est n'importe où dans le monde : écrire la date GMT
			$actionDate:=String(Current date; ISO date GMT; Current time)
			$actionID:=$params.actionID
			$dataTexte:=JSON Stringify(OB Copy($params))
			
			Case of 
				: (($params.actionID=cdk Ouvrir Journal) | ($params.actionID=cdk Fermer Journal))
					$trace.Error:=0
					// rien à faire de plus
					Begin SQL
						START TRANSACTION;
						INSERT INTO Ecritures (ID, UserID, UserNom, ActionDate, ActionID, data) VALUES (:$ID, :$UserID, :$UserNom, :$actionDate, :$actionID, :$dataTexte);
						COMMIT TRANSACTION;
					End SQL
					
				: ($params.PartageALV.Activation=200)
					$trace.Error:=0
					// pas d'écritures dans le journal
					cs.$trace.me.EnvoyerMessages([msgk_event]; "Partage ALV"; Current method name; "Le partage ALV n'est pas activé")
					
					
				: (($params.aQui=Null) & ($params.qui=Null))
					$trace.Error:=0
					// création ex-nihilo
					Begin SQL
						START TRANSACTION;
						INSERT INTO Ecritures (ID, UserID, UserNom, ActionDate, ActionID, ActionEtat, Data) VALUES (:$ID, :$UserID, :$UserNom, :$actionDate, :$actionID, 0, :$dataTexte);
						COMMIT TRANSACTION;
					End SQL
					
					
					// ici il faut toujours un aQui en $aQuiObjet
				: (Not(OB Is defined($params.aQui; "DataClassNom")))
					$trace.ErrorDescription:="DataClassNom n'est pas défini dans $params.aQui"
				: (Not(OB Is defined($params.aQui; "IDunique")))
					$trace.ErrorDescription:="IDunique n'est pas défini dans $params.aQui"
					
				: ($params.actionID=cdk Modifier)
					$trace.Error:=0
					// on a une entité en $aQuiObjet et la modification d'un attribut en $quiObjet
					$aQui:=$params.aQui.DataClassNom
					$aQuiUUID:=$params.aQui.IDunique
					$aQuiCreator:=$params.créateur
					
					// est ce que cet attribut a déjà été modifié par cet utilisateur?
					$Qui:=$params.qui.attribut
					$QuiUUID:=JSON Stringify($params.qui)
					
					$ID:=""
					Begin SQL
						SELECT  ID FROM Ecritures WHERE UserID = :$UserID AND ActionID = :$actionID AND aQui = :$aQui AND aQuiUUID = :$aQuiUUID AND Qui = :$Qui INTO :$ID;
					End SQL
					
					If ($ID="")
						// non, créer une action
						$ID:=Generate UUID
						Begin SQL
							START TRANSACTION;
							INSERT INTO Ecritures (ID, UserID, UserNom, ActionDate, ActionID, aQui, aQuiUUID, aQuiCreator, Qui, QuiUUID, QuiCreator, Data) VALUES (:$ID, :$UserID, :$UserNom, :$actionDate, :$actionID, :$aQui, :$aQuiUUID, :$aQuiCreator, :$Qui, :$QuiUUID, :$QuiCreator, :$dataTexte);
							COMMIT TRANSACTION;
						End SQL
						
					Else 
						// oui, modifier l'action $ID
						Begin SQL
							START TRANSACTION;
							UPDATE  Ecritures SET QuiUUID = :$QuiUUID, Data = :$dataTexte WHERE ID = :$ID;
							COMMIT TRANSACTION;
						End SQL
					End if 
					
				Else 
					// toutes les commandes d'ajout
					$trace.Error:=0
					
					$aQui:=$params.aQui.DataClassNom
					$aQuiUUID:=$params.aQui.IDunique
					// le créateur de aQui
					$entité:=ds[$aQui].query("IDunique = :1"; $aQuiUUID)[0]
					If (OB Is defined($entité; "créateur"))
						$aQuiCreator:=$entité.créateur
					End if 
					
					If ($params.qui#Null)
						$Qui:=$params.qui.DataClassNom
						$QuiUUID:=$params.qui.IDunique
						$entité:=ds[$Qui].query("IDunique = :1"; $QuiUUID)[0]
						If (OB Is defined($entité; "créateur"))
							$QuiCreator:=$entité.créateur
						End if 
					End if 
					
					Begin SQL
						START TRANSACTION;
						INSERT INTO Ecritures (ID, UserID, UserNom, ActionDate, ActionID, ActionEtat, aQui, aQuiUUID, aQuiCreator, Qui, QuiUUID, QuiCreator, Data) VALUES (:$ID, :$UserID, :$UserNom, :$actionDate, :$actionID, 0, :$aQui, :$aQuiUUID, :$aQuiCreator, :$Qui, :$QuiUUID, :$QuiCreator, :$dataTexte);
						COMMIT TRANSACTION;
					End SQL
					
					$trace.Error:=-15007*Num(ok=0)
					$trace.ErrorDescription:=String($params.actionID)+" non traitée"
			End case 
	End case 
	
	$trace.FixerSuccess()
	$trace.LeverException([msgk_event; msgk_log])
	
	
Function FixerContexte($params : Object)
	// fixer le contexte d'écriture
	
	$params.nomProcessAppelant:=Current process name
	
	If (Not(OB Is defined($params; "PartageALV")))
		$params.PartageALV:=This.session.prefs.PartageALV
	End if 
	
	If (Not(OB Is defined($params; "UserID")))
		$params.UserID:=OB Copy(This.session.user)
	End if 
	
	If (Storage.System.typeApplication=ALV Client APP)
		// utiliser le journal du serveur
		$params.journal:=ack Journal Serveur
	Else 
		// utiliser le journal local, BDDmère, et serveurAPP (via xWEB)
		$params.journal:=ack Journal Local
	End if 
	
	
	// ----------------------
	// MARK:Lecture 
	// -----------------------
	
Function ListerLesUtilisateurs($params : Object)
	// ici toujours BDDmère ou Serveur
	// lire le journal local (rappel de BDDmère ou serveur)
	var $sql_BDDpath : Text
	var $c : Collection
	
	// lister tous les users de la BDD
	ARRAY LONGINT($tabUserID; 0)
	ARRAY TEXT($tabUserNom; 0)
	Begin SQL
		SELECT DATABASE_PATH() FROM _USER_SCHEMAS LIMIT 1 INTO :$sql_BDDpath;
		SELECT DISTINCT UserID, UserNom FROM Ecritures INTO :$tabUserID, :$tabUserNom;
	End SQL
	
	$params.Error:=-15064*Num(ok=0)
	$params.ErrorDescription:=""
	$params.DATABASE_PATH:=$sql_BDDpath
	$params.commande:=Current method name
	
	// fixer la collection
	$c:=New collection
	ARRAY TO COLLECTION($c; $tabUserID; "UserID"; $tabUserNom; "UserNom")
	$c:=$c.orderBy("UserNom asc")
	
	// renvoyer le résultat (pour le traitement local)
	$params.data:=$c
	
	
Function ListerLesActions($params : Object)
	// lister toutes les actions du user demandé
	// ici toujours BDDmère ou Serveur
	var $action : Object
	var $UserID; $i : Integer
	var $sql_BDDpath : Text
	var $c : Collection
	
	$params.Error:=-15068
	Case of 
		: (Not(OB Is defined($params; "UserID")))
			// il faut un user
			$params.ErrorDescription:="UserID non défini dans $params"
			
		Else 
			// on a tout
			$params.Error:=0
			$params.ErrorDescription:=""
			
			$UserID:=$params.UserID
			ARRAY TEXT($tabUUID; 0)
			ARRAY TEXT($tabActionDate; 0)
			ARRAY LONGINT($tabActionID; 0)
			ARRAY LONGINT($tabActionEtat; 0)
			ARRAY TEXT($tabaQui; 0)
			ARRAY TEXT($tabaQuiUUID; 0)
			ARRAY TEXT($tabQui; 0)
			ARRAY TEXT($tabQuiUUID; 0)
			ARRAY OBJECT($tabData; 0)
			
			ARRAY TEXT($tabDataTexte; 0)
			Begin SQL
				SELECT DATABASE_PATH() FROM _USER_SCHEMAS LIMIT 1 INTO :$sql_BDDpath;
				SELECT  ID, ActionDate, ActionID, ActionEtat, aQui, aQuiUUID, Qui, QuiUUID, Data FROM Ecritures WHERE UserID = :$UserID INTO :$tabUUID, :$tabActionDate, :$tabActionID, :$tabActionEtat, :$tabaQui, :$tabaQuiUUID, :$tabQui, :$tabQuiUUID, :$tabDataTexte;
			End SQL
			
			$params.Error:=-15064*Num(ok=0)
			$params.DATABASE_PATH:=$sql_BDDpath
			$params.commande:=Current method name
			
			// transformer les data texte en data objet
			ARRAY OBJECT($tabData; Size of array($tabDataTexte))
			For ($i; 1; Size of array($tabDataTexte))
				If ($tabDataTexte{$i}="")
					$tabData{$i}:=New object
				Else 
					$tabData{$i}:=JSON Parse($tabDataTexte{$i}; Is object)
				End if 
			End for 
			
			// fixer la collection
			$c:=New collection
			ARRAY TO COLLECTION($c; $tabUUID; "ID"; $tabActionDate; "ActionDate"; $tabActionID; "ActionID"; $tabActionEtat; "ActionEtat"; $tabaQui; "aQui"; $tabaQuiUUID; "aQuiUUID"; $tabQui; "Qui"; $tabQuiUUID; "QuiUUID"; $tabData; "Data")
			For each ($action; $c)
				$action.Comment:=$action.Data.Description_Action
			End for each 
			$c:=$c.orderBy("ActionDate asc")
			
			// renvoyer le résultat (pour un traitement local)
			$params.data:=$c
	End case 
	
	
Function MettreAjourActions($params : Object)
	// mettre à la BDD avec l'état des actions calculés
	var $sql_BDDpath; $dataTexte : Text
	var $i : Integer
	
	$params.MiseAjourError:=-15068
	Case of 
		: (Not(OB Is defined($params; "Actions")))
			$params.MiseAjourErrorDescription:="Actions non défini dans $params"
		: (Value type($params.Actions)#Is collection)
			$params.MiseAjourErrorDescription:="Actions de $params.reqRetour n'est pas une collection"
			
		Else 
			ARRAY TEXT($tabUUID; 0)
			ARRAY LONGINT($tabActionEtat; 0)
			COLLECTION TO ARRAY($params.Actions; $tabUUID; "ID"; $tabActionEtat; "ActionEtat")
			$params.MiseAjourError:=-15068*Num($params.Actions.length=0)
			$params.MiseAjourErrorDescription:="Aucune action reçue"
			
			// mettre à jour chaque action reçue
			Begin SQL
				SELECT DATABASE_PATH() FROM _USER_SCHEMAS LIMIT 1 INTO :$sql_BDDpath;
				START TRANSACTION;
			End SQL
			$params.DATABASE_PATH:=$sql_BDDpath
			
			$params.commande:=""
			For ($i; 1; Size of array($tabUUID))
				$dataTexte:="UPDATE Ecritures SET ActionEtat = "+String($tabActionEtat{$i})+" WHERE ID = '"+$tabUUID{$i}+"';"
				Begin SQL
					EXECUTE IMMEDIATE :$dataTexte;
				End SQL
				$params.MiseAjourError:=-15064*Num(ok=0)
				$params.MiseAjourErrorDescription:="EXECUTE IMMEDIATE a échoué"*Num(ok=0)
				$params.commande:=$params.commande+", "+$dataTexte
				
				If ($params.MiseAjourError#0)
					// arrêter les frais
					$i:=Size of array($tabUUID)+1
				End if 
			End for 
			$params.commande:=Current method name+$params.commande
			
			Begin SQL
				COMMIT TRANSACTION;
			End SQL
	End case 
	
	
Function SupprimerLesActions($params : Object)
	var $sql_BDDpath; $dataTexte : Text
	var $UserID; $i : Integer
	var $c; $select : Collection
	var $action : Object
	
	$params.Error:=-15068
	Case of 
		: (Not(OB Is defined($params; "UserID")))
			// il faut un user
			$params.Error:=-15068
			$params.ErrorDescription:="UserID non défini dans $params"
			
		: (Not(OB Is defined($params; "Etat")))
			// il faut un etat
			$params.Error:=-15068
			$params.ErrorDescription:="Etat non défini dans $params"
			
		Else 
			// on a tout
			
			Begin SQL
				SELECT DATABASE_PATH() FROM _USER_SCHEMAS LIMIT 1 INTO :$sql_BDDpath;
				START TRANSACTION;
			End SQL
			
			$UserID:=$params.UserID
			ARRAY TEXT($tabUUID; 0)
			ARRAY TEXT($tabActionDate; 0)
			ARRAY LONGINT($tabActionID; 0)
			ARRAY LONGINT($tabActionEtat; 0)
			Begin SQL
				SELECT  ID, ActionDate, ActionID, ActionEtat FROM Ecritures WHERE UserID = :$UserID INTO :$tabUUID, :$tabActionDate, :$tabActionID, :$tabActionEtat;
			End SQL
			$params.Error:=-15064*Num(ok=0)
			$params.DATABASE_PATH:=$sql_BDDpath
			$params.commande:=Current method name
			
			// trier les actions par ordre chronologique
			SORT ARRAY($tabActionDate; $tabUUID; $tabActionID; $tabActionEtat; >)
			
			// passer en objet
			$c:=New collection
			ARRAY TO COLLECTION($c; $tabUUID; "ID"; $tabActionDate; "ActionDate"; $tabActionID; "ActionID"; $tabActionEtat; "ActionEtat")
			
			$i:=1
			Repeat 
				$i:=Find in array($tabActionID; cdk Modifier; $i)
				If ($i=-1)
					// plus d'actions à supprimer
				Else 
					$select:=$c.query("ActionDate <= :1 and ActionEtat # :2 and ActionEtat # :3"; $tabActionDate{$i}; ack action non connue; ack action traitée)
					If ($select.length>0)
						// il y a encore des actions à faire traiter
						$i:=-1
					Else 
						// supprimer les actions antérieures $tabActionDate{$i}
						$select:=$c.query("ActionDate <= :1"; $tabActionDate{$i})
						
						// on fait bourin (pas de DELETE par un $tab)
						For each ($action; $select)
							$dataTexte:=$action.ID
							Begin SQL
								DELETE FROM Ecritures WHERE ID = :$dataTexte;
							End SQL
							
							If (ok=1)
								// supprimer de la collection
								$c.remove($c.indexOf($action))
								
							Else 
								// on arrête
								$i:=-1
							End if 
						End for each 
						
						// rechercher le suivant
						$i:=$i+1
					End if 
				End if 
			Until ($i=-1)
			
			Begin SQL
				COMMIT TRANSACTION;
			End SQL
			
			// appeler la suite
			Case of 
				: (Not(OB Is defined($params; "nomProcessAppelant")))
				: (Not(OB Is defined($params; "CallBack")))
				Else 
					cs.$process.new().AppelerFormulaire($params.nomProcessAppelant; $params.CallBack; Null)
					// c'est fini
			End case 
			// c'est fini
	End case 
	
	
	// ----------------------
	// MARK:BDD 
	// -----------------------
	
Function DebutTransaction()
	This.FixerParamètres()
	This.OuvrirBDD()
	
	
Function FinTransaction()
	This.FermerBDD()
	
	
Function OuvrirBDD()->$result : cs.$trace
	var $sql_BDDpath; $sql_BDDcourantePath; $texte : Text
	var $table; $champ : Object
	
	$result:=cs.$trace.me
	
	// fixer le nom de la BDD externe ouvrir
	$sql_BDDpath:=This.sql_BDDpath
	
	// lire la BDD externe ouverte
	$sql_BDDcourantePath:=""
	Begin SQL
		SELECT DATABASE_PATH() FROM _USER_SCHEMAS LIMIT 1 INTO :$sql_BDDcourantePath;
	End SQL
	If (Position("/"; $sql_BDDcourantePath)>0)
		$sql_BDDcourantePath:=Convert path POSIX to system($sql_BDDcourantePath)
	End if 
	
	Case of 
		: ($sql_BDDpath+".4DB"=$sql_BDDcourantePath)
			// déjà ouverte, ne rien faire
			
		: (Test path name($sql_BDDpath+".4DB")=Is a document)
			// ouverture d'une BDD $nomBDD existante; auto_close ferme physiquement la base au prochain changement de base
			Begin SQL
				USE DATABASE DATAFILE :$sql_BDDpath AUTO_CLOSE;
			End SQL
			// attention ici on est thread-safe
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event]; "Process "+Current process name; Current method name; "Ouverture du journal : "+$sql_BDDpath; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		Else 
			Waiting(30)
			
			// nouvelle BDD externe
			//-- créer les fichiers $fichier.4DB et $fichier.4DD
			//-- créer / mettre à jour la structure
			//-- créer les index
			//-- envoyer les requêtes SQL vers la BDD externe
			
			// créer la commande de création de la structure
			$result.Error:=-15068
			Case of 
				: (Not(OB Is defined(This; "parametresBDD")))
					$result.ErrorDescription:="parametresBDD n'est pas défini dans $params"
				: (Not(OB Is defined(This.parametresBDD; "structure")))
					$result.ErrorDescription:="structure n'est pas défini dans this.parametresBDD"
				: (This.parametresBDD.structure.length=0)
					$result.ErrorDescription:="structure dans this.parametresBDD est vide"
				Else 
					
					CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Process "+Current process name; Current method name; "Création de '"+$sql_BDDpath+"'"; New object("nomProcess"; Current process name; "numProcess"; Current process))
					
					For each ($table; This.parametresBDD.structure)
						// on a une table
						Case of 
							: (Not(OB Is defined($table; "nomTable")))
							: (Not(OB Is defined($table; "champs")))
							: ($table.champs.length=0)
							Else 
								// ok on a une table et ses champs
								$texte:="CREATE TABLE IF NOT EXISTS "+$table.nomTable
								// lister les champs
								$texte:=$texte+" ("
								For each ($champ; $table.champs)
									$texte:=$texte+$champ.champ+" "+$champ.type+", "
								End for each 
								// fermer
								$texte:=Substring($texte; 1; Length($texte)-2)+");"
						End case 
					End for each 
					
					Begin SQL
						CREATE DATABASE IF NOT EXISTS DATAFILE :$sql_BDDpath;
						USE DATABASE DATAFILE :$sql_BDDpath AUTO_CLOSE;
						
						EXECUTE IMMEDIATE :$texte;
					End SQL
					$result.Error:=-15063*Num(ok=0)
			End case 
			
			$result.FixerSuccess()
			$result.LeverException([msgk_event; msgk_log])
	End case 
	// Maintenant toutes les requêtes SQL du process sont dirigées vers $sql_BDDpath
	
	
Function FixerParamètres()
	// Fixer les paramètres de la BDD
	
	This.nomBDD:="BDD_JALV"
	// chemin du dossier (local ou serveur, selon le type d'APP)
	This.dossierBDD:=cs.$document.new().GetAppWorkSpace().folder(Localized string("150"))
	// fixer les paramètres de la structure de la BDD, au cas où besoin de créer la BDD
	This.parametresBDD:=New object
	This.parametresBDD.cheminStructure:=Folder(fk resources folder; *).folder("Enumerations").file("Structure_BDD_JALV.json").platformPath
	This.parametresBDD.structure:=JSON Parse(Document to text(This.parametresBDD.cheminStructure))
	
	// chemin de la BDD externe
	This.dossierBDD.folder(This.nomBDD+".4dbase").create()
	This.sql_BDDpath:=This.dossierBDD.folder(This.nomBDD+".4dbase").file(This.nomBDD).platformPath
	
	
Function FermerBDD()->$result : cs.$trace
	// fermer la base
	Begin SQL
		USE DATABASE SQL_INTERNAL;
	End SQL

⇧ [class]DepartementsEntity - 12/04/2026 15:57:59

      Class extends Entity

Function IDcodé()->$ID : Integer
	$ID:=cs._ds.me.IDcodé(This)
	
	
Function Libellé($userFormats : Object)->$libellé : Text
	// renvoie le nom formaté suivant les options $1
	// $formats
	// .Options 
	//   bit 22 = département
	//   bit 24 = ajouter le n° de département au département
	var $formats : Object
	var $options : Integer
	var $texte : Text
	
	$formats:=New object("Options"; 0x01400000)
	Case of 
		: (Count parameters=0)
		: (OB Is defined($userFormats; "Options"))
			$formats:=$userFormats
	End case 
	// ajouter les formats manquants
	ds._FixerParamètresLibellé($formats)
	$options:=$formats.Options
	
	// (n° département) nom départemnt - suite
	$libellé:=("("+String(This.numero)+") ")*Num((This.numero#0) & ($options ?? 24))
	$libellé:=($libellé+This.nom)*Num($options ?? 22)
	$texte:=This.Le("Regions").Libellé($formats)
	$libellé:=$libellé+((" - "+$texte)*Num((Length($texte)>0)))
	
	
Function Icone()->$pict : Picture
	// renvoyer l'icone de l'entité
	var $result : Object
	
	$result:=ds.LeIcone(This; "blason")
	$pict:=$result.icone
	
	
	// ----------------------
	// sélections
	// -----------------------
	
Function Le($DataClassNom : Text)->$result : Object
	// renvoie l'entité [$DataClassNom]
	If ($DataClassNom=This.getDataClass().getInfo().name)
		$result:=This
	Else 
		$result:=This.laRegion.Le($DataClassNom)
	End if 
	
	
	// ----------------------
	// modification DataStore
	// -----------------------
	
Function Ajouter($quoi : Integer; $qui : Object; $params : Object)->$result : Object
	// ajouter une commune, une région à this
	ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "Début de l'ajout à ["+This.getDataClass().getInfo().name+"]"))
	
	$result:=ds.initResult()
	
	Case of 
		: ($quoi=geok Commune)
			// sous traiter
			$result:=ds.AjouterLienRetour($quoi; This; $qui; $params)
			// retour sur le lieu de la commune créée
			$result.entitéRetour:=$result.entitéAjoutée.lesSites.lesLieux[0]
			
		: ($quoi=geok Région)
			// créer une région au pays courant
			$result:=ds.AjouterLienRetour($quoi; This.laRegion.lePays; Null; $params)
			// accrocher le département à cette région
			If ($result.Error=0)
				This.region:=$result.entitéAjoutée.ID
				This.save()
			End if 
	End case 
	// pour le journal
	$params.Description_Action:=Localized string(String($quoi))+Localized string("33")+This.Libellé()
	
	$result.success:=($result.Error=0)
	ds.NotifierResultat(This; $quoi; $result)
	
	
Function _FixerDonnées($quoi : Integer; $params : Object)->$result : Object
	// un département a été créé
	$result:=ds._FixerDonnées(This; $quoi; $params)
	
	This.numero:=-1
	This.nom:=Localized string("38")+" ID_"+String(This.ID)
	This.save()
	// ici, pour les 2 cas "Ajout DataStore" ou "Modifier DataStore_Extérieur", $params a les mêmes informations
	
	
	// ----------------------
	// interface externe
	// -----------------------
	
Function CopierVersObjet($entitéExt : Object)
	// recopier les attributs de this dans $entitéExt (pour une utilisation hors BDD mère)
	var $entité : Object
	
	$entitéExt.ID:=This.ID
	$entitéExt.IDunique:=This.IDunique
	
	$entitéExt.nom:=This.nom
	$entitéExt.numero:=This.numero
	$entitéExt.blason:=This.blason
	$entitéExt.latitude:=This.latitude
	$entitéExt.longitude:=This.longitude
	
	// la région
	// demander à l'appelant sa classe Regions
	$entité:=OB Copy($entitéExt.protoRegion)
	// faire compléter
	This.laRegion.CopierVersObjet($entité)
	$entitéExt.laRegion:=$entité

⇧ [class]$visualisateur - 06/05/2026 09:49:59

      property InformationZS : Text

Class extends $formulaire

Class constructor()
	// construction commune
	Super()
	
	// on veut afficher une sélection dans un process "Visualisation"
	// le process de départ n'est pas connu ici
	This.params.numProcessAppelant:=-1
	
	// texte affichant l'information d'une zone sensible
	This.InformationZS:=""
	
	
	// ----------------------
	//  MARK:Affichage 
	// -----------------------
	
Function FixerSélectionVisualisable()
	// on a un .deQui en params, en faire une sélection affichable
	// la création se fait dans un worker pour libérer le process courant
	var $params : Object
	
	$params:=This.FixerParamètresSélectionVisualisable()
	$params.DataClassNom:=This.getDataClassInfos(OB Class(This).name).name
	$params.deQui:=This.params.deQui
	// on va passer sur le serveur; passer les userprefs
	$params.UserPrefs:=OB Copy(This.session.prefs)
	// WK à appeler
	$params.nomProcess:="WK_selectionsBDD"
	// pour la suite des opérations, le worker appellera le callBack du process nomProcessAppelant : "CallBackFixerSélectionVisualisable"
	$params.nomProcessAppelant:=Current process name
	$params.CallBack:="CallBackFixerSélectionVisualisable"
	
	This.process.ExecuterDansWorker(cs.$formulaire; "FixerSélectionVisualisable"; $params)
	
	
Function surEvenementFormulaire()
	Case of 
		: (FORM Event.code=On Load)
			This.FixerVisibilitéPalettes(False)
			
		: (FORM Event.code=On Deactivate)
			This.FixerVisibilitéPalettes(False)
	End case 
	// passer la main
	Super.surEvenementFormulaire()
	
	
Function AfficherInformations()
	// afficher les informations de l'objet lié (si demande utilisateur)
	// rappel : InformationZS est masqué à l'init, il est multistyle pour que le worker le mette à jour (mais pas de liens hypertexte possibles!)
	var $params; $data; $entité : Object
	var $result : Boolean
	
	// préparer les paramètres du worker
	$params:=New object
	$params.Options:=1
	// nom de la variable callback où stocker (obtenir le nom par un pointeur, sinon ça pourrait bugger si on fait un remplacer variable)
	$params.Variable:="InformationZS"  // (propriété de Form)
	// formulaire d'affichage
	$params.Formulaire:=Current form window
	// masquer par défaut
	$params.EnregistrementCodé:=-1
	
	// mettre à jour les infos, si on pointe une nouvelle zone sensible ou bien on en sort
	// Form.ZoneActive est l'entité codée liée à la zone en cours d'affichage
	// rappel : .ZoneSurvolée = -1 pas de ZS, sinon ID zone (.EnregistrementLié = objet du lien)
	$result:=True
	Case of 
		: ((Storage.System.Navigation.ZS.ZoneSurvolée=-1) & (Form.ZoneActive#-1))
			// on sort de toutes zones
			Form.ZoneActive:=-1
			
		: ((Storage.System.Navigation.ZS.ZoneSurvolée>0) & (Form.ZoneActive=-1))
			// on entre dans une zone
			Form.ZoneActive:=Storage.System.Navigation.ZS.EnregistrementLié
			
		: ((Storage.System.Navigation.ZS.ZoneSurvolée>0) & (Form.ZoneActive#Storage.System.Navigation.ZS.EnregistrementLié))
			// on change de zone
			Form.ZoneActive:=Storage.System.Navigation.ZS.EnregistrementLié
			
		Else 
			// ne rien faire
			$result:=False
	End case 
	// fin du filtrage
	
	Case of 
		: (Not($result))
		: (This.session.prefs.Visualisation.InformationsZS=1100)
		Else 
			// préparer les paramètres du worker
			$params:=New object
			// formulaire d'affichage
			$params.Formulaire:=Current form window
			// options de mise en forme
			$params.params:=0x0003
			If (Form.ZoneActive=-1)
				// effacer l'information
				$params.DataClassNom:=""
				$params.IDunique:=""
			Else 
				// entité dont l'utilisateur demande les informations
				$entité:=ds[Table name(CodeEnreg(Form.ZoneActive))].get(Form.ZoneActive & 0x00FFFFFF)
				$params.DataClassNom:=$entité.getDataClass().getInfo().name
				$params.IDunique:=$entité.IDunique
			End if 
			// pour la suite des opérations, le worker appellera le callBack du process numProcessAppelant : "FixerHyperTexte"
			$params.nomProcessAppelant:=Current process name
			$params.CallBack:="CallBackFixerTexte"
			
			// créer et afficher les informations
			$data:=New object("params"; $params)
			$data.execute:=Formula(cs.$serveurAPP.me.Executer(cs.$texteEditeur.name; "InformationEntité"; This.params))
			CALL WORKER("WK_selectionsBDD"; Formula($data.execute()))
	End case 
	
	
	// ----------------------
	// MARK:Demande actions 
	// -----------------------
	
Function CallBackFixerTexte($params : Object)
	var $texte : Text
	
	$texte:=$params.texteWorké
	This.InformationZS:=$texte
	// afficher l'information
	OBJECT SET VISIBLE(*; "InformationZS"; Length($texte)#0)
	
	
Function CallBackFixerSélectionVisualisable($params : Object)
	// fixer pour ce formulaire la sélection courante
	This.nav.FixerSélectionNavigation($params.sélectionEntités)
	// mettre à jour le deQui (a pu être réduit)
	This.informations.deQui:=$params.deQui
	// appeler la fonction d'affichage
	Form.AfficherEntité()
	
	
Function NouvelleSélection()
	// un process externe envoie une sélection à éditer
	// la lire
	This.params.deQui:=This.process.LireSélection()
	// la visualiser
	This.FixerSélectionVisualisable()
	
	
Function MettreAjourSelection()
	// afficher la nouvelle entité courante
	Form.AfficherEntité()

⇧ [class]$rechercheBDD - 22/08/2025 09:49:24

      property Critères; resultRecherche : Object

Class constructor()
	
	This.Critères:=Null
	This.resultRecherche:=Null
	
	
	// ----------------------
	// MARK:Personnes
	// -----------------------
	
Function RechercherPersonnes($params : Object; $resultRecherche : Pointer)->$result : Object
	// créer la sélection de personnes répondant aux critères de recherche $params :
	// nom, prénom, dates min / max de naissance / mariage / décès
	var $c : Collection
	var $sélection1; $sélection2 : cs.PersonnesSelection
	var $typeEvent : Object
	var $attribut : Text
	
	MESSAGES OFF
	
	$sélection1:=ds.Personnes.newSelection()
	
	// initialiser les consignes de filtrage demandés
	This.Critères:=OB Copy($params)
	
	// renseigner les filtres globaux
	If (Not(OB Is defined(This.Critères; "FiltrePersonnes")))
		This.Critères.FiltrePersonnes:=ds.Personnes.all().toCollection().extract("ID")
	End if 
	If (Not(OB Is defined(This.Critères; "FiltreEvents")))
		This.Critères.FiltreEvents:=ds.Events.all().toCollection().extract("ID")
	End if 
	If (Not(OB Is defined(This.Critères; "FiltreCommunes")))
		This.Critères.FiltreCommunes:=ds.Communes.all().toCollection().extract("ID")
	End if 
	
	// une personne trouvée sera retenue si ses events (par type) sont présents dans les filtres locaux
	// liste des type d'events pris en compte ; certains peuvent ne pas exister dans la demande $params
	$c:=This.ListerCritèresEvents()
	// valider les paramètres de ces filtres fournis par l'utilisateur, par type d'event
	For each ($typeEvent; $c)
		This.ValiderCritèresEvents($typeEvent)
	End for each 
	
	// * Rechercher selon nom et prénom
	$sélection1:=This.SélectionnerPersonnesSurCritères()
	
	// * Rechercher des personnes selon events (3 types)
	$sélection2:=ds.Personnes.newSelection()
	For each ($attribut; OB Keys(This.Critères.Events))
		$sélection2:=$sélection2.or(This.SélectionnerPersonnesSurEvents(This.Critères.Events[$attribut]))
	End for each 
	
	// * finalement, fixer le résultat dans $sélection1
	Case of 
		: (($sélection1.length=0) & ($sélection2.length=0))
			// rien
			$sélection1:=ds.Personnes.newSelection()
			
		: (($sélection1.length>0) & ($sélection2.length>0))
			// les 2 domaines ont données des résultats
			// faire l'intersection(peut être vide !)
			$sélection1:=$sélection1.and($sélection2)
			
		: ($sélection2.length>0)
			$sélection1:=$sélection2
			
		Else 
			// c'est $sélection1
	End case 
	
	Case of 
		: (Type($resultRecherche->)=Is object)
			// typiquement recherche depuis la base hôte
			$resultRecherche->:=New object
			$resultRecherche->:=$sélection1
			
		: (Type($resultRecherche->)=Is collection)
			// typiquement rechercher depuis un composant (les entités nes ont pas transmettables)
			$resultRecherche->:=New collection
			$resultRecherche->:=$sélection1.extract("ID")
	End case 
	// v20R7 semble nécessaire si utilisé par un .call()
	$result:=Null
	
	MESSAGES ON
	
	
Function SélectionnerPersonnesSurCritères()->$result : cs.PersonnesSelection
	// sélectionner toutes les personnes de nom et / ou prénom demandés
	var $sélection : cs.PersonnesSelection
	var $personnesSurCritères : Boolean
	
	$sélection:=ds.Personnes.query("ID in :1"; This.Critères.FiltrePersonnes)
	// pas défaut les critères ne donnent rien
	$personnesSurCritères:=False
	
	// ** Filtrer selon nom et prénom
	Case of 
		: (Not(OB Is defined(This.Critères; "Nom")))
			// le patronyme de la personne n'existe pas
		: (This.Critères.Nom="")
			// le patronyme de la personne n'est pas renseigné
		Else 
			$sélection:=$sélection.and($sélection.query("nom = :1"; This.Critères.Nom))
			$personnesSurCritères:=True
	End case 
	
	Case of 
		: (Not(OB Is defined(This.Critères; "Prenom")))
			// le prénom de la personne n'existe pas
		: (This.Critères.Prenom="")
			// le prénom de la personne n'est pas renseigné
		Else 
			$sélection:=$sélection.and($sélection.query("prenom = :1"; This.Critères.Prenom))
			$personnesSurCritères:=True
	End case 
	
	// finalement
	$result:=ds.Personnes.newSelection()
	If ($personnesSurCritères)
		$result:=$sélection
	End if 
	
	
Function SélectionnerPersonnesSurEvents($params : Object)->$result : cs.PersonnesSelection
	// renvoyer la sélection  de tous les events de la commune selon $2
	// les filtres globaux (events et commune) sont appliqués à la collection
	var $sélection : Object
	var $personnesSurEvents : Boolean
	
	// par défaut tous les events
	$sélection:=ds.Events.query("ID in :1"; This.Critères.FiltreEvents)
	// est ce que des critères events existent?
	$personnesSurEvents:=$params.date.valide
	
	//  essayer les events de la commune
	If ($params.lieu.valide)
		// on a une commune
		$sélection:=ds.Communes.query("nom = :1 and ID in :2"; $params["lieu"]["nom"]; This.Critères.FiltreCommunes)
		$sélection:=$sélection.lesSites.lesLieux.lesEvenements
		$personnesSurEvents:=True
	End if 
	
	// finalement
	$result:=ds.Personnes.newSelection()
	If ($personnesSurEvents)
		// on a quelque chose selon les critères
		// filtrer
		$sélection:=$sélection.Filtrer($params; This.Critères.FiltreEvents)
		
		// finalement les personnes de ces events, et filtrage
		$result:=$sélection.LesPersonnes().Filtrer($params; This.Critères.FiltrePersonnes)
	End if 
	
	
Function ListerCritèresEvents()->$result : Collection
	$result:=New collection
	$result.push(New object("nomEvent"; "Naissances"; "typeMin"; 22000; "typeMax"; 22000))
	$result.push(New object("nomEvent"; "Deces"; "typeMin"; 22100; "typeMax"; 22100))
	$result.push(New object("nomEvent"; "Mariages"; "typeMin"; 33600; "typeMax"; 33699))
	
	
Function ValiderCritèresEvents($critères : Object)
	// fixe des données de filtrage exploitables dans this.Critères.Events[$typeEvent] : 
	// .date.valide, .date.start (dateNum), .date.stop (dateNum) .lieu  (nom)
	var $data : Object
	var $nomEvent : Text
	
	$nomEvent:=$critères.nomEvent
	Case of 
		: (Not(OB Is defined(This.Critères; "Events")))
			// créer l'event, date invalide par principe
			This.Critères.Events:=New object($nomEvent; New object("date"; New object("valide"; False)))
			
		: (Not(OB Is defined(This.Critères.Events; $nomEvent)))
			// créer l'event, date invalide par principe
			This.Critères.Events[$nomEvent]:=New object("date"; New object("valide"; False))
			
		: (Not(OB Is defined(This.Critères.Events[$nomEvent]; "date")))
			// créer la date invalide par principe
			This.Critères.Events[$nomEvent]["date"]:=New object("valide"; False)
			
		Else 
			$data:=This.Critères.Events[$nomEvent]["date"]
			// invalide par défaut
			$data.valide:=False
			$data.FormatDate:=0
			// rappel cas du serveur Web : il envoie toujours une donnée, nulle si non utilisée
			
			// date de début
			// mettre la date par défaut (au cas où elle serait nécessaire
			$data.StartNum:=!100-01-01!
			Case of 
				: (Not(OB Is defined($data; "Start")))
				: ($data.Start="")
				Else 
					// on a une date chaine
					This.getDateNum($data.Start; $data)
					$data.StartNum:=$data.dateNum
					$data.valide:=$data.dateValide
					// date non renseignée, mettre la date par défaut (au cas où elle serait nécessaire)
			End case 
			
			// date de fin
			// mettre la date par défaut (au cas où elle serait nécessaire)
			$data.StopNum:=!3000-01-01!  // y a de la marge !
			Case of 
				: (Not(OB Is defined($data; "Stop")))
				: ($data.Stop="")
				Else 
					// utiliser cette date chaine
					This.getDateNum($data.Stop; $data)
					$data.StopNum:=$data.dateNum
					$data.valide:=$data.dateValide
			End case 
			
			Case of 
				: (Not(OB Is defined(This.Critères.Events[$nomEvent]; "lieu")))
					// créer le lieu invalide par principe
					This.Critères.Events[$nomEvent]["lieu"]:=New object("valide"; False)
					
				: (Not(OB Is defined(This.Critères.Events[$nomEvent]["lieu"]; "nom")))
					This.Critères.Events[$nomEvent]["lieu"]["valide"]:=False
					
				: (This.Critères.Events[$nomEvent]["lieu"]["nom"]="")
					This.Critères.Events[$nomEvent]["lieu"]["valide"]:=False
					
				Else 
					This.Critères.Events[$nomEvent]["lieu"]["valide"]:=True
			End case 
			// ici valide vaut vrai si la date de dbut et / ou de fin est correcte et / ou commune existe
			
			// recopier le filtrage sur le type
			This.Critères.Events[$nomEvent].typeMin:=$critères.typeMin
			This.Critères.Events[$nomEvent].typeMax:=$critères.typeMax
	End case 
	
	
	// ----------------------
	// MARK:Communes
	// -----------------------
	
Function RechercherCommunes($params : Object; $resultRecherche : Pointer)->$result : Object
	var $sélection : cs.CommunesSelection
	
	MESSAGES OFF
	
	// initialiser les consignes de filtrage demandés
	This.Critères:=OB Copy($params)
	
	// renseigner les filtres globaux
	If (Not(OB Is defined(This.Critères; "FiltreCommunes")))
		This.Critères.FiltreCommunes:=ds.Communes.all().toCollection().extract("ID")
	End if 
	
	// valider les paramètres de ces filtres fournis par l'utilisateur
	This.ValiderCritèresCommunes()
	
	// * Rechercher selon nom et prénom
	$sélection:=This.SélectionnerCommunesSurCritères()
	
	Case of 
		: (Type($resultRecherche->)=Is object)
			// typiquement recherche depuis la base hôte
			$resultRecherche->:=New object
			$resultRecherche->:=$sélection
			
		: (Type($resultRecherche->)=Is collection)
			// typiquement rechercher depuis un composant (les entités nes ont pas transmettables)
			$resultRecherche->:=New collection
			$resultRecherche->:=$sélection.extract("ID")
	End case 
	// v20R7 semble nécessaire si utilé par un .call()
	$result:=Null
	
	MESSAGES ON
	
	
Function SélectionnerCommunesSurCritères()->$result : cs.CommunesSelection
	$result:=ds.Communes.query("nom = :1 and ID in :2"; This.Critères.nom; This.Critères.FiltreCommunes)
	
	
Function ValiderCritèresCommunes()
	Case of 
		: (Not(OB Is defined(This.Critères; "nom")))
			This.Critères.nom:=""
			
		: (Length(This.Critères.nom)>0)
			This.Critères.nom[[1]]:=Uppercase(This.Critères.nom[[1]])
	End case 
	
	
	// ----------------------
	// MARK:Lieux
	// -----------------------
	
Function RechercherLieux($params : Object; $resultRecherche : Pointer)
	
	//Sinon 
	//// au cas où... (initialisation pas faite)
	//Au cas ou 
	//: (Type($3->)=Est un objet)
	//$3->:=Créer objet
	
	//: (Type($3->)=Est une collection)
	//$3->:=Créer collection
	//Fin de cas 
	//Fin de cas 
	
	
	
	// ----------------------
	// MARK:Utilitaires
	// -----------------------
	
Function getDateNum($dateChaine : Text; $data : Object)
	// convertit $dateChaine en une variable date
	var $date; $jour; $mois; $année; $nomDuMois; $nomMois : Text
	var $i : Integer
	
	Case of 
		: (Match regex("[0-9]{1,2}\\/[0-9]{1,2}\\/[0-9]{4}"; $dateChaine))
			// $dateChaine = jj/mm/aaaa
			$data.dateValide:=True
			$data.dateNum:=Date($dateChaine)
			
		: (Match regex("[0-9]{1,2}\\ [a-z]{3,9}\\ [0-9]{4}"; $dateChaine))
			// $dateChaine = jj mois aaaa
			
			// bit 8 de $options = entête  ;  $Formats.FormatDate
			// créer la date numérique et la valider
			$date:=$dateChaine
			//le séparateur d'items de date est " "
			$jour:=Substring($date; 1; Position(" "; $date; *)-1)
			$date:=Delete string($date; 1; Position(" "; $date; *))
			$nomDuMois:=Substring($date; 1; Position(" "; $date; *)-1)
			$date:=Delete string($date; 1; Position(" "; $date; *))
			$année:=Substring($date; 1; 4)
			
			$data.dateValide:=False
			
			$mois:="01"
			For ($i; 12; 1; -1)
				$nomMois:=String(Add to date(!1999-12-01!; 0; $i; 0); Internal date long)
				$nomMois:=Substring($nomMois; Position(" "; $nomMois; *)+1)
				$nomMois:=Substring($nomMois; 1; Position(" "; $nomMois; *)-1)  // nom du mois $1 dans la langue courante
				If ($nomDuMois=$nomMois)
					$mois:=String($i)
					$data.dateValide:=True
					$i:=0
				End if 
			End for 
			
			If (Num($année)=0)
				$année:="100"
				$data.dateValide:=False
			End if 
			
			If (Num($jour)=0)  // dernier jour du mois $mois
				$jour:=String(Day of(Add to date(Add to date(!00-00-00!; Num($année); Num($mois)+1; 1); 0; 0; -1)))
				$data.dateValide:=False
			End if 
			
			$data.dateNum:=Add to date(!00-00-00!; Num($année); Num($mois); Num($jour))
			
		Else 
			// $dateChaine autre format ou vide
			$data.dateValide:=False
	End case

⇧ [class]EventsEntity - 23/04/2026 10:03:01

      Class extends Entity

Function IDcodé()->$ID : Integer
	$ID:=cs._ds.me.IDcodé(This)
	
	
Function Libellé($userFormats : Object)->$libellé : Text
	// renvoie le nom formaté  de l'évent suivant les options $1
	var $formats : Object
	var $options : Integer
	var $texte : Text
	var $sélection : Object
	
	$formats:=New object("Options"; 0x9000)
	Case of 
		: (Count parameters=0)
		: (OB Is defined($userFormats; "Options"))
			$formats:=OB Copy($userFormats)  // on va le modifier
	End case 
	// ajouter les formats manquants
	ds._FixerParamètresLibellé($formats)
	$options:=$formats.Options
	
	// le quoi :
	If ($options ?? 12)
		If (($options ?? 13) & (This.leEventPersonnel.length=1))
			$libellé:=cs._cfct.me.LireLocatedSTR(This.typeReduit()+1000; New object("genre"; This.leEventPersonnel.laPersonne[0].sexe; "plur"; False))
		Else 
			$libellé:=Localized string(String(This.type))
			If ($options ?? 24)
				$libellé[[1]]:=Lowercase($libellé[[1]])
				$libellé:=Localized string(String(This.typeReduit()+1100))+$libellé
			End if 
		End if 
	End if 
	
	If ($options ?? 20)
		$libellé:=Localized string(String(16000000+This.type))+" "
	End if 
	
	// de qui :
	If ($options ?? 15)
		$sélection:=This.LesProtagonistes()
		$formats.Options:=$formats.Options ?+ 0
		$formats.Options:=$formats.Options ?+ 1
		Case of 
			: ($sélection.length=1)
				// un event de personne
				$libellé:=$libellé+Localized string("1001")+$sélection[0].Libellé($formats)
			: ($sélection.length=2)
				// un event de famille
				$libellé:=$libellé+Localized string("1001")+$sélection.Libellés($formats).result
		End case 
	End if 
	
	// date :
	If ($options ?? 10)
		$libellé:=$libellé
		$libellé:=$libellé+This.FormaterDate($formats)
		
		If ($options ?? 14)
			$libellé:=$libellé+This.FormaterHeure($formats)
		End if 
	End if 
	
	// lieu
	If (($options ?? 11) & (This.leLieu#Null))
		$libellé:=$libellé
		$texte:=$formats.SymbolDateLieu*Num(Not($options ?? 9))
		// créer la sélection commune
		$libellé:=$libellé+$texte+This.LeLieu().Le("Communes").Libellé($formats)
	End if 
	
	
Function LibelléEncyclo($attribut : Text)->$result : Text
	var $texte : Text
	
	$texte:="<span style="+Char(Double quote)+"-d4-ref-user:'"+String(cs._ds.me.IDcodé(This))+"'"+Char(Double quote)+">"+This.Libellé()+"</span>"
	$result:=cs.$hyperTexteEditeur.new().LibelléEncyclo($attribut; $texte)
	
	
Function RédigerCommentaire($formats : Object)->$result : Text
	$result:=""
	Case of 
		: (Not($formats.params ?? 0))
		: (Not(OB Is defined($formats; "débutComment")))
		: (Not(OB Is defined($formats; "finComment")))
		Else 
			$result:=This.commentaire
	End case 
	$result:=($formats.débutComment+$result+$formats.finComment)*Num(Length($result)#0)
	
	
Function CréerListBoxPerso($params : Object)->$result : Object
	// données communes
	$params.genre:=This.leEventPersonnel.laPersonne[0].sexe
	$params.plur:=False
	$result:=This.CréerListBox($params)
	
	// données perso
	$result["type"+$params.tag]+=Char(Carriage return)+This._getValide()
	$result["entete"+$params.tag]+=Char(Carriage return)+Localized string("33")
	If (Not(This.leLieu=Null))
		$result[$params.tag]+=Char(Carriage return)+"<SPAN STYLE="+$params.styleEvent+">"+This.leLieu.leSite.laCommune.Libellé(New object("Options"; 0x0000 ?+ 16))+"</SPAN>"
		$result[$params.tag]+=Char(Carriage return)+"<SPAN STYLE='font-size:9pt'>"+This.leLieu.leSite.nom+"</SPAN>"
		$result[$params.tag]+=Char(Carriage return)+"<SPAN STYLE='font-size:9pt'>"+This.leLieu.nom+"</SPAN>"
	End if 
	
	
Function CréerListBox($params : Object)->$result : Object
	// ici $params n'est pas utilisé
	var $image : Picture
	
	$result:=This.LesProtagonistes().Libellés($params.formats)
	$result.type:=Localized string(String(This.type))
	$result.date:=This.dateChaine
	$result.dateNum:=This.dateNum
	
	$result["itemText"+$params.tag]:=This.Libellé()  // utiliser les formats par défaut
	If (This.lesIllustrations.laZone.query("type = :1"; 3).length>0)
		$image:=cs._rsc.me.image(15000)
	End if 
	$result["pict"+$params.tag]:=CoDecBase64_Objet($image)
	$result["type"+$params.tag]:=cs._rsc.me["symbol_"+String(This.type)]+" "+This._getType($params)
	$result["entete"+$params.tag]:=Localized string("32")
	$result[$params.tag]:="<SPAN STYLE="+$params.styleEvent+">"+This.dateChaine+"</SPAN>"
	
	$result.DataClassNom:=This.getDataClass().getInfo().name
	$result.ID:=This.ID
	$result.itemRef:=This.IDcodé()
	
	
Function _getValide()->$result : Text
	// ici on ne connait pas le "schemaCouleurPolice" du client : coder l'information
	
	Case of 
		: (This.source="@Archives@")
			$result:="<SPAN STYLE='color:codeColorScheme'>"+Char(0x2714)+"</SPAN>"
		: (This.source="")
			$result:=""
		Else 
			$result:="<SPAN STYLE='color: gray'>"+Char(0x2714)+"</SPAN>"
	End case 
	
	
Function _getType($params : Object)->$result : Text
	$result:=cs._cfct.me.LireLocatedSTR(1000+This.typeReduit(); $params)
	
	
	// ----------------------
	// MARK:Attributs calculés
	// -----------------------
	
Function typeReduit()->$result : Integer
	$result:=Int(This.type/100)%100
	
	
Function IconeRef()->$iconeRef : Integer
	Case of 
		: (This.source="")
		: (This.source="@Archives@")
			$iconeRef:=Code ressource UTF8+0x2714
			$iconeRef:=$iconeRef ?+ 24
			
		Else 
			$iconeRef:=Code ressource UTF8+0x2714
	End case 
	
	
Function FormaterDate($formats : Object)->$result : Text
	// code dateNum dans le format $Formats avec les options $3.Options
	// $formats :
	// .FormatDate
	// .FormatHeure
	// .Options:
	//.  bit 8 = entête
	var $data : Object
	var $options : Integer
	
	$result:=""
	
	$options:=$Formats.Options
	
	$data:=New object("dateChaine"; This.dateChaine)
	cs.xSDK.Outils.me.getDateNum($data)
	
	// mettre au format demandé
	Case of 
		: ($Formats.FormatDate=0)  // la date de la BDD au format numérique
			$formats.dateValide:=$data.dateNumValid
			$formats.dateNum:=Add to date(!00-00-00!; Year of($data.dateNum); Month of($data.dateNum); Day of($data.dateNum))
			
		: ($Formats.FormatDate=Internal date long)  // la date mémorisée en la BDD
			$result:=Choose(($options ?? 8) & $data.dateNumValid; Localized string("1008"); " ")+This.dateChaine
			
		: ($Formats.FormatDate=Internal date short)  // la date de la BDD si possible au format numérique 7 = "jj-mm-aaaa"
			Case of 
				: ($data.dateNumValid)
					$result:=(Localized string("1008")*Num($options ?? 8))+String(Day of($data.dateNum))+"-"+String(Month of($data.dateNum))+"-"+String(Year of($data.dateNum))
					
				: (This.dateChaine="")
					$result:=cs._cfct.me.LireLocatedSTR(1004)  // inconnu
					
				Else 
					$result:=(" "*Num($options ?? 8))+This.dateChaine
			End case 
			
		: ($Formats.FormatDate=11)  // la date de la BDD au format numérique = "aaaa"
			$result:=String(Year of($data.dateNum))
	End case 
	
	
Function FormaterHeure($formats : Object)->$result : Text
	// code heure dans le format $Formats avec les options $3.Options
	// $formats :
	// .FormatHeure
	// .Options:
	//   bit 8 = entête
	var $options : Integer
	var $texte : Text
	
	$options:=$Formats.Options
	
	$texte:=String(Time(This.heure); Num($Formats.FormatHeure))
	$texte:=Replace string($texte; ":"; "h"; *)
	$texte:=(Localized string("33")*Num($options ?? 8))+$texte
	$result:=$texte*Num(Not(Time(This.heure)=?00:00:00?))
	
	
	// ----------------------
	// MARK:Sélections
	// -----------------------
	
Function LesProtagonistes()->$result : Object
	// renvoie la sélection entités [Personnes] à l'origine de cet event
	$result:=This.getEventType().LesProtagonistes()
	
	
Function LesTémoins($liste : Text)->$result : Object
	// renvoie la liste des témoins (liste $ 1) de l'event (selection Entity de [Personnes]
	$result:=This.getEventType().LesTémoins($liste)
	
	
Function LesEnfants()->$result : Object
	// renvoie la liste des enfants de l'event (selection Entity de [Personnes])
	$result:=This.getEventType().LesEnfants()
	
	
Function LeLieu()->$result : Object
	// renvoie l'entité [$DataClassNom]
	$result:=This.leLieu
	
	
Function est($type : Integer)->$result : Boolean
	// renvoie vrai si l'event est de type $type
	$result:=This.getEventType().est($type)
	
	
Function getEventType()->$result : Object
	// attention : c'est un lien 1->N
	Case of 
		: (This.leEventPersonnel.length>0)
			$result:=This.leEventPersonnel[0]
		: (This.leEventFamilial.length>0)
			$result:=This.leEventFamilial[0]
	End case 
	
	
	// ----------------------
	//MARK:Modification DataStore
	// -----------------------
	
Function Ajouter($quoi : Integer; $qui : Object; $params : Object)->$result : Object
	// créer un témoin, une illystration de this
	// $1 = code de la création, $2 = entité (peut-être null), $3 paramètres
	var $entité : Object
	var $ID : Integer
	ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "Début de l'ajout à ["+This.getDataClass().getInfo().name+"]"))
	
	$result:=ds.initResult()
	
	// fixer Qui
	If ($qui=Null)
		// créer qui, envoyer les paramètres de this, au besoin
		$result:=ds.Créer($quoi; ""; $params)
		$qui:=$result.entitéAjoutée
	End if 
	
	// créer le lien entre $qui et this
	Case of 
		: ($qui=Null)
		: ($quoi=agk Temoin)
			
			// ajouter $qui comme témoin de l'évent
			// récupérer le groupe de témoins
			Case of 
				: (Not(OB Is defined($params; "liste")))
					$result.Error:=-15068
					$result.ErrorDescription:="le choix de la liste de témoins n'est pas défini"
					$params.groupe:=Null
					
					// on a déjà une liste
				: (This.LesTémoins($params.liste)#Null)
					// filtrer
					If (This.type=22300)
						$result.Error:=-15010
						$result.ErrorDescription:="un témoin de baptème ("+$params.liste+") est unique"
					Else 
						// une liste existe déjà; pointer le groupe de témoins
						$params.groupe:=This.getEventType()["le"+$params.liste]
					End if 
					
				Else 
					// créer le groupe de témoins
					$params.groupe:=ds.Groupes.new()
					ds.FixerIDentification($params.groupe)
					$params.groupe.save()
					// lier à l'event
					$entité:=This.getEventType()
					$entité[$params.liste]:=$params.groupe.ID
					$entité.save()
			End case 
			
			// ajouter le témoin
			If ($result.Error=0)
				$result.témoin:=$params.groupe.AjouterMembre($qui)
				$result.Error:=$result.témoin.Error
				$result.entitéAjoutée:=$qui
				// pour le journal
				$ID:=3033+Num($params.liste="Groupe2")
				$params.Description_Action:=Localized string(String($ID))+Localized string("33")+"Event ID"+String(This.ID)+" ("+$qui.Libellé(New object("Options"; 3))+")"
				
				// nettoyer
				OB REMOVE($params; "groupe")
			End if 
			
		: ($quoi=imk Illustration)
			// on a un media (qui a été créé  s'il n'existait pas) ; le lier à this
			// attention pour ajouter la zone il faut un aQui de type entité
			$params.aQui:=This
			$result:=$qui.Ajouter(imk Zone; Null; $params)
			$result.entitéAjoutée:=$qui
			// pour le journal
			$params.aQui:=cs._ds.me.EntitéRéduite(This)
			$params.Description_Action:=Localized string("3045")+Localized string("33")+This.Libellé(New object("Options"; (0x0000 ?+ 12) ?+ 15))+", fichier '"+$params.cheminDuMediaAjouté+"'"
			
		: ($quoi=imk URL)
			// on a un media (qui a été créé  s'il n'existait pas)
			// le lier à this
			$params.aQui:=This
			// fixer la position de la zone (pas forcément à sa place ici !)
			$params.gauche:=0
			$params.haut:=0
			$params.droite:=1
			$params.bas:=0.05
			$result:=$qui.Ajouter(imk Zone; Null; $params)
			$result.entitéAjoutée:=$qui
			// pour le journal
			$params.aQui:=cs._ds.me.EntitéRéduite(This)
			$params.Description_Action:=Localized string("3038")+Localized string("33")+This.Libellé(New object("Options"; (0x0000 ?+ 12) ?+ 15))+", fichier '"+$params.cheminDocument+"'"
			
		: ($quoi=dsk Private)
			// on a dans $qui , le lier à this
			// créer le lien
			$qui.IDunique:=This.IDunique
			$qui.save()
			// pour le journal
			$params.Description_Action:=Localized string("3113")+Localized string("33")+This.Libellé()
			
	End case 
	
	$result.success:=($result.Error=0)
	ds.NotifierResultat(This; $quoi; $result)
	
	
Function _FixerDonnées($quoi : Integer; $params : Object)->$result : Object
	
	$result:=ds._FixerDonnées(This; $quoi; $params)
	$result.entité:=This
	
	If (OB Is defined($params; "type"))
		This.type:=$params.type
	End if 
	This.dateNum:=!00-00-00!
	This.dateNumValid:=False
	This.save()
	
	
	// ----------------------
	// MARK:Interface externe
	// -----------------------
	
Function CopierVersObjet($entitéExt : Object)
	// recopier les attributs de this dans $entitéExt (pour une utilisation hors BDD mère)
	var $entité : Object
	
	$entitéExt.ID:=This.ID
	$entitéExt.IDunique:=This.IDunique
	
	$entitéExt.type:=This.type
	$entitéExt.dateChaine:=This.dateChaine
	$entitéExt.dateNum:=This.dateNum
	$entitéExt.heure:=This.heure
	$entitéExt.commentaire:=This.commentaire
	$entitéExt.source:=This.source
	
	// le lieu
	If (This.leLieu=Null)
		$entitéExt.leLieu:=Null
		
	Else 
		// demander à l'appelant sa classe Lieux
		$entité:=OB Copy($entitéExt.protoLieu)
		// faire compléter
		This.leLieu.CopierVersObjet($entité)
		$entitéExt.leLieu:=$entité
	End if

⇧ [class]$image - 24/04/2026 09:25:48

      property zonesEditeur : cs.ZonesEditeur
property zoomIncrement : Real:=1.1892
property contrasteZSIncrement : Real:=0.02
property dateAction : Integer:=0
property transformation : Object
property transformationCourante : Object
property MediaHSpoté : Boolean
property contrasteZS : Real
property nomObjet : Text
property image : Picture

Class extends $media

singleton Class constructor()
	
	Super()
	
	This.zonesEditeur:=cs.ZonesEditeur.new()
	// MediaHSpoté, nomObjet doivent être fixés par l'héritier
	
	
	// ----------------------
	// MARK:Affichage
	// -----------------------
	
Function AfficherPageMedia($ID : Integer)
	This.contrasteZS:=cs.$session.me.prefs.Apparence.Formulaire.VisibiliteZS/100
	
	This.LireAvecIDmedia($ID; Form.numPageMedia)
	This.RafraichirImage()
	
	
Function RafraichirImage()
	// Créer l'image HSpotée
	
	If (This.MediaHSpoté)
		This.zonesEditeur.Afficher(This.cheminFichier; "ImageSVG"; This.contrasteZS)
		This.image:=This.zonesEditeur.imageSVG
		
	Else 
		// plus rapide !
		This.image:=This.imagePageMedia
	End if 
	// initialiser l'image de FORM avec l'image réelle
	Form[This.nomObjet]:=This.image
	
	This._Afficher()
	
	
Function _Afficher($coeffZoom : Real)
	
	If (Count parameters=0)
		$coeffZoom:=1
	End if 
	This.transformation:=New object
	
	// Avant de modifier, récupérer les paramètres courants
	This._LireTransformationCourante()
	
	This._ZoomerImage($coeffZoom)
	
	
Function AfficherVideo($mediaPath : Text)
	// renseigner les paramètres de la page html
	var $width : Integer:=0
	var $height : Integer:=0
	var $gauche; $haut; $droite; $bas : Integer
	var $zoom; $scrollX; $scrollY : Real
	var Image_Pict1 : Picture
	
	wwwEtatNavigation:="video"
	wwwMediaPath:=Convert path system to POSIX($mediaPath)
	cs.$wrapperPlugIn.me.PropriétésVideo($mediaPath; ->$width; ->$height; ->Image_Pict1)
	
	wwwMediaWidth:=String($width)+"px"  //pixel
	wwwMediaHeight:=String($height)+"px"
	
	$zoom:=-Scaled to fit prop centered
	$scrollX:=0
	$scrollY:=0
	OBJECT GET COORDINATES(*; "Page Vidéo"; $gauche; $haut; $droite; $bas)
	cs.xSDK.Outils.me.CalculerRectangleMedia(->$gauche; ->$haut; ->$droite; ->$bas; $width; $height; ->$zoom; ->$scrollX; ->$scrollY)
	
	ZoneWeb_Zoom:=Replace string(String($zoom); ","; ".")
	$scrollX:=($scrollX)/$zoom
	$scrollY:=$scrollY/$zoom
	wwwScrollX:=String(Trunc($scrollX; -1))
	wwwScrollY:=String(Trunc($scrollY; -1))
	
	
Function _LireTransformationCourante()
	// lire le zoom et le scroll courants de l'objet courant
	var $gauche; $haut; $droite; $bas; $largeur; $hauteur; $largeurOrigine; $hauteurOrigine : Integer
	var $scrollX; $scrollY : Integer
	
	// calculer le zoom optimal
	This.transformationCourante:=This.CalculerCadrageNominal()
	
	// calculer le zoom courant
	// attention ici on suppose qu'un formulaire existe !
	Case of 
		: (This.nomObjet="")
		: (Form=Null)
		: (Not(OB Is defined(Form; This.nomObjet)))
		: (Not(Value type(Form[This.nomObjet])=Is picture))
		Else 
			
			PICTURE PROPERTIES(This.image; $largeurOrigine; $hauteurOrigine)
			PICTURE PROPERTIES(Form[This.nomObjet]; $largeur; $hauteur)
			OBJECT GET COORDINATES(*; This.nomObjet; $gauche; $haut; $droite; $bas)
			
			Case of 
				: (Num(OBJECT Get format(*; This.nomObjet))=Truncated non centered)
					// l'image est déjà zoomée
					This.transformationCourante.zoom:=$largeurOrigine*$hauteurOrigine
					This.transformationCourante.zoom:=Square root(($largeur*$hauteur)/This.transformationCourante.zoom)
					
					// cas 'Scaled to fit prop centered'
				: (This.transformationCourante.scrollX=0)
					// image cadrée sur la largeur
					This.transformationCourante.zoom:=($droite-$gauche)/$largeurOrigine
					
				: (This.transformationCourante.scrollY=0)
					// image cadrée sur la hauteur
					This.transformationCourante.zoom:=($bas-$haut)/$hauteurOrigine
				Else 
					// pas normal
			End case 
			
			// Récupérer le scroll courant
			OBJECT GET SCROLL POSITION(*; This.nomObjet; $scrollY; $scrollX)
			This.transformationCourante.scrollX:=$scrollX
			This.transformationCourante.scrollY:=$scrollY
	End case 
	
	
Function _ZoomerImage($coeffZoom : Real)
	// zoom demandé :
	This.transformation.zoom:=This.transformationCourante.zoom*$coeffZoom
	
	// cas particuliers
	Case of 
		: ($coeffZoom=1)
			// affichage du formulaire 
			// format defini dans le formulaire : image au format 6 (Scaled to fit prop centered), pas de scroll
			OBJECT SET FORMAT(*; This.nomObjet; Char(Scaled to fit prop centered))
			
		: (This.transformation.zoom>1)
			// par principe, l'image ne peut être plus grande que l'original
			This.transformation.zoom:=1
			// on reste dans le format fixé (a priori trunqué)
			BEEP
			
		: (This.transformation.zoom>This.transformationCourante.zoomMinTroncature)
			// on passe en scrolling
			OBJECT SET FORMAT(*; This.nomObjet; Char(Truncated non centered))
			OBJECT SET SCROLLBAR(*; This.nomObjet; 2; 2)
			
		Else 
			// image au format 6 (Scaled to fit prop centered) ; ré initialiser
			This.transformation.zoom:=This.transformationCourante.zoomMinTroncature
			OBJECT SET FORMAT(*; This.nomObjet; Char(Scaled to fit prop centered))
			OBJECT SET SCROLLBAR(*; This.nomObjet; False; False)
			BEEP
	End case 
	// nouvelle taille
	Form[This.nomObjet]:=This.image*This.transformation.zoom
	
	
	// ----------------------
	// MARK:Traitement
	// -----------------------
	
Function CalculerCadrageNominal()->$result : Object
	var $gauche; $haut; $droite; $bas; $largeur; $hauteur : Integer
	var $zoomMinTroncature : Real
	var $scrollX; $scrollY : Real
	
	OBJECT GET COORDINATES(*; This.nomObjet; $gauche; $haut; $droite; $bas)
	PICTURE PROPERTIES(This.image; $largeur; $hauteur)
	$zoomMinTroncature:=-Scaled to fit prop centered
	cs.xSDK.Outils.me.CalculerRectangleMedia(->$gauche; ->$haut; ->$droite; ->$bas; $largeur; $hauteur; ->$zoomMinTroncature; ->$scrollX; ->$scrollY)
	
	$result:=New object
	$result.zoomMinTroncature:=$zoomMinTroncature
	$result.scrollX:=$scrollX
	$result.scrollY:=$scrollY
	
	
	// ----------------------
	// MARK:Transformations
	// -----------------------
	
Function ZoomPlus()
	This._Afficher(This.zoomIncrement)
	
	// mettre à jour le formulaire
	Form.MettreAjourLaPage()
	
	
Function ZoomMoins()
	This._Afficher(1/This.zoomIncrement)
	
	// mettre à jour le formulaire
	Form.MettreAjourLaPage()
	
	
Function LireContraste()->$result : Real
	// renvoie la visibilité des ZS (entre 0 et 100)
	$result:=This.contrasteZS*100
	
	
Function FixerContraste($visibilitéZS : Integer)
	// entre 0 et 1
	This.contrasteZS:=$visibilitéZS/100
	This._ContrasterImage()
	
	
Function ContrastePlus()
	// applique la visibilité demandée des ZS
	This.contrasteZS:=This.contrasteZS-This.contrasteZSIncrement
	This._ContrasterImage()
	
	
Function ContrasteMoins()
	// applique la visibilité demandée des ZS
	This.contrasteZS:=This.contrasteZS+This.contrasteZSIncrement
	This._ContrasterImage()
	
	
Function _ContrasterImage()
	// Borner le contraste entre 0 et 1
	Case of 
		: (This.contrasteZS<0)
			This.contrasteZS:=0
		: (This.contrasteZS>1)
			This.contrasteZS:=1
	End case 
	// appliquer le contraste
	This.RafraichirImage()
	
	
Function AppliquerTransformation()
	Case of 
		: (Tickcount<This.dateAction)
			// attendre
			
		: (Form.ActionUtilisateur("[ContrastePlus]"))
			// gérer l'assombrissement du fond
			// agir
			BEEP
			This.ContrastePlus()
			// poster le prochain traitement
			This.dateAction:=Tickcount+Int(0.3*60)
			
		Else 
			// c'est fini
			This.dateAction:=0
	End case 
	
	
	// ----------------------
	// MARK:Zone Sensible
	// -----------------------
	
Function existeZoneSensibleActiveinImage()
	// image normale, sans possibilité de zoom / scroll : sa taille vraie est [Medias]largeur / [Medias]hauteur
	var $gauche; $haut; $droite; $bas : Integer
	var $largeur; $hauteur : Integer
	var $zoom : Real
	
	$largeur:=Form.entité.largeur
	$hauteur:=Form.entité.hauteur
	
	// trouver son zoom
	$zoom:=-Scaled to fit prop centered
	OBJECT GET COORDINATES(*; This.nomObjet; $gauche; $haut; $droite; $bas)
	cs.xSDK.Outils.me.CalculerRectangleMedia(->$gauche; ->$haut; ->$droite; ->$bas; $largeur; $hauteur; ->$zoom)
	// attention ici on suppose que le zoom image est géré par 4D (le format d'affichage de This.nomObjet est "Proportionnelle centrée")
	$largeur:=Form.entité.largeur*$zoom
	$hauteur:=Form.entité.hauteur*$zoom
	
	This.transformationCourante:=New object("scrollX"; 0; "scrollY"; 0)
	
	This._existeZoneSensibleActive($largeur; $hauteur)
	
	
Function existeZoneSensibleActiveinMedia()
	// image avec possibilité de zoom / scroll : sa taille vraie n'est pas forcément [Medias]largeur / [Medias]hauteur (cf PDF)
	var $largeur; $hauteur : Integer
	
	If (Form[This.nomObjet]=Null)
		// formulaire pas encore complètement affiché
	Else 
		// taille de l'image affichée (intègre le zoom courant)
		PICTURE PROPERTIES(Form[This.nomObjet]; $largeur; $hauteur)
		// transformation courante du media
		This._LireTransformationCourante()
		
		This._existeZoneSensibleActive($largeur; $hauteur)
	End if 
	
	
Function existeZoneSensibleActiveinZoneWeb()
	// zoneWeb affichant une page html : le media n'a donc pas de largeur / hauteur
	var $gauche; $haut; $droite; $bas : Integer
	var $largeur; $hauteur : Integer
	var $zoom : Real
	
	$zoom:=-Scaled to fit prop centered  //format d'affichage de l'image
	OBJECT GET COORDINATES(*; This.nomObjet; $gauche; $haut; $droite; $bas)
	$largeur:=$droite-$gauche
	$hauteur:=$bas-$haut
	cs.xSDK.Outils.me.CalculerRectangleMedia(->$gauche; ->$haut; ->$droite; ->$bas; $largeur; $hauteur; ->$zoom)
	// attention ici on suppose que le zoom image est géré par 4D (le format d'affichage de $1 est "Proportionnelle centrée")
	$largeur:=$largeur*$zoom
	$hauteur:=$hauteur*$zoom
	
	This.transformationCourante:=New object("scrollX"; 0; "scrollY"; 0)
	
	This._existeZoneSensibleActive($largeur; $hauteur)
	
	
Function _existeZoneSensibleActive($largeur : Integer; $hauteur : Integer)
	var $gauche; $haut; $droite; $bas; $SourisBtn : Integer
	var $sourisX; $sourisY; $zoom; $scrollX; $scrollY : Real
	var $sélectionEntités : cs.ZonesSelection
	
	// par défaut, il n'y pas de ZSsurvolée
	This.nonExisteZoneSensibleActive()
	
	// le contexte
	// coordonnées du pointeur par rapport à la fenêtre de premier plan du process courant
	MOUSE POSITION($sourisX; $sourisY; $SourisBtn)
	// position de l'objet
	OBJECT GET COORDINATES(*; This.nomObjet; $gauche; $haut; $droite; $bas)
	
	// position absolue du pointeur dans le repère de l'objet This.nomObjet
	$sourisX:=$sourisX-$gauche
	$sourisY:=$sourisY-$haut
	// calculer la position du media dans le repère de This.nomObjet
	$zoom:=1  // $largeur et $hauteur intègrent déjà le zoom
	$scrollX:=0
	$scrollY:=0
	cs.xSDK.Outils.me.CalculerRectangleMedia(->$gauche; ->$haut; ->$droite; ->$bas; $largeur; $hauteur; ->$zoom; ->$scrollX; ->$scrollY)
	
	// position absolue du pointeur dans le repère du Media
	If ($scrollX>0)
		// toute la largeur du media zoomé est dans le rectangle de This.nomObjet
		$sourisX:=$sourisX-$scrollX
	Else 
		// la largeur du media zoomé sort du rectangle de This.nomObjet
		$sourisX:=$sourisX+This.transformationCourante.scrollX
	End if 
	If ($scrollY>0)
		// toute la hauteur du media zoomé est dans le rectangle de $1
		$sourisY:=$sourisY-$scrollY
	Else 
		// la hauteur du media zoomé sort du rectangle de $1
		$sourisY:=$sourisY+This.transformationCourante.scrollY
	End if 
	// position relative du pointeur dans le media
	$sourisX:=$sourisX/$largeur
	$sourisY:=$sourisY/$hauteur
	
	// récupérer les ZS
	If (($sourisX>=0) & ($sourisX<=1) & ($sourisY>=0) & ($sourisY<=1))  //souris dans la VarImage
		// chercher et trier les ZS par taille croissante
		$sélectionEntités:=Form.entité.lesZones.TrierParTaille()
		
		// tester si on en survole une ZS
		If ($sélectionEntités.length>0)
			$sélectionEntités.existeZoneSensibleActive($sourisX; $sourisY)
		End if 
	End if 
	
	
Function nonExisteZoneSensibleActive()
	// il n'y pas de ZSsurvolée
	Use (Storage.System.Navigation.ZS)
		Storage.System.Navigation.ZS.ZoneSurvolée:=-1
		Storage.System.Navigation.ZS.EnregistrementLié:=-1
	End use

⇧ [class]DataStore - 21/07/2026 18:02:34

      Class extends DataStoreImplementation


// ----------------------
//MARK:Authentification
// -----------------------

exposed Function authentify($LogIn : Text)->$result : Boolean
	// v11.3.4 on recopie l'ancienne méthode "On REST Authentication"
	// doc 4D v20 : "Cette méthode base est automatiquement appelée lorsqu'une nouvelle session est ouverte à l'aide d'une requête REST
	// doc 4D v21 : "Tous les types de session peuvent gérer des privilèges, mais seul le code exécuté dans un contexte web est réellement contrôlé par les privilèges de la session"
	
	// authentification d'accès à une session WEB du site Hôte, cas du composant MOB
	// la function est appelée dans une session Guest lors de l'authentification d'un user ; fixe les privilèges
	// rappel : pour être appelée, la function est renseignée dans le fichier roles.json
	var $entité : cs.UtilisateursALVEntity
	var $info : Object
	
	$result:=False
	
	// Pour des raisons de sécurité, refuser les noms qui contiennent @
	Case of 
		: ($LogIn="")
			// possible sur des url non gérées directement par ALV ; pas de message
		: (cs.xSDK.Outils.me.ContientJoker($LogIn))
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_log]; "Nom d'utilisateur"; Current method name; "Le nom '"+$LogIn+"' est invalide"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		Else 
			// reconnaître le requêteur
			// un invité d'une session web a des privilèges
			$entité:=ds.UtilisateursALV.query("LogIn = :1"; $LogIn).first()
			Case of 
				: ($entité=Null)
					// boucle jusqu'à LogIn/pwd ok
				: (WEB Validate digest($LogIn; $entité.Password))
					// c'est ok
					$info:=New object()
					$info.userName:=$entité.First_Name+" "+$entité.Name
					// Rappel : un utilisateur ALV d'une session a des privilèges "CreateRecords" incluant "ReadRecords"
					$info.privileges:=$entité.privileges  // v11.6.5 privilèges du UtilisateursALV courant
					//$info.roles:=New collection("UtilisateurALV")
					Session.setPrivileges($info)
					
					$result:=True
					
				Else 
					CALL WORKER(Worker Services; Formula(traceHandler); [msgk_log]; "Echec de validation du mot de passe"; Current method name; "de "+$LogIn; New object("nomProcess"; Current process name; "numProcess"; Current process))
			End case 
	End case 
	
	
exposed Function FixerSessionUser($data : Object)->$result : Boolean
	var $selection : cs.UtilisateursALVSelection
	ALERT("toto 1"+Current method name+JSON Stringify($data))
	$data.success:=False
	
	Case of 
		: ($data.userName=Null)
		: ($data.userName="")
		Else 
			$selection:=ds.UtilisateursALV.query("LogIn=:1"; $data.userName)
			ALERT("toto "+Current method name+String($selection.length=1))
			
			If ($selection.length=1)
				$data.success:=True
				
				// renseigner .user 
				$data.user:=OB Copy($selection[0].toObject(["ID"; "LogIn"; "Password"; "droits"; "privileges"; "role"]))
				$data.user.IDfamille:=$selection[0].leGroupe.IDfamille
			End if 
	End case 
	$result:=$data.success
	ALERT("toto 2"+Current method name+JSON Stringify($data))
	
	
	// ----------------------
	//MARK:Modification DataStore
	// -----------------------
	
Function Ajouter($quoi : Integer; $aQuiIN : Object; $quiIN : Object; $data : Object)->$result : Object
	// Ajouter Quoi ($quoi), aQui (2), Qui ($quiIN), avec les paramètres $data
	// renvoie toujours dans $0 une information d'erreur et une entité de retour.
	// Méthode bas niveau d'appel des classes entité pour réaliser les ajouts
	// Méthode nécessairement thread-safe (pour le client APP)
	var $aQui; $Qui : Object
	var $méthodeErreur : Text
	
	// erreur par défaut
	$result:=New object("Error"; -15004; "success"; False; "ErrorDescription"; "")
	
	// faire l'ajout :
	ds.startTransaction()
	// attention $aQuiIN n'a pas forcément de function 'Ajouter'
	// en cas d'erreur :
	$méthodeErreur:=Method called on error
	ON ERR CALL(Formula(errorHandler_DS).source; ek local)
	
	If ($aQuiIN=Null)
		// ex nihilo
		$result:=ds.Créer($quoi; ""; $data)
		
	Else 
		$result:=$aQuiIN.Ajouter($quoi; $quiIN; $data)
	End if 
	
	ON ERR CALL($méthodeErreur; ek local)
	
	Case of 
		: ($result=Null)
			$result:=New object("Error"; -15004; "success"; False; "ErrorDescription"; Current method name+": $aQuiIN n'a pas de function .Ajouter")
			
		: (Not(OB Is defined($result; "entitéRetour")))
			// initialiser l'entité de retour
			$result.entitéRetour:=$result.entitéAjoutée
	End case 
	
	//$result.Error:=-1  // pour test
	If ($result.Error=0)
		ds.validateTransaction()
		
		// inscrire au journal
		// transformer en pseudo-entité
		$aQui:=Null  // une création ex nihilo
		$Qui:=Null
		// les éventuelles données sont dans $data
		// aQui
		If ($aQuiIN#Null)
			$aQui:=cs._ds.me.EntitéRéduite($aQuiIN)
		End if 
		// qui
		If ($quiIN#Null)
			// qui = typiquement un glisser-déposer
			$Qui:=cs._ds.me.EntitéRéduite($quiIN)
		End if 
		$data.actionID:=$quoi
		cs.$journalALV.me.Ecrire($data; $aQui; $Qui)
		
	Else 
		ds.cancelTransaction()
		CALL WORKER(Worker Services; Formula(traceHandler); [msgk_log; msgk_son]; "Erreur "+String($result.Error); Current method name; $result.ErrorDescription; New object("nomProcess"; Current process name; "numProcess"; Current process; "numErreur"; $result.Error; "méthodeErreurs"; Method called on error))
	End if 
	
	
Function Modifier($commande : Integer; $entité : Object; $params : Object)->$result : Object
	// Modifier  aQui ($entité) , avec les paramètres $params
	// renvoie toujours dans $0 une information d'erreur et une entité de retour.
	// Méthode bas niveau d'appel des classes entité pour réaliser les modification
	// Méthode nécessairement thread-safe (pour le clientAPP)
	
	var $i : Integer
	var $status; $paramsLocal; $aQui; $modification : Object
	var $c; $modifications : Collection
	var $attribut : Text
	
	// pas d'erreur par défaut
	$result:=New object("Error"; 0; "success"; True; "ErrorDescription"; "")
	$result.entitéRetour:=Null
	
	Case of 
		: ($commande=cdk Modifier)
			// enregistrer les modifications de l'entité $entité
			// attention : des entités peuvent être indéfinies (ex lien 1-N  : si l'attribut de N est modifié, l'entité 1 peut ne pas exister)
			Case of 
				: ($entité=Null)
					// c'est possible
				: (Undefined($entité))
					// c'est possible
				Else 
					ASSERT(cs.$trace.me.DebugerMethode("dsk Modifier"; Current method name; "Début de transaction Modification"))
					ds.startTransaction()
					// pour le journal
					
					$aQui:=New object("DataClassNom"; $entité.getDataClass().getInfo().name; "IDunique"; $entité.IDunique)
					$params.aQui:=New object("DataClassNom"; $entité.getDataClass().getInfo().name; "IDunique"; $entité.IDunique)
					$params.créateur:=Choose(OB Is defined($entité; "créateur"); $entité.créateur; 0)
					
					// ici $entité a un certain nombre de données modifiées, lesquelles?
					$c:=$entité.touchedAttributes()
					
					// stocker les modifications dans $modifications
					If ($c.length>0)
						$modifications:=New collection
						For each ($attribut; $c)
							// on ne garde que les attributs de données d'entité (type "storage")
							// les modifications de données liées sont en principe dans l'une des autres entités ${$i}
							If ($entité.getDataClass()[$attribut]["kind"]="storage")
								// données
								// attention : Type valeur renvoie 'un numerique' si l'attibut est un entier !
								$modification:=New object("attribut"; $attribut; "valeurAttribut"; $entité[$attribut]; "typeValeur"; Value type($entité[$attribut]))
								$modifications.push($modification)
							End if 
						End for each 
						// enregistrer
						If ($modifications.length>0)
							// v9.4,5 : une entité commune qui vient juste d'être créée à un stamp non nul (un .save manque quelque part...)
							This.ModifierHoroDatage($entité)
							Try
								$entité._TriggerModifier()
							End try
							// on force auto merge pour tout sauver
							$status:=$entité.save(dk auto merge)
							cs.$trace.me.Créer(-15005*Num(Not($status.success)); Current method name; "5099").LeverException([msgk_event; msgk_log])
						End if 
						
						Case of 
							: ($modifications.length=0)
								CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Absence d'attributs modifié"; Current method name; "Entité ID "+String($entité.ID)+" de  ["+$entité.getDataClass().getInfo().name+"]"; New object("nomProcess"; Current process name; "numProcess"; Current process))
								
							: ($status.success)
								CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Modification effectuée"; Current method name; "Entité ID "+String($entité.ID)+" de  ["+$entité.getDataClass().getInfo().name+"]"; New object("nomProcess"; Current process name; "numProcess"; Current process))
								$result.entitéRetour:=New object("DataClassNom"; $entité.getDataClass().getInfo().name; "IDunique"; $entité.IDunique)
								
								// enregister les modifications dans le journal
								For each ($modification; $modifications)
									// description
									$attribut:=$modification.attribut
									$params.Description_Action:="Modification de l'entité ID "+String($entité.ID)+" de ["+$entité.getDataClass().getInfo().name+"] :"+" '"+$attribut
									$i:=Value type($entité[$attribut])
									Case of 
										: ($i=Is text)
											$params.Description_Action:=$params.Description_Action+"' = '"+$entité[$attribut]+"'"
											
										: ($i=Is picture)
											// image en BDD ; rappel $params.fichierAjouté contient le chemin du fichier ajouté
											$params.Description_Action:=$params.Description_Action+"', fichier "+$params.cheminDuMediaAjouté
											
										Else 
											$params.Description_Action:=$params.Description_Action+"' = '"+String($entité[$attribut])+"'"
									End case 
									
									$params.actionID:=cdk Modifier
									$params.functionJALV:=EXT Modifier BDD
									cs.$journalALV.me.Ecrire($params; $aQui; $modification)
								End for each 
								
							Else 
								CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Echec de la modification de  Entité ID "+String($entité.ID)+" de  ["+$entité.getDataClass().getInfo().name+"]"; Current method name; JSON Stringify($status); New object("nomProcess"; Current process name; "numProcess"; Current process))
						End case 
					End if 
					
					$result.success:=($c.length>0) & ($modifications.length>0)
					
					ds.validateTransaction()
					ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "Transaction Modification validée"))
			End case 
			
		: ($commande=cdk Lier)
			// faire un lien entre $entité et l'entité $params.params
			// $params contient le nom de l'attribut de $entité à modifier, et la valeur à utiliser (un seul cas : est un IDcodé)
			Case of 
				: ($entité=Null)
				: ($params=Null)
				: ($params.params.valeur<1)
				Else 
					// c'est ok
					// on pourait vérifier la cohérence des dataClass (?)
					$entité[$params.params.attribut]:=$params.params.valeur & 0x00FFFFFF
					// nettoyer
					$paramsLocal:=OB Copy($params)
					OB REMOVE($paramsLocal; "params")
					// il faut passer par là (pas de FORMevent généré)
					$result:=This.Modifier(cdk Modifier; $entité; $paramsLocal)
					// donc pas d'écriture journal
			End case 
	End case 
	
	
Function AjouterLienRetour($quoi : Integer; $aQui : Object; $qui : Object; $params : Object)->$result : Object
	// créer une entité 'fille' et l'accrocher à aQui
	var $data : Object
	
	$result:=ds.initResult()
	// trouver les niveaux les liens aller et retour de $aQui
	$data:=ds._infoRelationsDataStore($aQui.getDataClass())
	Case of 
		: (Not(OB Is defined($data; "liensRetour")))
		: ($data.liensRetour.length#1)
			ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "il y a plus de 1 lien retour : impossible de créer le lien de "+$aQui.getDataClass().getInfo().name))
		Else 
			// c'est ok
			// créer le niveau
			If ($qui=Null)
				$result:=This.Créer($quoi; $data.liensRetour[0].DataClassNom; $params)
				$qui:=$result.entitéAjoutée
			End if 
			
			// lier $qui à this
			If ($qui#Null)
				$qui[$data.liensRetour[0].nomChamp]:=$aQui.ID
				$qui.save()
			End if 
	End case 
	
	
Function LeIcone($entité : Object; $attributImage : Text)->$result : Object
	// renvoyer l'icone de l'entité ; le créer au besoin
	var $pict : Picture
	
	$result:=ds.initResult()
	
	Case of 
		: (Picture size($entité.icone)#0)
			$result.icone:=$entité.icone
			
		: (Not(OB Is defined($entité; $attributImage)))
			$result.success:=False
			$result.ErreurDescription:="'$attributImage' n'est pas un attribut de $entité"
			
		Else 
			// créer l'icone à partir de l'attribut $2 de $1
			CREATE THUMBNAIL($entité[$attributImage]; $pict; 10; 10; Scaled to fit prop centered)
			// l'enregistrer
			ds.startTransaction()
			$entité.icone:=$pict
			$result:=$entité.save()
			ds.validateTransaction()
			
			$result.icone:=$pict
	End case 
	
	
Function Créer($quoi : Integer; $DataClassNom : Text; $params : Object)->$result : Object
	// crée une entité de type $1 et initialise les données
	var $qui : Object
	var $cPersonnes; $cMedias; $cDossiers : Collection
	
	$result:=ds.initResult()
	
	$cPersonnes:=New collection(agk Individu; agk Père; agk Mère; agk Conjoint; agk Enfant; agk Temoin)
	$cMedias:=New collection(imk Media; imk Illustration; imk Document; imk URL)
	$cDossiers:=New collection(imk Dossier; imk Volume)
	Case of 
		: (OB Is defined(ds; $DataClassNom))
			// utiliser cette classe
		: ($cPersonnes.indexOf($quoi)>-1)
			$DataClassNom:="Personnes"
		: ($quoi=agk Union)
			$DataClassNom:="Unions"
			// rappel : le trigger va créer un groupe de conjoints
		: ($quoi=agk EventPersonnel)
			$DataClassNom:="EventsPerso"
			// rappel : le trigger va créer un event
		: ($quoi=agk EventFamilial)
			$DataClassNom:="EventsFam"
			// rappel : le trigger va créer un event
			
		: ($quoi=geok Pays)
			$DataClassNom:="Pays"
		: ($quoi=geok Région)
			$DataClassNom:="Regions"
		: ($quoi=geok Département)
			$DataClassNom:="Departements"
		: ($quoi=geok Commune)
			$DataClassNom:="Communes"
			// rappel : les triggers vont créer un site et lieu
		: ($quoi=geok Site)
			$DataClassNom:="Sites"
			// rappel : le trigger va créer un lieu
		: ($quoi=geok Lieu)
			$DataClassNom:="Lieux"
			
		: ($cMedias.indexOf($quoi)>-1)
			$DataClassNom:="Medias"
		: ($quoi=imk Zone)
			$DataClassNom:="Zones"
		: ($cDossiers.indexOf($quoi)>-1)
			$DataClassNom:="Dossiers"
		: ($quoi=imk Fichier)
			$DataClassNom:="Fichiers"
		: ($quoi=imk Arborescence)
			$DataClassNom:="Arborescence"
			
		: ($quoi=dsk Private)
			$DataClassNom:="PrivateData"
		: ($quoi=dsk Encyclopédie)
			$DataClassNom:="Encyclopedia"
		: ($quoi=dsk Commande)
			$DataClassNom:="Commandes"
		: ($quoi=dsk Utilisateur)
			$DataClassNom:="UtilisateursALV"
		: ($quoi=dsk Groupe)
			$DataClassNom:="wwwGroupes"
			
		Else 
			// inconnue
			$DataClassNom:=""
			$result.Error:=-15068
			$result.ErrorDescription:=Current method name+"Aucune classe ne peut être créée avec "+String($quoi)+" ou le nom "+$DataClassNom
	End case 
	
	If ($result.Error=0)
		
		ASSERT(cs.$trace.me.DebugerMethode(String($quoi); Current method name; "Début de création ["+$DataClassNom+"]"))
		
		ds.startTransaction()
		
		$qui:=ds[$DataClassNom].new()
		This._TriggerHoroDater($qui)
		
		// fixer l'identifiant
		This.FixerIDentification($qui)
		
		// appeler le trigger de $qui (possible création d'entités liées)
		// n'existe pas forcément
		Try
			$qui._TriggerCreer()
		End try
		$result.success:=$qui.save().success
		// rappel : ici le trigger de $entité a été appelé
		
		If ($result.success)
			$result.entitéAjoutée:=$qui
			
			// initialiser les données
			$result.FixerDonnées:=$qui._FixerDonnées($quoi; $params)
			$result.Error:=$result.FixerDonnées.Error
			$result.ErrorDescription:=$result.FixerDonnées.ErrorDescription
			// pour le journal, dans le cas général sera surchargé
			
		Else 
			$result.Error:=ErrorNum
			$result.ErrorDescription:=ErrorDescription
		End if 
		
		If ($result.Error=0)
			ds.validateTransaction()
			ASSERT(cs.$trace.me.DebugerMethode(String($quoi); Current method name; "Création entité de ["+$DataClassNom+"]"+" : entité ajoutée = "+ds._LeLibellé($qui)))
			
		Else 
			$result.entitéAjoutée:=Null
			ds.cancelTransaction()
			ASSERT(cs.$trace.me.DebugerMethode(String($quoi); Current method name; "Création ["+$DataClassNom+"] annulée"))
			ASSERT(cs.$trace.me.DebugerVariables("détail"; Current method name; New object("Result"; JSON Stringify($result))))
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Erreur "+String($result.Error); Current method name; $result.ErrorDescription; New object("nomProcess"; Current process name; "numProcess"; Current process; "numErreur"; $result.Error; "méthodeErreurs"; Method called on error))
		End if 
	End if 
	
	
Function FixerIDentification($entité : Object)
	// renvoyer le premier ID disponible de la dataClass de $1
	var $DataClassNom : Text
	var $nbrEntitésDansDS; $ID : Integer
	
	// il faut que ID soit un attribut de $entité
	If (OB Is defined($entité; "ID"))
		$DataClassNom:=$entité.getDataClass().getInfo().name
		$nbrEntitésDansDS:=ds[$DataClassNom].all().length  // dont ceux créés dans la transaction
		
		// récupérer les ID de la table
		ARRAY LONGINT($tabIDlong; 0)
		COLLECTION TO ARRAY(ds[$DataClassNom].all().extract("ID"); $tabIDlong)
		$nbrEntitésDansDS:=$nbrEntitésDansDS-Size of array($tabIDlong)
		
		$ID:=$tabIDlong{Size of array($tabIDlong)}  //par défaut (cas normal) $ID = le plus grand ID
		
		If (Size of array($tabIDlong)=0)  // table vide
			$ID:=$nbrEntitésDansDS+1
			
		Else   //chercher dans le tableau
			$ID:=0
			Repeat   // chercher l'ID pas dans le tableau et suivant les $nbrEnregCréésDansTransaction précédant 
				$ID:=$ID+1
				If (Find in array($tabIDlong; $ID)<0)
					$nbrEntitésDansDS:=$nbrEntitésDansDS-1
				End if 
			Until ($nbrEntitésDansDS<0)
		End if 
		// finalement
		$entité.ID:=$ID
	End if 
	
	
Function _TriggerHoroDater($qui : Object)
	If (OB Is defined($qui; "création"))
		$qui.création:=Current date
	End if 
	
	If (OB Is defined($qui; "heureCréation"))
		$qui.heureCréation:=Current time
	End if 
	
	This.ModifierHoroDatage($qui)
	
	
Function ModifierHoroDatage($qui : Object)
	If (OB Is defined($qui; "miseAjour"))
		$qui.miseAjour:=Current date
	End if 
	
	
Function initResult($Error : Integer; $ErrorDescription : Text; $success : Boolean)->$result : Object
	$result:=This._InitResult($Error; $ErrorDescription; $success)
	$result.entitéAjoutée:=Null
	
	
Function NotifierResultat($entité : Object; $quoi : Integer; $result : Object)
	
	If ($result.success)
		CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Ajout à ["+$entité.getDataClass().getInfo().name+"]"; Current method name; "Quoi = "+Localized string(String($quoi))+", aQui = "+ds._LeLibellé($entité); New object("nomProcess"; Current process name; "numProcess"; Current process))
	Else 
		ASSERT(cs.$trace.me.DebugerMethode(String($quoi); Current method name; "Annulation de l'ajout à ["+$entité.getDataClass().getInfo().name+"]"+", Quoi = "+Localized string(String($quoi))+", aQui = "+ds._LeLibellé($entité)))
		ASSERT(cs.$trace.me.DebugerVariables("détail"; Current method name; New object("Result"; JSON Stringify($result))))
	End if 
	
	
Function _LeLibellé($entité)->$libellé : Text
	$libellé:=$entité.getDataClass().getInfo().name+" "+String($entité.ID)
	
	
	// ----------------------
	//MARK:Interne
	// -----------------------
	
Function _classeParente($entité : Object)->$result : Object
	// qui est le niveau supérieur?
	var $liens; $entitéLiée : Object
	
	$result:=New object
	
	$liens:=ds._infoRelationsDataStore($entité.getDataClass())
	$entitéLiée:=$entité[$liens.liensAller[0].nomORDA]
	// quelle est la sélection du niveau inférieur
	$liens:=ds._infoRelationsDataStore($entitéLiée.getDataClass())
	$result.sélection:=$entitéLiée[$liens.liensRetour[0].nomORDA]
	$result.parent:=$entitéLiée.IDcodé()
	
	
Function _infoRelationsDataStore($dataClass : 4D.DataClass)->$data : Object
	// renvoie la collection de liens aller (N->1) et celle des liens retour (1->N) de la DS $1
	// un lien est défini par : le nom de la DS et l'le nom du champ faisant le lien (ce n'est PAS le nom ORDA du lien)
	var $i : Integer
	var $attribut : Text
	
	$data:=New object("liensAller"; New collection; "liensRetour"; New collection)
	
	ARRAY TEXT($tabNoms; 0)
	OB GET PROPERTY NAMES($dataClass; $tabNoms)
	
	For ($i; 1; Size of array($tabNoms))
		If ($dataClass[$tabNoms{$i}].kind="relatedEntity")
			// ok trouvé
			// $tabNoms{$i} est le nom de la DataClasseAttribut de TableN en lien vers Table1
			// trouver le nom du champ :
			$attribut:=This._ChercherAttributLien($dataClass; ds[$dataClass[$tabNoms{$i}].relatedDataClass])
			$data.liensAller.push(New object("DataClassNom"; $dataClass[$tabNoms{$i}].relatedDataClass; "nomChamp"; $attribut; "nomORDA"; $dataClass[$tabNoms{$i}].name))
		End if 
		If ($dataClass[$tabNoms{$i}].kind="relatedEntities")
			// ok trouvé
			// $tabNoms{$i} est le nom de la DataClassAttribut  du lien TableN vers Table1
			// trouver le nom du champ :
			$attribut:=This._ChercherAttributLien(ds[$dataClass[$tabNoms{$i}].relatedDataClass]; $dataClass)
			$data.liensRetour.push(New object("DataClassNom"; $dataClass[$tabNoms{$i}].relatedDataClass; "nomChamp"; $attribut; "nomORDA"; $dataClass[$tabNoms{$i}].name))
		End if 
	End for 
	
	
Function _ChercherAttributLien($dataClass1 : Object; $dataClass2 : Object)->$attribut : Text
	// renvoie l'attribut de $dataClass1 qui fait le lien avec $dataClass2
	var $numTable; $numChamp; $i; $j : Integer
	var $ptrTable : Pointer
	
	$attribut:=""
	$ptrTable:=Table($dataClass1.getInfo().tableNumber)
	$numTable:=$dataClass2.getInfo().tableNumber
	
	For ($numChamp; 1; Last field number($ptrTable))
		// trouver un lien N->1
		GET RELATION PROPERTIES(Table($ptrTable); $numChamp; $i; $j)
		Case of 
			: ($i=0)
			: ($j=0)
			: ($i#$numTable)
			Else 
				// trouvé
				$attribut:=Field name(Field(Table($ptrTable); $numChamp))
		End case 
	End for 
	
	
Function _FixerParamètresLibellé($formats : Object)
	// fixer la valeur par défaut des $formats manquant
	var $data : Object
	var $i : Integer
	
	// valeurs par défaut
	$data:=New object("SymbolConjoints"; " & "; "SymbolDateLieu"; ","+Localized string("33"); "FormatDate"; 5; "FormatHeure"; 5; "FormatLieu"; 1; "FormatGeoLoc"; 1)
	
	// compléter $formats
	OB GET PROPERTY NAMES($data; $tabNoms)
	For ($i; 1; Size of array($tabNoms))
		If (Not(OB Is defined($formats; $tabNoms{$i})))
			$formats[$tabNoms{$i}]:=$data[$tabNoms{$i}]
		End if 
	End for 
	
	
Function _FixerDonnées($qui : Object; $quoi : Integer; $params : Object)->$result : Object
	// une entité a été créée : on initialise ses données génériques suivant 2 cas
	// ajout dans BDD mère : données génériques, ou ajout par le serveur WEB : données lues dans le journal $params
	// dans les 2 cas on complète le journal
	var $JALV_UUID : Text
	
	$result:=ds.initResult()
	$result.ErrorDescription:=Current method name
	$result.LectureJournal:=False
	
	$JALV_UUID:="JALV_UUID_"+String($quoi)
	Case of 
		: (Not(OB Is defined($qui; "IDunique")))
			// dataclass non concernée par les UUID
			
		: (OB Is defined($params; $JALV_UUID))
			// cas ajout par lecture du journal
			$result.LectureJournal:=True
			$qui.IDunique:=$params[$JALV_UUID]  // utiliser cet UUID
			$qui.save()
			
		Else 
			// cas ajout par BDD mère, le serveur APP ou par le site Web
			// renseigner le journal
			$params[$JALV_UUID]:=$qui.IDunique
	End case 
	
	// renseigner ce qui a été ajouté (pseudo entité)
	$params.entitéAjoutée:=cs._ds.me.EntitéRéduite($qui)
	
	
	// ----------------------
	//MARK:Utilitaires
	// -----------------------
	
Function _InitResult($Error : Integer; $ErrorDescription : Text; $success : Boolean)->$result : Object
	If (Count parameters=0)
		$Error:=0
		$ErrorDescription:=""
		$success:=True
	End if 
	$result:=New object("Error"; $Error; "ErrorDescription"; $ErrorDescription; "success"; $success)
	
	
Function _FinirTexteFormDetail()->$result : Text
	// sur un form detail android, la barre menus masque la fin du texte affiché : ajouter des lignes vides pour démasquer la fin
	// sur un form detail iOS, la barre menus est masquée , pas ce pb
	$result:=""
	Case of 
		: (Session=Null)
		: (Not(OB Is defined(Session; "id")))
		Else 
			$result:=3*(Char(Line feed)+"")
	End case 
	
	
Function Maintenance()
	// lancer la maintenance (si existe) de chaque DataClass
	var $dataClassNom : Text
	
	For each ($dataClassNom; OB Keys(ds))
		If (OB Is defined(ds[$dataClassNom]; "Maintenance"))
			ds[$dataClassNom].Maintenance()
		End if 
	End for each 
	
	
	// ----------------------
	//MARK:Sélection
	// -----------------------
	
Function EntitéRéduite($entité : Object)->$objet : Object
	// réduire $entité à sa dataclass et son UUID ; utile dans les échanges client - serveur
	$objet:=New object()
	$objet.DataClassNom:=$entité.getDataClass().getInfo().name
	$objet.IDunique:=$entité.IDunique
	
	
Function EntitéAvecUUID($objet : Object)->$entité : Object
	// restaure l'entité à partir de sa dataclass et son UUID ; utile dans les échanges client - serveur
	var $dataStore; $sélection : Object
	
	$entité:=Null
	Case of 
		: (Not(OB Is defined($objet; "DataClassNom")))
			ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "'DataClassNom' n'est pas défini dans $objet"))
		: (Not(OB Is defined(ds; $objet.DataClassNom)))
			ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "$objet.DataClassNom n'est pas une dataClass"))
		Else 
			$dataStore:=ds[$objet.DataClassNom]
			
			Case of 
				: (Not(OB Is defined($objet; "IDunique")))
					ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "'IDunique' n'est pas défini dans $objet"))
				: (Not(OB Is defined($dataStore; "IDunique")))
					ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "'IDunique' n'est pas un attribut de la dataClass $objet.DataClassNom"))
				Else 
					$sélection:=ds[$objet.DataClassNom].query("IDunique = :1"; $objet.IDunique)
					$entité:=$sélection[0]
			End case 
	End case

⇧ [class]$formulaire_SF_ProtocoleHTTPS - 18/04/2026 18:35:18

      property certificatSSL : cs.$certificatSSL
property certPrefs; hote_SSL; xWEB_SSL; data : Object

Class extends $formulaire

Class constructor()
	
	Super()
	
	// gestion Certbot
	This.certificatSSL:=cs.$certificatSSL.new()
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	var $data : Object
	var $url : Text:=""
	
	Case of 
		: (FORM Event.code=On Load)
			OBJECT SET ENABLED(*; "@srvHote@"; Storage.System.typeApplication=ALV BDD mère)
			OBJECT SET ENABLED(*; "@srvxWEB@"; (Storage.System.typeApplication=ALV Client APP maintenance) | (This.session.prefs.Session_Etat ?? 6))
			
			// get the prefs (cf composant ACME)
			This.certPrefs:=New object
			This.certPrefs.id:=1
			This.certPrefs.acmePrefs:=New object
			$data:=New object("to"; "")
			cs.xMAIL.$eMail.new().FixerAdresse($data; "to")
			This.certPrefs.acmePrefs.contacts:=New collection(New object("email"; $data.to))
			cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "serveur_URL/Nom_sousDomaine"; Is text; ->$url)
			This.certPrefs.acmePrefs.domains:=New collection(New object("fqdn"; $url))
			
			// charger les objets
			This.onEndLoad()
			This.MettreAjour()
			
		: (FORM Event.code=On Activate)
			This.MettreAjour()
	End case 
	
	
Function onEndLoad()
	var $c : Collection
	
	$c:=New collection("hote_SSL"; "xWEB_SSL")
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:Page 1
	// ----------------------
	
Function _FORM_srvHote_newCert()
	Case of 
		: (FORM Event.code=On Clicked)
			Form.certificatSSL.CréerCertAutoSigné()
	End case 
	
	
Function _FORM_srvHote_reNewCert()
	Case of 
		: (FORM Event.code=On Clicked)
			Form.certificatSSL.RecréerCertAutoSigné()
	End case 
	
	
Function _FORM_goTo_letsEncrypt()
	Case of 
		: (FORM Event.code=On Clicked)
			OPEN URL("https://letsencrypt.org/")
	End case 
	
	
Function _FORM_srvxWEB_newCert()
	Case of 
		: (FORM Event.code=On Clicked)
			Form.certificatSSL.ObtenirCertificatSSL()
	End case 
	
	
Function _FORM_srvxWEB_reNewCert()
	var $result : Object
	
	Case of 
		: (FORM Event.code=On Clicked)
			// demande manuelle de renouvellement du certificat SSL
			$result:=Form.certificatSSL.RenouvelerCertificatSSL()
			
			ALERT(JSON Stringify($result; *))
	End case 
	
	
Function _FORM_srvxWEB_activeCertBot()
	Case of 
		: (FORM Event.code=On Clicked)
			Form.certificatSSL.AutoriserACME()
	End case 
	
	
Function _FORM_srvxWEB_desActiveCertBot()
	Case of 
		: (FORM Event.code=On Clicked)
			Form.certificatSSL.InterdireACME()
	End case 
	
	
Function _FORM_hote_SSL()
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=New object
	End case 
	
	
Function _FORM_xWEB_SSL()
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=New object
	End case 
	
	
	// ----------------------
	//MARK:subFORM SF_EtatSSL
	// ----------------------
	
Function _FORM_SF_EtatSSL_resID_207()
	var $wndRef : Integer
	
	Case of 
		: (FORM Event.code=On Clicked)
			// Afficher le certificat
			
			$wndRef:=Open form window("certificateInfos"; Sheet form window)  //;Horizontally centered;Vertically centered)
			
			// attention ici FORM est l'objet du sous formulaire actif, et this est l'objet du formulaire
			DIALOG("certificateInfos"; Form.data)
			CLOSE WINDOW($wndRef)
	End case 
	
	
	// ----------------------
	//MARK:sous Formulaires
	// ----------------------
	// dans cette version les SF_EtatSSL ne font qu'afficher des données
	// les données sont calculées ici ; ils n'ont pas besoin d'une classe
	
Function FixerEtatSSL($nomDossierSSL : Text)->$result : Object
	var $certInformations : Object
	var $url : Text
	var $image : Picture
	
	$result:=New object
	
	// la date d'expiration
	$certInformations:=This.certificatSSL.getCertificatSSL($nomDossierSSL)
	$result.expiration:=$certInformations.Production.libellé
	
	// état du certificat ( = image affichée)
	Case of 
		: (Not($certInformations.Production.exists))
			// pas de certificat erreur ?
			$url:=Get 4D folder(Current resources folder)+"Images"+Folder separator+"HTTP"+Folder separator+"http_noCert.png"
			
		: ($certInformations.Production.Invalide)
			// https à renouveler
			$url:=Get 4D folder(Current resources folder)+"Images"+Folder separator+"HTTP"+Folder separator+"https_invalid.png"
			
		: ($certInformations.Production.aRenouveler)
			// https à renouveler
			$url:=Get 4D folder(Current resources folder)+"Images"+Folder separator+"HTTP"+Folder separator+"https_toRenew.png"
			
		Else 
			// cas normal, https certificat ok
			$url:=Get 4D folder(Current resources folder)+"Images"+Folder separator+"HTTP"+Folder separator+"https.png"
	End case 
	
	READ PICTURE FILE($url; $image)
	$result.img_httpMode:=$image
	
	// contenu du certificat
	$result.data:=New object("text"; $certInformations.Production.certificateInfos)
	
	// traitement des subFORM event
	$result.execute:=This
	
	
	// ----------------------
	// MARK:Gestion formulaire
	// -----------------------
	
Function MettreAjour()
	// relire les infos / états SSL
	This.hote_SSL:=This.FixerEtatSSL("Certificat_Autosigne")
	This.xWEB_SSL:=This.FixerEtatSSL("Certificat_LetsEncrypt")

⇧ [class]LieuxVisualisateur - 20/05/2026 08:55:48

      property carto : cs.xCarto.$carte

Class extends $visualisateur

Class constructor()
	// construction commune
	Super()
	
	// taguer le type du visualisation
	This.informations.Contexte:="_cartographie_"
	
	// fixer les données du formulaire (surcharge les valeurs par défaut)
	This.grandEcran:=True
	This.mémoTaille:=False
	
	// pour la page Web
	This.params.vs4D:="_init_"
	
	// classe de gestion de la carto
	This.carto:=cs.xCarto.$carte.new()
	
	
Function getDataClassInfos()->$result : Object
	$result:=Super.getDataClassInfos("Lieux")
	
	
Function FixerParamètresSélectionVisualisable()->$result : Object
	// paramètres de filtrage des lieux de la sélection courante
	$result:=New object
	$result.tousLesLieux:=True
	$result.géolocalisés:=True
	
	
	// ----------------------
	// MARK:MARK:FORMevents FORM
	// -----------------------
	
Function _FORM()
	var $gauche; $haut; $droite; $bas : Integer
	
	// traitements génériques
	This.surEvenementFormulaire()
	
	Case of 
		: (FORM Event.code=On Load)
			ZoneWeb_ZoomMin:=""
			ZoneWeb_ZoomMax:=""
			// se fait avant ouverture du formulaire
			cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Site_Web/Carto_ZoomMin_OL"; Is text; ->ZoneWeb_ZoomMin)
			cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Site_Web/Carto_ZoomMax_OL"; Is text; ->ZoneWeb_ZoomMax)
			
			OBJECT SET VISIBLE(*; "avancement"; True)
			
		: (FORM Event.code=On Activate)
			HIDE MENU BAR
			OBJECT SET VISIBLE(*; "avancement"; False)
			
		: (FORM Event.code=On Resize)
			OBJECT GET COORDINATES(*; "zoneCartographie"; $gauche; $haut; $droite; $bas)
			ZoneWeb_Largeur:=String($droite-$gauche)+"px"  //pixel
			ZoneWeb_Hauteur:=String($bas-$haut)+"px"
			
		: (FORM Event.code=On Unload)
			ZoneWeb_Largeur:=""
			ZoneWeb_Hauteur:=""
	End case 
	
	
Function _FORM_zoneCartographie()
	Case of 
		: (FORM Event.code=On End URL Loading)
			OBJECT SET VISIBLE(*; "curseurHoraire"; False)
	End case 
	
	// ----------------------
	// MARK:Gestion formulaire 
	// -----------------------
	
Function OuvrirFormulaire()
	// méthode du process U_Nav Cartographie
	var $wndNum : Integer
	
	DEFAULT TABLE([Lieux])
	
	If (Is Windows)
		$wndNum:=Open window(0; 25; Screen width; Screen height-30; 2; "Cartographie")
		MAXIMIZE WINDOW($wndNum)
		DIALOG("Visualiser La Cartographie")
		CLOSE WINDOW
		CLEAR VARIABLE($wndNum)
		
	Else 
		cs.$dialogue_3001.new().Ouvrir("Visualiser La Cartographie"; Plain form window; ""; This)
	End if 
	
	// purger la palette
	cs.EncyclopediaVisualisateur.new().Tuer()
	
	
Function AfficherEntité()
	// afficher la sélection courante dans le formulaire
	var $params : Object
	var $fichier : 4D.File
	var $URL : Text
	
	CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "AfficherEntité"; Current method name; "lancement création données GeoPortail"; New object("nomProcess"; Current process name; "numProcess"; Current process))
	
	// créer les données de la carte
	$params:=New object
	// entité à cartographier (entité réduite, mais de type collection)
	$params.sélection:=New collection(New object("DataClassNom"; Form.nav.sélectionCourante.getDataClass().getInfo().name; "IDs"; Form.nav.sélectionCourante.extract("ID")))
	// créer le dossier où mettre les fichiers
	$params.cheminRacineHTML:=This.document.GetSessionFolder().folder(Localized string("235")).platformPath
	// dossier de sessions
	$params.SessionID:="CartoVisualisateur"
	$params.cheminSessionFolder:=Folder($params.cheminRacineHTML; fk platform path).folder($params.SessionID).platformPath
	$params.sousDossierImages:="images"
	// pour les URL de la page Web des sous-dossiers
	$params.dossierCartoURL:=$params.SessionID
	$params.nomFichierMarkers:="dataGP.js"
	// formats pour Visualisateur
	$params.Apparence:=New object("CodeLangue"; "fr"; "SymbolConjoints"; " & "; "SymbolDateLieu"; " - "; "FormatDate"; 5; "FormatHeure"; 2; "FormatLieu"; 1; "FormatGeoLoc"; 1)
	$params.formatsPopUp:=New object("Events"; New object("Options"; 0x9500); "Medias"; New object("Options"; 0x0000); "Lieux"; New object("Options"; 0x00040000); "Communes"; New object("Options"; 0x002E0000); "Departements"; New object("Options"; 0x00890000); "Regions"; New object("Options"; 0x00890000); "Pays"; New object("Options"; 0x00890000))
	$params.PopUpOptions:=New object("Events"; 0x9500; "Medias"; 0x0000; "Lieux"; 0x00040000; "Communes"; 0x00C80000; "Departements"; 0x00C80000; "Regions"; 0x00880000; "Pays"; 0x0000)
	$params.PopUpLiens:=True
	// renseigner le deQui est affiché
	$params.deQui:=This.informations.deQui
	
	// fixer les variables process type www
	This.FixerHTTPvars($params)
	
	// générer les données de la carte
	// données de la class / function à utiliser
	cs.$serveurAPP.me.Executer(cs.LieuxEditeur.name; "CréerDonnéesCarto"; $params)
	// les données sont dans .reqRetour
	// restituer les données
	$params.data:=CoDecBase64_Objet($params.reqRetour.dataB64)
	OB REMOVE($params; "reqRetour")
	
	// installer les ressources carto
	This.carto.InstallerRessources($params.cheminRacineHTML)
	This.carto.InstallerRessourcesAPP()
	// créer les fichiers
	This.carto.InstallerDonnées($params)
	// récupérer les MarkersData
	Use (Storage.Processes[Current process name].Data)
		Storage.Processes[Current process name].Data.MarkersData:=$params.data.MarkersData
	End use 
	
	// fixer les variables process
	This.RestaurerHTTPvars($params.data.HTTPvars)
	vs4D:="_visualiser_"  // utile ?
	
	// créer le fichier .shtml
	$fichier:=Folder(fk resources folder).folder("TemplatesPagesWeb").file("cartographieVisualisateur.shtml")
	$URL:=$params.cheminRacineHTML
	cs._cfct.me.TraiterBalisesFichier($fichier; Folder($URL; fk platform path); New object)
	
	$URL:=$URL+"cartographieVisualisateur.shtml"
	WA OPEN URL(*; "zoneCartographie"; $URL)
	WA SET PREFERENCE(*; "zoneCartographie"; WA enable Web inspector; This.session.prefs.Session_Etat ?? 6)
	CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "AfficherURL"; Current method name; $URL; New object("nomProcess"; Current process name; "numProcess"; Current process))

⇧ [class]$formulaire_0123 - 08/05/2026 17:44:14

      Class extends $formulaire

Class constructor()
	
	Super()
	
	
Function Ouvrir()
	var $params : Object
	
	$params:=New object
	$params.nomProcess:="U_Process_aPropos"
	$params.initProcess:=Formula(InitProcessCooperative)
	This.process.NouveauProcess(cs.$formulaire_0123; "Afficher"; $params)
	
	
Function Afficher()
	var $texte : Text:=""
	
	cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Ressources_Communes/Nom_Application"; Is text; ->$texte)
	$texte:=Localized string("123")+$texte
	cs.$dialogue_3001.new().Ouvrir("U_Formulaire?0123"; Movable form dialog box; $texte; This)
	
	
Function _FORM()
	var $dataTexte : Text:=""
	var $texte; $InformationObjet : Text
	
	Case of 
		: (FORM Event.code=On Load)
			$InformationObjet:=""
			
			cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Ressources_Communes/Nom_Application"; Is text; ->$dataTexte)
			// on attend une version au format vxxxxx
			$texte:=Substring(Form.environnement.LireVersionAPP(); 2)
			ST SET ATTRIBUTES($texte; ST Start text; ST End text; Attribute bold style; 1)
			$InformationObjet+="Version "+$dataTexte+" "+$texte+Char(Carriage return)
			
			$texte:=Application version
			$texte:=String(Num(Substring($texte; 1; 2)))+"."+$texte[[4]]  // v14 n° de release non géré
			ST SET ATTRIBUTES($texte; ST Start text; ST End text; Attribute bold style; 1)
			$InformationObjet+="Version 4D "+$texte+Char(Carriage return)
			
			Case of 
				: ((Storage.System.typeApplication=ALV Serveur APP) | (Storage.System.typeApplication=ALV Serveur HTTP))
					// lire llrd infos
				Else 
					// c'est ok
					$texte:="Licence accordée à "+ds.UtilisateursALV.query("LogIn = :1"; This.session.userName)[0].Libellé(New object("Options"; 3))
					ST SET ATTRIBUTES($texte; ST Start text; ST End text; Attribute italic style; 1; Attribute text size; 8)
					$InformationObjet+=$texte+Char(Carriage return)
			End case 
			
			$InformationObjet+=Char(Carriage return)
			
			$texte:=String(ds.Personnes.all().length)
			ST SET ATTRIBUTES($texte; ST Start text; ST End text; Attribute bold style; 1)
			$texte:=((8-Length(ST Get plain text($texte)))*" ")+$texte+" "+cs._cfct.me.LireLocatedSTR(1055; New object("plur"; ds.Personnes.all().length>1))  // 3 blancs min  + 5 chiffres max
			$InformationObjet+=$texte+Char(Carriage return)
			
			$texte:=String(ds.Events.all().length)
			ST SET ATTRIBUTES($texte; ST Start text; ST End text; Attribute bold style; 1)
			$texte:=((8-Length(ST Get plain text($texte)))*" ")+$texte+" "+Localized string("10201")  // 3 blancs min  + 5 chiffres max
			$InformationObjet+=$texte+Char(Carriage return)
			
			$texte:=String(ds.Communes.all().length)
			ST SET ATTRIBUTES($texte; ST Start text; ST End text; Attribute bold style; 1)
			$texte:=((8-Length(ST Get plain text($texte)))*" ")+$texte+" "+Localized string("39")+"s"  // 3 blancs min  + 5 chiffres max
			$InformationObjet+=$texte+Char(Carriage return)
			
			// retirer les ressources
			$texte:=String(ds.Medias.query("type <= :1 or type >= :2"; 100; 200).length)
			ST SET ATTRIBUTES($texte; ST Start text; ST End text; Attribute bold style; 1)
			$texte:=((8-Length(ST Get plain text($texte)))*" ")+$texte+" Medias"  // 3 blancs min  + 5 chiffres max
			$InformationObjet+=$texte
			// dont les actes Etats Civils
			$texte:=String(ds.Events.all().lesIllustrations.laZone.leMedia.length)
			ST SET ATTRIBUTES($texte; ST Start text; ST End text; Attribute bold style; 1)
			$texte:=((8-Length(ST Get plain text($texte)))*" ")+$texte  // 3 blancs min  + 5 chiffres max
			$texte:=" dont "+$texte+" actes d'état civil"
			$InformationObjet+=$texte+Char(Carriage return)
			// dont les documents externes
			$texte:=String(ds.Medias.query("type = :1"; 200).length)
			ST SET ATTRIBUTES($texte; ST Start text; ST End text; Attribute bold style; 1)
			$texte:=((8-Length(ST Get plain text($texte)))*" ")+$texte  // 3 blancs min  + 5 chiffres max
			$texte:=(30*" ")+" et "+$texte+" liens vers des pages http"
			$InformationObjet+=$texte+Char(Carriage return)
			// ajouter les liens
			$texte:=String(ds.Zones.all().length)
			ST SET ATTRIBUTES($texte; ST Start text; ST End text; Attribute bold style; 1)
			$texte:=((8-Length(ST Get plain text($texte)))*" ")+$texte+" Zones sensibles"  // 3 blancs min  + 5 chiffres max
			$InformationObjet+=$texte+Char(Carriage return)
			
			$texte:="Fichier de données : "+This.getCheminBDD()
			ST SET ATTRIBUTES($texte; ST Start text; ST End text; Attribute text size; 10)
			$InformationObjet+=Char(Carriage return)+$texte+Char(Carriage return)
			
			Form.contenu:=$InformationObjet
	End case 
	
	
Function getCheminBDD()->$result : Text
	var $params : Object
	
	$params:=New object
	cs.$serveurAPP.me.Executer(OB Class(This).name; "CheminBDD"; $params)
	// le résultat est dans .reqRetour.chemin
	$result:=$params.reqRetour.chemin
	
	
Function CheminBDD($params : Object)
	$params.chemin:=Data file

⇧ [class]_ds - 06/05/2026 11:28:19

      // point d'entrée de toutes les modifications de la BDD par BDD mère / serveur APP ou _ds_EXT
property result; session : Object

singleton Class constructor()
	
	This.result:=Null
	This.session:=cs.$session.me
	
	
	// ----------------------
	//MARK:Modification
	// -----------------------
	
Function $ajouter($quoi : Integer)->$success : Boolean
	// appel par menus de type Ajout à BDD (BDD mère uniquement)
	// ajouter un quoi à DS, par défaut ajout non fait 
	var $entité; $params : Object
	
	$success:=False
	
	// fixer le aQui
	Case of 
			// appels spécifiques :
			
			// Ajouter un enfant
		: ($quoi=3024)
			If ((Form.entité.LesUnions()=Null) | (Form.indexUnion=-1))
				// il n'y a pas d'unions, ou aucune union sélectionnée ; on va créer une union
				$entité:=Form.entité
			Else 
				// utiliser l'union sélectionnée
				$entité:=Form.entité.LesUnions()[Form.indexUnion]
			End if 
			$success:=This.Ajouter(agk Enfant; $entité; Null)
			
			// Ajouter un événement personnel
		: ($quoi=3031)
			// demander le type d'event
			// v9.1.12, ne pas passer par les méthodes de classe (où le process est préemptif)
			$params:=cs.$dialogue_5006.new()
			$params.quoi:=$quoi
			If (cs.$dialogue_3001.new().Ouvrir("U_Dialogue?5006"; Sheet form window; ""; $params))
				// annulation
			Else 
				$success:=This.Ajouter(agk EventPersonnel; Form.entité; Null; New object("type"; $params.type))
			End if 
			
			// Ajouter un événement familial
		: ($quoi=3032)
			// demander le type d'event de l'union sélectionnée
			$params:=cs.$dialogue_5006.new()
			$params.quoi:=$quoi
			Case of 
				: (Form.entité.LesUnions()=Null)
					// il n'y a pas d'unions
				: (Form.indexUnion=-1)
					//  aucune union sélectionnée
					// demander le type, v9.1.13, ne pas passer par les méthodes de classe (où le process est préemptif)
				: (cs.$dialogue_3001.new().Ouvrir("U_Dialogue?5006"; Sheet form window; ""; $params))
					// annulation
				Else 
					// utiliser l'union sélectionnée
					$entité:=Form.entité.LesUnions()[Form.indexUnion]
					$success:=This.Ajouter(agk EventFamilial; $entité; Null; New object("type"; $params.type))
			End case 
			
			// Ajouter une personne
		: ($quoi=3025)
			$success:=This.Ajouter(agk Individu; Null; Null)
			
			// Ajouter  un témoin 1
		: ($quoi=3033)
			$success:=This.Ajouter(agk Temoin; Form.entité; Null; New object("liste"; "Groupe1"))
			
			// Ajouter un témoin 2
		: ($quoi=3034)
			$success:=This.Ajouter(agk Temoin; Form.entité; Null; New object("liste"; "Groupe2"))
			
			// Ajouter une information
		: ($quoi=3113)
			// rmk : aQui doit être en paramètre de .créer (voir 'Ajouter A DataStore')
			$success:=This.Ajouter(dsk Private; Form.entité; Null; New object("aQui"; Form.entité; "proprietaire"; This.session.user.IDfamille))
			// l'ajout ne se fait pas par l'entité courant
			// l'entité est définie dans les paramètres du menu
			
			// Ajouter un média
		: ($quoi=3045)
			$success:=This.Ajouter(imk Media; Null; Null)
			
			// Importer une illustration
			// créer un media avec une ZS liée à l'entité courante
		: ($quoi=3029)
			$success:=This.Ajouter(imk Illustration; Form.entité; Null; New object("typeZone"; 1; "numPage"; 1))
			
			// ajouter une ZS à l'entité courante liée à un media créé (avec zone centrale)
		: ($quoi=3059)
			$success:=This.Ajouter(imk Illustration; Form.entité; Null; New object("typeZone"; 2; "aQui"; Form.entité; "numPage"; Form.numPageMedia; "PositionX"; 0.5; "PositionY"; 0.5))
			
			// Importer un document
		: ($quoi=3054)
			$success:=This.Ajouter(imk Illustration; Form.entité; Null; New object("typeZone"; 3; "numPage"; 1))
			
			// Créer la vignette et l'icône du média
		: ($quoi=3056)
			$success:=This.Ajouter(imk Ressource; Form.entité; Null)
			
			// Ajouter un lien externe
		: ($quoi=3038)
			$success:=This.Ajouter(imk URL; Form.entité; Null; New object("typeZone"; 3; "aQui"; Form.entité; "numPage"; 1))
			
			// Créer un utilisateur au groupe courant
		: ($quoi=3076)
			$success:=This.Ajouter(dsk Utilisateur; Form.entité.leGroupe; Null)
			
			// Créer un groupe d'utilisateurs
		: ($quoi=3077)
			// il faut un user sélectionné
			$success:=This.Ajouter(dsk Groupe; Form.entité; Null)
			Form.AfficherMessageUtilisateur(New object("libelle"; Num(Form.entité=Null)*Localized string("5184")))
			
		Else 
			// appels génériques :
			$success:=This.Ajouter($quoi; Form.entité; Null)
	End case 
	
	
Function Ajouter($quoi : Integer; $aQui : Object; $qui : Object; $paramsIN : Object)->$success : Boolean
	// lancer l'exécution (BDD mère, serveur Web, client APP, journal)
	var $entité; $result; $params : Object
	var $chemin : Text
	
	// fixer les paramètres
	If (Count parameters>3)
		// l'action $quoi a généré des paramètres
		$params:=$paramsIN
	Else 
		$params:=New object()
	End if 
	
	If (Not(OB Is defined($params; "UserID")))
		$params.UserID:=OB Copy(This.session.user)
	End if 
	$params.PartageALV:=This.session.prefs.PartageALV
	// contexte
	$params.Contexte:=Storage.System.typeApplication
	
	// erreur par défaut
	$result:=New object("Error"; -15004; "success"; False; "ErrorDescription"; "")
	// initialiser (nécessaire si la transaction n'a pas été lancée)
	$params.result:=$result
	
	Case of 
		: (Not(Storage.System.Status ?? 1))
			// fichier "données" non modifiable
			Form.AfficherMessageUtilisateur(New object("ID"; 5059))
			$params.result.ErrorDescription:=cs._cfct.me.LireLocatedSTR(5059)
			
		: (Not(Form.ActionUtilisateur("[SaisieAutorisée]")))
			// modifications non autorisées
			Form.AfficherMessageUtilisateur(New object("ID"; 5042))
			$params.result.ErrorDescription:=Localized string("5042")
			
		: (Not(This._SelectionnerDocument($quoi; $params)))
			// on a besoin d'un document
			// A faire ici (hors des classes) pour un fonctionnement préemptif
			// si on reste ici, ça s'est mal passé (annulation par exemple)
			
		: (Storage.System.typeApplication=ALV Client APP)
			// ici le client APP fait une requête au serveur
			
			// préparer la requête
			$params.functionJALV:=EXT Ajouter A BDD
			$params.quoi:=$quoi
			
			// copier les paramètres
			// à faire tout de suite (une entité ne passe pas 'OB copier')
			If (OB Is defined($params; "aQui"))
				$params.aQui:=ds.EntitéRéduite($params.aQui)
			End if 
			If (OB Is defined($params; "deQui"))
				$params.deQui:=ds.EntitéRéduite($params.deQui)
			End if 
			$params.Data:=OB Copy($params)
			
			// passer les entités en réduit
			// à qui, qui
			$params.aQui:=Null
			If ($aQui#Null)
				$params.aQui:=ds.EntitéRéduite($aQui)
			End if 
			$params.Qui:=Null
			If ($qui#Null)
				$params.Qui:=ds.EntitéRéduite($qui)
			End if 
			
			cs.$serveurAPP.me.Executer(cs._ds_EXT.name; "Modifier"; $params)
			$result:=$params.reqRetour.result
			
			// importation d'un document
			Case of 
				: (Not($result.success))
					// pas de chance
					
				: (($quoi#imk Illustration) & ($quoi#imk Media))
				: (Not(OB Is defined($params; "cheminMediaSurDD")))
					// on n'a pas ajouté d'illustration
					
				Else 
					// on a demandé au serveur d'importer le document externe ; le mettre dans la BDD du client.
					$entité:=ds.EntitéAvecUUID($result.entitéAjoutée)
					
					// recopier le document du DD dans le dossier des ajout de la BDD
					$chemin:=cs.$document.new().GetMediaFolder(Dossier Media Client).folder(ds.Dossiers.query("volume = :1"; 0)[0].nom).file($entité.leFichier[0].nom).platformPath
					COPY DOCUMENT($params.cheminMediaSurDD; $chemin; *)
			End case 
			
			// fixer le retour : repasser en entité
			//If ($result.success)
			//$result.entitéAjoutée:=ds.EntitéAvecUUID($result.entitéAjoutée)
			//$result.entitéRetour:=ds.EntitéAvecUUID($result.entitéRetour)
			//End if 
			
		Else 
			// ici BDD mère ou serveur APP
			
			// faire l'ajout :
			$result:=ds.Ajouter($quoi; $aQui; $qui; $params)
			
			// fixer le retour : repasser en entité
			If ($result.success)
				$result.entitéAjoutée:=ds.EntitéRéduite($result.entitéAjoutée)
				$result.entitéRetour:=ds.EntitéRéduite($result.entitéRetour)
			End if 
			
	End case 
	$success:=$result.success
	
	// mettre à jour les formulaires
	// dans un worker , ici on est thread-safe
	CALL WORKER("WK_Communication"; Formula from string("cs.$processUser.new().AfficherModificationBDD($1;$2)"); $quoi; $result)
	
	
Function Modifier($quoi : Integer; $c : Collection; $params : Object)->$return : Boolean
	// appel par BDDmère, ClientAPP ou cs._ds_EXT (serveur Web, Import Journaux)
	var $result; $entité : Object
	
	// erreur par défaut
	$result:=New object("Error"; -15005; "success"; False; "ErrorDescription"; "")
	
	If ($params=Null)
		$params:=New object
	End if 
	// compléter, au cas ou
	If (Not(OB Is defined($params; "UserID")))
		$params.UserID:=OB Copy(This.session.user)
	End if 
	If (Not(OB Is defined($params; "PartageALV")))
		$params.PartageALV:=This.session.prefs.PartageALV
	End if 
	If (Not(OB Is defined($params; "Contexte")))
		$params.Contexte:=Storage.System.typeApplication
	End if 
	
	Case of 
		: (Not(Storage.System.Status ?? 1))
			// BDD verrouillée
			$entité:=Form.entité.reload()
			Form.AfficherMessageUtilisateur(New object("ID"; 5059))
			$result.ErrorDescription:=cs._cfct.me.LireLocatedSTR(5059)
			
		: (Not(Form.ActionUtilisateur("[SaisieAutorisée]")))
			$entité:=Form.entité.reload()
			Form.AfficherMessageUtilisateur(New object("ID"; 5042))
			$result.ErrorDescription:=Localized string("5042")
			
		Else 
			
			Case of 
				: ($quoi=cdk Modifier)
					// enregistrer les modifications de la liste d'entités
					Case of 
						: ($c=Null)
						: ($c.length=0)
						Else 
							For each ($entité; $c)
								// attention : des entités peuvent être indéfinies (ex lien 1-N  : si l'attribut de N est modifié, l'entité 1 peut ne pas exister)
								// attention : les paramètres ($params) sont communs à la liste d'entités (modification d'un groupe 'homogène' d'entités)
								Case of 
									: ($entité=Null)
										// c'est possible
									: (Undefined($entité))
										// c'est possible
									Else 
										$result:=ds.Modifier(cdk Modifier; $entité; $params)
										// mettre à jour les FORM
										cs.$processUser.new().AfficherModificationBDD($quoi; $result)
								End case 
							End for each 
							
							$result.success:=True
							$return:=True
					End case 
					
				: ($quoi=cdk Lier)
					// faire un lien entre $c et l'entité $params
					// $params l'attribut de $c à modifier, et la valeur à utiliser (un seul cas : est un IDcodé)
					$result.Erreur:=-15068
					Case of 
						: ($c=Null)
						: ($c.length=0)
						: (Not(OB Is defined($params; "params")))
							$result.ErrorDescription:="$params n'a pas l'attribut 'params'"
						: (Not(OB Is defined($params.params; "attribut")))
							$result.ErrorDescription:="$params.params n'a pas l'attribut 'attribut'"
						: (Not(OB Is defined($params.params; "valeur")))
							$result.ErrorDescription:="$params.params n'a pas l'attribut 'valeur'"
							
						Else 
							// c'est ok
							$result.Erreur:=0
							
							$entité:=$c[0]
							// il faut passer par là (pas de FORMevent généré)
							$result:=ds.Modifier(cdk Lier; $entité; $params)
							// donc pas d'écriture journal
							// mettre à jour les FORM
							cs.$processUser.new().AfficherModificationBDD($quoi; $result)
					End case 
			End case 
			
	End case 
	$result.Error:=$result.Error*Num(Not($result.success))
	
	// renvoyer le résultat (appel par serveur Web ou journal)
	If ($params#Null)
		$params.result:=$result
	End if 
	$return:=$result.success
	
	
	// ----------------------
	//MARK:CoDec
	// -----------------------
	
Function IDcodé($entité : Object)->$result : Integer
	// renvoyer l'IDcodé de $entité
	If (OB Is defined($entité; "ID"))
		$result:=cs._cfct.me.CoderID($entité.ID; $entité.getDataClass().getInfo().tableNumber)
	Else 
		$result:=-1
	End if 
	
	
Function IDcodés($sélection : Object)->$c : Collection
	// renvoyer la collection des IDcodés de la sélection this
	var $ID : Integer
	var $entité : Object
	
	$c:=New collection
	Case of 
		: ($sélection=Null)
		: ($sélection.length=0)
		Else 
			For each ($entité; $sélection)
				$ID:=This.IDcodé($entité)
				If ($id#-1)
					$c.push($ID)
				End if 
			End for each 
	End case 
	
	
	// ----------------------
	//MARK:Entité
	// -----------------------
	
Function EntitéRéduite($entité : Object)->$objet : Object
	// réduire $entité à sa dataclass et son UUID ; utile dans les échanges client - serveur
	$objet:=New object()
	$objet.DataClassNom:=$entité.getDataClass().getInfo().name
	$objet.IDunique:=$entité.IDunique
	
	
Function EntitéAvecUUID($objet : Object)->$entité : Object
	// restaure l'entité à partir de sa dataclass et son UUID ; utile dans les échanges client - serveur
	var $dataStore; $sélection : Object
	
	$entité:=Null
	Case of 
		: (Not(OB Is defined($objet; "DataClassNom")))
			ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "'DataClassNom' n'est pas défini dans $objet"))
		: (Not(OB Is defined(ds; $objet.DataClassNom)))
			ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "$objet.DataClassNom n'est pas une dataClass"))
		Else 
			$dataStore:=ds[$objet.DataClassNom]
			
			Case of 
				: (Not(OB Is defined($objet; "IDunique")))
					ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "'IDunique' n'est pas défini dans $objet"))
				: (Not(OB Is defined($dataStore; "IDunique")))
					ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "'IDunique' n'est pas un attribut de la dataClass $objet.DataClassNom"))
				Else 
					$sélection:=ds[$objet.DataClassNom].query("IDunique = :1"; $objet.IDunique)
					$entité:=$sélection[0]
			End case 
	End case 
	
	
Function EntitéAvecIDcodé($IDentitéCodé : Integer)->$result : Object
	var $dataClassNom : Text
	
	$result:=Null
	Case of 
		: (($IDentitéCodé >> 24)=0)
		: (Not(Is table number valid($IDentitéCodé >> 24)))
		Else 
			$dataClassNom:=Table name($IDentitéCodé >> 24)
			$result:=ds[$dataClassNom].get($IDentitéCodé & 0x00FFFFFF)
	End case 
	
	
	// ----------------------
	//MARK:Selection
	// -----------------------
	
Function SelectionEditable($sélection : Object)->$result : Object
	Try
		Case of 
			: ($sélection=Null)
				$result:=Null
				
			: (OB Instance of($sélection.SelectionEditable; 4D.Function))
				$result:=$sélection.SelectionEditable()
		End case 
		
	Catch
		$result:=$sélection
	End try
	
	
Function SelectionAvecID($DataClassNom : Text; $IDs : Collection)->$result : Object
	var $ID : Integer
	
	$result:=ds[$DataClassNom].newSelection(dk keep ordered)
	For each ($ID; $IDs)
		$result.add(ds[$DataClassNom].get($ID))
	End for each 
	
	
	// ----------------------
	//MARK:Utilitaires
	// -----------------------
	
Function _InitResult($error : Integer; $errorDescription : Text; $success : Boolean)->$result : Object
	If (Count parameters=0)
		$error:=0
		$errorDescription:=""
		$success:=True
	End if 
	$result:=New object("Error"; $error; "ErrorDescription"; $errorDescription; "success"; $success)
	
	
Function _SelectionnerDocument($commande : Integer; $params : Object)->$result : Boolean
	// Description
	//  sélectionner sur le DD  un fichier importable
	//
	// Paramètres
	// ----------------------------------------------------
	// la commande $commande peut nécessiter un document du DD
	// si c'est le cas, sélectionner ou saisir un chemin sur un disque, retour dans .cheminDocument
	// sinon ne rien faire
	var $System; $data : Object
	var $c : Collection
	var $dataTexte : Text
	var $error : Integer:=0
	var $errorDescription : Text:=""
	
	$System:=Storage.System
	
	Case of 
		: (OB Is defined($params; "cheminDocument"))
			// le chemin est défini
			
		: (($commande#imk URL) & ($commande#imk Media))
			// pas concerné
			
		Else 
			// ici on veut quelque chose de l'extérieur
			Case of 
				: (Not($System.Status ?? 2))
					// dossier des medias non connu
					$error:=-15043
					$errorDescription:=Localized string("5086")
					
				: (Not($System.Status ?? 3))
					// dossier des medias non modifiable
					$error:=-15078
					$errorDescription:=Localized string("5060")
					
				: ($commande=imk URL)
					// demander un lien html
					// préparer la demande
					$data:=New object("typeFenetre"; Sheet window; "titre"; Localized string("3038"); "numPageForm"; 4; "message"; Localized string("5201"); "texteExemple"; "http://...")
					// une sélection ?
					If (cs.$dialogue_3001.new().Lancer($data))
						$error:=-15021
						
					Else 
						$params.cheminDocument:=$data.texteSaisi
					End if 
					
				: ($commande=imk Media)
					// sélectionner un fichier sur DD
					// lister les types connus de l'APP
					$c:=OB Entries(OB Copy(cs._rsc.me)).query("key = :1"; "media@").extract("value")
					// supprimer les types internes ALV
					$c:=$c.query("typeObjet < :1"; 10)
					
					// sélectionner les types de documents importables
					$dataTexte:=$c.extract("UTI").join(";")
					If (Is Windows)
						$dataTexte:=$c.extract("type").join(";")
					End if 
					
					$dataTexte:=Select document(79; $dataTexte; Localized string("5011"); Use sheet window)
					$params.cheminDocument:=Document
					$error:=Erreur de lecture du fichier*Num((Length(Document)=0))
			End case 
			// ici, $error = 0 => ok (on veut un chemin, pas d'erreur)
	End case 
	
	// import de document par le client APP
	// on remplace le chemin du document par son contenu
	Case of 
		: (Storage.System.typeApplication#4D Client APP)
			// pas concerné, on garde l'erreur éventuelle
			
		: (Not(OB Is defined($params; "cheminDocument")))
			// pas de document à traiter (possible)
			
		: ($error#0)
			// a priori annulation, ou erreur de sélection de document
			
		: ($commande=imk URL)
			// pas de contenu à charger
			
			// le client doit envoyer le contenu du document
		: (Not(cs.$document.new(Est un document ALV; $params.cheminDocument).LireLeContenu($params).success))
			// pas de contenu importé
			
		Else 
			// c'est ok, mémoriser le chemin du media
			$params.cheminMediaSurDD:=$params.cheminDocument
			// nettoyer, pour ne pas s'emmèler les pinceaux sur le serveur
			OB REMOVE($params; "cheminDocument")
	End case 
	
	
	$errorDescription:=$errorDescription*Num($error#0)
	$error:=$error*Num($error#Erreur de lecture du fichier)  // pas de log erreur si annulation
	cs.$trace.me.Créer($error; Current method name; $errorDescription).LeverException([msgk_son; msgk_user])
	$result:=($error=0)

⇧ [class]EventsEditeur - 20/04/2026 18:24:33

      Class extends $editeur

Class constructor()
	// construction commune
	Super()
	
	
	
	
Function getDataClassInfos()->$result : Object
	$result:=Super.getDataClassInfos("Events")
	
	
	// ----------------------
	// MARK:Sélections 
	// -----------------------
	
Function CréerLaListeDesEnfants($params : Object)
	// ici on est toujours sur BDDmère ou ServeurAPP
	var $sélection : Object
	
	// créer la sélection de personnes
	$sélection:=ds.Events.get($params.entitéID)
	$sélection:=$sélection.LesEnfants()
	// créer la collection de personnes de $sélection
	$sélection.CréerListBox($params)
	// le résultat est dans $params
	
	
Function CréerLaListeDesDocuments($params : Object)
	// ici on est toujours sur BDDmère ou ServeurAPP
	var $sélection : cs.EventsSelection
	
	$sélection:=ds.Events.query("ID = :1"; $params.entitéID)
	// créer la collection des documents personnels de $sélection
	$sélection.CréerListBoxMedia($params)
	// le résultat est dans $params
	
	
Function ListerTémoins($params : Object)
	// ici on est toujours sur BDDmère ou ServeurAPP
	
	// exécuter
	$params.entitéID:=Form.entité.ID
	$params.Options:=7
	This.CréerLaListe(cs.EventsEditeur.name; "CréerLaListeDesTémoins"; $params)
	
	
Function CréerLaListeDesTémoins($params : Object)
	var $sélection : Object
	
	$sélection:=ds.Events.get($params.entitéID)
	// créer la collection hiérarchique des documents personnels de $sélection
	$sélection:=$sélection.LesTémoins($params.groupe)
	
	// demander la LH
	If ($sélection#Null)
		$sélection.CréerListBox($params)
	End if 
	// le résultat est dans $params
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	
	ASSERT(cs.$trace.me.DebugerEventForm(Current method name; "EventForm"; New object("numEvent"; FORM Event.code; "numTable"; Table(Current form table))))
	
	// traitements génériques
	This.surEvenementFormulaire()
	
	// traitements particuliers
	Case of 
		: (FORM Event.code=On Load)
			// se fait avant ouverture du formulaire
			OBJECT SET ENABLED(*; "btnTri@"; True)
			// ici, toutes les variables pointées sont init
			
			// charger les objets
			This.onEndLoad()
			
		: (FORM Event.code=On Activate)
			// autorise modif. par le formulaire
			This.FixerVisibilitéPalettes(True)
			SET WINDOW TITLE(Localized string("5002")+Form.conjoint1+Form.conjoint2)
			
		: (FORM Event.code=On Data Change)
			cs._ds.me.Modifier(cdk Modifier; New collection(Form.entité; Form.PrivateData); Null)
			
		: (FORM Event.code=On Deactivate)
			
		: (FORM Event.code=On Unload)
			// décharge du formulaire : purger les variables (les objets ne sont pas automatiquement appelés)
			This.onEndUnLoad()
	End case 
	
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection()
	$c.combine(["dateChaine"; "listeTypeEvent"; "listeIllustrations"; "listeTemoins1"; "listeTemoins2"; "listeDocuments"; "listeEnfants"])
	Super.onEndEventForm($c)
	
	
	// décharger les objets
Function onEndUnLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection("listeTypeEvent")
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:FORMevents Page fond
	// ----------------------
	
Function _FORM_actionFormulaire()->$result : Integer
	$result:=Super.surActionFormulaire([ds.Personnes; ds.Communes; ds.Medias])
	
	
	// ----------------------
	//MARK:FORMevents Page 1
	// ----------------------
	
Function _FORM_dateChaine()
	Case of 
		: ((FORM Event.code=On Load) | (FORM Event.code=On Losing Focus))
			OBJECT SET RGB COLORS(*; This.nomOBJ; (Foreground color*Num(This.entité.dateNumValid))+(0x00777777*Num(Not(This.entité.dateNumValid))))
			
		: (FORM Event.code=On Data Change)
			cs.xSDK.Outils.me.getDateNum(This.entité)
			cs._ds.me.Modifier(cdk Modifier; [This.entité]; Null)
	End case 
	
	
Function _FORM_nomLieu()->$result : Integer
	var $IDcodée : Integer
	
	Case of 
		: (FORM Event.code=On Clicked)
			$IDcodée:=Form.entité.leLieu.IDcodé()
			Form.EditerSélection($IDcodée; 0)
			
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserENTITE([ds.Lieux])
			Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5024; This.glisserDeposer.paramsMessage)))
			
		: (FORM Event.code=On Drop)
			// on a reçu un lieu : faire le lien
			$IDcodée:=Storage.System.GlisserDéposer.refItem
			cs._ds.me.Modifier(cdk Lier; New collection(Form.entité); New object("params"; New object("attribut"; "lieu"; "valeur"; $IDcodée)))
	End case 
	
	
Function _FORM_listeTypeEvent()
	var $i : Integer
	var listeTypeEvent : Integer
	
	Case of 
		: (FORM Event.code=On Load)
			// initialiser la liste
			listeTypeEvent:=New list
			
			If (This.entité.est(agk EventFamilial))
				listeTypeEvent:=cs._cfct.me.LireLocatedSTR_LH(33600; 33999)
				
				$i:=Int(This.entité.type/100)%100
				Form.typeEvent:=cs._cfct.me.LireLocatedSTR(1000+$i; New object("genre"; False; "plur"; True))
				
			Else 
				listeTypeEvent:=cs._cfct.me.LireLocatedSTR_LH(22000; 22999)
				
				$i:=Int(This.entité.type/100)%100
				Form.typeEvent:=cs._cfct.me.LireLocatedSTR(1000+$i; New object("genre"; Form.entité.LesProtagonistes()[0].sexe; "plur"; False))
			End if 
			SELECT LIST ITEMS BY REFERENCE(listeTypeEvent; Form.entité.type)
			
		: (FORM Event.code=On Data Change)
			$i:=Selected list items(*; This.nomOBJ; *)
			If ($i#0)
				If (Form.entité.type#$i)
					Form.entité.type:=$i
					cs._ds.me.Modifier(cdk Modifier; New collection(Form.entité); Null)
					
					// il faut mettre à jour les libellés du formulaire (ex si genre = femelle)
					Appeler_Le_Formulaire(Current process; "AfficherEntité"; New object)
				End if 
			End if 
			
		: (FORM Event.code=On Unload)
			CLEAR LIST(listeTypeEvent; *)
	End case 
	
	
Function _FORM_listeIllustrations()
	var $params : Object:=New object
	Super._FORM_listeIllustrations($params)
	
	
Function _FORM_listeIllustrations_photo()
	Super._FORM_listeIllustrations_photo()
	
	
Function _FORM_listeTemoins1()
	var $params : Object
	
	Case of 
		: (FORM Event.code=On Load)
			$params:=New object("groupe"; "Groupe1")
			This.ListerTémoins($params)
			
			Form[This.nomOBJ]:=$params.liste
			
			If ($params.liste.length>0)
				If (Form.entité.type=22300)
					OB SET(Form; "titre_"+This.nomOBJ; cs._cfct.me.LireLocatedSTR(1042; New object("plur"; (Form[This.nomOBJ].length>1))))
				Else 
					OB SET(Form; "titre_"+This.nomOBJ; cs._cfct.me.LireLocatedSTR(1044; New object("plur"; (Form[This.nomOBJ].length>1))))
				End if 
			End if 
	End case 
	
	
Function _FORM_listeTemoins1_temoin1()->$result : Integer
	//rappel : l'event drop n'existe pas sur la LB ; on utilise la colonne 'temoin1'
	Case of 
		: (FORM Event.code=On Clicked)
			If (Form[This.nomOBJ+"PositionElementCourant"]#0)
				Form.EditerSélection(Form.entité.LesTémoins("Groupe1"); Form[This.nomOBJ+"PositionElementCourant"]-1)
			End if 
			
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserENTITE([ds.Personnes])
			Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5028; This.glisserDeposer.paramsMessage); "userMessageTime"; 30))
			
		: (FORM Event.code=On Drop)
			This.dropSurTemoins(New object("liste"; "Groupe1"))
	End case 
	
	
Function _FORM_listeTemoins2()
	var $params : Object
	
	Case of 
		: (FORM Event.code=On Load)
			$params:=New object("groupe"; "Groupe2")
			This.ListerTémoins($params)
			
			Form[This.nomOBJ]:=$params.liste
			
			If ($params.liste.length>0)
				If (Form.entité.type=22300)
					OB SET(Form; "titre_"+This.nomOBJ; cs._cfct.me.LireLocatedSTR(1043; New object("plur"; (Form[This.nomOBJ].length>1))))
				Else 
					OB SET(Form; "titre_"+This.nomOBJ; cs._cfct.me.LireLocatedSTR(1045; New object("plur"; (Form[This.nomOBJ].length>1))))
				End if 
			End if 
	End case 
	
	
Function _FORM_listeTemoins2_temoin2()->$result : Integer
	//rappel : l'event drop n'existe pas sur la LB ; on utilise  la colonne 'temoin2'
	Case of 
		: (FORM Event.code=On Clicked)
			If (Form[This.nomOBJ+"PositionElementCourant"]#0)
				Form.EditerSélection(Form.entité.LesTémoins("Groupe2"); Form[This.nomOBJ+"PositionElementCourant"]-1)
			End if 
			
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserENTITE([ds.Personnes])
			Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5029; This.glisserDeposer.paramsMessage); "userMessageTime"; 30))
			
		: (FORM Event.code=On Drop)
			This.dropSurTemoins(New object("liste"; "Groupe2"))
	End case 
	
	
Function _FORM_listeDocuments()->$result : Integer
	var $data; $params : Object
	
	Case of 
		: (FORM Event.code=On Load)
			// exécuter
			$params:=New object
			$params.entitéID:=Form.entité.ID
			$params.typeZone:=3
			$params.IDgroupe:=This.session.user.IDfamille
			$params.attribut:="icone"
			
			// exécuter
			This.CréerLaListe(cs.EventsEditeur.name; "CréerLaListeDesDocuments"; $params)
			
			For each ($data; $params.liste)
				$data.icone:=CoDecBase64_Objet($data.pict)
			End for each 
			Form[This.nomOBJ]:=$params.liste
			
		: (FORM Event.code=On Drag Over)
			// dépot d'un media du Disque Dur?
			$result:=This.glisserDeposer.surGlisserFICHIER()
			Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5025; This.glisserDeposer.paramsMessage)))
			If ($result=-1)
				// non, dépot d'un media de la BDD?
				$result:=This.glisserDeposer.surGlisserENTITE([ds.Medias])
				Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5061; This.glisserDeposer.paramsMessage)))
			End if 
	End case 
	
	
Function _FORM_listeDocuments_document()
	//rappel : l'event drop n'existe pas sur la LB ; on utilise une colonne
	var $sélection : cs.MediasSelection
	var $entité : Object
	
	Case of 
		: (FORM Event.code=On Clicked)
			If (Form[This.nomOBJ+"PositionElementCourant"]#0)
				$sélection:=ds.Events.query("ID = :1"; Form.entité.ID).LesMedias(New object("typeZone"; 3; "IDgroupe"; This.session.user.IDfamille))
				Form.EditerSélection($sélection; Form[This.nomOBJ+"PositionElementCourant"]-1)
			End if 
			
		: (FORM Event.code=On Drop)
			If (Form.ActionUtilisateur("[ModificationAutorisée]"))  // $3 ne doit pas passer les tests "deposer"
				$entité:=Form.entité
				// ici, on importe un document
				Use (Storage.System.GlisserDéposer)
					Storage.System.GlisserDéposer.numPage:=1
					Storage.System.GlisserDéposer.typeZone:=3
				End use 
				This.glisserDeposer.surDéposerILLUSTRATION($entité)
			End if 
	End case 
	
	
Function _FORM_listeEnfants()
	var $params : Object
	
	Case of 
		: (FORM Event.code=On Load)
			If (Form.entité.est(agk EventFamilial))
				// exécuter
				$params:=New object
				$params.entitéID:=This.entité.ID
				This.CréerLaListe(cs.EventsEditeur.name; "CréerLaListeDesEnfants"; $params)
				
				Form[This.nomOBJ]:=$params.liste
				
				Form[This.nomOBJ+"Label"]:=cs._cfct.me.LireLocatedSTR(1007; New object("plur"; ($params.liste.length>1)))
			End if 
			
			OBJECT SET VISIBLE(*; This.nomOBJ; Form.entité.est(agk EventFamilial))
			OBJECT SET VISIBLE(*; This.nomOBJ+"Label"; Form.entité.est(agk EventFamilial))
	End case 
	
	
Function _FORM_listeEnfants_enfant()
	Case of 
		: (FORM Event.code=On Clicked)
			If (Form[This.nomOBJ+"PositionElementCourant"]#0)
				Form.EditerSélection(This.entité.LesEnfants(); Form[This.nomOBJ+"PositionElementCourant"]-1)
			End if 
	End case 
	
	
Function _FORM_goToPersonne()
	Case of 
		: (FORM Event.code=On Clicked)
			Form.EditerSélection(This.entité.LesProtagonistes(); 0)
	End case 
	
	
Function _FORM_ajoutMedia()->$result : Integer
	var $entité : Object
	
	Case of 
		: (FORM Event.code=On Drag Over)
			// dépot d'un media du Disque Dur?
			$result:=This.glisserDeposer.surGlisserFICHIER()
			Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5027; This.glisserDeposer.paramsMessage)))
			
			If ($result=-1)
				// non, dépot d'un media de la BDD?
				$result:=This.glisserDeposer.surGlisserENTITE([ds.Medias])
				Form.AfficherMessageUtilisateur(New object("libelle"; Num($result=0)*cs._cfct.me.LireLocatedSTR(5026; This.glisserDeposer.paramsMessage)))
			End if 
			ASSERT(cs.$trace.me.DebugerVariables("état"; Current method name; New object("Événement formulaire"; On Drag Over; "$result"; $result)))
			
		: (FORM Event.code=On Drop)
			If (Form.ActionUtilisateur("[ModificationAutorisée]"))
				$entité:=Form.entité
				// ici, on importe une illustration
				Use (Storage.System.GlisserDéposer)
					Storage.System.GlisserDéposer.numPage:=1
					Storage.System.GlisserDéposer.typeZone:=1
				End use 
				This.glisserDeposer.surDéposerILLUSTRATION($entité)
			End if 
			
		: (FORM Event.code=On Mouse Leave)
			// effacer
			Form.EffacerMessageUtilisateur()
	End case 
	
	
	// ----------------------
	// MARK:Affichages 
	// -----------------------
	
Function AfficherEntité()
	var $membre; $params : Object
	
	OBJECT SET VISIBLE(*; "grplieu@"; Form.entité.leLieu#Null)
	
	// afficher les listes des media liés à l'event
	OBJECT SET VISIBLE(*; "illustration"; Records in selection([Medias])#0)
	
	// afficher les conjoints
	$params:=OB Copy(This.session.prefs.Apparence.Formulaire)
	$params.Options:=Choose(Form.entité.est(agk EventFamilial); 0x0013; 0x0003)
	$membre:=Form.entité.LesProtagonistes().Libellés($params)
	Form.conjoint1:=$membre.Membre1
	Form.conjoint2:=$membre.Membre2
	
	// contextualiser les menus
	// les témoins peuvent être des parrain / marraine
	If (Form.entité.type=22300)
		// baptème
		$params:=New object("IDnomMenu"; "BM_01-09-0105")  // menu "témoin 1"
		Form.menu.LireRefMenu($params)
		SET MENU ITEM($params.refMenu; $params.numLigne; Localized string("3035"))
		If (Form.entité.LesTémoins("Groupe1")=Null)
			ENABLE MENU ITEM($params.refMenu; $params.numLigne)
		Else 
			// un seul parrain
			DISABLE MENU ITEM($params.refMenu; $params.numLigne)
		End if 
		
		$params:=New object("IDnomMenu"; "BM_01-09-0106")  // menu "témoin 2"
		Form.menu.LireRefMenu($params)
		SET MENU ITEM($params.refMenu; $params.numLigne; Localized string("3036"))
		If (Form.entité.LesTémoins("Groupe2")=Null)
			ENABLE MENU ITEM($params.refMenu; $params.numLigne)
		Else 
			// une seule marrainne
			DISABLE MENU ITEM($params.refMenu; $params.numLigne)
		End if 
		
	Else 
		$params:=New object("IDnomMenu"; "BM_01-09-0105")  // menu "témoin 1"
		Form.menu.LireRefMenu($params)
		SET MENU ITEM($params.refMenu; $params.numLigne; Localized string("3033"))
		ENABLE MENU ITEM($params.refMenu; $params.numLigne)
		
		$params:=New object("IDnomMenu"; "BM_01-09-0106")  // menu "témoin 2"
		Form.menu.LireRefMenu($params)
		SET MENU ITEM($params.refMenu; $params.numLigne; Localized string("3034"))
		ENABLE MENU ITEM($params.refMenu; $params.numLigne)
	End if 
	
	// barre menu "event" : vérifier qu'il y a quelque chose pour le diaporama ou la cartographie
	$params:=New object("IDnomMenu"; "BM_01-09-0100")
	Form.menu.LireRefMenu($params)
	Form.menu.ValiderBarreMenus($params.refMenu)
	
	// pour cette version, pas d'ajout d'events à partir de ce formulaire
	$params:=New object("IDnomMenu"; "BM_01-09-0101")  // menu "event perso"
	Form.menu.LireRefMenu($params)
	DISABLE MENU ITEM($params.refMenu; $params.numLigne)
	
	$params:=New object("IDnomMenu"; "BM_01-09-0102")  // menu "event fam"
	Form.menu.LireRefMenu($params)
	DISABLE MENU ITEM($params.refMenu; $params.numLigne)
	
	
	// ----------------------
	// MARK:Demande actions 
	// -----------------------
	
Function dropSurTemoins($params : Object)
	var $entité : Object
	var $IDcodé : Integer
	
	If (Form.ActionUtilisateur("[ModificationAutorisée]"))
		$IDcodé:=Storage.System.GlisserDéposer.refItem
		$entité:=cs._ds.me.EntitéAvecIDcodé($IDcodé)
		cs._ds.me.Ajouter(agk Temoin; Form.entité; $entité; $params)
	End if

⇧ [class]LieuxPalette - 19/05/2026 08:18:22

      property nomTache : Text:="nouvelleListeLieux"

Class extends $formulaire

Class constructor()
	// construction commune
	Super()
	
	
	
Function getDataClassInfos()->$result : Object
	$result:=Super.getDataClassInfos("Lieux")
	
	
Function FixerParamètres($params : Object)
	// $params = paramètres de menu
	
	Super.FixerParamètres($params)
	This.informations.nomForm:="U_Palette?3016"
	
	
	// ----------------------
	// MARK:Sélections
	// -----------------------
	
Function NouvelleSélection()
	// initialiser dans un process externe
	var $params : Object
	var $nomProc : Text
	var $numProc : Integer
	var ListeGéographie : Integer
	
	CLEAR LIST(ListeGéographie; *)
	
	// paramètres de la fonction
	$params:=New object
	$params.DataClassNom:=cs.Pays.name  // mettre cs !
	If (This.session.prefs.Palettes.Palette_3016.ParamsForm.ReductionLieux)
		$params.Options:=0x00333113
	Else 
		$params.Options:=0x00333333
	End if 
	
	// c'est parti
	cs.$serveurAPP.me.Executer(OB Class(This).name; "CréerHiérarchie"; $params)
	// récupérer les données
	$params:=$params.reqRetour
	
	// créer la LH
	$params.tache:=This.registreTaches.Inscrire(New object("nomProcess"; Current process name; "nomTache"; This.nomTache; "numProcessAppelant"; Current process))
	$params.tache.FixerEtat(Localized string("5072"))
	
	$params.déployée:=False
	// pour le retour, exécuter :
	$params.nomProcessAppelant:=Current process name
	$params.CallBack:="getListeHiérarchique"
	
	$nomProc:="$ALV_process_CréationLH lieux"
	This.process.TuerAvecNom($nomProc)
	
	// rappel : les listes He sont pas thread-safe
	$numProc:=New process(Formula(Créer Liste Hiérarchique).source; 0; $nomProc; $params)
	
	
Function CréerHiérarchie($params : Object)
	// ici on est sur la BDD mère ou le serveur APP
	var $sélection : Object
	
	// créer la sélection
	Case of 
		: (OB Is defined($params; "DataClassNom"))
			// tout sélectionner
			$sélection:=ds[$params.DataClassNom].all()
			
		: (OB Is defined($params; "itemRef"))
			$sélection:=ds[Table name($params.itemRef >> 24)].query("ID = :1"; $params.itemRef & 0x00FFFFFF)
			
		Else 
			$sélection:=Null
	End case 
	
	If ($sélection#Null)
		$sélection.CréerHiérarchie($params)
		// le résultat est dans $params
	End if 
	
	
Function AjouterAsélection($itemRef : Integer)
	// ajouter à ListeGéographie l'élément administratif $1 (un lieu, un site...)
	// recréer la sous-liste à laquelle doit appartenir $1
	var $params : Object
	var $itemText : Text
	var $détail : Integer
	var $déployé : Boolean
	
	If (This.session.prefs.Palettes.Palette_3016.ParamsForm.ReductionLieux)
		// pas de modif si la liste est réduite
		Form.AfficherMessageUtilisateur(New object("ID"; 5093))
		
	Else 
		// trouver la liste parente de la sous-liste
		If (CodeEnreg($itemRef; [Table(->[Pays])])=1)
			// un pays n'a pas de niveau supérieur : tout réinitialiser
			This.NouvelleSélection()
			
		Else 
			// reconstruire sa sous liste
			// paramètres de la fonction
			$params:=New object("itemRef"; $itemRef; "Options"; 0x00333333; "déployée"; False)
			cs.$serveurAPP.me.Executer(cs.LieuxPalette.name; "CréerHiérarchie"; $params)
			
			$itemRef:=$params.reqRetour.parent
			GET LIST ITEM(ListeGéographie; List item position(ListeGéographie; $itemRef); $itemRef; $itemText; $détail; $déployé)
			If ($détail#0)
				CLEAR LIST($détail; *)
			End if 
			
			Créer Liste Hiérarchique($params.reqRetour)
			$détail:=$params.reqRetour.LH
			// re afficher l'item
			SET LIST ITEM(ListeGéographie; $itemRef; $itemText; $itemRef; $détail; $déployé)
		End if 
		
		// re trier la liste
		SORT LIST(ListeGéographie; >)
		// re sélection l'élément courant
		This.AfficherEntité()
	End if 
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	ASSERT(cs.$trace.me.DebugerEventForm(Current method name; "EventForm"; New object("numEvent"; FORM Event.code; "numTable"; Table(Current form table))))
	
	// traitements génériques
	This.surEvenementFormulaire()
	
	// traitements particuliers
	Case of 
		: (FORM Event.code=On Load)
			SHOW PROCESS(Current process)
			cs.$processData.me.FixerTache(Current process name; New object("nomTache"; This.nomTache; "activerThermometre"; True))
			
			This.NouvelleSélection()
			
			// charger les objets
			This.onEndLoad()
			
		: (FORM Event.code=On Timer)
			cs.$processData.me.AfficherProgressionTache()
			
		: (FORM Event.code=On Close Box)
			CANCEL
	End case 
	
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection("ReduireLieux")
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:FORMevents Page fond
	// ----------------------
	
Function _FORM_DeplacerFenetre()
	Case of 
		: (FORM Event.code=On Mouse Move)
			SET CURSOR(9001)
			
		: (FORM Event.code=On Clicked)
			// ne fonctionne pas
			DRAG WINDOW
	End case 
	
	
	// ----------------------
	//MARK:FORMevents Page LH
	// ----------------------
	
Function _FORM_ReduireLieux()
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=Form.UserPrefs.ParamsForm.ReductionLieux
			
		: (FORM Event.code=On Clicked)
			Use (Form.UserPrefs.ParamsForm)
				Form.UserPrefs.ParamsForm.ReductionLieux:=Form[This.nomOBJ]
			End use 
			// recréer la palette
			Form.NouvelleSélection()
	End case 
	
	
Function _FORM_ListeGéographieAffichée()
	var $itemRef : Integer
	
	Case of 
		: (FORM Event.code=On Begin Drag Over)
			cs.$glisserDeposer.me.surDebutGlisserITEM_LH()
			
		: (FORM Event.code=On Clicked)
			$itemRef:=Selected list items(*; This.nomOBJ; *)
			Use (Form.UserPrefs)
				Form.UserPrefs.SelectionCourante:=$itemRef
			End use 
			
			//: (FORM Event.code=On Double Clicked)
			//$itemRef:=Selected list items(*; This.nomOBJ; *)
			//If (CodeEnreg($itemRef; [Table(->[Communes]); Table(->[Sites]); Table(->[Lieux])])=1)
			//cs.$editeur.new().EditerSélection($itemRef)
			//End if 
	End case 
	
	// ----------------------
	// MARK:Gestion formulaire
	// -----------------------
	
Function AfficherEntité()
	OBJECT SET VISIBLE(*; "grpChoix@"; True)
	SELECT LIST ITEMS BY REFERENCE(ListeGéographie; Form.UserPrefs.SelectionCourante)
	
	
Function MettreAjour($param : Object)
	// mettre à jour un élément de la LH
	var $itemText; $itemTextSave : Text
	var $déployé; $déployéSave : Boolean
	var $itemRef; $détail; $itemRefSave; $détailSave; $itemPos : Integer
	var $entité : Object
	
	// récupérer les infos de l'élément mis à jour
	$itemRef:=$param.refItem
	If (cs._cfct.me.estIDcodeDeClasses($itemRef; [ds.Pays; ds.Regions; ds.Departements; ds.Communes; ds.Sites; ds.Lieux]))
		//If (CodeEnreg($itemRef; [Table(->[Pays]); Table(->[Regions]); Table(->[Departements]); Table(->[Communes]); Table(->[Sites]); Table(->[Lieux])])=1)
		
		$entité:=cs._ds.me.EntitéAvecIDcodé($itemRef)
		$itemPos:=List item position(ListeGéographie; $itemRef)
		
		// déplacer une sous liste (pas forcément l'objet de la modif, mais on ne sait pas)
		Case of 
				// ne rien faire si la liste est réduite
			: (This.session.prefs.Palettes.Palette_3016.ParamsForm.ReductionLieux)
				Form.AfficherMessageUtilisateur(New object("ID"; 5093))
				
				// nouvel élément
			: ($itemPos=0)
				// reconstruire le niveau supérieur à $itemRef
				Form.AjouterAsélection($itemRef)
				
			Else 
				// c'est une modification d'élément existant (nom ou déplacement)
				// informations de l'élément modifié :
				GET LIST ITEM(ListeGéographie; $itemPos; $itemRefSave; $itemTextSave; $détailSave; $déployéSave)
				// changer le texte de l'élément (pas forcément l'objet de la modif, mais on ne sait pas)
				SET LIST ITEM(ListeGéographie; $itemRefSave; $entité.nom; $itemRefSave; $détailSave; $déployéSave)
		End case 
	End if 
	
	
	// ----------------------
	// MARK:Demande actions
	// -----------------------
	
Function getListeHiérarchique($params : Object)
	// un process externe envoie une sélection à éditer
	// afficher la liste triée
	ListeGéographie:=$params.LH
	SORT LIST(ListeGéographie; >)
	
	This.AfficherEntité()

⇧ [class]$serveursEditeur - 08/05/2026 12:50:11

      property DonnéesParamètresWeb; DonnéesHTTPS; DonnéesActivité : Object
property InformationsServeurHTTP : Object
property cadenceLocale : Integer:=10*1000  // 10 s
property decompte : Integer
// liste box
property celluleData : Text
property celluleID : Integer

Class extends $formulaire

Class constructor
	
	Super()
	
	This.InformationsServeurHTTP:=New object
	This.decompte:=Milliseconds
	
	
Function FixerParamètres($params : Object)
	// $params = paramètres de menu
	
	Super.FixerParamètres($params)
	This.informations.nomForm:="U_Formulaire?3101"
	
	// le sous formulaire xWEB
	This.DonnéesParamètresWeb:=New object
	This.DonnéesParamètresWeb.DonnéesMessagerie:=New object
	// les sous formulaires BDDmère
	This.DonnéesHTTPS:=cs.$formulaire_SF_ProtocoleHTTPS.new()
	This.DonnéesActivité:=cs.$formulaire_SF_Activities.new()
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	
	Super.surEvenementFormulaire()
	
	Case of 
		: (FORM Event.code=On Load)
			
			// charger les objets
			This.onEndLoad()
			This.MettreAjour()
			
		: (FORM Event.code=On Timer)
			// rafraichir les infos du formulaire, plus lentement de le timer de base
			// en utilisant les millisecondes on est indépendant de la cadence APP
			If (Milliseconds>(This.decompte+This.cadenceLocale))
				// on y va
				This.MettreAjour()
				// relancer
				This.decompte:=Milliseconds
				
			Else 
				// attendre
			End if 
	End case 
	
	
Function onEndLoad()
	var $c : Collection
	
	$c:=New collection("choix"; "Users")
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:Fond
	// ----------------------
	
Function _FORM_choix()
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=New object
			
			// onglets disponibles :  201 (users), 202 (lets'encrypt)
			// lister les pages pour chaque contexte : BDD mère, client APP et client 4D
			
			Case of 
				: (This.session.user.estMembreDe_Developpement)
					// mode debug et maintenance
					Case of 
						: (Storage.System.typeApplication=ALV Client APP)
							// pour debug du serveur par client
							Form[This.nomOBJ].values:=New collection(Localized string("16410601"); Localized string("202"); Localized string("16410603"))
							Form[This.nomOBJ].index:=0
							Form.Pages:=New collection(1; 2; 3)
							
						: ((Storage.System.typeApplication=ALV Client APP maintenance) | (Storage.System.typeApplication=4D Remote mode))
							// pour debug du serveur par client
							Form[This.nomOBJ].values:=New collection(Localized string("16410601"); Localized string("202"); Localized string("16410603"))
							Form[This.nomOBJ].index:=0
							Form.Pages:=New collection(1; 2; 3)
							
						: (This.session.prefs.Session_Etat ?? 6)
							// la totale
							Form[This.nomOBJ].values:=New collection(Localized string("16410601"); Localized string("202"); Localized string("16410603"); Localized string("201"))
							Form[This.nomOBJ].index:=0
							Form.Pages:=New collection(1; 2; 3; 4)
							
						Else 
							// pour debug du serveur en local
							Form[This.nomOBJ].values:=New collection(Localized string("16410601"); Localized string("202"); Localized string("16410603"))
							Form[This.nomOBJ].index:=0
							Form.Pages:=New collection(1; 2; 3)
					End case 
					
				: (User in group(Current user; "Administration BDD"))
					// pour modification des données user
					Form[This.nomOBJ].values:=New collection(Localized string("201"))
					Form[This.nomOBJ].index:=0
					Form.Pages:=New collection(4)
					
				Else 
					Form[This.nomOBJ].values:=New collection(Localized string("201"))
					Form[This.nomOBJ].index:=0
					Form.Pages:=New collection(4)
			End case 
			FORM GOTO PAGE(Form.Pages[Form[This.nomOBJ].index])
			
		: (FORM Event.code=On Clicked)
			FORM GOTO PAGE(Form.Pages[Form[This.nomOBJ].index])
	End case 
	
	
	// ----------------------
	//MARK:Page Users
	// ----------------------
	
Function _FORM_Users()
	// ATTENTION : en BDDmère, les modifications ne sont pas protégées ; sinon voir le réglage des privilèges
	var $params : Object
	
	$params:=New object
	Case of 
		: (FORM Event.code=On Load)
			
			Case of 
				: (Not(OB Is defined(Storage.System; "UserID")))
					// a priori, environnement 4D_distant
					
				: (This.session.user.IDfamille#0)
					// chercher tous les adhérents de cette famille
					$params.IDfamille:=This.session.user.IDfamille
					cs.$serveurAPP.me.Executer(OB Class(ds.wwwGroupes).name; "CréerSélectionMembres"; $params)
					Form.Users:=$params.reqRetour.selection
					
				: (User in group(Current user; "Administration"))
					cs.$serveurAPP.me.Executer("UtilisateursALV"; "CréerSélectionALL"; $params)
					Form.Users:=$params.reqRetour.selection
					
				: ((This.session.prefs.Session_Etat ?? 6))
					cs.$serveurAPP.me.Executer("UtilisateursALV"; "CréerSélectionALL"; $params)
					Form.Users:=$params.reqRetour.selection
					
				Else 
					Form.Users:=Null
			End case 
			
			If (Not(Form.Users=Null))
				Form.Users:=Form.Users.orderBy("Name asc, First_Name asc")
			End if 
	End case 
	
	
	// ----------------------
	// MARK:Gestion formulaire
	// -----------------------
	
Function MettreAjour()
	var $data : Object
	// récupérer les infos des serveurs WEB
	
	// Web Host
	$data:=ExecuterSurServeur("$serveurWEB"; "LireInformationsServeur")
	This.InformationsServeurHTTP[$data.serveurWeb.name]:=$data
	
	// xWeb
	$data:=ExecuterSurServeur("$serveur"; "LireInformationsServeur"; Null; "xWEB")
	This.InformationsServeurHTTP[$data.serveurWeb.name]:=$data
	
	// MOBWeb
	$data:=ExecuterSurServeur("$serveur"; "LireInformationsServeur"; Null; "xWEBMO")
	This.InformationsServeurHTTP[$data.serveurWeb.name]:=$data
	
	// information des serveurs WEB (à disposition des autres pages)
	This.DonnéesParamètresWeb.InformationsServeurHTTP:=Form.InformationsServeurHTTP
	This.DonnéesActivité.InformationsServeurHTTP:=Form.InformationsServeurHTTP
	
	// mettre à jour les sous formulaires
	This.DonnéesHTTPS.MettreAjour()
	This.DonnéesActivité.MettreAjour()
	
	
	//--------------------
	//MARK:EventFormulaire ???
	//--------------------
	
Function _FORM_clientAdministration()
	// fenetre admin du serveur (existe aussi dans cs.CommandesEditeur !)
	// un seul event ('onClic')
	OPEN ADMINISTRATION WINDOW
	
	
Function _FORM_clientConsoleServeur()
	var $numProc : Integer
	var $data : Object
	
	$numProc:=Process number("Liste Evenements ALV"; *)
	
	If ($numProc=0)
		// pas de process, le créer
		// ici a priori on n'a pas les barresMenus : on tape directement dans le dur
		$data:=cs.$menu.new()
		$data.LireParamètresMenu("BM_00-00-11831"; Storage.BarresMenus.Standard)
		$data.Exécuter()
		
	Else 
		This.process.TuerAvecNumero($numProc)
	End if 
	
	
Function _FORM_clientParamétrageServeur()
	var $numProc : Integer
	var $data : Object
	
	$numProc:=Process number("U_Formulaire?3101"; *)
	
	If ($numProc=0)
		// pas de process, le créer
		// appeler le menu
		$data:=cs.$menu.new()
		$data.LireParamètresMenu("BM_00-00-0106"; Storage.BarresMenus.Standard)
		$data.Exécuter()
		
	Else 
		This.process.TuerAvecNumero($numProc)
	End if 
	
	
Function _FORM_mobileGestionSessions()
	MOBILE APP SESSION MANAGEMENT

⇧ [class]UtilisateursALVImport - 06/05/2026 11:25:30

      property journal : Text
property Actions : Collection
property nomLB : Text:="listeActions"
property nomDetail : Text:="listeDataAction"

Class extends $editeur

Class constructor()
	// construction commune
	Super()
	
	// collection de la ListBox
	This.Actions:=New collection
	
	
	
Function getDataClassInfos()->$result : Object
	$result:=Super.getDataClassInfos("UtilisateursALV")
	
	
Function FixerParamètres($params : Object)
	// $params = paramètres de menu
	
	Super.FixerParamètres($params)
	This.informations.nomForm:="U_Palette?3103"
	
	
	// ----------------------
	// MARK:Sélections 
	// -----------------------
	
Function ListerLesUtilisateurs()
	var $params : Object
	
	$params:=New object
	// function / contexte (un journal du serveur, ou celui de la BDDmère)
	$params.functionID:=cdk Lister Les Utilisateurs
	$params.journal:=This.journal
	// WK à appeler
	$params.nomProcess:="WK_selectionsBDD"
	// pour la suite de la requête
	$params.numProcessAppelant:=Current process
	$params.nomProcessAppelant:=Current process name
	$params.CallBack:="AfficherUser"
	
	This.process.ExecuterDansWorker(cs.$journalALV; "Requeter"; $params)
	
	
Function ListerLesActions()
	// fixer les actions de l'utilisateur sélectionné
	var $params : Object
	
	Form.nbreActions:=""
	OBJECT SET VISIBLE(*; This.nomLB; False)
	OBJECT SET VISIBLE(*; This.nomDetail; False)
	
	If (Form.listeUtilisateursElementCourant#Null)
		// lister les actions du user courant (dans un worker)
		$params:=New object
		$params.UserID:=Form.listeUtilisateursElementCourant.UserID
		// function / contexte (un journal du serveur, ou celui de la BDDmère)
		$params.functionID:=cdk Lister Les Actions
		$params.journal:=This.journal
		// WK à appeler
		$params.nomProcess:="WK_selectionsBDD"
		// pour la suite de la requête
		$params.nomProcessAppelant:=Current process name
		$params.CallBack:="AfficherSelection"
		
		This.process.ExecuterDansWorker(cs.$journalALV; "Requeter"; $params)
	End if 
	
	
Function SupprimerLesActions()
	var $params : Object
	
	// demander l'accord de l'utilisateur
	// préparer la demande
	$params:=New object("typeFenetre"; Sheet window; "titre"; ""; "numPageForm"; 3; "message"; cs._cfct.me.LireLocatedSTR(5091; New object("param_1"; Form.listeUtilisateursElementCourant.UserNom)))
	Case of 
		: (Form.listeUtilisateursElementCourant=Null)
		: (cs.$dialogue_3001.new().Lancer($params))
		Else 
			
			// supprimer les actions traitées de l'utilisateur sélectionné
			$params:=New object
			$params.UserID:=Form.listeUtilisateursElementCourant.UserID
			$params.Etat:=ack action traitée
			// function / contexte (un journal du serveur, ou celui de la BDDmère)
			$params.functionID:=cdk Supprimer Les Actions
			$params.journal:=This.journal
			$params.numProcessAppelant:=Current process
			// WK à appeler
			$params.nomProcess:="WK_selectionsBDD"
			// pour la suite de la requête
			$params.CallBack:="Initialiser"
			
			This.process.ExecuterDansWorker(cs.$journalALV; "Requeter"; $params)
			
	End case 
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	ASSERT(cs.$trace.me.DebugerEventForm(Current method name; "EventForm"; New object("numEvent"; FORM Event.code; "numTable"; Table(Current form table))))
	
	// traitements génériques
	This.surEvenementFormulaire()
	
	// traitements particuliers
	Case of 
		: (FORM Event.code=On Load)
			SHOW PROCESS(Current process)
			
			// charger les objets
			This.onEndLoad()
			
		: (FORM Event.code=On Close Box)
			CANCEL
			
		: (FORM Event.code=On Unload)
			//This.onEndUnLoad()
	End case 
	
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	// dans l'ordre
	$c:=New collection()
	$c:=$c.combine(["listeUtilisateurs"; "listeActions"; "affichageDetail"])
	Super.onEndEventForm($c)
	
	
Function onEndUnLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection()
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:FORMevents Page 1
	// ----------------------
	
Function _FORM_selectServeur()
	Case of 
		: (FORM Event.code=On Clicked)
			This.journal:=ack Journal Serveur
			
			This.Initialiser()
	End case 
	
	Form[This.nomOBJ]:=(This.journal=ack Journal Serveur)
	
	
Function _FORM_selectClient()
	Case of 
		: (FORM Event.code=On Clicked)
			This.journal:=ack Journal Local
			
			This.Initialiser()
	End case 
	
	Form[This.nomOBJ]:=(This.journal=ack Journal Local)
	
	
Function _FORM_listeUtilisateurs()
	Case of 
		: (FORM Event.code=On Load)
			OBJECT SET VISIBLE(*; This.nomOBJ; False)
			// propriété n'existe pas dans l'éditeur de formulaire !
			OBJECT SET HELP TIP(*; This.nomOBJ; Localized string("535"))
			
		: (FORM Event.code=On Selection Change)
			This.ListerLesActions()
	End case 
	
	
Function _FORM_listeActions()
	var $IDentitéCodée : Integer
	var $data; $action : Object
	
	Case of 
		: (FORM Event.code=On Load)
			OBJECT SET VISIBLE(*; This.nomOBJ; False)
			
		: (FORM Event.code=On Selection Change)
			// afficher l'enregistrement concerné par cette action
			// lire la ligne sélectionnée
			$action:=Form.listeActionsElementCourant
			// l'action doit être non traitée
			If ($action.ActionEtat=ack action à traiter)
				// ouvrir l'éditeur de l'entité concernée par l'action sélectionnée UUID $2
				// l'UUID en BDD de l'action sélectionnée est $action.UUID
				
				// récupérer l'enregCodé de l'objet de la BDD concerné par l'action (aQui)
				$data:=cs._ds.me.EntitéAvecUUID(New object("DataClassNom"; $action.aQui; "IDunique"; $action.aQuiUUID))
				// s'il n'y a pas d'aQui, on a ajouté une entité toute nue : chercher Qui
				// dans l'ordre
				Case of 
					: ($data=Null)
						// création ex nihilo
						
					: (($action.ActionID=agk Individu) | ($action.ActionID=imk Media))
						// le aQui n'existe pas, ne pas ouvrir le formulaire
					: ($action.ActionID=agk EventFamilial)
						// aller aux membres de l'union $data
						$IDentitéCodée:=$data._lesMembres(agk Tout)[0].IDcodé()
						Form.EditerSélection($IDentitéCodée; 0)
						
					: ($data.IDcodé()=-1)
						// pb
					: ($action.aQui="PrivateData")
						// aller à l'entité liée à $data
						$IDentitéCodée:=$data._Liaison().IDcodé()
						Form.EditerSélection($IDentitéCodée; 0)
						
					: ($action.aQui="Zones")
						// aller au media de cette zone
						$IDentitéCodée:=$data.leMedia.IDcodé()
						// ouvrir l'éditeur concerné par $UUID, et y afficher $IDentitéCodée
						Form.EditerSélection($IDentitéCodée; 0)
						
					Else 
						// c'est ok
						$IDentitéCodée:=$data.IDcodé()
						// ouvrir l'éditeur concerné par $UUID, et y afficher $IDentitéCodée
						This.EditerSélection($IDentitéCodée; 0)
				End case 
			End if 
			
			// afficher le détail
			This.AfficherDetailAction()
			OBJECT SET VISIBLE(*; This.nomDetail; True)
			
	End case 
	
	
Function _FORM_listeActions_Comment()
	var $ligne : Integer
	var $texte : Text
	var $params; $action : Object
	
	Case of 
		: ((Right click) | (Contextual click))  // Clic droit ou Control+clic
			// gestion des modifications
			// lire la ligne sélectionnée
			$action:=Form.listeActionsElementCourant
			
			// l'action doit être non traitée ou en attente d'une action traitée
			Case of 
				: ($action.ActionEtat=ack action à traiter)
					// l'action doit être non traitée ou en attente d'une action traitée
					$texte:=Localized string("3201")+";"+Localized string("3202")
				: ($action.ActionEtat=ack action en attente)
					// l'action doit être non traitée ou en attente d'une action traitée
					$texte:=Localized string("3201")
				: ($action.ActionEtat=ack action non connue)
					// l'action doit être non traitée ou en attente d'une action traitée
					$texte:=Localized string("3201")
					
				Else 
					$texte:=""
			End case 
			
			If ($texte#"")
				$ligne:=Pop up menu($texte)
				
				If (Form.ActionUtilisateur("[ModificationAutorisée]"))
					Case of 
						: ($ligne=2)
							// modifier la BDD
							// utiliser l'action $action du journal pour compléter la BDD
							Form.ExécuterAction($action)
							
						: ($ligne=1)
							// désactiver la modification
							$action.ActionEtat:=ack action traitée
							
							// écrire dans la BDD journaux que l'action est traitée
							$params:=New object()
							$params.Actions:=New collection($action)
							$params.UserID:=Form.listeUtilisateursElementCourant.UserID
							// function / contexte (un journal du serveur, ou celui de la BDDmère)
							$params.functionID:=cdk Mettre A Jour Action
							$params.journal:=This.journal
							$params.numProcessAppelant:=Current process
							cs.$journalALV.me.Requeter($params)
							
							// recalculer les états (les actions non de type "Modifier BDD" peuvent déverrouiller des actions suivantes)
							Form.ListerLesActions()
					End case 
					
					// mettre à jour la listBox
					Form.Actions:=Form.Actions
				End if 
			End if 
	End case 
	
	
Function _FORM_supprimerActions()
	If (FORM Event.code=On Clicked)
		This.SupprimerLesActions()
	End if 
	
	
	// ----------------------
	// MARK:Gestion formulaire 
	// -----------------------
	
Function AfficherEntité()
	// appel générique ; bouchonner
	
Function Initialiser()
	This.ListerLesUtilisateurs()
	OBJECT SET VISIBLE(*; This.nomLB; False)
	
	
Function AfficherUser($params : Object)
	// récupérer les users
	var $nomOBJ : Text:="listeUtilisateurs"
	
	Case of 
		: (Not(OB Is defined($params; "data")))
		: ($params.data=Null)
		Else 
			// récupérer les users
			// initialiser la Box
			Form[$nomOBJ]:=New object
			Form[$nomOBJ]:=$params.data
			OBJECT SET VISIBLE(*; $nomOBJ; True)
	End case 
	
	
Function AfficherSelection($params : Object)
	// lire les actions du user sélectionné, mettre les résultats dans la collection de la liste box du formulaire
	
	Case of 
		: (Not(OB Is defined($params; "data")))
		: ($params.data=Null)
		Else 
			// récupérer les actions
			
			// initialiser la Box
			Form[This.nomLB]:=$params.data
			// style d'affichage, rappel : ils sont dans This.ActionEtat
			OBJECT SET VISIBLE(*; This.nomLB; Form[This.nomLB].length>0)
			Form.nbreActions:=Choose(Form[This.nomLB].length>0; String(Form[This.nomLB].length)+" action"+Choose(Form[This.nomLB].length=1; ""; "s")+", dont "+String(Form[This.nomLB].query("ActionEtat = :1 OR ActionEtat = :2"; ack action à traiter; ack action en attente).length)+" à traiter"; "Aucune action")
	End case 
	
	// traiter les erreurs
	Case of 
		: (Not(OB Is defined($params; "Error")))
			This.AfficherMessageUtilisateur(New object("ID"; 5143))
			
		: ($params.Error#0)
			This.AfficherMessageUtilisateur(New object("libelle"; $params.ErrorDescription))
	End case 
	
	
Function AfficherDetailAction()
	var $data : Object
	
	$data:=OB Copy(Form.listeActionsElementCourant)
	// renommer (-> fin de liste)
	$data.xData:=$data.Data
	
	// supprimer les inutiles
	OB REMOVE($data; "Data")
	OB REMOVE($data.xData; "PartageALV")
	OB REMOVE($data.xData; "UserID")
	OB REMOVE($data.xData; "result")
	
	// conversion d'objets
	$data.xData:=JSON Stringify($data.xData; *)
	
	Form.listeDataAction:=OB Entries($data)
	Form.listeDataAction:=Form.listeDataAction.orderBy("key asc")
	
	
Function getIconeAction($ID : Integer)->$result : Picture
	// lire l'icone de l'application ID $1
	var $pict : Picture
	var $data : Object
	
	$data:=cs.xSDK.EnvironnementALV.new()
	
	Case of 
		: ($ID=0)
			// peut-être normal
		: ($data.infosApplication($ID)=Null)
		: (OB Is empty($data.infosApplication($ID)))
		: (Not(OB Is defined(cs._rsc.me; $data.infosApplication($ID).icone)))
		Else 
			
			$pict:=cs._rsc.me.image($data.infosApplication($ID).icone)
			CREATE THUMBNAIL($pict; $pict; 24; 24)
	End case 
	$result:=$pict
	
	
Function ExécuterAction($actionAtraiter : Object)
	// rappel : on est dans le process Import de journaux
	var $params; $action : Object
	
	$action:=$actionAtraiter
	
	// créer les paramètres de la méthode
	$params:=OB Copy($actionAtraiter.Data)
	$params.Data:=OB Copy($actionAtraiter.Data)
	
	// recréer les pseudo entités
	$params.aQui:=New object("DataClassNom"; $actionAtraiter.aQui; "IDunique"; $actionAtraiter.aQuiUUID)
	$actionAtraiter.Qui:=Null
	If ($actionAtraiter.Qui="")
		$params.Qui:=New object("DataClassNom"; $actionAtraiter.Qui; "IDunique"; $actionAtraiter.QuiUUID)
	End if 
	// rappel : $params.aQui en est déjà une
	
	// faire la modification
	cs._ds_EXT.new().Modifier($params)
	
	Case of 
		: (Not($params.result.success))
		: (Not(OB Is defined($params.result; "entitéRetour")))
		Else 
			// action traitée 
			$action.ActionEtat:=ack action traitée
			
			// mettre à jour les éditeurs
			cs.$processUser.new().AfficherModificationBDD($action.ActionID; $params.result)
			
			// écrire dans la BDD journaux que l'action est traitée
			$params:=New object()
			$params.Actions:=New collection($action)
			$params.UserID:=Form.listeUtilisateursElementCourant.UserID
			// function / contexte (un journal du serveur, ou celui de la BDDmère)
			$params.functionID:=cdk Mettre A Jour Action
			$params.journal:=This.journal
			$params.numProcessAppelant:=Current process
			cs.$journalALV.me.Requeter($params)
			
			// recalculer les états (les actions non de type "Modifier BDD" peuvent déverrouiller des actions suivantes)
			This.ListerLesActions()
	End case

⇧ [class]PersonnesSelection - 27/03/2026 10:32:06

      Class extends EntitySelection

Function IDcodés()->$c : Collection
	$c:=cs._ds.me.IDcodés(This)
	
	
Function Libellés($formats : Object)->$data : Object
	// renvoie les noms formatés de la sélection courante, suivant les paramètres $formats
	// $formats :
	// .Options
	//    (cf class Personnes)
	//   bit  4 = lier un conjoint
	//   bit  6 = d'abord le conjoint ???
	// .SymbolConjoints
	var $entité; $sélection : Object
	
	ds._FixerParamètresLibellé($formats)
	
	// trier homme / femme
	// remarque : si on a un élément vide, le tri le passe en second 
	$sélection:=This.orderBy("sexe "+Choose($formats.Options ?? 6; "desc"; "asc"))
	// fixer le retour
	$data:=New object("Membre1"; ""; "Membre2"; ""; "result"; "")
	// pour coder les noms des membres, il faut passer par une entité de personne
	For each ($entité; $sélection)
		Case of 
			: ($data.Membre1="")
				$data.Membre1:=$entité.Libellé($formats)
			: ($data.Membre2="")
				$data.Membre2:=$entité.Libellé($formats)
		End case 
	End for each 
	
	Case of 
		: ($data.Membre2=Null)
		: ($data.Membre2="")
		Else 
			// bit 4 = renvoyer le conjoint lié
			If ($formats.Options ?? 4)
				$data.Membre2:=$formats.SymbolConjoints+($data.Membre2)
			End if 
			// les conjoints liés
			$data.result:=($data.Membre1)+$formats.SymbolConjoints+($data.Membre2)
	End case 
	
	
	// ----------------------
	// MARK:Affichage
	// -----------------------
	
Function CréerListBox($params : Object)
	var $élément : Object
	var $entité : cs.PersonnesEntity
	var $c : Collection
	
	$c:=New collection
	
	For each ($entité; This)
		$élément:=New object
		$élément.itemText:=$entité.Libellé(New object("Options"; $params.Options))
		$élément.itemRef:=cs._ds.me.IDcodé($entité)
		
		$élément.DataClassNom:=$entité.getDataClass().getInfo().name
		$élément.ID:=$entité.ID
		
		$c.push($élément)
	End for each 
	$c:=$c.orderBy("itemText asc")
	$params.liste:=$c
	
	
Function CréerHiérarchie($params : Object)
	// wrapper de CréerLH (function récursive)
	var $c : Collection
	
	$c:=New collection
	This.CréerLH($c; $params)
	$params.liste:=$c
	
	
Function CréerLH($LH : Collection; $params : Object)
	// renvoie une collection hiérarchique de la sélection courante (image d'une liste hiérarchique)
	var $entité; $élément; $data; $sélection; $information : Object
	var $c : Collection
	
	For each ($entité; This)
		// pour chaque entité, créer une collection de la Xcendance ( = sous liste H)
		// * le nom de entité
		$élément:=New object
		$élément.itemText:=$entité.Libellé(New object("Options"; $params.FormatPersonne))
		// l'IDcodé dépend du contexte
		Case of 
			: ($params.génération=0)
				$élément.itemRef:=cs._ds.me.IDcodé($entité)
				
			: ($params.Options ?? 31)
				// descendance
				$élément.itemRef:=CodeEnreg($params.IDunion; [160+$entité.indexOf()+1])
			Else 
				// ascendance
				$élément.itemRef:=CodeEnreg($params.IDunion; [145+Num($entité.sexe)])
		End case 
		
		// ajouter les données de l'item
		$data:=New object
		// les properties de l'item
		$data.properties:=New object("saisissable"; False; "style"; Bold)
		If ($params.Options ?? 3)
			$data.parameters:=New collection(New object("sélecteur"; Additional text; "valeur"; String($params.génération)))
		End if 
		$élément.data:=CoDecBase64_Objet($data)
		
		// option : ajouter les biodata de l'entité
		If ($params.Options ?? 0)
			// entête : info du de-cujus de l'Xscendance
			$LH.push($élément)
			
			// bio data de l'entité
			If ($params.Options ?? 4)
				$information:=$entité.Naissance()
				If ($information#Null)
					$sélection:=New object
					$sélection.itemText:=$information.Libellé($params)
					$sélection.itemRef:=cs._ds.me.IDcodé($information)
					
					// ajouter les données de l'item
					$data:=New object
					// les properties de l'item
					$data.properties:=New object("saisissable"; False; "style"; Italic)
					$sélection.data:=CoDecBase64_Objet($data)
					
					$LH.push($sélection)
				End if 
				
				$information:=$entité.Décès()
				If ($information#Null)
					$sélection:=New object
					$sélection.itemText:=$information.Libellé($params)
					$sélection.itemRef:=cs._ds.me.IDcodé($entité)
					
					// ajouter les données de l'item
					$data:=New object
					// les properties de l'item
					$data.properties:=New object("saisissable"; False; "style"; Italic)
					$sélection.data:=CoDecBase64_Objet($data)
					
					$LH.push($sélection)
				End if 
			End if 
		End if 
		
		If ($params.génération=0)
			// ça démarre : utiliser $LH comme récepteur des collections
			$c:=$LH
		Else 
			// cas normal : utiliser une nouvelle collection
			$c:=New collection
			$c.push(CoDecBase64_Objet($élément))
		End if 
		
		// passer à la génération suivante
		If ($params.génération+1<=$params.numGénérationMax)
			
			// fixer $sélection pour la boucle sur les membres de l'Xscendance
			If ($params.Options ?? 31)
				// descendance
				$sélection:=$entité.LesUnions()
				
			Else 
				// ascendance
				// il faut une sélection
				$sélection:=Create entity selection([Unions]).add($entité.LesParents())
			End if 
			
			If ($sélection#Null)
				// les infos de chaque union de l'entité $entité
				$params.entité:=$entité
				$sélection.CréerLH($c; $params)
			End if 
			
			If ($params.génération>0)
				$LH.push($c)
			End if 
			
		Else 
			// fin de liste H
			$LH.push($c)
		End if 
	End for each 
	// nettoyer
	Try
		OB REMOVE($params; "entité")
	End try
	
	
Function CréerListBoxMedia($params : Object)
	var $selection : cs.MediasSelection
	
	$selection:=This.LesMedias($params)
	If ($params.cléTri=Null)
		$selection:=$selection.orderBy("dateNum asc, heure asc")
	Else 
		$selection:=$selection.orderBy($params.cléTri)
	End if 
	// demander la LB
	$params.liste:=$selection.CréerListBox($params.attribut)
	
	
	// ----------------------
	// MARK:Sélections
	// -----------------------
	
Function trierParDate($formats : Object)->$result : Object
	// trier la sélection de personnes par la date de naissance
	var $sensDuTri : Integer
	
	$sensDuTri:=dk ascending
	// $sensDuTri:=dk descending  // pour test !
	Case of 
		: (This.length=0)
		: (Count parameters=0)
		: (OB Is defined($formats; "sensDuTri"))
			$sensDuTri:=$formats.sensDuTri
	End case 
	
	$result:=This.orderByFormula("this.Naissance().dateNum"; $sensDuTri)
	
	
Function LesMedias($params : Object)->$result : cs.MediasSelection
	// sélectionner les media de this de type $params.typeZone, eventuellement privé
	$result:=This.lesIllustrations.laZone.Filtrer($params).leMedia.Filtrer($params)
	$result:=$result.orderBy("dateNum asc, heure asc")
	
	
Function LesEvents()->$result : cs.EventsSelection
	// sélectionner les events liés à this
	$result:=ds.Events.newSelection()
	
	// les events perso et familiaux
	$result:=$result.add(This.lesEventsPersonnels.leEvent)
	$result:=$result.add(This.lesRelations.leGroupe.lesUnions.lesEventsFamiliaux.leEvent)
	
	// les events liés aux témoignages
	$result:=$result.add(This.lesRelations.LesEvents())
	$result:=$result.orderBy("dateNum asc")
	
	
Function LesLieux($params : Object)->$result : cs.LieuxSelection
	// sélectioner les lieux où this ont mis les pieds
	$result:=ds.Lieux.newSelection()
	
	// les lieux liés aux events
	$result:=$result.add(This.LesEvents().leLieu)
	
	// ajouter les lieux liés aux medias où apparaissent this
	Case of 
		: (Not(OB Is defined($params; "tousLesLieux")))
		: (Not($params.tousLesLieux))
		Else 
			$result:=$result.add(This.LesMedias().lesZones.lesPaysages.leLieu)
	End case 
	// filtrer
	$result:=$result.Filtrer($params)
	
	
Function Filtrer($params : Object; $filtreID : Collection)->$result : cs.PersonnesSelection
	$result:=This
	If (Count parameters>1)
		$result:=$result.query("ID in :1"; $filtreID)
	End if

⇧ [class]MediasImport - 08/06/2026 13:56:27

      property media : cs.$media
property nomDossier : Text
property nomOBJimage : Text:="imageMedia"
property nomTache : Text:="MediasImport_CollecterDocuments"

Class extends $formulaire

Class constructor()
	// construction commune
	var listeMedias : Integer
	
	Super()
	
	This.nomDossier:=""
	listeMedias:=0
	
	This.media:=cs.$media.me
	
	
Function getDataClassInfos()->$result : Object
	$result:=Super.getDataClassInfos("Medias")
	
	
Function FixerParamètres($params : Object)
	// $params = paramètres de menu
	
	Super.FixerParamètres($params)
	This.informations.nomForm:="U_Palette?3002"
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	
	This.surEvenementFormulaire()
	
	Case of 
		: (FORM Event.code=On Load)
			SHOW PROCESS(Current process)
			cs.$processData.me.FixerTache(Current process name; New object("nomTache"; This.nomTache; "activerCurseurHoraire"; True))
			
			// charger les objets
			This.onEndLoad()
			
		: (FORM Event.code=On Clicked)
			This.zoneSensible.ActionMenuContextuel()
			
		: (FORM Event.code=On Timer)
			cs.$processData.me.AfficherProgressionTache()
			
		: (FORM Event.code=On Close Box)
			CANCEL
	End case 
	
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection("choixDossier")
	
	Super.onEndEventForm($c)
	
	
Function _FORM_choixDossier()
	var $cheminDossier : Text
	
	$cheminDossier:=""
	Case of 
		: (FORM Event.code=On Load)
			//chemin du dossier d'import
			$cheminDossier:=This.document.GetMediaImportFolder().platformPath
			
		: (FORM Event.code=On Clicked)
			$cheminDossier:=This.SélectionnerUnDossier(Localized string("5098"); 82; True)
			// mémoriser le chemin dans les préférences
			This.document.SetMediaImportFolder($cheminDossier)
	End case 
	
	This.nomDossier:=""
	If (($cheminDossier#"") & (Test path name($cheminDossier)=Is a folder))
		This.nomDossier:=Substring($cheminDossier; 1; Length($cheminDossier)-1)  //pour affichage
	End if 
	This.ChargerDocuments()
	
	
Function _FORM_listeMedias()
	Case of 
		: (FORM Event.code=On Begin Drag Over)
			This.glisserDeposer.surDebutGlisserITEM_LH()
			
		: (FORM Event.code=On Clicked)
			This.AfficherEntité()
	End case 
	
	
Function _FORM_imageMedia()
	Case of 
		: (FORM Event.code=On Begin Drag Over)
			// rappel : envoyer le nom de la liste hiérarchique associée à 'imageMedia'
			This.glisserDeposer.surDebutGlisserIMAGE_LH("listeMedias")
	End case 
	
	
Function _FORM_transformPDF()->$result : Integer
	// renvoyer 0 si ok, -1 si glisser refusé
	var $quoi : Integer
	
	Case of 
		: (FORM Event.code=On Drag Over)
			// on veut un média PDFisable
			$result:=-1
			$quoi:=5096
			Case of 
				: (Storage.System.GlisserDéposer.typeMedia<1)
					// on ne veut que des fichiers image, ou un dossier
					
				: (This.glisserDeposer.surGlisserDOSSIER()=0)
					$result:=0
					$quoi:=5095  // ok un dossier
					
				: (This.glisserDeposer.surGlisserFICHIER()=0)
					$result:=0
					$quoi:=5094  // ok un fichier
			End case 
			This.AfficherMessageUtilisateur(New object("ID"; $quoi))
			
		: (FORM Event.code=On Drop)
			$result:=This.surDeposerDocument()
	End case 
	
	
	// ----------------------
	// MARK:Gestion des documents
	// -----------------------
	
Function ChargerDocuments()
	// afficher le contenu du dossier .nomDossier
	var $params : Object
	
	If (This.nomDossier#"")
		$params:=New object
		$params.dossier:=Folder(This.nomDossier; fk platform path)
		$params.nomTache:=This.nomTache
		$params.initProcess:=Formula(InitProcessThreadSafe)
		$params.ActionID:=mdk Est un Dossier externe
		$params.Error:=0
		$params.tache:=This.registreTaches.Inscrire(New object("nomProcess"; Current process name; "nomTache"; This.nomTache; "numProcessAppelant"; Current process))
		// pour le retour
		$params.nomProcessAppelant:=Current process name
		$params.CallBack:="CallBackMediasImport"
		cs.$process.new().NouveauProcess(cs.MediasImport; "CollecterDocuments"; $params)
		
		OBJECT SET VISIBLE(*; This.nomOBJimage; False)
	End if 
	
	
Function CollecterDocuments($params : Object)
	var $data; $objet : Object
	var $fichier : 4D.File
	var $dossier : 4D.Folder
	var $c : Collection
	var $pict : Picture
	
	// initialiser la création
	If (Not(OB Is defined($params; "liste")))
		$params.liste:=New collection
	End if 
	
	Case of 
		: (Not(OB Is defined($params; "dossier")))
		: (Not($params.dossier.exists))
		Else 
			// ajouter les données du dossier (chemin long et type)
			$data:=New object
			// la liste
			$data.itemText:=$params.dossier.name
			// objet ALV de type dossier : $itemRef = un ID (quelconque) + code objet (8 bits)
			$data.itemRef:=cs._cfct.me.CoderID(Random; mdk Est un Dossier externe)
			
			// les paramètres du dossier
			$objet:=New object
			$c:=New collection
			$c.push(New object("sélecteur"; "cheminDocument"; "valeur"; $params.dossier.platformPath))
			$c.push(New object("sélecteur"; "typeMedia"; "valeur"; mdk Est un Dossier externe))
			$objet.parameters:=$c
			// ici pas de properties
			
			$data.data:=CoDecBase64_Objet($objet)
			
			// ajouter à la collection
			$params.liste.push(CoDecBase64_Objet($data))
			
			// ajouter les fichiers du dossier $1
			If ($params.dossier.files(fk ignore invisible).length>0)
				For each ($fichier; $params.dossier.files(fk ignore invisible))
					
					If (This.media.estReconnu($fichier.platformPath))
						// ajouter ce fichier
						$objet:=New object
						$objet.itemText:=$fichier.name
						
						// objet ALV de type media d'un dossier : $itemRef = un ID (quelconque) + code objet (8 bits)
						$objet.itemRef:=cs._cfct.me.CoderID(Random; mdk Est un Dossier externe)
						
						// ajouter un icône
						$pict:=cs._rsc.me.image(15110+This.media.typeObjet)
						$objet.iconePict:=CoDecBase64_Objet($pict)
						
						// ajouter les données du fichier (chemin long et type)
						$data:=New object
						// les paramètres du fichier
						$c:=New collection
						$c.push(New object("sélecteur"; "cheminDocument"; "valeur"; $fichier.platformPath))
						$c.push(New object("sélecteur"; "typeMedia"; "valeur"; This.media.typeObjet))
						$data.parameters:=$c
						// ici pas de propriétés d'élément
						
						$objet.data:=CoDecBase64_Objet($data)
						
						// ajouter à la collection
						$params.liste.push($objet)
					End if 
				End for each 
			End if 
			
			// ajouter une collection pour chaque dossier de $params.dossier
			If ($params.dossier.folders().length>0)
				For each ($dossier; $params.dossier.folders())
					// créer la sous liste du dossier
					$data:=New object
					$data.dossier:=$dossier
					This.CollecterDocuments($data)
					
					// ajouter à la liste courante
					$params.liste.push($data.liste)
				End for each 
			End if 
	End case 
	
	
	// ----------------------
	// MARK:Affichage
	// -----------------------
	
Function AfficherEntité()
	// afficher le document sélectionné
	var $mediaPath : Text:=""
	var $itemPos; $itemRef : Integer
	var $itemText : Text
	var $result : Boolean
	
	$itemPos:=Selected list items(listeMedias)
	$itemPos:=Choose($itemPos=0; 1; $itemPos)
	
	GET LIST ITEM(listeMedias; $itemPos; $itemRef; $itemText)
	If (CodeEnreg($itemRef; [mdk Est un Document externe])=1)
		Use (Form.UserPrefs)
			Form.UserPrefs.SelectionCourante:=$itemRef
		End use 
		
		If (($itemRef & 0x00FFFFFF)#0)
			GET LIST ITEM PARAMETER(listeMedias; $itemRef; "cheminDocument"; $mediaPath)
			
			$result:=This.media.LireAvecChemin($mediaPath; 1)
			This[This.nomOBJimage]:=This.media.imagePageMedia
			OBJECT SET VISIBLE(*; This.nomOBJimage; $result)
			
			SELECT LIST ITEMS BY POSITION(listeMedias; $itemPos)
		End if 
	End if 
	
	
Function MettreAjour($params : Object)
	// appel de l'extérieur
	var $itemRef; $newItemRef; $i; $listeH : Integer
	var $path; $pathPDF : Text
	var $pict : Picture
	
	Case of 
		: (OB Is defined($params; "cheminFichierPDF"))
			// on vient de créer un PDF, afficher le fichier PDF créé
			// retrouver $path dans le paramètre 'chemin' d'un élément (pas simple)
			$pathPDF:=$params.cheminFichierPDF
			
			// utiliser une copie de la LH (les sous listes vont être déployées)
			$listeH:=Copy list(listeMedias)
			For ($i; Count list items($listeH; *); 1; -1)
				GET LIST ITEM($listeH; $i; $itemRef; $path)
				GET LIST ITEM PARAMETER($listeH; $itemRef; "cheminDocument"; $path)
				If ($path=$params.cheminDocument)
					
					Case of 
						: (CodeEnreg($itemRef; [mdk Est un Document externe])=1)
							// ok, trouvé stopper
							$i:=0
							$newItemRef:=$itemRef
							
						: (CodeEnreg($itemRef; [mdk Est un Dossier externe])=1)
							// ok, trouvé stopper
							$i:=0
							// retyper document
							$newItemRef:=CodeEnreg(Random; [mdk Est un Document externe])
						Else 
							// garder $i pour continuer
					End case 
					
					If ($i=0)
						// modifier cet élément
						SET LIST ITEM(listeMedias; $itemRef; $params.nomFichierPDF; $newItemRef)
						SET LIST ITEM PARAMETER(listeMedias; $newItemRef; "cheminDocument"; $params.cheminFichierPDF)
						$pict:=cs._rsc.me.image(15112)
						SET LIST ITEM ICON(listeMedias; $newItemRef; $pict)
						// refaire la sélection
						SELECT LIST ITEMS BY REFERENCE(listeMedias; $newItemRef)
					End if 
				End if 
			End for 
			
			CLEAR LIST($listeH; *)
			
			OBJECT SET VISIBLE(Image_Pict1; True)
			This.AfficherEntité()
			//Appeler_Le_Formulaire(Current process; "AfficherEntité")
			
		: (CodeEnreg($params.refItem; [mdk Est un Dossier externe])=1)
			// la LH est affichée, afficher l'image du premier élément
			// afficher le premier document
			SELECT LIST ITEMS BY POSITION(listeMedias; 1)
			OBJECT SET VISIBLE(Image_Pict1; True)
			This.AfficherEntité()
			
			
		: (CodeEnreg(Storage.System.GlisserDéposer.refItem; [mdk Est un Document externe])=1)
			//  un ajout à mediathèque a été fait, il doit disparaître de la liste
			// l'élément Storage.System.GlisserDéposer.refItem doit être supprimé de la liste
			SELECT LIST ITEMS BY REFERENCE(listeMedias; Storage.System.GlisserDéposer.refItem)
			$i:=Selected list items(listeMedias)
			If ($i>0)
				DELETE FROM LIST(listeMedias; Storage.System.GlisserDéposer.refItem; *)
				This.AfficherEntité()
			End if 
			
		Else 
			// filtrer le reste
	End case 
	
	
Function CallBackMediasImport($params : Object)
	// traitements en retour d'un process externe
	// est piloté par .ActionID
	var $document; $result : Object
	
	Case of 
		: ($params.Error#0)
		: (Not(OB Is defined($params; "ActionID")))
			
		: ($params.ActionID=mdk Est un Dossier externe)
			
			If (OB Is defined($params; "liste"))
				CLEAR LIST(listeMedias; *)
				OB REMOVE($params; "ActionID")
				$result:=Créer Liste Hiérarchique($params)
				listeMedias:=$params.LH
				SORT LIST(listeMedias; >)
				
				$params.refItem:=mdk Est un Dossier externe
				This.MettreAjour($params)
			End if 
			
		: ($params.ActionID=cdk Afficher dans Formulaire)
			// après création d'un PDF, retour dans le formulaire
			
			// détruire ce qu'on PDFisé
			$document:=Path to object($params.cheminDocument)
			If ($document.isFolder)
				Folder($params.cheminDocument; fk platform path).delete(Delete with contents)
			Else 
				File($params.cheminDocument; fk platform path).delete()
			End if 
			
			// mettre à jour la LH
			This.MettreAjour($params)
			// afficher le résultat
			This.AfficherMessageUtilisateur(New object("libelle"; Num($params.Error#0)*Localized string("5096")))
	End case 
	
	
Function APP_PassePremierPlan()
	This.ChargerDocuments()
	
	
	// ----------------------
	// MARK:Gestion PDF
	// -----------------------
	
Function surDeposerDocument()->$result : Integer
	var $data : Object
	
	If (This.ActionUtilisateur("[ToucheValidation]"))
		// récupérer le chemin de ce qui a été glissé 
		$data:=OB Copy(Storage.System.GlisserDéposer)
		
		$data.nomTache:="$CreerPDFdepuisImport"+String(Random)
		$data.initProcess:=Formula(InitProcessThreadSafe)
		// appel de $formulaire pour gérer la mise à jour
		$data.CallBack:="CallBackMediasImport"
		$data.ActionID:=cdk Afficher dans Formulaire
		
		cs.$process.new().NouveauProcess(cs.$document; "CréerDocumentPDF"; $data)
	End if

⇧ [class]UnionsEntity - 13/04/2026 11:20:31

      Class extends Entity

Function IDcodé()->$ID : Integer
	$ID:=cs._ds.me.IDcodé(This)
	
	
Function CréerListBox($params : Object)
	var $entité; $element : Object
	var $selection : cs.PersonnesSelection
	
	// données communes
	If (This.LesEvenementsFamiliaux().length>0)
		$entité:=This.LesEvenementsFamiliaux()[0]
		
		$element:=$entité.CréerListBox($params)
		$params.liste.push($element)
		// retager le type (pour loger le texte dans la colonne !
		$element["type"+$params.tag]:=cs._rsc.me["symbol_"+String($entité.type)]+" "+cs._cfct.me.LireLocatedSTR(1036; $params)
		
		// données fam
		$element:=New object
		$element["type"+$params.tag]:=$entité._getValide()
		$element["entete"+$params.tag]:=Localized string("33")
		
		$entité:=$entité.leLieu
		If ($entité#Null)
			$element.DataClassNom:=$entité.getDataClass().getInfo().name
			$element.ID:=$entité.ID
			$element.itemRef:=$entité.IDcodé()
		End if 
		
		$entité:=$entité.leSite.laCommune
		If ($entité#Null)
			$element[$params.tag]:="<SPAN STYLE="+$params.styleEvent+">"+$entité.Libellé(New object("Options"; $params.FormatLieu))+"</SPAN>"
			$params.liste.push($element)
		End if 
	End if 
	
	$element:=New object
	$element["entete"+$params.tag]:=Localized string("1013")
	
	If (This.LeConjoint($params.entité)=Null)
		$element[$params.tag]:=cs._cfct.me.LireLocatedSTR(1004)
		$élément.itemRef:=cs._cfct.me.CoderID(0; 204)
		
	Else 
		$entité:=This.LeConjoint(ds.Personnes.get($params.entitéID))
		$element[$params.tag]:="<SPAN STYLE="+$params.stylePersonne+">"+$entité.Libellé(New object("Options"; $params.FormatConjoint))+"</SPAN>"
		$element.DataClassNom:=$entité.getDataClass().getInfo().name
		$element.ID:=$entité.ID
		$élément.itemRef:=cs._cfct.me.CoderID($entité.ID; 128+This.indexOf()+1)
	End if 
	$params.liste.push($element)
	
	$selection:=This.LesEnfants()
	If ($selection#Null)
		For each ($entité; $selection)
			$element:=New object
			$element["entete"+$params.tag]:=Char(0x21AA)
			$element[$params.tag]:="<SPAN STYLE="+$params.stylePersonne+">"+$entité.Libellé(New object("Options"; $params.FormatEnfant))+"</SPAN>"
			$element.DataClassNom:=$entité.getDataClass().getInfo().name
			$element.ID:=$entité.ID
			$élément.itemRef:=cs._cfct.me.CoderID(This.ID; 160+$entité.indexOf()+1)
			$params.liste.push($element)
		End for each 
	End if 
	
	
	// ----------------------
	// MARK:Attributs calculés
	// -----------------------
	
	// fonction accessible de l'extérieur
Function LeConjoint($deQui : Object)->$result : cs.PersonnesEntity
	// renvoie l'entité du conjoint de $1 pour l'union
	var $sélection : Object
	//peut ne pas exister
	$result:=Null
	
	$sélection:=This.leGroupe.lesMembres.laPersonne
	Case of 
		: ($sélection.length=1)
			// conjoint pas connu
		: ($sélection[0].ID=$deQui.ID)
			// prendre le second
			$result:=$sélection[1]
		Else 
			// c'est la bonne personne
			$result:=$sélection[0]
	End case 
	
	
Function LeMariage()->$result : Object
	// renvoie l'entity [events] du mariage de  l'union
	// l'event de l'union est l'event Fam le plus ancien
	var $sélection : Object
	
	// il n'y a pas d'event
	$result:=Null
	// chercher les mariages civils
	$sélection:=This.lesEventsFamiliaux.leEvent.query("type >= :1 and type <= :2"; 33610; 33619)
	If ($sélection.length=0)
		// essayer les mariages religieux
		$sélection:=This.lesEventsFamiliaux.leEvent.query("type = :1 "; 33700)
	End if 
	// il y a des events fam, prendre le plus ancien
	If ($sélection.length>0)
		$result:=$sélection.orderBy("dateNum asc").first()
	End if 
	
	
Function LesEnfants()->$result : cs.PersonnesSelection
	// envoie la sélection d'entités [Personnes] enfants de l'union, triée par date de naissance
	// peut ne pas exister
	$result:=Null
	
	If (This.lesEnfants.length>0)
		// trier les enfants par date de naissance
		$result:=This.lesEnfants.trierParDate()
	End if 
	
	
	// fonctions privées
Function _lesMembres($Qui : Integer)->$result : Object
	// renvoie la ou les entités [personnes] de type $1
	var $sélection : Object
	// peut ne pas exister
	$result:=Null
	
	$sélection:=This.leGroupe.lesMembres.laPersonne
	Case of 
		: ($sélection.length=0)
		: ($Qui=agk Tout)
			// renvoyer tout
			$result:=$sélection.orderBy("sexe asc")
			
		Else 
			$sélection:=$sélection.query("sexe = :1"; $Qui=agk Mère)
			Case of 
				: ($sélection.length=0)
					// oops
				: ($sélection.length=1)
					$result:=$sélection[0]
				Else 
					// cas de parents homosexuels
					$sélection:=$sélection.orderBy("prenom asc")
					$result:=Choose($Qui=agk Père; $sélection.first(); $sélection.last())
			End case 
	End case 
	
	
Function _EvenementFamilial($type : Integer)->$result : Object
	// renvoie l'entité events fam de type $1
	var $sélection : Object
	
	$result:=Null
	$sélection:=This.LesEvenementsFamiliaux().query("type = :1"; $type)
	If ($sélection.length>0)
		// en principe first() est inutile
		$result:=$sélection.first()
	End if 
	
Function LesEvenementsFamiliaux()->$result : Object
	// renvoie la sélection d'entités d'events fam triée par date
	$result:=This.lesEventsFamiliaux.leEvent.orderBy("dateNum asc")
	
	
Function Libellé($formats : Object)->$libellé : Text
	// renvoie le nom formaté  des protagonistes suivant les options $formats
	// $formats
	// l'union (parentale par exemple) peut être nulle
	If (This.ID#0)
		// sélectionner les membres de l'union
		// coder leur noms
		$libellé:=This.leGroupe.lesMembres.laPersonne.Libellés($formats).result
	End if 
	
	
	// ----------------------
	// MARK:Modification DataStore
	// -----------------------
	
Function Ajouter($quoi : Integer; $qui : Object; $params : Object)->$result : Object
	ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "Début de l'ajout à ["+This.getDataClass().getInfo().name+"]"))
	
	$result:=ds.initResult()
	
	// fixer Qui
	If ($qui=Null)
		// créer qui
		$result:=ds.Créer($quoi; ""; $params)
		$qui:=$result.entitéAjoutée
	End if 
	
	Case of 
		: ($quoi=agk Conjoint)
			// ajouter un conjoint à this
			// rappel : une union a toujours son groupe
			Case of 
				: (This.leGroupe=Null)
					$result:=New object("Error"; -15004; "ErrorDescription"; Current method name+" - absence du groupe de l'union")
					
				: (This.leGroupe.lesMembres.length=2)
					// l'union est au complet! BUG ??????
					$result:=New object("Error"; -15004; "ErrorDescription"; Current method name+" - "+Localized string("5129"))
					
				Else 
					// ajouter un membre au groupe
					$result.membre:=This.leGroupe.AjouterMembre($qui)
					$result.Error:=$result.membre.Error
					$result.entitéAjoutée:=$qui
			End case 
			// pour le journal
			$params.Description_Action:=Localized string("3023")
			
		: ($quoi=agk Enfant)
			// ajouter un enfant à this
			This.SansEnfant:=False
			This.save()
			// lier $qui à ses parents
			$qui.parents:=This.ID
			// l'enfant à le nom de son père
			$qui.nom:=This._lesMembres(agk Père).nom
			$qui.save()
			// pour le journal
			$params.Description_Action:=Localized string("3024")+Localized string("33")+This.Libellé(New object("Options"; 3))
			
		: ($quoi=agk EventFamilial)
			Case of 
				: ($result.Error#0)
				: (This._EvenementFamilial($qui.leEvent.type)#Null)
					$result.Error:=-15010
					// l'event fam doit être unique
				Else 
					// faire le lien
					$result.entitéAjoutée.famille:=This.ID
					$result.entitéAjoutée.save()
					$result.entitéAjoutée:=$result.entitéAjoutée.leEvent
			End case 
			// pour le journal
			$params.Description_Action:=Localized string("3032")+" ("+Localized string(String($qui.leEvent.type))+")"+Localized string("33")+This.Libellé(New object("Options"; 3))
			
	End case 
	
	$result.success:=($result.Error=0)
	ds.NotifierResultat(This; $quoi; $result)
	
	
Function _FixerDonnées($quoi : Integer; $params : Object)->$result : Object
	// une union a été créée 
	$result:=ds._FixerDonnées(This; $quoi; $params)
	// ici, pour les 2 cas "Ajout DataStore" ou "Modifier DataStore_Extérieur", $params a les mêmes informations
	
	This.SansEnfant:=True
	This.save()
	
	
Function _TriggerCreer()
	var $entité : cs.GroupesEntity
	
	// associer un groupe
	$entité:=ds.Groupes.new()
	ds.FixerIDentification($entité)
	$entité.save()
	This.couple:=$entité.ID
	
	
	// ----------------------
	// interface externe
	// -----------------------
	
Function CopierVersObjet($entitéExt : Object)
	// recopier les attributs de this dans $entitéExt (pour une utilisation hors BDD mère)
	var $entité; $objet; $sélection : Object
	var $c : Collection
	
	$entitéExt.ID:=This.ID
	$entitéExt.IDunique:=This.IDunique
	
	$entitéExt.SansEnfant:=This.SansEnfant
	
	// ** ajouter l'évent de l'union
	
	// attention il peut ne pas y en avoir
	$objet:=This.LeMariage()
	If ($objet=Null)
		$entitéExt.leEvent:=Null
		
	Else 
		// demander à l'appelant sa classe Events
		$entité:=OB Copy($entitéExt.protoEvent)
		// faire compléter
		$objet.CopierVersObjet($entité)
		$entitéExt.leEvent:=$entité
	End if 
	
	// ** liste des personnes de l'union
	
	// créer les entités EXT
	$sélection:=This._lesMembres(agk Tout)
	$c:=New collection
	For each ($objet; $sélection)
		// demander à l'appelant sa classe Personnes
		$entité:=OB Copy($entitéExt.protoPersonne)
		// faire compléter
		$objet.CopierVersObjet($entité)
		$c.push($entité)
	End for each 
	
	// créer un objet de $entitéExt avec membre1 = homme, membre2 = femme
	// rappel : homme sexe = faux, femme sexe = vrai
	// plusieurs cas
	$entitéExt.lesMembres:=New object
	Case of 
		: ($c.length=0)
			// cas impossible?
			$entitéExt.lesMembres:=Null
			
		: ($c.length=1)
			$entitéExt.lesMembres.membre1:=Null
			$entitéExt.lesMembres.membre2:=Null
			If ($c[0].sexe)
				$entitéExt.lesMembres.membre2:=$c[0]
			Else 
				$entitéExt.lesMembres.membre1:=$c[0]
			End if 
			
		Else 
			$c:=$c.orderBy("sexe asc")
			$entitéExt.lesMembres.membre1:=$c[0]
			$entitéExt.lesMembres.membre2:=$c[1]
	End case 
	
	// ** liste des enfants de l'union
	
	// attention il peut ne pas y en avoir
	$entitéExt.lesEnfants:=New collection
	
	$sélection:=This.LesEnfants()
	Case of 
		: ($sélection=Null)
		: ($sélection.length=0)
		Else 
			// créer les entités EXT
			For each ($objet; $sélection)
				// demander à l'appelant sa classe Personnes
				$entité:=OB Copy($entitéExt.protoPersonne)
				// faire compléter
				$objet.CopierVersObjet($entité)
				$entitéExt.lesEnfants.push($entité)
			End for each 
	End case

⇧ [class]$media - 08/06/2026 14:10:14

      property trace : cs.$trace
property IsPackALV : Boolean
property typeDoc; _type; MIME; functionLecture; cheminFichier : Text
property typeObjet; numeroPage; IDcodé : Integer
property imagePageMedia : Picture

singleton Class constructor()
	
	This.trace:=cs.$trace.me
	This.typeObjet:=0
	This.MIME:=""
	This.functionLecture:=""
	
	// vrai si le plugIn est installé
	This.IsPackALV:=Storage.System.Status ?? 21
	
	
	
Function estReconnu($cheminFichier : Text)->$result : Boolean
	// fixer les propriétés du fichier reconnu
	
	This.trace.Initialiser(Current method name)
	
	// fixer le type du document
	Case of 
		: ($cheminFichier="")
			This.typeDoc:=""
			This.trace.Error:=Erreur de lecture du fichier
			
		: ($cheminFichier="http@")
			// URL de documents externes
			This.typeDoc:=".html"
			
		Else 
			This.typeDoc:=File($cheminFichier; fk platform path).extension
	End case 
	
	// définir le type du media
	This._type:=Replace string(This.typeDoc; "."; "")
	If (OB Is defined(cs._rsc.me; "media_"+This._type))
		cs.xSDK.Outils.me.CopierAttributs(cs._rsc.me["media_"+This._type]; This)
	Else 
		// doc non reconnu par l'application
		This.trace.Error:=Type de fichier media inconnu
	End if 
	
	This.trace.ErrorDescription:="le type <"+This._type+"> du fichier <"+$cheminFichier+"> est inconnu"
	This.trace.FixerSuccess()
	This.trace.LeverException([msgk_log])
	
	$result:=This.trace.success
	
	
Function getCheminSurDD($ID : Integer)
	var $entité : cs.FichiersEntity
	var $path : Text
	var $data : Object:=New object
	
	$entité:=ds.Medias.get($ID).leFichier[0]
	This.cheminFichier:=File($entité.CheminDuFichier()).platformPath
	
	This.trace.Initialiser(Current method name)
	
	Case of 
		: ($entité=Null)
			// le fichier peut ne pas exister
			This.trace.Error:=-Chemin dans la BDD invalide  // erreur BDD 
			
		: (Storage.System.typeApplication=ALV BDD mère)
			//  il faut que le path soit bon!!! (ex : appel depuis "Ajouter à media", serveur non installé)
			This.trace.Error:=Chemin externe invalide*Num(Not($entité.existeSurDD()))
			
		: (Storage.System.typeApplication=ALV Serveur APP)
			// filtrer ces cas
			This.trace.Error:=-Chemin externe invalide
			
		Else 
			// v 5.3.12 les medias ne sont plus installés avec l'application client APP : on les obtient par FTP sur l'hébergeur
			Case of 
					// on veut un document
				: (cs.$processData.me.existeTache("$application_TelechargerFichierMedia_"+String($entité.media)))
					// le document est en cours de téléchargement, attendre
					This.trace.Error:=Fichier en téléchargement
					
				: (Not($entité.existeSurDD()))
					// fichier non présent : le télécharger, dans un process externe (ça peut être long)
					// du coup, l'erreur arrive par ailleurs
					// dossier destination
					$path:=$entité.LeFichier().parent.platformPath
					// créer la hiérarchie du dossier, au cas où n'existe pas
					CREATE FOLDER($path; *)
					// lancer le téléchargement dans un process externe
					$data.IDnomFichier:=String($entité.media)
					$data.cheminDestination:=$path
					$data.Options:=0
					
					$data.nomTache:="$application_TelechargerFichierMedia_"+$data.IDnomFichier
					$data.initProcess:=Formula(InitProcessThreadSafe)
					// appel de $formulaire pour gérer la mise à jour
					$data.CallBack:="MettreAjourSelection"
					// s'il existe, on le laisse terminer
					This.trace.Error:=cs.$process.new().NouveauProcess(cs.$application; "TelechargerFichierMedia"; $data)
					If (This.trace.Error=0)
						// process non lancé, renvoyer une erreur
						This.trace.Error:=-15002
						
					Else 
						// renvoyer "fichier en cours de téléchargement"
						This.trace.Error:=Fichier en téléchargement
					End if 
					
					CALL WORKER(Worker Services; Formula(traceHandler); [msgk_log]; "Téléchargement du media : "; Current method name; JSON Stringify($data); New object("nomProcess"; Current process name; "numProcess"; Current process))
					
				Else 
					// fichier présent ?
					This.trace.Error:=Erreur de lecture du fichier*Num(Not($entité.existeSurDD()))
			End case 
			
	End case 
	
	
	// -----------------------------
	// MARK:Lecture Media BDD ou externe
	// -----------------------------
	
Function LireAvecChemin($cheminFichier : Text; $numPage : Integer)->$result : Boolean
	// $numPage est optionnel
	
	This.cheminFichier:=$cheminFichier
	This.numeroPage:=$numPage
	This._Lire()
	$result:=This.trace.success
	
	
Function LireAvecIDmedia($ID : Integer; $numPage : Integer)
	// $numPage est optionnel
	
	This.getCheminSurDD($ID)
	// le resultat est dans This.trace
	This.numeroPage:=$numPage
	
	Case of 
		: (This.trace.Error=Fichier en téléchargement)
			// fichier en téléchargement, pas d'erreur, fixer un type
			This.typeObjet:=0
			// attention : le téléchargement se fait dans un process externe ; une erreur ne viendra pas ici
			// message, attention : ici on veut être thread-safe
			cs.$trace.me.EnvoyerMessages([msgk_user; msgk_event; msgk_log]; "Message Utilisateur"; Current method name; "le fichier du media <"+String($ID)+"> est en cours de téléchargement")
			
			
		: (This.trace.Error#0)
			// pb
			This.trace.Error:=Chemin dans la BDD invalide
			This.trace.ErrorDescription:="le chemin du media <"+String($ID)+"> est invalide en BDD"
			// message, attention : ici on veut être thread-safe
			cs.$trace.me.EnvoyerMessages([msgk_user; msgk_event; msgk_log]; "Message Utilisateur"; Current method name; "le chemin du media <"+String($ID)+"> est invalide en BDD")
			
		Else 
			// cas normal, le chemin du "media".cheminFichier  existe
			This._Lire()
	End case 
	
	
Function LireAvecIDfichier($ID : Integer; $numPage : Integer)
	// $numPage est optionnel
	
	// attention téléchargement pas fait A FAIRE ?
	This.cheminFichier:=ds.Fichiers.get($ID).LeFichier().platformPath
	This.numeroPage:=$numPage
	This._Lire()
	
	
Function _Lire()
	Case of 
		: (Not(This.estReconnu(This.cheminFichier)))
		: (This._FixerHandler())
		Else 
			// c'est ok
			This.trace.Initialiser(This.functionLecture)
			This[This.functionLecture]()
			
			// si error, renvoyer le media par défaut
			Case of 
				: (This.trace.Error=0)
				: ((This.typeObjet>=0) & (This.typeObjet<=4))
					This.trace.Error:=This.LireRessourceImage(16201)
					This.trace.ErrorDescription:="La ressource Image <16201> est absente"
					
				Else 
					This.trace.Error:=Media hors BDD
					This.trace.ErrorDescription:="Le type objet "+String(This.typeObjet)+" est inconnu, ou non géré"
			End case 
	End case 
	
	This.trace.FixerSuccess()
	This.trace.LeverException([msgk_event; msgk_log])
	
	
Function _FixerHandler()->$result : Boolean
	$result:=False
	Case of 
		: (This.typeObjet=0)
			This.functionLecture:="_LireFTP"
		: (This.typeObjet=mdk Est une Image)
			This.functionLecture:="_LireImage"
		: (This.typeObjet=mdk Est un document PDF)
			This.functionLecture:="_LirePDF"
		: (This.typeObjet=mdk Est un flux Video)
			This.functionLecture:="_LireVignetteVideo"
		: (This.typeObjet=mdk Est une Ressource)
			This.functionLecture:="_LireRSC"
		: (This.typeObjet=mdk Est un flux Audio)
			This.functionLecture:="_LireVignetteAudio"
		: (This.typeObjet=mdk Est un document SVG)
			This.functionLecture:="_LireSVG"
		: (This.typeObjet=mdk Est un Document externe)
			This.functionLecture:="_LireLienExterne"
		Else 
			$result:=True
	End case 
	
	
Function _LireFTP()
	This.trace.Error:=This.LireRessourceImage(16201)
	
	
Function _LireImage()
	var $image : Picture
	
	This.trace.Error:=This.CompresserImage()
	
	If (This.trace.Error=0)
		READ PICTURE FILE(This.cheminFichier; $image)
		This.imagePageMedia:=$image
		This.trace.Error:=Erreur de lecture du fichier*Num(ok=0)
	End if 
	This.trace.ErrorDescription:="Erreur de lecture du fichier image  <"+This.cheminFichier+">"
	
	
Function _LirePDF()
	var $mediaPath : Text:=This.cheminFichier
	var $numPage : Integer:=This.numeroPage
	var $zoom : Real:=4.166666
	var $image : Picture
	
	// utilisation du plugIn ALV_pack : extraire la page dans le fichier PDF
	If (This.IsPackALV)
		This.trace.Error:=cs.$wrapperPlugIn.me.ConvertirPageDansImage($mediaPath; $numPage; $zoom; ->$image)
		This.imagePageMedia:=$image
		
	Else 
		// absence de plugIn (cas windows en particulier) lire le fichier de la page 
		// recupérer le chemin du fichier de la page $numPage
		This.cheminFichier:=This.FichierDePagePDF($mediaPath; $numPage)
		
		This._LireImage()
		This.imagePageMedia:=This.imagePageMedia*$zoom
	End if 
	
	This.trace.Error:=Choose(This.trace.Error=0; 0; Conversion PDF_PNGf impossible)
	This.trace.ErrorDescription:="Erreur de lecture de la page "+String($numPage)+" du fichier PDF <"+$mediaPath+">"
	
	
Function _LireVignetteVideo()
	var $mediaPath : Text:=This.cheminFichier
	var $largeur : Real:=0
	var $hauteur : Real:=0
	var $image : Picture
	
	// test Windows = test présence PlugIn
	If (This.IsPackALV)
		//créer la vignette et renvoyer les dimensions
		This.trace.Error:=cs.$wrapperPlugIn.me.PropriétésVideo($mediaPath; ->$largeur; ->$hauteur; ->$image)
		This.imagePageMedia:=$image
		This.trace.Error:=Fichier de sortie indisponible*Num((This.trace.Error#0) | (Test path name($mediaPath)#Is a document))
		
	Else 
		This.trace.Error:=Fichier de sortie indisponible
	End if 
	
	This.trace.ErrorDescription:="erreur de lecture du fichier Vidéo <"+$mediaPath+">"
	
	If (This.trace.Error#0)
		This.trace.Error:=This.LireRessourceImage(16205)
	End if 
	
	
Function _LireRSC()
	This.trace.Error:=This.LireRessourceImage(This.IDcodé)
	This.trace.ErrorDescription:="La ressource Image <"+String(This.IDcodé & 0xFFFF)+"> est absente"
	
	
Function _LireVignetteAudio()
	This.trace.Error:=This.LireRessourceImage(16206)
	This.trace.ErrorDescription:="erreur de lecture du fichier Son <"+This.cheminFichier+">"
	
	
Function _LireSVG()
	var $image : Picture
	var $RacineXML : Text
	
	$RacineXML:=DOM Parse XML source(This.cheminFichier)
	This.trace.Error:=Erreur de lecture du fichier*Num(ok=0)
	
	If (This.trace.Error=0)
		SVG EXPORT TO PICTURE($RacineXML; $image; Copy XML data source)
		DOM CLOSE XML($RacineXML)
		This.imagePageMedia:=$image
	End if 
	This.trace.ErrorDescription:="erreur de lecture du fichier SVG <"+This.cheminFichier+">"
	
	
Function _LireLienExterne()
	ALERT(Current method name+" TODO")
	// renvoyer le lien
	//If (Type($3->)=Is text)
	//$3->:=$path
	//Else 
	//$0:=Chemin externe invalide
	//End if 
	
	
	// -----------------------------
	// MARK:Lecture Ressource
	// -----------------------------
	
Function LireRessourceImage($ID : Integer)->$result : Integer
	var $c : Collection
	var $image : Picture
	
	$result:=0  // pas d'erreur
	
	// le type de l'image n'est pas connu : recherche dans la liste des images disponibles
	// essayer une image standard
	$c:=Folder(fk resources folder).folder("Images").files(fk ignore invisible).query("fullName= :1"; String($ID)+".@")
	If ($c.length=1)
		// trouvé
	Else 
		// essayer une image HTML
		$c:=Folder(fk resources folder).folder("Images/HTML").files(fk ignore invisible).query("fullName= :1"; String($ID)+".@")
		If ($c.length=1)
			// trouvé
		Else 
			$result:=Media hors BDD
		End if 
	End if 
	
	// lire l'image
	If ($result=0)
		READ PICTURE FILE($c[0].platformPath; $image)
		$result:=Erreur de lecture du fichier*Num(ok=0)
		This.imagePageMedia:=$image
	End if 
	
	
	// -----------------------------
	// MARK:Utilitaires
	// -----------------------------
	
Function FichierDePagePDF($cheminFichier : Text; $numPage : Integer)->$result : Text
	var $sousDossier : Text:=""
	var $nomFichier : Text
	var $entité : cs.FichiersEntity
	var $dossier : Object
	var $c : Collection
	
	$result:=""
	
	// nom du fichier actuel
	$nomFichier:=File($cheminFichier; fk platform path).name
	// fichier actuel
	$entité:=ds.Medias.get(Num($nomFichier)).leFichier[0]
	// dossier du volume
	$dossier:=$entité.LeVolume().LeDossier()
	
	// nom du fichier de la page
	$nomFichier:=$nomFichier+"_"+String($numPage)+".png"
	
	// cf le "Lisez-moi.rtf" : le fichier demandé est dans un volume de medias suffixé
	// lire le suffixe des dossiers de pages PDF
	cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Ressources_Communes/Suffixe_Dossier_ImagesPDF"; Is text; ->$sousDossier)
	// ajouter le suffixe au nom de dossier et créer le chemin du dossier
	$dossier:=$dossier.parent.folder($dossier.name+$sousDossier)
	
	$c:=$dossier.files(fk recursive+fk ignore invisible).query("fullName = :1"; $nomFichier)
	If ($c.length=1)
		$result:=$c[0].platformPath
	End if 
	
	
Function CompresserImage($ptrCheminFichier : Pointer; $cheminFichierOUT : Text)->$result : Integer
	var $fichier; $fichierCompressé : 4D.File
	var $zoom : Real
	var $image : Picture
	
	$result:=0
	
	Case of 
		: (Count parameters=0)
			// utiliser les données de classe
		: (Type($ptrCheminFichier->)#Is text)
		: (Not(File($ptrCheminFichier->; fk platform path).isFile))
		Else 
			// utiliser ce fichier
			This.cheminFichier:=$ptrCheminFichier->
	End case 
	
	If (This.cheminFichier#"")
		$fichier:=File(This.cheminFichier; fk platform path)
		
		// on compresse si la taille de l'image est supérieure à cs.$session.me.prefs.Apparence.Formulaire.TailleMaxMedia en Mo
		$zoom:=Square root(cs.$session.me.prefs.Apparence.Formulaire.TailleMaxMedia/$fichier.size*1024*1024)
		If ($zoom<1)
			// on compresse
			
			// déterminer le chemin du fichier de destination
			If (Count parameters>1)
				// stockage temporaire
				$fichierCompressé:=File($cheminFichierOUT; fk platform path)
				If ($fichierCompressé.exists)
					$fichierCompressé.delete()
				End if 
				
			Else 
				// stockage de l'application
				$fichierCompressé:=cs.$document.new().GetCompressedMediaFile($fichier)
			End if 
			
			// compresser si nécessaire :
			If (Not($fichierCompressé.exists))
				READ PICTURE FILE($fichier.platformPath; $image)
				$result:=Erreur de lecture du fichier*Num(ok=0)
				
				If ($result=0)  // compresser l'image lue :
					TRANSFORM PICTURE($image; Scale; $zoom; $zoom)
					WRITE PICTURE FILE($fichierCompressé.platformPath; $image; $fichier.typeDoc)  // stocker dans le dossier des images compressées
					$result:=Erreur de compression*Num(ok=0)
					
					// on ne renvoie pas d'erreur de stockage
				End if 
				CLEAR VARIABLE($image)
			End if 
			
			If ($result=0)
				This.cheminFichier:=$fichierCompressé.platformPath
				
				If (Count parameters>0)
					$ptrCheminFichier->:=This.cheminFichier
				End if 
			End if 
		End if 
	End if

⇧ [class]PersonnesVisualisateur - 19/05/2026 08:17:04

      // classe du process de visualisation d'un AG
property nomTache : Text:="VisualiserArbre"
property arbre : cs.xARB.$arbre
property grandEcran; mémoTaille : Boolean
property ZoneActive : Integer
property paramsArbre : Object
property CheminDossierExport; titre : Text
property IDcodés : Integer

Class extends $visualisateur

Class constructor()
	// construction arbre
	Super()
	
	// taguer le type du visualisation
	This.informations.Contexte:="_arbre_genealogique_"
	
	// fixer les données du formulaire (surcharge les valeurs par défaut)
	This.grandEcran:=True
	This.mémoTaille:=False
	
	// fixer les paramètres de l'arbre : paramsArbre
	// rappel IMPORTANT : this va fixer Form du formulaire
	This.paramsArbre:=New object
	
	// fixer le ID user (pour le chemin de la BDD_AG)
	This.paramsArbre.LogIn:=This.session.userName
	
	This.paramsArbre.NmaxAscendance:=This.session.prefs.Apparence.AG.Mode_10612.NmaxAscendance
	This.paramsArbre.NmaxDescendance:=This.session.prefs.Apparence.AG.Mode_10612.NmaxDescendance
	This.paramsArbre.Modele:=This.session.prefs.Apparence.AG.Mode_10612.Modele
	
	This.paramsArbre.FormatImage:=Truncated non centered
	This.paramsArbre.Session_Etat:=This.session.prefs.Session_Etat
	// données arbre
	This.paramsArbre.nomBDD:="Visualisation"
	// paramètres de construction
	This.paramsArbre.functionID:=cagk Construire
	This.paramsArbre.optionsMsg:=[msgk_event]
	This.paramsArbre.Options:=1
	This.document.Créer(Créer un dossier ALV; This.document.GetSessionFolder().path; New collection("debug"; "AG Visu"))
	This.CheminDossierExport:=This.document.dossier.platformPath
	
	This.paramsArbre.EtatProcessus:=New object
	This.paramsArbre.EtatProcessus.SaisieAutorisée:=True
	// callback du traitement
	This.paramsArbre.EtatProcessus.Params:=0x0000
	
	
Function getDataClassInfos()->$result : Object
	$result:=Super.getDataClassInfos("Personnes")
	
	
	// ----------------------
	// MARK:Gestion formulaire 
	// -----------------------
	
Function OuvrirFormulaire()
	// méthode du process U_Nav Arbrographie
	
	MouseX:=0  // init des variables du process (nécessaire en interprété)
	MouseY:=0
	
	// créer la fenêtre
	If (Is Windows)
	Else 
		// rappel IMPORTANT : This va fixer Form du formulaire, qui fixe la variable "Form.paramsArbre" associée au sous formulaire "AffichageArbre"
		cs.$dialogue_3001.new().Ouvrir("Visualiser Arbre Généalogique"; Plain form window; ""; This)
	End if 
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	var $refMenu; $menuID : Text
	
	ASSERT(cs.$trace.me.DebugerEventForm(Current method name; "EventForm"; New object("numEvent"; FORM Event.code)))
	
	// traitements génériques
	Super.surEvenementFormulaire()
	
	// traitements particuliers
	Case of 
		: (FORM Event.code=On Load)
			cs.$processData.me.FixerTache(Current process name; New object("nomTache"; This.nomTache; "activerCurseurHoraire"; True))
			
		: (FORM Event.code=On Activate)
			HIDE MENU BAR
			
		: (FORM Event.code=On Timer)
			// mettre à jour les thermomètres
			cs.$processData.me.AfficherProgressionTache()
			
			
		: (FORM Event.code=On Clicked)
			Case of 
				: (This.zoneSensible.ActionZS())
					// action traitée
					
				: (Contextual click | Right click)
					Case of 
						: (Storage.System.Navigation.ZS.ZoneSurvolée=-1)
							// on est hors ZS
							// ici on doit partager avec le composant; on ne peut pas tout gérer par "Menus Contextuels"
							// créer les menus de l'application
							$refMenu:=This.menuContextuel.CréerPopUp("MC_ArbreGenealogique")
							// ajouter les menus du composant
							This.arbre.menu.FixerMenuContextuel($refMenu)
							
						: ((Storage.System.Navigation.ZS.ZoneSurvolée>0) & (This.ZoneActive#-1))
							// on est dans une ZS NE SERT PLUS cf $c.$zonesensible
							// récupérer numTable
							//$menuID:=String(CodeEnreg(This.ZoneActive))
							// menu contextuel associé à toutes les ZS d'une entité de numTable
							//$refMenu:=This.menuContextuel.CréerPopUp("MC_ZS_"+$menuID)
					End case 
					
					// demander le menu
					$menuID:=Dynamic pop up menu($refMenu)
					// récupérer les paramètres avant de purger le menu
					This.menuContextuel.LireParamètresMenu($menuID; $refMenu)
					
					// traiter la commande demandée
					Case of 
						: ($menuID="")
							// rien, filtrer
							
						: (This.zoneSensible.ActionZS())
							// actions standard traitée
							
						: (This.menuContextuel.ExécuterCommande())
							// action contextuelle traitée
							
						Else 
							// essayer une action du composant
							This.arbre.menu.ExecuterCommandeContextuel($menuID)
							
					End case 
					RELEASE MENU($refMenu)
			End case 
	End case 
	
	
	// ----------------------
	//MARK:FORMevents SubFORM
	// ----------------------
	// events générés par le sous formulaire du composant xARB
	
Function onSurVolElement()
	// on survole qque chose ?
	// utiliser les paramètres du sous formulaire
	This.zoneSensible.SurvolZSarbre(This.arbre)
	
	// gérer le curseur en fonction des ZS et des touches clavier
	This.SurvolZSimage()
	
	// afficher les informations de l'objet lié (si demande utilisateur)
	This.AfficherInformations()
	
	
Function onModification()
	var $paramsArbre : Object
	
	// utiliser les paramètres du sous formulaire
	$paramsArbre:=OB Copy(This.paramsArbre)
	cs.xARB.$arbre.new($paramsArbre).Modifier_AG()
	
	
	// ----------------------
	//  MARK:Affichage 
	// -----------------------
	
Function AfficherEntité()
	// .nav de la classe a été fixé
	
	This.titre:=This.nav.entitéCourante.Libellé(New object("Options"; 7))
	
	// fixer le(s) IDcodés de l'arbre
	// utiliser l'entité courante du formulaire courant
	// rappel : une option utilisateur peut la réduire à l'entité courante
	This.IDcodés:=cs._ds.me.IDcodé(This.nav.entitéCourante)
	
	// compléter les paramètres
	// user paramètres
	This.paramsArbre.IDpersonne:=cs._ds.me.IDcodé(This.nav.entitéCourante)
	// données arbre
	This.paramsArbre.IDarbre:=This.nav.entitéCourante.ID
	
	// fixer le retour
	This.paramsArbre.nomProcessAppelant:=Current process name
	This.paramsArbre.CallBack:="AfficherArbre"
	
	// la tache associée
	This.paramsArbre.tache:=This.registreTaches.Inscrire(New object("nomProcess"; Current process name; "nomTache"; This.nomTache; "numProcessAppelant"; Current process))
	
	// c'est parti
	cs.$serveurAPP.me.Executer(cs.xARB.$arbre.name; "Imager_AG"; This.paramsArbre; "xARB")
	
	
Function AfficherArbre($params : Object)
	// retour du serveur APP
	// afficher l'arbre dans le formulaire
	
	This.arbre:=cs.xARB.$arbre.new($params; This)
	// rappel : this contient les functions du FORM déclenchées par le SUBFORM
	This.arbre.Afficher_AG_dansFormulaire($params.arbreXML)
	
	This.paramsArbre.tache.DésInscrire()

⇧ [class]$documentation - 06/06/2026 10:04:15

      property dossierTravail : 4D.Folder
property params : Object
property nomDossierDOC; nomDossierCompressé : Text
property langues : Collection
property IDpage : Integer
// classe de la documentation HTML de l'APP
property pageWebDOC : cs.$pageWebDOC

Class extends $formulaire

Class constructor()
	var $nomDossier : Text:=""
	
	Super()
	
	// integrer les functions du Web
	This.pageWebDOC:=cs.$pageWebDOC.new()
	
	// sous domaine
	cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Serveur_Web/nomDossier_Documentation"; Is text; ->$nomDossier)
	This.dossierTravail:=cs.$document.new().GetSessionFolder().folder($nomDossier)
	This.dossierTravail.create()
	
	
	
Function FixerParamètres($params : Object)
	// $params = paramètres de menu
	Super.FixerParamètres($params)
	This.informations.nomForm:="U_Palette?3106"
	
	// calculer le num de la page à afficher
	If (OB Is defined(This.menu.params; "IDpage"))
		This.params.IDpage:=This.menu.params.IDpage
	Else 
		This.params.IDpage:=This.LireIDpageDeFORM()
	End if 
	This.params.numPage:=This.params.IDpage
	
	
	// -----------------------------
	// Mark:Archive Web
	// -----------------------------
	
Function CreerDocumentation($params : Object)
	// fixer les langues disponibles
	This.Versionner()
	
	This.dossierTravail:=Folder(fk documents folder).folder("ALVtempo_ExporterDocumentation")
	This.dossierTravail.delete(Delete with contents)
	This.dossierTravail:=This.dossierTravail.folder(This.nomDossierDOC)
	This.dossierTravail.create()
	
	// créer les pages dans toutes les langues
	$params.tache.FixerParamsAvancement(0; 10000)
	This.CreerPages($params)
	
	// fermer
	This.pageWebDOC.FermerDocDataXML()
	
	// envoyer vers l'hébergeur
	This.Televerser($params)
	// c'est fini
	$params.tache.FixerTime(10000)
	Waiting(30)
	$params.tache.Désinscrire()
	
	
Function CreerPages($params : Object)
	var $dossier : Object
	var $langue : Text
	
	// recopier les ressources HTML DOC dans le dossier session (même structure que celle du serveur Web!)
	$dossier:=cs.$document.new(Est un dossier ALV; Get 4D folder(Current resources folder); New collection("TemplatesPagesWeb"; "documentation"; "ressources")).dossier
	$dossier.copyTo(This.dossierTravail)
	
	// paramètres des pages
	// dossier de réception des pages
	$params.cheminDossierPages:=This.dossierTravail.platformPath
	// dosser des templates de la documentation
	$params.dossierTemplate:=Folder(Get 4D folder(Current resources folder); fk platform path).folder("TemplatesPagesWeb").folder("Documentation")
	For each ($langue; This.langues)
		$params.avancement:=(1/This.langues.length)*(This.langues.indexOf($langue))
		$params.langue:=$langue
		This.CreerPagesLocalisees($params)
	End for each 
	
	
Function CreerPagesLocalisees($params : Object)
	// créer la page index
	var wwwRacineHTMLstatic : Text
	
	// ajouter les paramètres de la page
	$params.cheminRelatifPage:="index."+$params.langue+".html"
	$params.cheminPage:=$params.cheminDossierPages+$params.cheminRelatifPage
	$params.cheminTemplate:=$params.dossierTemplate.file("IndexPageAide.shtml").platformPath
	
	// mettre  les paramètres du template (toujours en variables process, utilisées par "EcrireElementHTML_DOC"
	wwwRacineRessources:=This.CalculerNiveauRelatifHTML($params.cheminRelatifPage)
	// redirection vers le sous dossier des pages : donner le chemin relatif
	wwwRacineHTMLstatic:=This.fct.ConvertirPathVersURL("Aide"+Folder separator+$params.langue+Folder separator; False; False; True)
	// numéro de la première page
	numPageForm:=6000
	This.CreerPageHTML($params)
	
	// créer les pages dans le sous dossier
	$params.cheminTemplate:=$params.dossierTemplate.file("pageAide.shtml").platformPath
	// boucler sur toutes les pages (disponibles dans les fichiers de localisation)
	numPageForm:=6000
	While (Localized string(String(numPageForm))#"")
		$params.cheminRelatifPage:="Aide"+Folder separator+$params.langue+Folder separator+"page"+String(numPageForm)+".html"
		$params.cheminPage:=$params.cheminDossierPages+$params.cheminRelatifPage
		
		// mettre en paramètres les paramètres du template
		wwwRacineRessources:=This.CalculerNiveauRelatifHTML($params.cheminRelatifPage)
		//  niveau du sous domaine
		wwwSousDomaine:=""
		// wwwEtatNavigation
		wwwEtatNavigation:="DOC"
		This.CreerPageHTML($params)
		
		numPageForm:=numPageForm+1
		$params.tache.FixerAvancement($params.avancement+((numPageForm-6000)/200/This.langues.length))
	End while 
	
	
Function CreerPageHTML($params : Object; $paramTemplate1 : Text; $paramTemplate2 : Text; $paramTemplate3 : Text)->$result : Boolean
	// crée dans .$params.cheminPage le fichier de la page statique basée sur la page dynamique du fichier .cheminTemplate
	// $dossier : chemin du dossier des pages statiques
	// .cheminTemplate utilise 3 paramètres $i
	var $texte : Text
	var $texteBlobé : Blob
	
	// crée la page statique WEB à partir du template (page dynamique)
	$result:=True
	If (Test path name($params.cheminTemplate)=Is a document)  // le template existe
		DOCUMENT TO BLOB($params.cheminTemplate; $texteBlobé)
		$result:=$result & (ok=1)
		$texte:=BLOB to text($texteBlobé; UTF8 text without length)
		// créer la page
		PROCESS 4D TAGS($texte; $texte; $paramTemplate1; $paramTemplate2; $paramTemplate3)
		// enregistrer la page dans le dossier session
		SET BLOB SIZE($texteBlobé; 0)
		TEXT TO BLOB($texte; $texteBlobé; UTF8 text without length)
		BLOB TO DOCUMENT($params.cheminPage; $texteBlobé)
		$result:=$result & (ok=1)
	End if 
	
	
Function Televerser($params : Object)
	var $dossier; $data : Object
	
	$data:=New object
	If (cs.$document.new().ArchiverEnZIP(This.dossierTravail; $data).success)  // à faire dans le process courant
		// $data.fichierZippé contient le chemin du fichier zip
		// le nom du zip doit être regexifié (sur le serveur FTP) : renommer le fichier
		$dossier:=$data.fichierZippé.rename(This.nomDossierCompressé+".zip")
		// récupérer le dossier du fichier .zip
		$dossier:=$dossier.parent
		$dossier.folders()[0].delete(Delete with contents)
		// envoyer sur l'hébergeur
		ErrorNum:=0
		Case of 
				// pas d'export en debug
			: (This.session.prefs.Session_Etat ?? 6)
				// demander l'accès (et les données) au serveur FTP
			: (Not(This.ftp.FixerAccessDocumentation($params).success))
				// remarque : la version (fichier data ou application ALV) n'est pas gérée dans la documentation
			Else 
				// on a tout, transférer
				// options demandées : dans un process externe, suppression du dossier de travail
				$data:=New object
				$data.dossier:=$dossier
				$data.cheminFTP:=$params.urlDossier
				$data.Options:=0x0011
				$data.tache:=This.registreTaches.Inscrire(New object("nomProcess"; Current process name; "nomTache"; "FTPdocumentation"; "numProcessAppelant"; Current process))
				
				// lancer la tâche
				$params.result:=This.ftp.MettreAjourDossier($data)
				$data.tache.Désinscrire()
		End case 
	End if 
	
	
	// -----------------------------
	// Mark:Serveur Web
	// -----------------------------
	
Function CréerPageConnexionServeurWeb()
	// créer la page d'ouverture de l'aide dans un navigateur web
	// la page est dans le dossier ressources (cf doc 4D), et appelée par le menu aide 
	var $param1 : Text:=""
	var $dataTexte : Text:=""
	var $texteBlobé : Blob
	var $fichier; $texte; $param2 : Text
	var $i : Integer
	
	// lire le template de la page
	$fichier:=cs.$document.new(Est un dossier ALV; Get 4D folder(Current resources folder); New collection("TemplatesPagesWeb"; "documentation")).dossier.file("AideParNavigateurWeb.shtml").platformPath
	DOCUMENT TO BLOB($fichier; $texteBlobé)
	$texte:=BLOB to text($texteBlobé; UTF8 text without length)
	
	// fixer les paramètres du traitement des balises 4D :
	
	// - $param1 = url de la page documentation
	If ((Storage.System.typeApplication=ALV BDD mère) & (This.session.prefs.Session_Etat ?? 6))
		// utiliser le serveur Web local pour test
		WEB GET OPTION(Web port ID; $i)
		This.rsc.SetVariable(Est Ressource APP; "Serveurs_BDDmere/IP_Serveur"; Is text; ->$param1)
		$param1:=$param1+":"+String($i)
	Else 
		// utiliser le serveur Web de production
		This.rsc.SetVariable(Est Ressource APP; "serveur_URL/Nom_sousDomaine"; Is text; ->$param1)
	End if 
	
	// - $param2 = chemin du dossier local de l'aide (à utiliser si Serveur WEB indisponible)
	$param2:="(chemin du dossier de l'aide inconnu; à renseigner via le menu 'Préférences' de l'application)"
	$dataTexte:=""
	If (This.rsc.SetVariable(Est Ressource APP; "Aide/Chemin_Dossier"; Is text; ->$dataTexte))
		$dataTexte:=Convert path system to POSIX($dataTexte)
		$param2:=$dataTexte+"index.fr.html"
	End if 
	
	PROCESS 4D TAGS($texte; $texte; $param1; $param2)
	
	SET BLOB SIZE($texteBlobé; 0)
	TEXT TO BLOB($texte; $texteBlobé; UTF8 text without length)
	
	$fichier:=Get 4D folder(Current resources folder)+"Ainsi La Vie.htm"
	BLOB TO DOCUMENT($fichier; $texteBlobé)
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	
	Case of 
		: (FORM Event.code=On Load)
			This.ChargerRessources()
			
			// afficher
			This.AfficherLaPage(Form.params)
			// après la navigation se fait par les liens URL
			
			// charger les objets
			This.onEndLoad()
			
		: (FORM Event.code=On Activate)
			WA SET PREFERENCE(*; "zoneAide"; WA enable Web inspector; This.session.prefs.Session_Etat ?? 6)
			
		: (FORM Event.code=On Unload)
	End case 
	
	
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	// attention à l'ordre
	$c:=New collection("moisRepublicains"; "anneesRepublicaines"; "anneesGregoriennes"; "joursGregoriens"; "moisGregoriens"; "zoneCalculCalendriers"; "modifierBDD")
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:FORMevents Page 1
	// ----------------------
	
Function _FORM_previousItem()
	var $MenuID; $url : Text
	
	Case of 
		: (FORM Event.code=On Clicked)  //Clic simple
			If (WA Back URL available(*; "zoneAide"))
				WA OPEN BACK URL(*; "zoneAide")
			End if 
			
		: (FORM Event.code=On Alternative Click)
			// Créer un menu historique précédent
			$MenuID:=WA Create URL history menu(*; "zoneAide"; WA previous URLs)
			//Afficher ce menu dans un pop up
			$url:=Dynamic pop up menu($MenuID)
			If ($url#"")  //Si une ligne est sélectionnée
				WA OPEN URL(*; "zoneAide"; $url)  // Ouvrir la page Web
			End if 
			RELEASE MENU($MenuID)  //Effacer le menu pour libérer la mémoire
	End case 
	
	
Function _FORM_nextItem()
	var $MenuID; $url : Text
	
	Case of 
		: (FORM Event.code=On Clicked)  //Clic simple
			If (WA Forward URL available(*; "zoneAide"))
				WA OPEN FORWARD URL(*; "zoneAide")
			End if 
			
		: (FORM Event.code=On Alternative Click)
			// Créer un menu historique précédent
			$MenuID:=WA Create URL history menu(*; "zoneAide"; WA next URLs)
			//Afficher ce menu dans un pop up
			$url:=Dynamic pop up menu($MenuID)
			If ($url#"")  //Si une ligne est sélectionnée
				WA OPEN URL(*; "zoneAide"; $url)  // Ouvrir la page Web
			End if 
			RELEASE MENU($MenuID)  //Effacer le menu pour libérer la mémoire
	End case 
	
	
	// -----------------------------
	// Mark:Palette Client, BDDmère
	// -----------------------------
	// functions de gestion du formulaire DOC
	
Function ChargerRessources()
	// recopier les ressources HTML dans le dossier session (même structure que celle du serveur Web!)
	var $dossier : 4D.Folder
	
	$dossier:=cs.$document.new(Est un dossier ALV; Get 4D folder(Current resources folder); New collection("TemplatesPagesWeb"; "documentation"; "ressources")).dossier
	$dossier.copyTo(This.dossierTravail; fk overwrite)
	
	
Function LireIDpageDeFORM()->$result : Integer
	// appel depuis les menus de l'App
	// afficher l'aide de l'onglet courant du formulaire courant de la table courante
	var $fichier : 4D.File
	var $texte; $structureDeDonnées; $RacineXML; $ElementXML : Text
	
	// référence de la page du formulaire :
	$texte:=""
	If (Not(Is nil pointer(Current form table)))
		$texte:=Table name(Current form table)
	End if 
	$texte:=$texte+"_"+Current form name+"_"+String(FORM Get current page)
	$texte:=Current form name+"_"+String(FORM Get current page)
	// ID de la page d'aide de ce formulaire :
	$result:=0
	// lire la structure XML
	$fichier:=Folder(fk resources folder).file("DataPagesAide.xml")
	cs.xSDK.XML.me.LireFichier($fichier; ->$structureDeDonnées)
	$RacineXML:=DOM Parse XML variable($structureDeDonnées)
	// rechercher ce mot de définition de l'aide
	$ElementXML:=DOM Find XML element by ID($RacineXML; $texte)
	If (ok=1)
		DOM GET XML ELEMENT VALUE($ElementXML; $result)
		This.IDpage:=$result
	End if 
	DOM CLOSE XML($RacineXML)
	
	// si la page est absente, utiliser l'accueil
	If ($result=0)
		$result:=6000
	End if 
	
	
Function AfficherLaPage($params : Object)
	// afficher la page dans un formulaire
	var $texteBlobé : Blob
	var $fichier : Text
	
	// créer la page
	// définition du contexte
	$params.contexte:="ALV"
	
	// c'est parti
	cs.$serveurAPP.me.Executer(cs.$documentation.name; "CréerLaPage"; $params)
	
	// créer le fichier page
	Case of 
		: ($params.reqRetour=Null)
		: (Not(OB Is defined($params.reqRetour; "IDpage")))
		: (Not(OB Is defined($params.reqRetour; "page")))
		Else 
			// décoder
			BASE64 DECODE($params.reqRetour.page; $texteBlobé)
			
			// chemin du fichier de la page
			$fichier:=cs.$document.new().GetSessionFolder().file("page_"+String($params.reqRetour.IDpage)+".html").platformPath
			$fichier:=This.dossierTravail.file("page_"+String($params.reqRetour.IDpage)+".html").platformPath
			
			// créer le contenu
			BLOB TO DOCUMENT($fichier; $texteBlobé)
			
			// afficher le contenu
			Form.url:="file://"+Convert path system to POSIX($fichier)
	End case 
	
	
	// -----------------------------
	// MARK:Utilitaires
	// -----------------------------
	
Function CréerLaPage($params : Object)
	// ici on est forcément sur la BDDmère, le serveurAPP (appel client) ou serveur HTTP (site web)
	var $texteBlobé : Blob
	var $fichier; $texte : Text
	
	
	Case of 
		: (Not(OB Is defined($params; "IDpage")))
		: (Not(OB Is defined($params; "contexte")))
			
		Else 
			// ok
			
			// lire le template de la page
			$fichier:=cs.$document.new(Est un dossier ALV; Get 4D folder(Current resources folder); New collection("TemplatesPagesWeb"; "documentation")).dossier.file("pageAide.shtml").platformPath
			DOCUMENT TO BLOB($fichier; $texteBlobé)
			$texte:=BLOB to text($texteBlobé; UTF8 text without length)
			
			// fixer les paramètres de construction
			wwwSousDomaine:=""
			numPageForm:=$params.IDpage
			wwwEtatNavigation:=$params.contexte
			wwwRacineRessources:=""
			
			// créer la page
			PROCESS 4D TAGS($texte; $texte)
			
			If (Storage.System.typeApplication=ALV Serveur APP)
				This.pageWebDOC.FermerDocDataXML()
			End if 
			
			// enregistrer la page dans le dossier session
			SET BLOB SIZE($texteBlobé; 0)
			TEXT TO BLOB($texte; $texteBlobé; UTF8 text without length)
			// encoder pour passer le resultat au client
			BASE64 ENCODE($texteBlobé; $texte)
			
			// le résultat est dans $params
			$params.page:=$texte
	End case 
	
	
Function Versionner($params : Object)
	// fixer les noms des dossiers documentation
	// $1 est optionnel (utilisé par "EcrireElementHTML_DOC"
	
	This.langues:=cs.xSDK.Outils.me.ListerLanguesApplication().codes
	
	This.nomDossierDOC:="DOC_"+This.environnement.LireVersionAPP()+"_"+This.langues.join("_")
	This.nomDossierCompressé:="DOC_"+This.environnement.FixerIDversionAPP()+"_"+This.langues.join("_")
	
	If (Count parameters>0)
		$params.nomDossierDOC:=This.nomDossierDOC
		$params.nomDossierCompressé:=This.nomDossierCompressé
	End if 
	
	
Function CalculerNiveauRelatifHTML($chemin : Text)->$result : Text
	// rechercher le nombre de sur-dossiers ; renvoyer autant de ../
	var $i : Integer
	
	$i:=0
	$result:=""
	Repeat 
		$i:=Position(Folder separator; $chemin; $i+1; *)
		If ($i>0)
			$result:=$result+"../"
		End if 
	Until ($i=0)

⇧ [class]$accueil - 12/05/2026 10:40:59

      property image : cs.$image
property IDapplication : Text

Class extends $formulaire

Class constructor()
	
	Super()
	
	This.image:=cs.$image.me
	This.image.nomObjet:="ImageAccueil"
	
	This.grandEcran:=True
	This.mémoTaille:=False
	
	This.IDapplication:=""
	
	// remarque : la classe peut être créée en off pour exécuter une function
	// donc ici, pas d'init des variables dynamiques
	
	
	// -----------------------------
	//MARK:Gestion du process principal
	// -----------------------------
	
Function Initialiser()
	// initialiser les états (variables dynamiques)
	Use (Storage.System)
		Storage.System.JourNuitEtat:=True
		Storage.System.JourNuitTest:=Tickcount
		// demander l'init de l'image de fond
		Storage.System.JourNuitChanger:=True
		Storage.System.EtatConnexionServeur:=False
		Storage.System.TémoinRequeteServeurTimeOut:=0
	End use 
	
	//FIXER BARRE MENUS(Storage.BarresMenus["Standard"]; Numéro du process courant)
	
	
Function MettreAjourSelection()
	// function standard
	This.AfficherImageAccueil()
	
	
Function ChangerLangue($params : Object)
	var $itemRef : Integer
	
	cs.$process.new().TuerUserProcesses()
	// re traduire les menus
	This.menu.CréerBarreMenus()
	// mettre à jour le formulaire
	$itemRef:=$params.IDcodé
	cs.$editeur.new().EditerSélection($itemRef; 0)
	
	
Function callFunction($params : Object)
	// passe plat
	cs[$params.nomClass].new()[$params.functionID]($params.params)
	
	
Function callCommandes($params : Object)
	// passe plat
	cs.CommandesEditeur.new()[$params.functionID]($params.action)
	
	
	// -----------------------------
	//MARK:FORMevents FORM
	// -----------------------------
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection("TimeDisplay")
	Super.onEndEventForm($c)
	
	
Function _FORM()
	var $cadence : Integer:=0
	var $gauche; $haut; $droite; $bas; $largeur; $hauteur : Integer
	
	// ici, pas traitements génériques
	
	// traitements particuliers
	Case of 
			
		: (FORM Event.code=On Load)
			cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Ressources_Communes/RefreshTime"; Is longint; ->$cadence)
			SET TIMER($cadence)
			
			OBJECT SET VISIBLE(*; "avancement"; False)
			This.session.Ouvrir()
			Form.MettreAjourSelection()
			
			// son ouverture sur le canal Accueil
			This.sonorisation.AjouterCanal("Accueil"; Est Ressource APP; ""; This.session.prefs.SonorisationPrefs.Ambiance)
			This.sonorisation.LireLeCanal("Accueil"; "Ouverture"+("_OSX"*Num(Is macOS))+("_WIN"*Num(Is Windows))+".mp3")
			
			This.Initialiser()
			OBJECT SET VISIBLE(*; "ConnexionAPPService"; False)
			OBJECT SET VISIBLE(*; "ModeDebug"; False)
			
			// charger les objets
			This.onEndLoad()
			
			
		: (FORM Event.code=On Resize)
			OBJECT GET COORDINATES(*; "TimeDisplay"; $gauche; $haut; $droite; $bas)
			$largeur:=$droite-$gauche
			$hauteur:=$bas-$haut
			OBJECT GET COORDINATES(*; "ImageAccueil"; $gauche; $haut; $droite; $bas)
			$haut:=$haut+20
			$gauche:=$droite-(0.15*$droite)
			OBJECT MOVE(*; "TimeDisplay"; $gauche; $haut; $gauche+$largeur; $haut+$hauteur; *)
			
		: (FORM Event.code=On Activate)
			HIDE MENU BAR
			// afficher le mode de fonctionnement
			This.AfficherTypeApplication()
			
		: (FORM Event.code=On Timer)
			This.AfficherMessageUtilisateur()
			This.FixerEtatImageAccueil()
			
			// MaJ des IHM
			cs.$processData.me.AfficherProgressionTache()
			
			// état de la connexion aux services (rappel : ici on n'a pas appelé le traitement générique)
			This.MajEtatConnexionServeur()
			
			// fond d'écran
			Case of 
				: (Not(OB Is defined(Storage.System; "JourNuitEtat")))
				: (Not(OB Is defined(Storage.System; "JourNuitChanger")))
				: (Storage.System.JourNuitChanger=False)
				Else 
					This.MettreAjourSelection()
					Use (Storage.System)
						Storage.System.JourNuitChanger:=False
					End use 
			End case 
			
			// modes Debug
			OBJECT SET VISIBLE(*; "ModeDebug"; This.session.prefs.Session_Etat ?? 6)
			
			// rappel ! le clic droit est géré par la méthode de l'image
			
			
		: (FORM Event.code=On Deactivate)
			This.image.nonExisteZoneSensibleActive()
			
			
		: (FORM Event.code=On Unload)
			// son fermeture sur le canal Accueil
			This.sonorisation.LireLeCanal("Accueil"; "Fermeture"+("_OSX"*Num(Is macOS))+("_WIN"*Num(Is Windows))+".mp3")
			Waiting(60*3)
			
			SHOW MENU BAR
	End case 
	
	
	// ----------------------
	//MARK:FORMevents Accueil
	// ----------------------
	
Function _FORM_ImageAccueil()
	var $entité : cs.CommandesEntity
	
	Case of 
		: (FORM Event.code=On Mouse Move)
			This.image.existeZoneSensibleActiveinImage()
			
			If (Storage.System.Navigation.ZS.ZoneSurvolée>0)  // le curseur est sur une zone
				SET CURSOR(9000)
				$entité:=ds.Commandes.query("ID = :1"; Storage.System.Navigation.ZS.EnregistrementLié & 0x00FFFFFF)[0]
				Form.AfficherMessageUtilisateur(New object("ID"; $entité.libelle))
				
			Else 
				SET CURSOR  // RAZ pointeur
				Form.EffacerMessageUtilisateur()
			End if 
			
		: (FORM Event.code=On Clicked)
			Case of 
				: (This.ActionMenuContextuel())
				: (This.zoneSensible.ActionZS())
					// ok action prise en compte
				Else 
			End case 
	End case 
	
	
Function _FORM_TimeDisplay()
	Case of 
		: (FORM Event.code=On Load)
			// you have to choose between these options !
			// ***** EITHER ***** static clock (declared as time) 
			// *****   OR  ***** dynamic clck (declared as longint)
			If (True)
				// dynamic clock sample
				// dynamic clock will display current time (0 = no time shift, 3600 = one hour time shift... etc))
				Form.TimeDisplay:=0
				
			Else 
				// static clock sample
				// static clock -> will display 09:30:00
				OBJECT Get pointer(Object current)->:=?09:30:00?
				
			End if 
	End case 
	
	
	// -----------------------------
	//MARK:Ecran accueil
	// -----------------------------
	
Function AfficherImageAccueil()
	// Afficher l'image de fond correspondant à l'utilisateur
	var $JourNuit : Boolean
	var $ID : Integer
	
	If (OB Is defined(Storage.System; "JourNuitEtat"))
		$JourNuit:=Storage.System.JourNuitEtat
		Case of 
			: (This.session.user.estMembreDe_Developpement)
				$ID:=Choose($JourNuit; 1338; 2978)
				
			: (This.session.user.estMembreDe_Administration)
				$ID:=Choose($JourNuit; 1339; 2977)
				
			: (This.session.user.estMembreDe_Saisie)
				$ID:=Choose($JourNuit; 1340; 2979)
				
			Else 
				$ID:=Choose($JourNuit; 1241; 2976)
		End case 
		
		This.entité:=ds.Medias.get($ID)
		
		This.image.nomObjet:="ImageAccueil"
		This.image.LireAvecIDmedia($ID; 1)
		This.image.RafraichirImage()
	End if 
	
	
Function FixerEtatImageAccueil()
	// l'image de l'accueil change en fonction de l'état jour / nuit
	var $JourNuit : Boolean
	var $maintenant : Time
	
	// initialiser
	$JourNuit:=Storage.System.JourNuitEtat
	// nouvel état
	$maintenant:=Current time
	If (Tickcount>Storage.System.JourNuitTest)
		// faire le test
		Case of 
			: (((?08:00:00?<=$maintenant) & ($maintenant<?20:00:00?)) & $JourNuit & OB Is defined(Storage.System; "JourNuitChanger"))
				// il fait jour et écran = jour
			: (Not(($maintenant>=?08:00:00?) & ($maintenant<?20:00:00?)) & Not($JourNuit) & OB Is defined(Storage.System; "JourNuitChanger"))
				// il fait nuit et écran = nuit
			Else 
				// il faut changer
				// on ne sait pas où en est le process principal : le laisser se débrouiller
				Use (Storage.System)
					// dans l'ordre :
					Storage.System.JourNuitEtat:=(?08:00:00?<=Current time) & (Current time<?20:00:00?)
					Storage.System.JourNuitChanger:=True
					// prise en compte de la commande ici !
					Storage.System.JourNuitTest:=Tickcount+(60*5)
				End use 
		End case 
		// nouvelle attente
		Use (Storage.System)
			Storage.System.JourNuitTest:=Tickcount+(60)
		End use 
	End if 
	
	
Function AfficherTypeApplication()
	var $texte : Text:=""
	
	This.rsc.SetVariable(Est Ressource APP; "Ressources_Communes/Nom_Application"; Is text; ->$texte)
	$texte:=$texte+Char(8482)
	
	Case of 
		: (Storage.System.typeApplication=ALV Client APP)
			$texte:=$texte+" Client"
			
		Else 
	End case 
	$texte:=$texte+"  "+This.environnement.LireVersionAPP()
	This.IDapplication:=$texte+(Num(Not(Is compiled mode))*"   Application interprétée")
	
	
Function MajEtatConnexionServeur()
	// afficher l'état de la connexion au serveur
	var $result : Boolean
	var $date : Integer
	
	$result:=False
	$date:=Milliseconds
	Case of 
		: ($date>Storage.System.TémoinRequeteServeurTimeOut)
		: (Not(Storage.System.TémoinRequeteServeur))
		Else 
			$result:=True
	End case 
	// état de la connexion aux Webservices (rappel : ici on n'a pas appelé le traitement générique)
	Use (Storage.System)
		Storage.System.EtatConnexionServeur:=$result
	End use 
	
	// témoin connexion serveur APP
	OBJECT SET VISIBLE(*; "ConnexionAPPService"; Storage.System.EtatConnexionServeur)
	// surcharger en cas de l'un des serveurs de test
	OBJECT SET VISIBLE(*; "ConnexionWebLocal"; (Storage.System.EtatConnexionServeur & ((This.session.prefs.Session_Etat ?? 16) | (This.session.prefs.Session_Etat ?? 18))))

⇧ [class]$wrapperPlugIn - 26/12/2025 10:19:37

      // appels thread-safe aux plugIns

singleton Class constructor()
	
	// -----------------------------
	// MARK:PlugIn 15003 ALV Pack
	// -----------------------------
	
Function ConvertirPageDansFichier($cheminFichier : Text; $numPage : Integer; $zoom : Real; $cheminFichierPage : Text)->$result : Integer
	// renvoie la page du PDF demandée dans un fichier image
	// $zoom de l'image = 1 ramère à 72 dpi, >= 300/72 renvoir la pleine résolution
	var $pathIn_POSIX; $pathOut_POSIX : Text
	
	$result:=0
	
	If (This.existsPlugIn(21))
		$pathIn_POSIX:=Convert path system to POSIX($cheminFichier)
		$pathOut_POSIX:=Convert path system to POSIX($cheminFichierPage)
		$result:=Convertir_PagePDF_dansFichier($pathIn_POSIX; $numPage; $zoom; $pathOut_POSIX)
		
		This.gererErreurs($result; Current method name)
	End if 
	
	
Function ConvertirPageDansImage($cheminFichier : Text; $numPage : Integer; $zoom : Real; $ptrIimage : Pointer)->$result : Integer
	// renvoie la page du PDF demandée dans une image
	// $zoom de l'image = 1 ramène à 72 dpi, >= 300/72 renvoir la pleine résolution
	var $pathOut : Text
	
	$result:=0
	
	If (This.existsPlugIn(21))
		$pathOut:=Folder(fk documents folder).file("tempo.png").platformPath
		$result:=This.ConvertirPageDansFichier($cheminFichier; $numPage; $zoom; $pathOut)
		If ($result=0)
			READ PICTURE FILE($pathOut; $ptrIimage->)
			DELETE DOCUMENT($pathOut)
		End if 
	End if 
	
	This.gererErreurs($result; Current method name)
	
	
Function CréerPDFmultiPages($ptrPages : Pointer; $cheminFichier : Text)->$result : Integer
	// $1 = tableau des chemins des pages
	// $2 = chemin du PDF
	var $pathOut_POSIX : Text
	var $i : Integer
	
	$result:=-15083
	
	If (This.existsPlugIn(21))
		If (Type($ptrPages->)=Text array)
			// on a un tableau de chemins
			// recopier le tableau en local 
			ARRAY TEXT($Pages; 0)
			//%W-518.1
			COPY ARRAY($ptrPages->; $Pages)
			//%W+518.1
			For ($i; 1; Size of array($Pages))
				$Pages{$i}:=Convert path system to POSIX($Pages{$i})
			End for 
			$pathOut_POSIX:=Convert path system to POSIX($cheminFichier)
			//%T-
			$result:=Creer_PDF_multiPages($Pages; $pathOut_POSIX)
			//%T+
			
		Else 
			$result:=-15068
		End if 
	End if 
	
	This.gererErreurs($result; Current method name)
	
	
Function PropriétésPDF($cheminFichier : Text; $ptrLargeur : Pointer; $ptrHauteur : Pointer; $ptrNbrePages : Pointer; $ptrMode : Pointer)->$result : Integer
	// $1 = chemin du fichier PDF
	// $2 = largeur de la box PDF
	// $3 = hauteur de la box PDF 
	// $4 = nombre de pages
	// $5 = zombie? (tronqué ou proportionnel  encore utile ?)
	var $pathIn_POSIX : Text
	var $width; $height; $nbre; $mode : Integer
	
	$result:=0
	
	If (This.existsPlugIn(21))
		$pathIn_POSIX:=Convert path system to POSIX($cheminFichier)
		$result:=Proprietes_PDF($pathIn_POSIX; $width; $height; $nbre; $mode)
		$ptrLargeur->:=$width
		$ptrHauteur->:=$height
		$ptrNbrePages->:=$nbre
		$ptrMode->:=$mode
	End if 
	
	This.gererErreurs($result; Current method name)
	
	
Function PropriétésVideo($cheminFichier : Text; $ptrWidth : Pointer; $ptrHeight : Pointer; $ptrPict : Pointer)->$result : Integer
	// $1 = chemin du fichier
	// $2 = largeur de l'image
	// $3 = hauteur de l'image 
	// $4 = image de la première trame
	var $pathIn_POSIX : Text
	var $width; $height : Integer
	var $pict : Picture
	
	$result:=0
	
	If (This.existsPlugIn(21))
		$pathIn_POSIX:=Convert path system to POSIX($cheminFichier)
		$result:=Proprietes_Video($pathIn_POSIX; $width; $height; $pict)
		$ptrWidth->:=$width
		$ptrHeight->:=$height
		$ptrPict->:=$pict
	End if 
	
	This.gererErreurs($result; Current method name)
	
	
	// -----------------------------
	// MARK:Utilitaires
	// -----------------------------
	
Function existsPlugIn($IDplugIn : Integer)->$result : Boolean
	// tester la présence du plugIn $IDplugIn
	$result:=(Storage.System.Status ?? $IDplugIn)
	
	
Function gererErreurs($Error : Integer; $nomMethode : Text)
	// attention ici on est thread-safe
	var $ErrorDescription : Text
	
	$ErrorDescription:=Localized string(String($Error))
	If ($ErrorDescription="")
		$ErrorDescription:="Erreur inconnue"
	End if 
	cs.$trace.me.Créer($Error; $nomMethode; $ErrorDescription).LeverException([msgk_event; msgk_log])

⇧ [class]MediasPalette - 20/05/2026 08:56:57

      property sélection : Object
property Fichiers : Collection
property nomLB : Text:="listeVignettes"
property nomLH : Text:="listeMedias"
property nomTacheLB : Text:="tacheListeVignettes"
property nomTacheLH : Text:="tacheListeMedias"
property dossierTravail : 4D.Folder

Class extends $formulaire

Class constructor()
	// construction commune
	Super()
	
	This.dossierTravail:=This.dossierImagettes()
	This.dossierTravail.create()
	
	
	
Function getDataClassInfos()->$result : Object
	$result:=Super.getDataClassInfos("Medias")
	
	
Function FixerParamètres($params : Object)
	// $params = paramètres de menu
	
	Super.FixerParamètres($params)
	This.informations.nomForm:="U_Palette?3015"
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	ASSERT(cs.$trace.me.DebugerEventForm(Current method name; "EventForm"; New object("numEvent"; FORM Event.code; "numTable"; Table(Current form table))))
	
	This.surEvenementFormulaire()
	
	Case of 
		: (FORM Event.code=On Load)
			SHOW PROCESS(Current process)
			cs.$processData.me.FixerTache(Current process name; New object("nomTache"; This.nomTacheLH; "activerThermometre"; True))
			cs.$processData.me.FixerTache(Current process name; New object("nomTache"; This.nomTacheLB; "activerCurseurHoraire"; True))
			
			// charger les objets
			This.onEndLoad()
			
		: (FORM Event.code=On Timer)
			cs.$processData.me.AfficherProgressionTache()
			
		: (FORM Event.code=On Resize)
			Form.reDimensionner()
			
		: (FORM Event.code=On Close Box)
			CANCEL
			
		: (FORM Event.code=On Unload)
			cs.xSDK.RegistreTaches.me.Tuer(Current process)
			This.onEndUnLoad()
			
		: (This.nomOBJ#This.nomLB)
		: (OB Is defined(FORM Event; "columnName"))
			// les events sur la listBox sont reçus par les colonnes ; les trapper ici. Attention le nombre de colonnes est variable
			This["_FORM_"+This.nomLB]()
	End case 
	
	
Function onEndLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection(This.nomLH; "selection"; "triSelection"; "affichageDetail")
	Super.onEndEventForm($c)
	
	
Function onEndUnLoad()
	// en DUR pour l'instant
	var $c : Collection
	
	$c:=New collection(This.nomLH; "selection")
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:FORMevents Page fond
	// ----------------------
	
Function _FORM_listeMedias()->$result : Integer
	var $dossier : 4D.Folder
	var $ptrVariableObjet : Pointer
	var $itemPos; $itemRef; $détail; $style; $icône; $menuID : Integer
	var $path; $chemin; $itemText : Text
	var $saisissable; $déployé : Boolean
	var $data; $entité : Object
	
	$ptrVariableObjet:=cs._cfct.me.getVariableObjet(This.nomOBJ)
	
	Case of 
		: (FORM Event.code=On Load)
			This.NouvelleSélection()
			
		: ((Right click) | (Contextual click))  // Clic droit ou Control+clic
			$itemPos:=Selected list items(*; This.nomLH)
			GET LIST ITEM(*; This.nomLH; $itemPos; $itemRef; $itemText; $détail; $déployé)
			
			Case of 
				: (Not(cs._cfct.me.estIDcodeDeClasses($itemRef; [ds.Dossiers])))  // gestion des dossiers medias
				: (Form.menuContextuel.MontrerPopUpMenu("MC_LHmedia"))
					// la commande a été traitée (bizarre)
				Else 
					$menuID:=Form.menuContextuel.params.numCommande
					Case of 
						: (($menuID=mck Ajouter Dossier) & (Process number("$SYS_Verifier BDDmedia")=0))
							// insérer un sous-dossier
							$itemText:=Request(Localized string("5097"))
							If ($itemText#"")
								// dossier parent
								$data:=ds.Dossiers.get($itemRef & 0x00FFFFFF)
								// nouveau dossier
								$dossier:=$data.LeDossier().folder($itemText)
								$dossier.create()
								cs._ds.me.Ajouter(imk Dossier; $data; Null; New object("dossier"; $dossier))
								// la suite est lancée par une mise à jour de la palette
							End if 
							
						: (($menuID=mck Renommer Dossier) & Form.ActionUtilisateur("[SaisieAutorisée]"))
							// renommer un sous-dossier
							$data:=ds.Dossiers.query("ID = :1"; $itemRef & 0x00FFFFFF)[0]
							If ($data.volume<0)  //on ne peut pas modifier le nom d'un volume!
								OBJECT SET ENTERABLE(*; This.nomLH; True)
								GET LIST ITEM PROPERTIES(*; This.nomLH; $itemRef; $saisissable; $style; $icône)
								SET LIST ITEM PROPERTIES(*; This.nomLH; $itemRef; True; $style; $icône)
								EDIT ITEM(*; This.nomLH; $itemPos)
							Else 
								BEEP
							End if 
							
						: (($menuID=mck Supprimer Dossier) & Form.ActionUtilisateur("[SaisieAutorisée]"))
							// supprimer un sous-dossier
							If (Count list items($détail; *)=0)  // supprimer le dossier sur DD
								$path:=Convert path POSIX to system(ds.Dossiers.get($itemRef & 0x00FFFFFF).LeChemin(""))
								ErrorNum:=0
								DELETE FOLDER($path; Delete with contents)
								Case of 
									: ((ErrorNum=0) | (ErrorNum=-120))
										// fait (ou dossier inexistant)
										// supprimer le dossier dans la BDD
										$data:=ds.Dossiers.query("ID = :1"; $itemRef & 0x00FFFFFF)
										Supprimer De DataStore(imk Dossier; $data)
										DELETE FROM LIST(*; This.nomLH; $itemRef; *)  //  MaJ de la LH
										
									: (ErrorNum=-47)  // incohérence : dossier non vide sur le disque, mais vide en BDD
										cs.$trace.me.Créer(-15043; Current method name; cs._cfct.me.LireLocatedSTR(5108; New object("param_1"; $data.nom))).LeverException([msgk_event; msgk_log])
										
									Else 
										BEEP  // autre erreur
								End case 
							End if 
							
						: (($MenuID=mck Ajouter Volume) & (Process number("$SYS_Verifier BDDmedia")=0))
							// créer un volume
							$itemText:=Request(Localized string("5097"))
							// créer au nouveau dossier (par défaut au meme niveau que celui du volume 0)
							$dossier:=This.document.GetMediaFolder(1).parent.folder($itemText)
							Case of 
								: ($itemText="")
									// abandon user
								: (Not($dossier.create()))
									// dossier non créé sur le DD
								Else 
									cs._ds.me.Ajouter(imk Volume; Null; Null; New object("dossier"; $dossier))
							End case 
					End case 
					
			End case 
			
		: (FORM Event.code=On Data Change)
			$itemPos:=Selected list items(*; This.nomLH)
			GET LIST ITEM(*; This.nomLH; $itemPos; $itemRef; $itemText; $détail; $déployé)
			// commande "renommer dossier" (n'existe pas)
			// MaJ la BDD
			$entité:=ds.Dossiers.get($itemRef & 0x00FFFFFF)
			$entité.nom:=$itemText
			cs._ds.me.Modifier(cdk Modifier; New collection($entité); Null)
			
			// MaJ LH
			GET LIST ITEM PROPERTIES(*; This.nomLH; $itemRef; $saisissable; $style; $icône)
			SET LIST ITEM PROPERTIES(*; This.nomLH; $itemRef; False; $style; $icône)
			OBJECT SET ENTERABLE(*; This.nomLH; False)
			
		: (FORM Event.code=On Begin Drag Over)
			cs.$glisserDeposer.me.surDebutGlisserITEM_LH()
			
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserENTITE([ds.Medias])
			
		: (FORM Event.code=On Drop)
			// on déplace un fichier du dossier affiché dans un autre
			If (Form.ActionUtilisateur("[ModificationAutorisée]"))
				// modif possible et autorisée
				$itemRef:=Storage.System.GlisserDéposer.refItem
				// sur quoi a-t-on déposé?
				$itemPos:=This.glisserDeposer.FixerDepotSurLH(cs._cfct.me.getVariableObjet(This.nomLH))
				If (cs._cfct.me.estIDcodeDeClasses($itemPos; [ds.Dossiers]))  // gestion des dossiers medias
					//(CodeEnreg($itemPos; [Table(->[Dossiers])])=1)
					// ok dépot sur un dossier destination
					$path:=Convert path POSIX to system(ds.Dossiers.get($itemPos & 0x00FFFFFF).LeChemin(""))
					
					$entité:=cs._ds.me.EntitéAvecIDcodé($itemRef)
					// chemin source
					$chemin:=$entité.LeFichier().platformPath
					// chemin de destination
					$entité:=$entité.leFichier.first()
					$path:=$path+$entité.nom
					
					ErrorNum:=0
					COPY DOCUMENT($chemin; $path; *)
					If (ErrorNum=0)
						DELETE DOCUMENT($chemin)
						// mettre le fichier dans le dossier
						cs._ds.me.Modifier(cdk Lier; New collection($entité); New object("params"; New object("attribut"; "dossier"; "valeur"; $itemPos)))
						Form.DéplacerFichier($entité; $itemPos)
						
						// supprimer $itemRef de la LBox
						Form.Fichiers.remove(Form.Fichiers.indexOf($itemRef & 0x00FFFFFF))
						Form.NouveauxTableaux(New object("functionID"; "GetData"; "fichiers"; Form.Fichiers))
					End if 
				End if 
			Else 
				$result:=-1
			End if 
			
		: (FORM Event.code=On Unload)
			CLEAR LIST($ptrVariableObjet->; *)
	End case 
	
	
Function _FORM_selection()->$result : Integer
	var $itemText : Text
	var $index; $itemRef; $détail; $draggedVariable : Integer
	var $déployé : Boolean
	var $ptrObjetCourant : Pointer
	
	$ptrObjetCourant:=OBJECT Get pointer(Object current)
	
	MESSAGES OFF
	Case of 
		: (FORM Event.code=On Load)
			// créer les tableaux
			ARRAY PICTURE(tabImages; 0)
			ARRAY LONGINT(tabID; 0)
			ARRAY TEXT(tabTitre; 0)
			ARRAY DATE(tabDate; 0)
			Form.NouveauxTableaux(New object("functionID"; "GetData"))
			
			Form.selection:=New object
			Form.selection.values:=New collection("")
			Form.selection.currentValue:=""
			
		: (FORM Event.code=On Clicked)
			Form.selection.currentValue:="?"
			
		: (FORM Event.code=On Data Change)
			$index:=Form.selection.values.indexOf(Form.selection.currentValue)
			If ($index=-1)
				Form.selection.values.push(Form.selection.currentValue)
			Else 
				Form.selection.currentValue:=Form.selection.values[$index]
			End if 
			
		: (FORM Event.code=On Drag Over)
			$result:=This.glisserDeposer.surGlisserENTITE([ds.Dossiers])
			
		: (FORM Event.code=On Drop)
			$draggedVariable:=Storage.System.GlisserDéposer.refItem
			GET LIST ITEM(listeMedias; List item position(listeMedias; $draggedVariable); $itemRef; $itemText; $détail; $déployé)
			If (Is a list($détail))
				// pour l'affichage :
				Form.selection.currentValue:=$itemText
				
				// extraire les ID fichiers de $détail
				Form.Fichiers:=New collection
				Form.FichiersDeListeH($détail)
				Form.NouveauxTableaux(New object("functionID"; "GetData"; "fichiers"; Form.Fichiers))
				
			End if 
			
		: (FORM Event.code=On Unload)
			// purger les tâches en cours liées à ce process
			cs.xSDK.RegistreTaches.me.Tuer(Current process)
	End case 
	
	If ((FORM Event.code=On Clicked) | (FORM Event.code=On Data Change))
		If (Length(Form.selection.currentValue)=0)
			// (ré-)afficher tous les medis
			Form.NouveauxTableaux(New object("functionID"; "GetData"))
			
		Else 
			Form.NouveauxTableaux(New object("functionID"; "GetData"; "motCle"; Form.selection.currentValue))
		End if 
	End if 
	
	
Function _FORM_triSelection()
	var $choixTri : Integer
	var $c : Collection
	var $data : Object
	var $refMenu : Text
	
	$data:=Form.UserPrefs
	$c:=New collection("15021.svg"; "15022.png"; "15023.svg")
	
	Case of 
		: (FORM Event.code=On Load)
			// fixer l'image du bouton en fonction des UserPrefs
			$choixTri:=$data.ParamsForm.ChoixTri
			
		: (FORM Event.code=On Clicked)
			// demander un choix de tri
			$refMenu:=Create menu
			For ($choixTri; 1; $c.length)
				APPEND MENU ITEM($refMenu; " ")
				SET MENU ITEM PARAMETER($refMenu; -1; String($choixTri))
				SET MENU ITEM ICON($refMenu; -1; "File:Images/"+$c[$choixTri-1])
			End for 
			$choixTri:=Num(Dynamic pop up menu($refMenu))
			
			If ($choixTri>0)
				// trier
				Use ($data.ParamsForm)
					$data.ParamsForm.ChoixTri:=$choixTri
				End use 
				// trier
				Form.TrierTableaux()
				// ré-afficher
				Form.CréerMatriceImages()
			End if 
	End case 
	
	If ((FORM Event.code=On Load) | (FORM Event.code=On Clicked))
		// mettre à jour l'icone
		// 4Dv20R10 l'image png se s'affiche pas automatiquement (because ??) ; mettre un tick
		OBJECT SET FORMAT(*; This.nomOBJ; "1;1;file:Images/"+$c[$choixTri-1]+";0;10")
	End if 
	
	
	//Function _FORM_affichageDetail()
	//var $gauche; $haut; $droite; $bas; $gaucheObjet; $hautObjet; $droiteObjet; $basObjet : Integer
	//var $data : Object
	
	//$data:=Form.UserPrefs
	
	//Case of 
	//: (FORM Event.code=On Load)
	//Form[This.nomOBJ]:=Num($data.ParamsForm.ExtensionLH)
	//FORM SET VERTICAL RESIZING(True)
	//FORM SET HORIZONTAL RESIZING(True)
	
	//If ($data.ParamsForm.ExtensionLH)
	//// affichée
	//FORM SET SIZE(This.nomLH; $data.ParamsForm.MargeForm; $data.ParamsForm.MargeForm)
	//Else 
	//// masquée
	//FORM SET SIZE(This.nomOBJ; $data.ParamsForm.MargeForm; $data.ParamsForm.MargeForm)
	//End if 
	
	//: (FORM Event.code=On Clicked)
	//Use ($data.ParamsForm)
	//$data.ParamsForm.ExtensionLH:=(Form[This.nomOBJ]=1)
	//End use 
	//// éventuellement, recadrer la fenêtre
	//GET WINDOW RECT($gauche; $haut; $droite; $bas; Current form window)
	//If (Form[This.nomOBJ]=0)  // contracter
	//OBJECT GET COORDINATES(*; This.nomOBJ; $gaucheObjet; $hautObjet; $droiteObjet; $basObjet)
	//$droite:=$gauche+$droiteObjet+$data.ParamsForm.MargeForm
	//$bas:=$haut+$basObjet+$data.ParamsForm.MargeForm
	//SET WINDOW RECT($gauche; $haut; $droite; $bas; Current form window)
	//FORM SET SIZE(This.nomOBJ; $data.ParamsForm.MargeForm; $data.ParamsForm.MargeForm)
	
	//Else   // déployer
	//OBJECT GET COORDINATES(*; This.nomLH; $gaucheObjet; $hautObjet; $droiteObjet; $basObjet)
	//$droite:=$gauche+$droiteObjet+$data.ParamsForm.MargeForm
	//$bas:=$haut+$basObjet+$data.ParamsForm.MargeForm
	//$droiteObjet:=$droite-(Screen width-4)
	//If ($droiteObjet>0)  // recadrer la fenêtre
	//$droite:=$droite-$droiteObjet
	//$gauche:=$gauche-$droiteObjet
	//End if 
	//SET WINDOW RECT($gauche; $haut; $droite; $bas; Current form window)
	//FORM SET SIZE(This.nomLH; $data.ParamsForm.MargeForm; $data.ParamsForm.MargeForm)
	//End if 
	//End case 
	
	
Function _FORM_affichageDetail()
	var $gauche; $haut; $droite; $bas; $gaucheObjet; $hautObjet; $droiteObjet; $basObjet : Integer
	var $data : Object
	
	$data:=Form.UserPrefs
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=Num($data.ParamsForm.ExtensionLH)
			FORM SET VERTICAL RESIZING(True)
			FORM SET HORIZONTAL RESIZING(True)
			
			If ($data.ParamsForm.ExtensionLH)
				// affichée
				FORM SET SIZE(This.nomLH; $data.ParamsForm.MargeForm; $data.ParamsForm.MargeForm)
			Else 
				// masquée
				FORM SET SIZE(This.nomOBJ; $data.ParamsForm.MargeForm; $data.ParamsForm.MargeForm)
			End if 
			
		: (FORM Event.code=On Clicked)
			Use ($data.ParamsForm)
				$data.ParamsForm.ExtensionLH:=(Form[This.nomOBJ]=1)
			End use 
			// éventuellement, recadrer la fenêtre
			GET WINDOW RECT($gauche; $haut; $droite; $bas; Current form window)
			If (Form[This.nomOBJ]=0)  // contracter
				OBJECT GET COORDINATES(*; This.nomOBJ; $gaucheObjet; $hautObjet; $droiteObjet; $basObjet)
				$droite:=$gauche+$droiteObjet+$data.ParamsForm.MargeForm
				$bas:=$haut+$basObjet+$data.ParamsForm.MargeForm
				SET WINDOW RECT($gauche; $haut; $droite; $bas; Current form window)
				FORM SET SIZE(This.nomOBJ; $data.ParamsForm.MargeForm; $data.ParamsForm.MargeForm)
				
			Else   // déployer
				OBJECT GET COORDINATES(*; This.nomLH; $gaucheObjet; $hautObjet; $droiteObjet; $basObjet)
				$droite:=$gauche+$droiteObjet+$data.ParamsForm.MargeForm
				$bas:=$haut+$basObjet+$data.ParamsForm.MargeForm
				$droiteObjet:=$droite-(Screen width-4)
				If ($droiteObjet>0)  // recadrer la fenêtre
					$droite:=$droite-$droiteObjet
					$gauche:=$gauche-$droiteObjet
				End if 
				SET WINDOW RECT($gauche; $haut; $droite; $bas; Current form window)
				FORM SET SIZE(This.nomLH; $data.ParamsForm.MargeForm; $data.ParamsForm.MargeForm)
			End if 
	End case 
	
	
	// ----------------------
	//MARK:FORMevents Page 1
	// ----------------------
	
Function _FORM_listeVignettes()
	var $colonne; $ligne; $ID : Integer
	
	LISTBOX GET CELL POSITION(*; This.nomOBJ; $colonne; $ligne)
	
	Case of 
		: (FORM Event.code=On Begin Drag Over)
			$ID:=(($ligne-1)*Form.UserPrefs.ParamsForm.NbrColonnes)+$colonne
			$ID:=tabID{$ID}
			This.glisserDeposer.surDebutGlisserCODED_ID($ID)
			
		: (FORM Event.code=On Double Clicked)
			$ID:=(($ligne-1)*Form.UserPrefs.ParamsForm.NbrColonnes)+$colonne
			$ID:=tabID{$ID}
			cs.$editeur.new().EditerSélection($ID; 0)
	End case 
	
	
	// ----------------------
	//MARK:Gestion formulaire
	// -----------------------
	
Function reDimensionner()
	// fixer le nombre de colonnes
	var $gauche; $haut; $droite; $bas; $width; $height; $nombre : Integer
	var $data : Object
	
	$data:=Form.UserPrefs
	
	// largeur de la ListBox
	OBJECT GET COORDINATES(*; This.nomLB; $gauche; $haut; $droite; $bas)
	// nombre de colonnes potentielles
	$width:=$droite-$gauche-15
	$nombre:=Int($width/$data.ParamsForm.TailleCellule)
	//  tailles min max en largeur, codées en dur !!!
	Case of 
		: ($nombre<2)
			$nombre:=2
		: ($nombre>6)
			$nombre:=6
	End case 
	
	If ($nombre=$data.ParamsForm.NbrColonnes)
		// modifier la largeur des colonnes
		$width:=$width/$nombre
		LISTBOX SET COLUMN WIDTH(*; This.nomLB; $width; $width; $width)
		LISTBOX SET ROWS HEIGHT(*; This.nomLB; $width; lk pixels)
		
	Else 
		Use ($data.ParamsForm)
			$data.ParamsForm.NbrColonnes:=$nombre
		End use 
		This.CréerMatriceImages()
		
		// modifier la largeur des colonnes
		$width:=$data.ParamsForm.TailleCellule
		LISTBOX SET COLUMN WIDTH(*; This.nomLB; $width; $width; $width)
		LISTBOX SET ROWS HEIGHT(*; This.nomLB; $width; lk pixels)
	End if 
	
	// fixer le nombre de lignes
	$height:=$bas-$haut
	$Nombre:=Int($height/($data.ParamsForm.TailleCellule))  //nbre lignes
	//  tailles min max en largeur, codées en dur !!!
	Case of 
		: ($nombre<1)
			$nombre:=1
		: ($nombre>5)
			$nombre:=5
	End case 
	
	If ($nombre=$data.ParamsForm.NbrLignes)
	Else 
		Use ($data.ParamsForm)
			$data.ParamsForm.NbrLignes:=$nombre
		End use 
	End if 
	
	
Function MettreAjour($param : Object)
	// appel de l'extérieur
	var $i; $j; $itemRef; $détail; $sousListe; $style; $icône : Integer
	var $itemText; $dossier; $libellé : Text
	var $saisissable; $déployé : Boolean
	var $image : Picture
	var $ptrCol : Pointer
	var $params; $entité : Object
	
	$itemRef:=$param.refItem
	Case of 
		: (cs._cfct.me.estIDcodeDeClasses($itemRef; [ds.Medias]))
			// mettre à jour la vignette
			$entité:=ds.Medias.get($itemRef & 0x00FFFFFF)
			$image:=This.CréerImagette($entité)
			
			// mettre à jour dans le tableau tabImages
			// si pas trouvé , l'image est dans {0}
			tabImages{indexTableau(Find in array(tabID; $itemRef))}:=$image
			ASSERT(Picture size(tabImages{0})=0; Current method name+" MettreAjour : imagette non trouvée")
			
			If (Find in array(tabID; $itemRef)>0)
				// le media est affiché : mettre à jour l'affichage
				For ($i; 1; Size of array(tabIDentités))
					$j:=Find in array(tabIDentités{$i}; $itemRef)
					If ($j#-1)
						$ptrCol:=Get pointer("ColonnePict"+String($i))
						$ptrCol->{$j}:=$image
						
						// arrêter
						$i:=1+Size of array(tabIDentités)
					End if 
				End for 
				
			Else 
				// 2 cas : 1) le media a été créé, 2) il existe déjà et est affiché ou pas 
				// dans tous les cas, on affiche l'élément
				This.AjouterEntité($entité)
				// re construire les tableaux affichés
				This.CréerMatriceImages()
			End if 
			
			// mettre à jour la LH
			Form.ModifierFichier($entité.leFichier.first())
			
		: (cs._cfct.me.estIDcodeDeClasses($itemRef; [ds.Dossiers]))
			$entité:=ds.Dossiers.get($itemRef & 0x00FFFFFF)
			
			If (($entité.volume>-1) & ($entité.volume<82))
				// un volume de la BDD : tout récréer
				This.NouvelleSélection()
				
			Else 
				// un sous dossier
				// créer le sous-dossier sur le disque dur
				$itemText:=$entité.nom
				$dossier:=$entité.LeChemin("")
				ErrorNum:=0
				CREATE FOLDER($dossier)
				// créer le sous élément à l'élément sélectionné de la LH
				If (ErrorNum=0)
					$i:=Selected list items(listeMedias)
					// récupérer sa sous liste
					GET LIST ITEM(listeMedias; $i; $j; $libellé; $détail; $déployé)
					// le nouvel élément à une sous liste vide de base !
					$sousListe:=New list
					// ajouter à la sous liste
					APPEND TO LIST($détail; $itemText; $itemRef; $sousListe; True)
					GET LIST ITEM PROPERTIES(listeMedias; $itemRef; $saisissable; $style; $icône)
					SET LIST ITEM PROPERTIES($détail; 0; $saisissable; $style; $icône)
					
				Else 
					$dossier:=""
					$params:=ds.Dossiers.query("ID = :1"; $entité.ID)
					Supprimer De DataStore(imk Dossier; $params)
				End if 
			End if 
	End case 
	
	
	// ----------------------
	//MARK:Gestion LH
	// -----------------------
	
Function NouvelleSélection()
	var $params : Object
	var $nomProc : Text
	var $numProc : Integer
	
	CLEAR LIST(listeMedias; *)
	
	// paramètres de la fonction
	$params:=New object
	$params.tache:=This.registreTaches.Inscrire(New object("nomProcess"; Current process name; "nomTache"; This.nomTacheLH; "numProcessAppelant"; Current process))
	$params.tache.FixerTime(0)
	
	// exécuter
	cs.$serveurAPP.me.Executer(OB Class(This).name; "CréerHiérarchie"; $params)
	// le résultat est dans $params.reqRetour
	
	// créer la LH
	$params.reqRetour.Etat:=" "
	$params.reqRetour.déployée:=False
	// pour le retour, exécuter :
	$params.reqRetour.nomProcessAppelant:=Current process name
	$params.reqRetour.CallBack:="VisualiserSélection"
	
	$nomProc:="$ALV_process_CréationLH medias"
	This.process.TuerAvecNom($nomProc)
	
	$numProc:=New process(Formula(Créer Liste Hiérarchique).source; 0; $nomProc; $params.reqRetour)
	
	
Function CréerHiérarchie($params : Object)
	// ici on est sur le serveur ou la BDD mère
	var $sélection : Object
	
	$sélection:=ds.Dossiers.query("volume > -1")
	$sélection.CréerHiérarchie($params)
	// le résultat est dans $params
	
	
Function VisualiserSélection($params)
	// un process externe envoie une sélection à éditer
	listeMedias:=$params.LH
	// renvoyer la liste triée
	SORT LIST(listeMedias; >)
	
	
Function ModifierFichier($fichier : cs.FichiersEntity)
	// ajouter / modifier un fichier
	var $itemPos; $newRef; $détail : Integer
	var $dossier : cs.DossiersEntity
	var $itemText; $newText : Text
	var $pict : Picture
	
	$newText:=$fichier.nom
	$newRef:=$fichier.IDcodé()
	$itemPos:=List item position(listeMedias; $newRef)
	$pict:=$fichier.leMedia.icone
	
	If ($itemPos=0)
		// Ajouter l'élément dans le volume 0
		$dossier:=ds.Dossiers.query("volume = :1"; 0).first()
		$itemPos:=List item position(listeMedias; $dossier.IDcodé())
		GET LIST ITEM(listeMedias; $itemPos; $itemRef; $itemText; $détail)
		APPEND TO LIST($détail; $newText; $newRef)
		SET LIST ITEM ICON($détail; 0; $pict)
		
	Else 
		// Modifier l'élément existant
		SET LIST ITEM(listeMedias; $newRef; $newText; $newRef)
		SET LIST ITEM ICON(listeMedias; $newRef; $pict)
	End if 
	
	
Function DéplacerFichier($fichier : cs.FichiersEntity; $itemPos : Integer)
	// déplacer le fichier dans le dossier $itemPos de la LH
	var $newRef; $style; $itemRef; $détail : Integer
	var $itemText : Text
	var $saisissable : Boolean
	var $pict : Picture
	
	// supprimer $fichier de la LH
	$newRef:=$fichier.IDcodé()
	GET LIST ITEM PROPERTIES(listeMedias; $newRef; $saisissable; $style)
	DELETE FROM LIST(listeMedias; $newRef)
	
	// ajouter $fichier à $itemPos
	GET LIST ITEM(listeMedias; List item position(listeMedias; $itemPos); $itemRef; $itemText; $détail)
	// la sous-liste existe toujours (même si le dossier est vide)
	APPEND TO LIST($détail; $fichier.nom; $newRef)
	SET LIST ITEM PROPERTIES($détail; 0; $saisissable; $style; 0)
	$pict:=$fichier.leMedia.icone
	SET LIST ITEM ICON($détail; 0; $pict)
	
	
	// ----------------------
	//MARK:Gestion LB
	// -----------------------
	
Function NouveauxTableaux($params : Object)
	// point d'entrée général
	// $params contient le nom de la fonction qui doit créer la sélection de media
	
	$params.nomTache:=This.nomTacheLB
	$params.initProcess:=Formula(InitProcessThreadSafe)
	$params.IDgroupe:=This.session.user.IDfamille
	cs.$process.new().NouveauProcess(cs.MediasPalette; "CréerTableaux"; $params)
	
	
Function CréerTableaux($params : Object)
	
	$params.tache:=This.registreTaches.Inscrire(New object("nomProcess"; Current process name; "nomTache"; $params.nomTache; "numProcessAppelant"; $params.numProcessAppelant))
	
	// exécuter
	cs.$serveurAPP.me.Executer(OB Class(This).name; $params.functionID; $params)
	// le résultat est dans $params.reqRetour
	
	This.sélection:=$params.reqRetour.sélection
	
	// le serveur a envoyé des images blobées; les restituer
	This.RestituerVignettes()
	// créer les tableaux de la LBox
	This.CréerImagettes($params)
	
	$params.tache.DésInscrire()
	
	
Function GetData($params : Object)
	// ici on est sur le serveur, ou BDD mère
	var $sélection : cs.MediasSelection
	
	Case of 
		: (OB Is defined($params; "motCle"))
			// on veut les medias dont infos contient un mot clé
			$sélection:=ds.Medias.query("titre = :1 || motsClé = :2"; "@"+$params.motCle+"@"; "@"+$params.motCle+"@")  //. || = or
			
		: (OB Is defined($params; "fichiers"))
			// on veut les medias d'une collection de ID
			$sélection:=ds.Fichiers.query("ID IN :1"; $params.fichiers).leMedia
			
		: (OB Is defined($params; "selectionReduite"))
			// on veut les medias d'une collection d'ID
			$sélection:=ds.Medias.query("ID in :1"; $params.selectionReduite)
			
		Else 
			// on prend tout
			$sélection:=ds.Medias.all()
	End case 
	
	// filtrer les données privées
	$sélection:=$sélection.query("private = :1 OR private = :2"; 0; $params.IDgroupe)
	// lire les données
	$sélection.GetData($params)
	// le résultat est dans $params
	
	
Function RestituerVignettes()
	var $objet : Object
	var $image : Picture
	
	// restaurer l'image de chaque objet
	For each ($objet; This.sélection)
		SET BLOB SIZE($blob; 0)
		BASE64 DECODE($objet.vignette; $blob)
		BLOB TO VARIABLE($blob; $image)
		$objet.vignette:=$image
	End for each 
	
	
Function CréerImagettes($params : Object)
	// attention ici on est dans un process extérieur
	var $élément : Object
	var $taille : Integer
	
	// trier les medias
	This.Trier()
	
	// créer les imagettes dans un dossier temporaire (userSpace)
	This.dossierTravail.delete(Delete with contents)
	This.dossierTravail.create()
	
	$taille:=This.session.prefs.Palettes["Palette_3015"].ParamsForm.TailleImage
	ARRAY PICTURE(tabImages; 0)
	ARRAY LONGINT(tabID; 0)
	ARRAY TEXT(tabTitre; 0)
	ARRAY DATE(tabDate; 0)
	// compteur de paquets de 24 (4 lignes de 6)
	tabID{0}:=24
	
	For each ($élément; This.sélection) While (Not($params.tache.Tuer.signaled))
		This.AjouterElement($élément)
		
		If ($élément.index>tabID{0})
			// envoyer ce paquet
			This.postTableaux($params)
			
			// la suite
			tabID{0}:=tabID{0}+500
		End if 
		
		$params.tache.FixerTime(10000*($élément.index+1)/This.sélection.length)
	End for each 
	
	// renvoyer les tableaux complets
	This.postTableaux($params)
	// nettoyer
	This.dossierTravail.delete(Delete with contents)
	
	
Function AjouterElement($élément : Object)
	var $image : Picture
	
	$image:=This.CréerImagette($élément)
	APPEND TO ARRAY(tabImages; $image)
	APPEND TO ARRAY(tabID; $élément.IDcodé)
	APPEND TO ARRAY(tabTitre; $élément.titre)
	APPEND TO ARRAY(tabDate; $élément.dateNum)
	
	
Function AjouterEntité($entité : Object)
	var $params : Object
	
	$params:=New object
	$params.selectionReduite:=New collection($entité.ID)
	$params.IDgroupe:=This.session.user.IDfamille
	$params.numProcessAppelant:=-1
	$params.tache:="AjouterAtableauPaletteMedias"
	
	// récupérer les infos du media,  exécuter
	cs.$serveurAPP.me.Executer(OB Class(This).name; "GetData"; $params)
	// le résultat est dans $params.reqRetour
	This.sélection:=$params.reqRetour.sélection
	
	// le serveur a envoyé des images blobées; les restituer
	This.RestituerVignettes()
	
	// ajouter au tableau
	This.AjouterElement(This.sélection[0])
	
	
Function postTableaux($params : Object)
	// renvoyer la main à l'appelant
	var $numProc : Integer
	var $data : Object
	
	$numProc:=$params.numProcessAppelant
	Case of 
		: (Process activity.processes.query("number = :1"; $numProc).length=0)
		: (Process activity.processes.query("number = :1"; $numProc)[0].status<0)
			// palette fermée
			
		Else 
			// transmettre au process demandeur les tableaux
			$data:=New object
			OB SET ARRAY($data; "tabImages"; tabImages)
			OB SET ARRAY($data; "tabID"; tabID)
			OB SET ARRAY($data; "tabTitre"; tabTitre)
			OB SET ARRAY($data; "tabDate"; tabDate)
			
			// appeler un worker non thread-safe, mais ne pas utiliser explicitement le nom la méthode non thread-safe 
			CALL WORKER("WK_Services"; Appeler Le Formulaire; $numProc; "getTableaux"; $data)
	End case 
	
	
Function getTableaux($params : Object)
	// un process externe envoie des tableaux à éditer
	OB GET ARRAY($params; "tabImages"; tabImages)
	OB GET ARRAY($params; "tabID"; tabID)
	OB GET ARRAY($params; "tabTitre"; tabTitre)
	OB GET ARRAY($params; "tabDate"; tabDate)
	
	// trier comme demandé
	Form.TrierTableaux()
	// afficher les tableaux
	Form.CréerMatriceImages()
	
	
Function CréerMatriceImages()
	// créer les tableaux image de la ListBox, en fonction de la taille du formulaire
	// dans le principe, on commence par agrandir / diminuer la taille des imagettes
	// et au delà / en deçà d'une taille, on augmente / diminue le nombre de colonnes
	var $nombre; $width; $i; $j : Integer
	var $data : Object
	var $ptrCol; $ptrNull : Pointer
	var $image : Picture
	
	ARRAY LONGINT(tabIDentités; 0; 0)
	ARRAY PICTURE(ColonnePict1; 0)
	ARRAY PICTURE(ColonnePict2; 0)
	ARRAY PICTURE(ColonnePict3; 0)
	ARRAY PICTURE(ColonnePict4; 0)
	ARRAY PICTURE(ColonnePict5; 0)
	ARRAY PICTURE(ColonnePict6; 0)
	
	$data:=Form.UserPrefs
	
	// afficher '$data.ParamsForm.NbrColonnes' colonnes
	// fixer le nombre de colonnes de la LB
	$nombre:=LISTBOX Get number of columns(*; This.nomLB)
	Case of 
		: ($data.ParamsForm.NbrColonnes<$nombre)
			// supprimer les colonnes en trop
			LISTBOX DELETE COLUMN(*; This.nomLB; $data.ParamsForm.NbrColonnes+1; $nombre-$data.ParamsForm.NbrColonnes)
			
		: ($data.ParamsForm.NbrColonnes>$nombre)
			// ajouter des colonnes
			$width:=$data.ParamsForm.TailleCellule
			For ($j; $nombre+1; $data.ParamsForm.NbrColonnes)
				$ptrCol:=Get pointer("ColonnePict"+String($j))
				//%W-518.5
				ARRAY PICTURE($ptrCol->; 0)
				//%W+518.5
				$ptrNull:=Get pointer("")
				LISTBOX INSERT COLUMN(*; This.nomLB; $j; "ColonnePict"+String($j); $ptrCol->; "Entête"+String($j); $ptrNull)
				LISTBOX SET COLUMN WIDTH(*; "ColonnePict"+String($j); $width; $width; $width)
				LISTBOX SET ROWS HEIGHT(*; "ColonnePict"+String($j); $width; lk pixels)
			End for 
			
		Else 
			// égalité, c'est ok
	End case 
	$nombre:=LISTBOX Get number of columns(*; This.nomLB)
	
	// raz
	ARRAY LONGINT(tabIDentités; $data.ParamsForm.NbrColonnes; 0)
	For ($j; 1; $nombre)
		$ptrCol:=Get pointer("ColonnePict"+String($j))
		//%W-518.5
		ARRAY PICTURE($ptrCol->; 0)
		//%W+518.5
	End for 
	
	// ventiler le tableau des imagettes vers les colonnes de la LB
	For ($i; 1; Size of array(tabImages))
		// numéro de la colonne
		$j:=($i-1)%$nombre  // $j compris entre 0 et $Nombre -1
		$j:=$j+1
		$ptrCol:=Get pointer("ColonnePict"+String($j))
		APPEND TO ARRAY($ptrCol->; tabImages{$i})
		APPEND TO ARRAY(tabIDentités{$j}; tabID{$i})
	End for 
	// la listBox affiche des colonnes de même taille !
	// finir les tableaux avec une image vide
	If ($j#$nombre)
		CLEAR VARIABLE($image)
		For ($i; $j+1; $Nombre)
			$ptrCol:=Get pointer("ColonnePict"+String($i))
			APPEND TO ARRAY($ptrCol->; $image)
		End for 
	End if 
	
	// formater
	For ($j; 1; $nombre)
		$ptrCol:=Get pointer("ColonnePict"+String($j))
		OBJECT SET FORMAT($ptrCol->; String(Scaled to fit prop centered))
		OBJECT SET DRAG AND DROP OPTIONS($ptrCol->; True; True; False; False)
	End for 
	
	
	// ----------------------
	//MARK:Utilitaires
	// -----------------------
	
Function TrierTableaux()
	// tri synchronisé des tableaux
	var $cléTri : Integer
	
	$cléTri:=This.session.prefs.Palettes["Palette_3015"].ParamsForm.ChoixTri
	Case of 
		: ($cléTri=1)
			SORT ARRAY(tabTitre; tabID; tabImages; tabDate; >)
			
		: ($cléTri=2)
			SORT ARRAY(tabDate; tabTitre; tabID; tabImages; >)
			
		: ($cléTri=3)
			SORT ARRAY(tabID; tabDate; tabTitre; tabImages; >)
			
		Else 
			// oops
	End case 
	
	
Function CréerImagette($objet : Object)->$image : Picture
	// créer l'imagette du media $1
	var $itemText : Text
	var $params : Object
	
	$itemText:=This.dossierTravail.platformPath+String($objet.ID)+"_Imagette_tempo.png"
	WRITE PICTURE FILE($itemText; $objet.vignette; "image/png")
	
	$params:=New object("url"; "file:///"+This.fct.ConvertirPathVersURL($itemText; False; True); "Format"; Get XML data source; "length"; 32; "nbrMaxLignes"; 2)
	$itemText:="("+String($objet.ID)+") "+$objet.titre
	
	cs._cfct.me.MultiLignerTexte($itemText; $params)
	cs._cfct.me.TraiterTemplateSVG("ImagetteDeMedia.xml"; ->$image; $params)
	
	
Function FichiersDeListeH($liste : Integer; $init : Boolean)
	var $i; $itemRef; $copieListe; $détail : Integer
	var $ItemText : Text
	var $déployé : Boolean
	
	If (Count parameters=1)
		// inititialisation
		This.Fichiers:=New collection
		$copieListe:=Copy list($liste)
		
		// lancer l'analyse
		This.FichiersDeListeH($copieListe; False)
		CLEAR LIST($copieListe)
		
	Else 
		
		// nbre total d'éléments (déployés ou non)
		For ($i; 1; Count list items($liste; *))
			GET LIST ITEM($liste; $i; $itemRef; $ItemText; $détail; $déployé)
			Case of 
				: (CodeEnreg($itemRef; [Table(->[Fichiers])])=1)
					This.Fichiers:=This.Fichiers.push($itemRef & 0x00FFFFFF)
					
				: ((CodeEnreg($itemRef; [Table(->[Dossiers])])=1) & Is a list($détail))
					SET LIST ITEM($liste; $itemRef; $ItemText; $itemRef; $détail; True)
					This.FichiersDeListeH($détail; False)
			End case 
		End for 
	End if 
	
	
Function Trier()
	var $cléTri : Integer
	
	$cléTri:=This.session.prefs.Palettes["Palette_3015"].ParamsForm.ChoixTri
	Case of 
		: ($cléTri=1)
			This.sélection.orderBy("titre asc")
			
		: ($cléTri=2)
			This.sélection.orderBy("dateNum asc")
			
		: ($cléTri=3)
			This.sélection.orderBy("ID asc")
			
		Else 
			// oops
	End case 
	
	
Function dossierImagettes()->$result : 4D.Folder
	$result:=This.document.GetSessionFolder().folder("PaletteMedia")

⇧ [class]$servicesEditeur - 08/06/2026 09:56:52

      property xml : cs.xSDK.XML
property dossierTravail; dossierDestination; dossierDestinationComponents; dossierMatriceComposants : 4D.Folder
property buildSettings : 4D.File
property ProcInProgress; DonnéesExportSiteWeb; Progress : Object
property VersionDataALV; VersionDataALV_FTP; VersionApplicationALV; IDversionApplicationALV; SystèmeVersion : Text
property pathDossierDestination; pathDossierAPP : Text
property CréerServeur; ExporterMiseAjour; ExporterInstallateur; CréerApplication : Boolean
property listeDossiersMedia : Collection
property nomTacheAPP : Text:="Génération_APP"
property nomTacheSRV : Text:="GénérerSRV_ALV"
property nomTacheEXP : Text:="ExporterDATA_ALV"

Class extends $formulaire

// fonctions d'exportation de la BDD mère
Class constructor()
	var $chemin : Text:=""
	
	Super()
	
	This.rsc.SetObjet(Est Ressource APP; "Versionnage/Data/Format_Fichier"; Is text; This; "VersionDataALV")
	This.VersionDataALV_FTP:=Replace string(This.VersionDataALV; "."; "_")
	This.VersionApplicationALV:=This.environnement.LireVersionAPP()
	This.IDversionApplicationALV:=This.environnement.FixerIDversionAPP()
	This.SystèmeVersion:=This.environnement.infoPlateForme().nom
	
	This.xml:=cs.xSDK.XML.me
	
	This.ProcInProgress:=New object
	This.ProcInProgress.numProcess:=-1
	
	// créer le dossier de travail
	// lire le nom de la version générée
	$chemin:="ALV "+This.VersionApplicationALV  // nom versionné du dossier de l'application générée
	// pb de compression du dossier quand ce dossier est parmi ceux de Dossier4D (pb de droit d'accès?) pour l'instant on se met dans le compte utilisateur
	This.dossierTravail:=Folder(System folder(Documents folder); fk platform path).folder(This.fct.FormaterHTML($chemin))
	
	
Function FixerParamètres($params : Object)
	// $params = paramètres de menu
	Super.FixerParamètres($params)
	This.informations.nomForm:="U_Formulaire?3100"
	
	This.DonnéesExportSiteWeb:=New object
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	
	ASSERT(cs.$trace.me.DebugerEventForm(Current method name; "EventForm"; New object("numEvent"; FORM Event.code)))
	
	// traitements génériques
	This.surEvenementFormulaire()
	
	Case of 
		: (FORM Event.code=On Load)
			// charger les objets
			This.onEndLoad()
			
			Form.AfficherLaPage()
			
		: (FORM Event.code=On Page Change)
			Form.AfficherLaPage()
			
		: (FORM Event.code=On Timer)
			// dans l'ordre
			This.SuivreCréationSiteWeb()
			cs.$processData.me.AfficherProgressionTache()
			
		: (FORM Event.code=On Unload)
			Form.dossierTravail.delete(Delete with contents)
	End case 
	
	
Function onEndLoad()
	var $c : Collection
	
	$c:=New collection("choix")
	$c.combine(["DonnéesExportSiteWeb"])
	$c.combine(["DossierApplication"])
	$c.combine(["Dossier_Serveurs_ALV"; "PathDossierInstallMaJ"])
	$c.combine(["DossierBDDdata"; "DossierWEBMedias"; "ExporterDonnées"])
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:FORMevents Page Fond
	// ----------------------
	
Function _FORM_choix()
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=New object
			
			Case of 
				: (This.session.prefs.Session_Etat ?? 6)
					Form[This.nomOBJ].values:=New collection(Localized string("10300"); Localized string("10301"); Localized string("10302"); Localized string("10303"))
					Form[This.nomOBJ].index:=0
					Form.Pages:=New collection(1; 2; 3; 4)
					
				: (User in group(Current user; "Archivage"))
					Form[This.nomOBJ].values:=New collection(Localized string("10300"); Localized string("10303"))
					Form[This.nomOBJ].index:=0
					Form.Pages:=New collection(1; 4)
					
				: (User in group(Current user; "Développement"))
					Form[This.nomOBJ].values:=New collection(Localized string("10301"); Localized string("10302"))
					Form[This.nomOBJ].index:=0
					Form.Pages:=New collection(2; 3)
			End case 
			FORM GOTO PAGE(Form.Pages[Form[This.nomOBJ].index])
			
		: (FORM Event.code=On Clicked)
			// en réalité, pas utile. Il existe une action4D gotopage
			FORM GOTO PAGE(Form.Pages[Form[This.nomOBJ].index])
	End case 
	
	
	// ----------------------
	//MARK:FORMevents Page SiteWeb
	// ----------------------
	
Function SuivreCréationSiteWeb()
	var $data : Object
	
	Form.DonnéesExportSiteWeb:=Form.DonnéesExportSiteWeb
	$data:=Form.DonnéesExportSiteWeb
	Case of 
		: (Not(FORM Get current page=1))
		: ($data.ProcInProgress.numProcess=-1)
			// tache composant non démarrée
		: (cs.$processData.me.existeTache($data.nomTache))
			// suivi de la tache en cours
		Else 
			// activer le suivi de la tache composant
			cs.$processData.me.FixerTache(Current process name; New object("nomTache"; $data.nomTache; "activerThermometre"; True))
	End case 
	
	
	// ----------------------
	//MARK:FORMevents Page APP
	// ----------------------
	
Function _FORM_ExporterAPP()
	var $params : Object
	
	Case of 
		: (FORM Event.code=On Clicked)
			$params:=New object
			$params.buildSettings:=Folder(fk resources folder).folder("Preferences").file("buildAppAPP.4DSettings")
			$params.CréerServeur:=False
			$params.ExporterMiseAjour:=True
			$params.CréerApplication:=True
			
			This.GénérerSRV_ALV($params)
	End case 
	
	
Function _FORM_ExporterMiseAjourAPP()
	var $params : Object
	
	Case of 
		: (FORM Event.code=On Clicked)
			$params:=New object
			$params.buildSettings:=Folder(fk resources folder).folder("Preferences").file("buildAppAPP.4DSettings")
			$params.CréerServeur:=False
			$params.ExporterMiseAjour:=True
			$params.CréerApplication:=False
			
			This.GénérerSRV_ALV($params)
	End case 
	
	
Function _FORM_DossierApplication()
	var $host : Text:=""
	var $racine : Text:=""
	var $texte : Text:=""
	var $rsc : cs.xSDK.ResourceALV
	
	$rsc:=cs.xSDK.ResourceALV.me
	
	Case of 
		: (FORM Event.code=On Load)
			$rsc.SetVariable(Est Ressource HOST; "Chemins/Installateurs/URL"; Is text; ->$texte)
			Form[This.nomOBJ]:=$texte
			OBJECT SET RGB COLORS(*; This.nomOBJ; Storage.System.schemaCouleurPolice)
			
			$rsc.SetVariable(Est Ressource HOST; "Chemins/Installateurs/Path"; Is text; ->$texte)
			This._AfficherPath($texte)
			
		: (FORM Event.code=On Data Change)
			$texte:=This._FormaterURL("/"+Form[This.nomOBJ]+"/")
			$rsc.SetResourceALV(Est Ressource HOST; "Chemins/Installateurs/URL"; ->$texte)
			
			// le chemin est relatif au chemin de la racine Web (pas connu de l'utilisateur)
			// créer le chemin complet (ajout du chemin de dossier racine HTML)
			Case of 
				: (Not($rsc.SetVariable(Est Ressource HOST; "Chemins/RacineHOST"; Is text; ->$host)))
				: (Not($rsc.SetVariable(Est Ressource HOST; "Chemins/RacineHTML"; Is text; ->$racine)))
				Else 
					$texte:=$host+$racine+$texte+"/"
					$texte:=This._FormaterURL($host+$racine+$texte+"/")
					$rsc.SetResourceALV(Est Ressource HOST; "Chemins/Installateurs/Path"; ->$texte)
					
					This._AfficherPath($texte)
			End case 
	End case 
	
	
Function _FORM_VersionDataALV()
	var $texte : Text:=""
	
	Case of 
		: (FORM Event.code=On Data Change)
			$texte:=Form[This.nomOBJ]
			cs.xSDK.ResourceALV.me.SetResourceALV(Est Ressource APP; "Versionnage/Data/Format_Fichier"; ->$texte)
	End case 
	
	
	// ----------------------
	//MARK:FORMevents Page ServeurAPP
	// ----------------------
	
Function _FORM_Dossier_Serveurs_ALV()
	var $dossier : Text:=""
	
	Case of 
		: (FORM Event.code=On Load)
			cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Serveurs_ALV/Dossier_Serveurs_ALV"; Is text; ->$dossier)
			Form[This.nomOBJ]:=Substring($dossier; 1; Length($dossier)-1)
			
			This.APP_PassePremierPlan()
			
			
		: (FORM Event.code=On Double Clicked)
			// chemin d’accès mémorisé par 4D en 2
			$dossier:=Select folder(cs._cfct.me.LireLocatedSTR(5092; New object("param_1"; "Serveur APP"; "param_2"; "d'installation")); 2; Use sheet window)
			If (Length($dossier)>0)
				Form[This.nomOBJ]:=Substring($dossier; 1; Length($dossier)-1)  // afficher le nom du dossier
				OBJECT SET RGB COLORS(*; This.nomOBJ; Storage.System.schemaCouleurPolice)
				
				cs.xSDK.ResourceALV.me.SetResourceALV(Est Ressource APP; "Serveurs_ALV/Dossier_Serveurs_ALV"; ->$dossier)
				// pour la DOC
				$dossier:=Convert path system to POSIX($dossier)
				// si on n'est pas sur la machine serveur, $dossier commence par Volumes ; remplacer par User (cf DOC)
				$dossier:=Replace string($dossier; "Volumes"; "Users")
				cs.xSDK.ResourceALV.me.SetResourceALV(Est Ressource APP; "Serveurs_ALV/URL_Serveurs_ALV"; ->$dossier)
			End if 
	End case 
	
	
Function _FORM_ExporterSRV()
	var $params : Object
	
	Case of 
		: (FORM Event.code=On Clicked)
			$params:=New object
			$params.buildSettings:=Folder(fk resources folder).folder("Preferences").file("buildAppSRV.4DSettings")
			$params.CréerServeur:=True
			$params.ExporterInstallateur:=True
			$params.ExporterMiseAjour:=False
			$params.CréerApplication:=False
			
			$params.nomTache:=This.nomTacheSRV
			
			This.GénérerSRV_ALV($params)
	End case 
	
	
Function _FORM_ExporterSRV_debug()
	var $params : Object
	
	Case of 
		: (FORM Event.code=On Clicked)
			$params:=New object
			$params.ComposantsCompilés:=False
			
			$params.nomTache:=This.nomTacheSRV
			
			This.ExporterSRVdebug($params)
	End case 
	
	
Function _FORM_PathDossierInstallMaJ()
	var $texte : Text:=""
	
	Case of 
		: (FORM Event.code=On Load)
			cs.xSDK.ResourceALV.me.SetVariable(Est Ressource HOST; "Chemins/UpdateFiles/Path"; Is text; ->$texte)
			Form[This.nomOBJ]:=$texte
	End case 
	
	
Function _FORM_ExporterMiseAjourSRV()
	var $params : Object
	
	Case of 
		: (FORM Event.code=On Clicked)
			$params:=New object
			$params.buildSettings:=Folder(fk resources folder).folder("Preferences").file("buildAppSRV.4DSettings")
			$params.CréerServeur:=True
			$params.ExporterInstallateur:=False
			$params.ExporterMiseAjour:=True
			
			$params.nomTache:=This.nomTacheSRV
			
			This.GénérerSRV_ALV($params)
			$params.CréerApplication:=False
	End case 
	
	
	// ----------------------
	//MARK:FORMevents Page DATA
	// ----------------------
	
Function _FORM_DossierBDDdata()
	var $host : Text:=""
	var $racine : Text:=""
	var $texte : Text:=""
	var $rsc : cs.xSDK.ResourceALV
	
	$rsc:=cs.xSDK.ResourceALV.me
	
	Case of 
		: (FORM Event.code=On Load)
			$rsc.SetVariable(Est Ressource HOST; "Chemins/UpdateFiles/Dossier"; Is text; ->$texte)
			$texte:=Split string($texte; "/"; sk ignore empty strings).last()
			Form[This.nomOBJ]:=$texte
			OBJECT SET RGB COLORS(*; This.nomOBJ; Storage.System.schemaCouleurPolice)
			
			$rsc.SetVariable(Est Ressource HOST; "Chemins/UpdateFiles/Path"; Is text; ->$texte)
			This._AfficherPath($texte)
			
		: (FORM Event.code=On Data Change)
			$texte:=Form[This.nomOBJ]
			
			// le chemin est relatif au chemin de la racine Web (pas connu de l'utilisateur)
			// créer le chemin complet (ajout du chemin de dossier racine HTML)
			Case of 
				: (Not($rsc.SetVariable(Est Ressource HOST; "Chemins/RacineHOST"; Is text; ->$host)))
				: (Not($rsc.SetVariable(Est Ressource HOST; "Chemins/RacineDATA"; Is text; ->$racine)))
				Else 
					$texte:=This._FormaterURL($racine+Form[This.nomOBJ]+"/")
					$rsc.SetResourceALV(Est Ressource HOST; "Chemins/UpdateFiles/Dossier"; ->$texte)
					
					$texte:=This._FormaterURL($host+$texte)
					$rsc.SetResourceALV(Est Ressource HOST; "Chemins/UpdateFiles/Path"; ->$texte)
					
					This._AfficherPath($texte)
			End case 
	End case 
	
	
Function _FORM_DossierWEBMedias()
	var $texte : Text:=""
	var $dossier : Text:=""
	var $rsc : cs.xSDK.ResourceALV
	
	$rsc:=cs.xSDK.ResourceALV.me
	
	Case of 
		: (FORM Event.code=On Load)
			$rsc.SetVariable(Est Ressource HOST; "Chemins/Media/Dossier"; Is text; ->$texte)
			Form[This.nomOBJ]:=$texte
			
			This._AfficherPath($texte)
			
		: (FORM Event.code=On Data Change)
			$texte:=Form[This.nomOBJ]
			$rsc.SetResourceALV(Est Ressource HOST; "Chemins/Media/Dossier"; ->$texte)
			
			// créer l'URL du dossier des medias sur le site
			$dossier:="/media/"
			$rsc.SetResourceALV(Est Ressource HOST; "Chemins/Media/URL"; ->$dossier)
			
			// (la racine Web n'est pas connue de l'utilisateur)
			
			// créer le chemin FTP complet (ajout du chemin de la racine HTML)
			If ($rsc.SetVariable(Est Ressource HOST; "Chemins/RacineHTML"; Is text; ->$texte))
				$texte:=This._FormaterURL($texte+$dossier)
				$rsc.SetResourceALV(Est Ressource HOST; "Chemins/Media/Path"; ->$texte)
			End if 
			
			// créer l'URL du dossier des icons sur le site
			$dossier:="/icones/"
			$rsc.SetResourceALV(Est Ressource HOST; "Chemins/Icons/URL"; ->$dossier)
			
			// créer le chemin FTP complet du dossier des Icons
			If ($rsc.SetVariable(Est Ressource HOST; "Chemins/RacineHTML"; Is text; ->$texte))
				$texte:=This._FormaterURL($texte+$dossier)
				$rsc.SetResourceALV(Est Ressource HOST; "Chemins/Icons/Path"; ->$texte)
			End if 
	End case 
	
	
Function _FORM_ExporterDonnées()
	var $params : Object
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=False
			OBJECT SET VISIBLE(*; This.nomOBJ; This.session.user.estMembreDe_ConnexionServeurWeb)
			
		: (FORM Event.code=On Clicked)
			// mettre à jour les données sur l'herbergeur
			$params:=New object
			$params.nomTache:=This.nomTacheEXP
			
			This.ExporterDATA($params)
			Form[This.nomOBJ]:=False
	End case 
	
	
Function _FormaterURL($url : Text)->$result : Text
	// au cas où saisie incorrecte
	$result:=Replace string($url; "//"; "/")
	
	
Function _AfficherPath($texte : Text)
	// afficher
	Form[This.nomOBJ+"Path"]:=$texte
	
	
	// ----------------------
	//MARK:Actions formulaire
	// -----------------------
	
Function AfficherLaPage()
	// déclenche le contrôle de la progression
	
	Case of 
		: (FORM Get current page=1)
			// rappel : la tache est gérée par le composant
			cs.$processData.me.FixerTache(Current process name; New object("nomTache"; cs.xWEB.$maintenanceSite.new().nomTache; "activerThermometre"; True))
			
		: (FORM Get current page=2)
			cs.$processData.me.FixerTache(Current process name; New object("nomTache"; This.nomTacheAPP; "activerThermometre"; True))
			
		: (FORM Get current page=3)
			cs.$processData.me.FixerTache(Current process name; New object("nomTache"; This.nomTacheSRV; "activerThermometre"; True))
			
		: (FORM Get current page=4)
			cs.$processData.me.FixerTache(Current process name; New object("nomTache"; This.nomTacheEXP; "activerThermometre"; True))
	End case 
	
	
Function APP_PassePremierPlan()
	var $VarName : Text
	var $Error : Integer
	
	$VarName:="Dossier_Serveurs_ALV"
	$Error:=Test path name(This[$VarName]+Folder separator)
	OBJECT SET RGB COLORS(*; $VarName; (Storage.System.schemaCouleurPolice*Num($Error=Is a folder)+("Red"*Num(Not($Error=Is a folder)))))
	
	
	// ----------------------
	//MARK:Wrappers $generationAPP
	// -----------------------
	
Function GénérerSRV_ALV($params : Object)
	cs.$generationAPP.new().GénérerSRV_ALV($params)
	
	
Function ExporterSRVdebug($params : Object)
	cs.$generationAPP.new().ExporterSRVdebug($params)
	
	
Function ExporterDATA($params : Object)
	cs.$generationAPP.new().ExporterDATA($params)
	
	
	// ----------------------
	//MARK:Maintenance du serveurAPP
	// -----------------------
	
Function MiseAjourApplication()
	var $dataTexte : Text:=""
	var $fichier : 4D.File
	var $dossier : 4D.Folder
	var $data; $result : Object
	
	$result:=New object("Error"; 0; "ErrorDescription"; "")
	
	// demander au serveur FTP les mises à jour possibles
	// préparer les paramètres de la requête HTTP
	OB SET($data; "Format"; This.VersionDataALV_FTP; "Version"; This.SystèmeVersion)
	
	Case of 
		: (Not(This.ListerLesMajAPP($data).success))
			// le serveur n'a pas répondu (les erreurs sont traitées par le service Web)
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Démarrage [KO]"; Current method name; "lecture des mises à jour, pas de réponse serveur"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		: (($data.MisesAjour.MiseAjourApplication="") & ($data.MisesAjour.NouvelleVersionApplication=""))
			// pas de mise à jour
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Version actuelle "+This.IDversionApplicationALV+" [KO]"; Current method name; "Pas de mise à jour disponible sur le serveur"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		: (Num($data.MisesAjour.MiseAjourApplicationIDversion)<=Num(This.IDversionApplicationALV))
			// cette version est plus ancienne que la version actuelle
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Démarrage [KO]"; Current method name; "pas de nouvelle mise à jour"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		: (Not(This.AutoriserMaj()))
			// attendre
		Else 
			// c'est ok
			// télécharger la mise à jour dans un dossier d'installation
			// fixer le dossier d'installation (à l'emplacement standard d'installation des données user)
			This.rsc.SetVariable(Est Ressource APP; "Dossier_MiseAjour"; Is text; ->$dataTexte)
			This.document.Créer(Créer un dossier ALV; This.document.GetAppWorkSpace().path; New collection($dataTexte+"_APP"))
			$dossier:=This.document.dossier
			// si on ré installe la même mise à jour (cas debug en particulier), la présence de l'ancien dosier de MaJ empêche le dézip du nouveau
			// vider le dossier
			This.document.ViderLeContenu($dossier)
			
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Démarrage [OK]"; Current method name; "téléchargement de "+$data.MisesAjour.MiseAjourApplication; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
			// recevoir le fichier dans $result et le dézipper
			$data.numProcessAppelant:=Current process
			$data.typeAPP:="MiseAjour"
			$data.version:=This.VersionDataALV_FTP
			$data.IDnomFichier:=$data.MisesAjour.MiseAjourApplication
			$data.cheminDestination:=$dossier.platformPath
			$result:=This.TelechargerFichierAPP($data)
			$fichier:=$result.fichier
			
			// fichier reçu, on dézipe
			Case of 
				: (Not($result.success))
					$result:=This.ftp.dernierResult
				: (Not($fichier.exists))
					$result.Error:=-15068
					$result.ErrorDescription:="le fichier "+$fichier.platformPath+" n'a pas été téléchargé"
					// pas d'arrêt par l'utilisateur
				: (Not(This.document.DeArchiverZIP($fichier; $data).success))
					//: (Compresser Dossier(->$fichier; ".unzip"; New object("Options"; 0x0001))=False)
					// on n'a pas dé-zippé
					$result.Error:=-15071
					$result.ErrorDescription:="le fichier "+$fichier.platformPath+" n'est pas décompressé"
					// on a un dossier dé-zippé
				: (Not($data.dossier.exists))
					$result.Error:=-15072
					$result.ErrorDescription:="Absence du fichier "+$fichier.platformPath+" décompressé"
					
				Else 
					// tout est ok
					$result.Error:=0
					// $fichier contient le dossier dézippé de la MaJ
					$dossier:=$data.dossier
					// renommer le dossier
					$dataTexte:=$dossier.fullName
					$dataTexte:=Substring($dataTexte; 1; Position(" "; $dataTexte)-1)
					$dossier:=$dossier.rename($dataTexte+".app")
					
					// fixer le dossier de redémarrage
					SET UPDATE FOLDER($dossier.platformPath; True)
					CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log; msgk_mail]; "Re démarrage"; Current method name; "sur fichier "+$dossier.platformPath; New object("nomProcess"; Current process name; "numProcess"; Current process))
					// pour debug éventuel
					CALL WORKER(Worker Services; Formula(traceHandler); [msgk_mail]; "Ainsi La Vie - Maintenance"; Current method name; "Mise à jour de l'application (fichier "+$data.IDnomFichier+")"; New object("nomProcess"; Current process name; "numProcess"; Current process))
					// alea jacta est
					
					// purger les workers
					This.progress.TuerWorkers()
					
					RESTART 4D
			End case 
			// si ça se passe mal
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Mise à jour Application : erreur "+String($result.Error); Current method name; $result.ErrorDescription; New object("nomProcess"; Current process name; "numProcess"; Current process))
	End case 
	
	
Function ProgrammerMajAPP($data : Object)
	// renvoyer la méthode à faire exécuter par le planificateur de tâches
	var $params : Object:=New object()
	
	Case of 
			// filtrer les applications non concernées
		: (Storage.System.typeApplication#4D Serveur APP)
			// ne concerne que le serveur
		Else 
			// c'est ok, renvoyer les données
			
			$params:=New object("nomClass"; "$servicesEditeur"; "functionID"; "MiseAjourApplication"; "params"; New object)
			// heures d'été à minuit, heures d'hiver à 1h00
			$params.params.dateTache:=String(Add to date(Current date; 0; 0; 1); ISO date GMT; ?02:00:00?)
			// toutes les jours
			$params.params.période:=New object("jour"; 1; "seconde"; 0)
			// pas urgence
			$params.params.initialiser:=False
			
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Programmation"; Current method name; "tâche programmée (voir détails dans Logs)"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_log]; "Donnée"; Current method name; JSON Stringify($params))
	End case 
	// finalement
	$data.params:=$params
	
	
Function MiseAjourDonnées()
	var $result; $data : Object
	var $dossier : 4D.Folder
	var $dataTexte; $fichier; $fichierStructure : Text
	
	$result:=New object("Error"; 0; "ErrorDescription"; ""; "success"; True)
	
	// demander au serveur FTP les mises à jour possibles
	// préparer les paramètres de la requête HTTP
	OB SET($data; "Format"; This.VersionDataALV_FTP; "Version"; This.SystèmeVersion)
	Case of 
		: (Not(This.ListerLesMajAPP($data).success))
			// le serveur n'a pas répondu (les erreurs sont traitées par le service Web)
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Démarrage [KO]"; Current method name; "pas de nouvelle mise à jour"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		: ($data.MisesAjour.MiseAjourData="")
			// pas de mise à jour
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Démarrage [KO]"; Current method name; "Version actuelle "+This.SystèmeVersion+" ; pas de mise à jour disponible sur le serveur"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		: (Not(This.AutoriserMaj()))
			// attendre
		Else 
			// lire la version actuelle du fichier de données
			$fichier:=File(Data file; fk platform path).parent.name
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Recherche... [OK]"; Current method name; "le fichier de données courant est "+$fichier; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
			// lire le chemin de la dernière mise à jour pour cette plateforme
			// MiseAjourData est au format horodatage.zip
			$dataTexte:=Replace string($data.MisesAjour.MiseAjourData; ".zip"; "")
			
			// cette version est plus récente de la version locale (attention : non testable avec la BDD mère) v7.0.3 : il faut comparer les chaines ISO !
			If (This.environnement.LireVersionBDD($dataTexte)>This.environnement.LireVersionBDD($fichier))
				// c'est ok
				CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Nouvelle version [OK]"; Current method name; This.environnement.LireVersionBDD($dataTexte); New object("nomProcess"; Current process name; "numProcess"; Current process))
				
				// télécharger la mise à jour dans un dossier d'installation
				$dataTexte:=$data.MisesAjour.MiseAjourData
				// fixer le dossier d'installation (à l'emplacement standard d'installation des données user)
				$dossier:=This.document.GetDataFileFolder()
				
				// recevoir le fichier dans $fichier et le dézipper
				$data.numProcessAppelant:=Current process
				$data.typeAPP:="MiseAjour"
				$data.version:=This.VersionDataALV_FTP
				$data.IDnomFichier:=$dataTexte
				$data.cheminDestination:=$dossier.platformPath
				$result:=This.TelechargerFichierAPP($data)
				
				// fichier reçu, on dézipe
				Case of 
					: (Not($result.fichier.exists))
						// on n'a pas de fichier
						$result.Error:=-15042
						$result.ErrorDescription:="le fichier "+$result.fichier.platformPath+" n'est pas un document"
					: (Not(This.document.DeArchiverZIP($result.fichier; $data).success))
						// on n'a pas dé-zippé
						$result.Error:=-15071
						$result.ErrorDescription:="le fichier "+$result.fichier.platformPath+" n'est pas décompressé"
					: (Not($data.dossier.exists))
						// on n'a pas de dossier dé-zippé
						$result.Error:=-15072
						$result.ErrorDescription:="Absence du fichier "+$result.fichier.platformPath+" décompressé"
						
					Else 
						// tout est ok 
						// $fichier contient le dossier dézippé de la MaJ
						$dossier:=$data.dossier
						// chemin du fichier de données
						$fichier:=$dossier.platformPath+File(Data file; fk platform path).fullName
						
						// vérifier que le fichier est compatible du fichier de structure de cette version de l'APP
						ErrorNum:=0
						$fichierStructure:=Structure file
						VERIFY DATA FILE($fichierStructure; $fichier; Verify all; Timestamp log file name; Formula(errorHandler_checkData).source)
						$result.Error:=ErrorNum  // on a un fichier ok
						CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Vérification "+Choose($result.Error=0; "[OK]"; "[KO]"); Current method name; "fichier de données "+$fichier+", fichier de Structure "+$fichierStructure; New object("nomProcess"; Current process name; "numProcess"; Current process))
						
						// ici $fichier est le fichier data (.4DD) placé dans le dossier $dossier
						// *** mettre à jour  (va redémarrer l'application ou le serveur Web)
						Case of 
							: ($result.Error#0)
								$result.ErrorDescription:="Le fichier de données téléchargé ("+$data.MisesAjour.MiseAjourData+") n'est pas compatible avec l'application courante ou est corrompu"
								// nettoyer
								$dossier.parent.delete(Delete with contents)
								
							Else 
								// c'est ok partout
								$result.Error:=0
								// on y va
								CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log; msgk_mail]; "Maintenance - Mise à jour données"; Current method name; "le nouveau fichier "+$fichier+" va être ouvert"; New object("nomProcess"; Current process name; "numProcess"; Current process))
								// attendre que les messages partent...
								Waiting(10*60)
								OPEN DATA FILE($fichier)
								// à la fin de la méthode seulement : fermeture de 4D et ré-ouverture avec le nouveau fichier de données
						End case 
				End case 
				
				If ($result.Error#0)
					CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Maintenance - Mise à jour données, erreur n° "+String($result.Error); Current method name; $result.ErrorDescription; New object("nomProcess"; Current process name; "numProcess"; Current process))
				End if 
				
			Else 
				// cette version est plus ancienne que la version actuelle
				CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Maintenance - Pas de mise à jour Données disponible"; Current method name; "Mise à jour disponible : "+This.environnement.LireVersionBDD($dataTexte); New object("nomProcess"; Current process name; "numProcess"; Current process))
			End if 
	End case 
	
	
Function ProgrammerMajDATA($data : Object)
	// renvoyer la méthode à faire exécuter par le planificateur de tâches
	var $params : Object:=New object()
	
	Case of 
			// filtrer les applications non concernées
		: (Storage.System.typeApplication#4D Serveur APP)
			// ne concerne que le serveur
		Else 
			// c'est ok, renvoyer les données
			
			$params:=New object("nomClass"; "$servicesEditeur"; "functionID"; "MiseAjourDonnées"; "params"; New object)
			// cette nuit, après une éventuelle mise à jour de l'APP
			$params.params.dateTache:=String(Add to date(Current date; 0; 0; 1); ISO date GMT; ?02:15:00?)
			// tous les 8 jours
			$params.params.période:=New object("jour"; 8; "seconde"; 0)
			// pas urgence
			$params.params.initialiser:=False
			
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Programmation"; Current method name; "tâche programmée (voir détails dans Logs)"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_log]; "Donnée"; Current method name; JSON Stringify($params))
	End case 
	// finalement
	$data.params:=$params
	
	
Function ListerLesMajAPP($params : Object)->$result : Object
	// récupérer les dernières mises à jour au .Format de données et .Version de plateforme, disponibles sur le serveur FTP
	var $dataTexte : Text
	var $Elements; $format4DB : Collection
	
	$result:=ds.initResult()
	$params.MisesAjour:=New object
	
	$Elements:=New collection
	$format4DB:=New collection
	Case of 
			// on doit avoir au moins 2 données du demandeur
		: (($params.Format=Null) | ($params.Version=Null))
			$result.Error:=-15068
			$result.ErrorDescription:="Les données de l'application autonome sont incomplètes ($2 de "+Current method name+")"
			// lire le chemin sur l'hébergeur des mises à jour
		: (Not(This.ftp.FixerAccessMisesAjour($params).success))
			$result.Error:=-15067
			$result.ErrorDescription:="Dossier des mises à jour absent"
			
		Else 
			// c'est ok, on a tout
			
			// créer le chemin des mises à jour disponibles pour la version {1} demandée
			$dataTexte:=$params.Format
			$dataTexte:=This.fct.FormaterHTML($dataTexte)
			$params.urlDossierFormat:=$params.urlDossier+$dataTexte+"/"
			Case of 
				: (Not(This.ftp.existsParamètres))
					// lister les fichiers de mise à jour existant
				: (Not(This.ftp.ListerLesDocuments($params.urlDossierFormat; ->$Elements).success))
					// lister les dossiers de version disponibles
				: (Not(This.ftp.ListerLesDocuments($params.urlDossier; ->$format4DB).success))
					
				Else 
					// on a tous les fichiers .zip de mise à jour
					// trier par ordre décroissant de date
					$Elements:=$Elements.orderBy("nom desc")
					$format4DB:=$format4DB.orderBy("nom desc")
			End case 
	End case 
	
	// mises à jour application autonome, est au format APP_IDplateforme_IDversion.zip
	$params.MisesAjour.MiseAjourApplication:=""
	Case of 
			// on n'a pas d'erreur
		: ($Elements.length=0)
			// on a une application candidate (nom contenant APP et nomOS_)
		: ($Elements.query("nom = :1"; "APP_"+$params.Version+"_@").length=0)
			
		Else 
			// on a une mise à jour supérieure
			$dataTexte:=$Elements.query("nom = :1"; "APP_"+$params.Version+"_@").first().nom
			// nom du fichier
			$params.MisesAjour.MiseAjourApplication:=$dataTexte
			
			$dataTexte:=Replace string($dataTexte; "APP_"+$params.Version+"_"; "")
			$dataTexte:=Replace string($dataTexte; ".zip"; "")
			// version du fichier, F(ou B)XXYYZZ
			$params.MisesAjour.MiseAjourApplicationIDversion:=$dataTexte
	End case 
	
	// mises à jour fichier de données, est au format BDD_IDversion.zip
	$params.MisesAjour.MiseAjourData:=""
	Case of 
			// on n'a pas d'erreur
		: ($Elements.length=0)
			// on a un fichier de données (nom contenant BDD)
		: ($Elements.query("nom = :1"; "BDD@").length=0)
			
		Else 
			// tout est ok; on a une mise à jour data
			// nom du fichier
			$params.MisesAjour.MiseAjourData:=$Elements.query("nom = :1"; "BDD@").first().nom
	End case 
	
	// format de fichier plus récent
	$params.MisesAjour.NouvelleVersionApplication:=""
	Case of 
			// Remarque : les dossiers FTP ont des sous dossiers de navigation"." et "..". Avec le tri ils sont en fin de tableau (sauf si aucune version disponible)
			// on a des versions
		: ($format4DB.length=0)
		: ($format4DB[0].nom[[1]]#"v")
			// il existe un format plus récent que celui demandé
		: (Not($format4DB[0].nom=$params.Format))
			
		Else 
			// on a une version supérieure
			$params.MisesAjour.NouvelleVersionApplication:=$format4DB[0].nom
	End case 
	This._nettoyerResult($result)
	
	
Function AutoriserMaj()->$result : Boolean
	// renvoie vrai si aucune connexion utilisateur
	var $sélection : Object
	
	$sélection:=Process activity(Sessions only)
	Case of 
		: (Storage.System.typeApplication=ALV BDD mère)
			// test en debug
			$result:=(This.session.prefs.Session_Etat ?? 6)
			
		: ($sélection=Null)
			$result:=True
			
		: ($sélection["sessions"].query("type = :1"; "remote").length>0)
			$result:=False
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Mise à jour Application"; Current method name; "report de la mise à jour (au moins un utilisateur est connecté)"; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		Else 
			$result:=True
	End case 
	CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; "Mise à jour serveur"; Current method name; "autorisation mise à jour "+Choose($result; "[OK]"; "[KO]"); New object("nomProcess"; Current process name; "numProcess"; Current process))

⇧ [class]$formulaire_3119 - 08/05/2026 11:33:23

      Class extends $formulaire

Class constructor($params : Object)
	
	Super($params)
	
	
	
	
Function FixerParamètres($params : Object)
	// $params = paramètres de menu
	
	Super.FixerParamètres($params)
	This.informations.nomForm:="U_Formulaire?3119"
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	
	ASSERT(cs.$trace.me.DebugerEventForm(Current method name; "EventForm"; New object("numEvent"; FORM Event.code)))
	
	// traitements génériques
	This.surEvenementFormulaire()
	
	Case of 
		: (FORM Event.code=On Load)
			// charger les objets
			This.onEndLoad()
	End case 
	
	
Function onEndLoad()
	var $c : Collection
	
	$c:=New collection("choix"; "Debuger"; "grpSubOptTracesALV"; "grpSubOptTracesFORMevent"; "grpSubOptTraces4Ddebug"; "grpSubOptTraces4Ddiagnostic"; "pathImagesArbres"; "pathPhotoBDD_AG"; "Fichier4Drequetes"; "FichierReqORDA"; "DebugCode4D"; "grpWebOptServeurHTTP"; "grpWebOptServeurHTTPtest"; "grpWebOptServeurHTTPlocal"; "grpWebOptDebugerWebServeur")
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:FORMevents Page Fond
	// ----------------------
	
Function _FORM_choix()
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=New object
			
			Case of 
				: (This.session.prefs.Session_Etat ?? 6)
					Form[This.nomOBJ].values:=New collection(Localized string("10301"); Localized string("10101"); Localized string("10302"))
					Form[This.nomOBJ].index:=0
					Form.Pages:=New collection(1; 2; 3)
					
				: (Storage.System.typeApplication=ALV Client APP)
					Form[This.nomOBJ].values:=New collection(Localized string("10301"); Localized string("10302"))
					Form[This.nomOBJ].index:=1
					Form.Pages:=New collection(1; 3)
					
				: (Storage.System.typeApplication=4D Remote mode)
					Form[This.nomOBJ].values:=New collection(Localized string("10301"); Localized string("10302"))
					Form[This.nomOBJ].index:=1
					Form.Pages:=New collection(1; 3)
					
				Else 
					Form[This.nomOBJ].values:=New collection(Localized string("10301"); Localized string("10101"); Localized string("10302"))
					Form[This.nomOBJ].index:=0
					Form.Pages:=New collection(1; 2; 3)
					
			End case 
			FORM GOTO PAGE(Form.Pages[Form[This.nomOBJ].index])
			
			// on doit être BDDmère ou un client
			OBJECT SET ENABLED(*; "grpWebOptServeurHTTPtest"; (Storage.System.typeApplication=ALV BDD mère) | (Storage.System.typeApplication=ALV Client APP))
			// on doit être BDDmère
			OBJECT SET ENABLED(*; "grpWebOptServeurHTTPlocal"; (Storage.System.typeApplication=ALV BDD mère))
			// on doit être BDDmère ou serveur APP
			OBJECT SET ENABLED(*; "grpSrvOpt@"; (Storage.System.typeApplication=ALV BDD mère) | (Storage.System.typeApplication=ALV Serveur APP))
			
			
		: (FORM Event.code=On Clicked)
			FORM GOTO PAGE(Form.Pages[Form[This.nomOBJ].index])
	End case 
	
	
	// ----------------------
	//MARK:FORMevents Page Application
	// ----------------------
	
Function _FORM_Debuger()
	var $SessionStatus : Integer
	
	This.EditerPropriétéObjet(Est une Option binaire; This.session.prefs; "Session_Etat"; 6)
	This.setDebugServeurAPP()
	
	// propager l'état debug
	$SessionStatus:=This.session.prefs.Session_Etat
	SET ASSERT ENABLED($SessionStatus ?? 6)
	
	Case of 
		: (FORM Event.code=On Load)
			// initialiser les traces
			Form.TracesALV:=False
			
			// initialiser les traces détaillées
			Form.TracesALVdétail:=False
			
			Form.grpSubOptAGafficherConnexions:=This.session.prefs.Apparence.AG.ChoixDebug ?? 24
			Form.grpSubOptAGafficherID:=This.session.prefs.Apparence.AG.ChoixDebug ?? 26
			Form.grpSubOptAGstoreImages:=This.session.prefs.Apparence.AG.ChoixDebug ?? 27
			Form.grpSubOptAGviewerSVG:=This.session.prefs.Apparence.AG.ChoixDebug ?? 25
	End case 
	
	// on doit être en debug pour accéder à ces options
	OBJECT SET ENABLED(*; "grpSubOpt@"; $SessionStatus ?? 6)
	
	
Function _FORM_grpSubOptTracesALV()
	This.EditerPropriétéObjet(Est une Option binaire; This.session.prefs; "Session_Etat"; 8)
	
	
Function grpSubOptTracesFORMevent()
	This.EditerPropriétéObjet(Est une Option binaire; This.session.prefs; "Session_Etat"; 3)
	
	
Function _FORM_grpSubOptTraces4Ddebug()
	Case of 
		: (FORM Event.code=On Clicked)
			If (Form[This.nomOBJ])
				// tracer les temps, les paramètres de méthodes et le détail des commandes
				SET DATABASE PARAMETER(Debug log recording; 2+4+16)
				
			Else 
				SET DATABASE PARAMETER(Debug log recording; 0)
			End if 
	End case 
	
	
Function _FORM_grpSubOptTraces4Ddiagnostic()
	This.EditerPropriétéObjet(Est une Option binaire; This.session.prefs; "Session_Etat"; 14)
	
	If (This.session.prefs.Session_Etat ?? 14)
		// lancer le jounal du Diagnostique (dossier Log)
		SET DATABASE PARAMETER(Diagnostic log recording; 1)
		SET DATABASE PARAMETER(Diagnostic log level; Log debug)
	Else 
		SET DATABASE PARAMETER(Diagnostic log recording; 0)
	End if 
	
	
	// ----------------------
	//MARK:FORMevents Page Arbre
	// ----------------------
	
Function _FORM_pathImagesArbres()
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=Localized string("5169")+Char(CR ASCII code)
			Form[This.nomOBJ]:=Form[This.nomOBJ]+cs.$document.new().GetSessionFolder().platformPath+"Debug"+Folder separator+"AG"+Folder separator
	End case 
	
	
Function _FORM_pathPhotoBDD_AG()
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=Localized string("5170")+Char(CR ASCII code)
			Form[This.nomOBJ]:=Form[This.nomOBJ]+cs.$document.new().GetSessionFolder().platformPath+"Debug"+Folder separator+"AG"+Folder separator
	End case 
	
	
	// rappel : ces objets sont actifs si SessionStatus ?+ 6
Function _FORM_grpSubOptAGafficherConnexions()
	This.EditerPropriétéObjet(Est une Option binaire; This.session.prefs.Apparence.AG; "ChoixDebug"; 24)
	
	
Function _FORM_grpSubOptAGafficherID()
	This.EditerPropriétéObjet(Est une Option binaire; This.session.prefs.Apparence.AG; "ChoixDebug"; 26)
	
	
Function _FORM_grpSubOptAGviewerSVG()
	This.EditerPropriétéObjet(Est une Option binaire; This.session.prefs.Apparence.AG; "ChoixDebug"; 25)
	
	
Function _FORM_grpSubOptAGstoreImages()
	This.EditerPropriétéObjet(Est une Option binaire; This.session.prefs.Apparence.AG; "ChoixDebug"; 27)
	
Function _FORM_grpSubOptAGstorePhoto()
	This.EditerPropriétéObjet(Est une Option binaire; This.session.prefs.Apparence.AG; "ChoixDebug"; 28)
	
	
	// ----------------------
	//MARK:FORMevents Page Serveurs
	// ----------------------
	
Function _FORM_Fichier4Drequetes()
	var $valid : Boolean
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=False
			$valid:=Not(Storage.System.typeApplication=ALV BDD mère)
			OBJECT SET ENABLED(*; This.nomOBJ; $valid)
			
			SET DATABASE PARAMETER(Client log recording; 0)
			
		: (FORM Event.code=On Clicked)
			If (Form[This.nomOBJ])
				// démarrer traçage
				SET DATABASE PARAMETER(Client log recording; 1)
				
			Else 
				// traçage en cours, l'arrêter
				SET DATABASE PARAMETER(Client log recording; 0)
			End if 
	End case 
	
	
Function _FORM_FichierReqORDA()
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=False
			OBJECT SET ENABLED(*; This.nomOBJ; Storage.System.typeApplication=ALV Client APP)
			
		: (FORM Event.code=On Clicked)
			If (Form[This.nomOBJ])
				// démarrer le traçage
				ds.startRequestLog(File("/LOGS/ordaLog.txt"))
				
			Else 
				// traçage en cours, l'arrêter
				ds.stopRequestLog()
			End if 
	End case 
	
	
Function _FORM_DebugCode4D()
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=False
			OBJECT SET ENABLED(*; This.nomOBJ; Storage.System.typeApplication=ALV Client APP)
			
		: (FORM Event.code=On Clicked)
			If (Form[This.nomOBJ])
				// démarrer le traçage
				SET DATABASE PARAMETER(Debug log recording; 2+4)
				
			Else 
				// traçage en cours, l'arrêter
				SET DATABASE PARAMETER(Debug log recording; 0)
			End if 
	End case 
	
	
Function _FORM_grpSrvOptDebugerWebServeur()
	var $SessionStatus : Integer
	
	This.EditerPropriétéObjet(Est une Option binaire; This.session.prefs; "Session_Etat"; 2)
	Case of 
		: (FORM Event.code=On Clicked)
			$SessionStatus:=This.session.prefs.Session_Etat
			
			If ($SessionStatus ?? 2)
				WEB SET OPTION(Web debug log; wdl enable with all body parts)
				
			Else 
				WEB SET OPTION(Web debug log; wdl disable web log)
			End if 
	End case 
	
	
Function _FORM_grpWebOptServeurHTTP()
	This.EditerPropriétéObjet(Est une Option booléenne radio; This.session.prefs; "Session_Etat"; 19; New object("radioGroup"; [16; 18; 19]))
	This.setDebugServeurAPP()
	
	
Function _FORM_grpWebOptServeurHTTPtest()
	This.EditerPropriétéObjet(Est une Option booléenne radio; This.session.prefs; "Session_Etat"; 16; New object("radioGroup"; [16; 18; 19]))
	This.setDebugServeurAPP()
	
	
Function _FORM_grpWebOptServeurHTTPlocal()
	This.EditerPropriétéObjet(Est une Option booléenne radio; This.session.prefs; "Session_Etat"; 18; New object("radioGroup"; [16; 18; 19]))
	This.setDebugServeurAPP()
	
	
Function _FORM_grpWebOptServeurHTTPno()
	This.EditerPropriétéObjet(Est une Option booléenne radio; This.session.prefs; "Session_Etat"; -1; New object("radioGroup"; [16; 18; 19]))
	This.setDebugServeurAPP()
	
	
	// ----------------------
	//MARK:Utilitaires
	// ----------------------
	
Function setDebugServeurAPP()
	// fixer estClientAPP de Storage.System
	// activer le serveur Web
	
	Case of 
		: (FORM Event.code=On Load)
			// passer
			
		: ((This.session.prefs.Session_Etat ?? 16) | (This.session.prefs.Session_Etat ?? 19))
			Use (Storage.System)
				// au cas où, virer un précédent appel
				Storage.System.estClientAPP:=False
				Waiting(10)
				// utiliser le serveur APP sélectionné
				Storage.System.estClientAPP:=True
			End use 
			
			CALL WORKER("WK_EtatConnexionHTTP"; Formula(cs.$requeteHTTP.me.FixerEtatConnexion()))
			
		: (This.session.prefs.Session_Etat ?? 18)
			
			// utiliser le serveur Web local
			If (Not(WEB Is server running))
				WEB START SERVER
				Waiting(10)
			End if 
			
			Use (Storage.System)
				// au cas où, virer un précédent appel
				Storage.System.estClientAPP:=False
				Waiting(10)
				// utiliser le serveur Web BDDmère
				Storage.System.estClientAPP:=True
			End use 
			CALL WORKER("WK_EtatConnexionHTTP"; Formula(cs.$requeteHTTP.me.FixerEtatConnexion()))
			
		Else 
			// rien, revenir au cas normal
			If (WEB Is server running)
				// cas BDDmère
				WEB STOP SERVER
			End if 
			
			Use (Storage.System)
				Storage.System.estClientAPP:=False
			End use 
			// rappel : Worker autokill
	End case 
	
	
Function NettoyerOptionsdebug()
	var $SessionStatus : Integer
	
	
	If (Not(This.session.prefs.Session_Etat ?? 6))
		$SessionStatus:=This.session.prefs.Session_Etat
		
		// RAZ DATABASE PARAMETER
		SET DATABASE PARAMETER(Debug log recording; 0)
		
		// RAZ debug WEB
		$SessionStatus:=$SessionStatus ?- 2
		WEB SET OPTION(Web debug log; wdl disable web log)
		
		// RAZ clientAPP
		Use (Storage.System)
			Storage.System.estClientAPP:=False
		End use 
		$SessionStatus:=$SessionStatus ?- 16
		$SessionStatus:=$SessionStatus ?- 18
		$SessionStatus:=$SessionStatus ?- 19
		
		Use (This.session.prefs)
			This.session.prefs.Session_Etat:=$SessionStatus
		End use 
	End if

⇧ [class]$process - 09/06/2026 09:56:06

      Class constructor()
	
	
	
	// ----------------------
	//MARK:Process
	// -----------------------
	
Function NouveauProcess($objetClass : Object; $functionID : Text; $params : Object)->$result : Integer
	var $nomProcess : Text:=""
	var $trace : cs.$trace
	
	$result:=-1
	
	Case of 
		: (OB Is defined($params; "nomProcess"))
			$nomProcess:=$params.nomProcess
			
		: (Not(OB Is defined($params; "nomTache")))
			cs.$trace.me.Créer(-15068; Current method name; "Paramètres 'nomProcess' et 'nomTache' non définis. Impossible de fixer le nom du worker").LeverException([msgk_event; msgk_log])
			
		: ($params.nomTache="")
			cs.$trace.me.Créer(-15068; Current method name; "Paramètre 'nomProcess' non défini et paramètre 'nomTache' vide. Impossible de fixer le nom du worker").LeverException([msgk_event; msgk_log])
			
		Else 
			$nomProcess:="$ALV_process_"+$params.nomTache
	End case 
	
	Case of 
		: ($nomProcess="")
		: (Not(OB Is defined($params; "initProcess")))
			$trace.Error:=-15068
			$trace.ErrorDescription:="Le paramètre 'initProcess' n'est pas défini"
		: (Not(OB Instance of($params.initProcess; 4D.Function)))
			$trace.Error:=-15068
			$trace.ErrorDescription:="Le paramètre 'initProcess' (pour initialiser le process du worker) n'est pas une 4D.Function"
			
		Else 
			// on a tout
			$params.numProcessAppelant:=Current process
			// rappel : initProcess est une formule qui exécute une méthode soit coopérative soit pré-emptive
			$result:=New process($params.initProcess.source; 0; $nomProcess; $objetClass; $functionID; $params; *)
	End case 
	
	
Function ExecuterDansProcess($objetClass : Object; $functionID : Text; $params : Object)
	// on vient ici après l'initialisation du process
	var $class : Object
	var $data : Object
	var $trace : cs.$trace
	
	$trace:=cs.$trace.me.Créer(0; Current method name; "")
	
	// fixer $class ; rmk : $class est valide (sinon erreur de compilation)
	Try
		$class:=$objetClass.new()
		
	Catch
		$class:=Null
		$trace.Error:=-15068
		$trace.ErrorDescription:="Impossible d'instancier de la classe "+JSON Stringify($objetClass)
	End try
	$trace.FixerSuccess()
	
	// fixer .execute
	$data:=New object("params"; $params; "execute"; Null)
	Case of 
		: (Not($trace.success))
		: (Not(OB Is defined($class; $functionID)))
			$trace.Error:=-15068
			$trace.ErrorDescription:="'"+$functionID+"' n'est pas une function de la classe '"+$objetClass.name+"'"
			
		: ($params=Null)
			$data.execute:=Formula($class[$functionID]())
			
		Else 
			$data.execute:=Formula($class[$functionID](This.params))
	End case 
	$trace.FixerSuccess()
	$trace.LeverException([msgk_event; msgk_log])
	
	If ($trace.success)
		// initialiser ses données
		cs.$processData.me.InscrireProcess(Current process name)
		
		// exécuter la function demandée
		cs.$trace.me.EnvoyerMessages([msgk_event; msgk_log]; "debug '"+Current process name+"'"+". "+$functionID; Current method name; JSON Stringify(Process info(Process number(Current process name))))
		$data.execute()
		// attention : $trace est un sigleton ; ici on a la dernière erreur générée
		
		// appeler un callBack
		Case of 
			: (Not(OB Is defined($params; "nomProcessAppelant")))
			: (Not(OB Is defined($params; "CallBack")))
			Else 
				$data:=$params
				// ici on doit être thread-safe
				This.AppelerFormulaire($params.nomProcessAppelant; $params.CallBack; $data)
		End case 
		
		cs.$processData.me.DeInscrireProcess(Current process name)
	End if 
	
	
	// ----------------------
	//MARK:Worker
	// -----------------------
	
Function ExecuterDansWorker($classe : Object; $functionID : Text; $params : Object)->$result : Text
	var $nomWorker : Text:=""
	
	$result:=""
	
	Case of 
		: (OB Is defined($params; "nomProcess"))
			$nomWorker:=$params.nomProcess
			
		: (Not(OB Is defined($params; "nomTache")))
			cs.$trace.me.Créer(-15068; Current method name; "Paramètres 'nomProcess' et 'nomTache' non définis. Impossible de fixer le nom du worker").LeverException([msgk_event; msgk_log])
			
		: ($params.nomTache="")
			cs.$trace.me.Créer(-15068; Current method name; "Paramètre 'nomProcess' non défini et paramètre 'nomTache' vide. Impossible de fixer le nom du worker").LeverException([msgk_event; msgk_log])
			
		Else 
			$nomWorker:="$ALV_process_"+$params.nomTache
	End case 
	
	If ($nomWorker#"")
		This.AppelerWorker($nomWorker; $classe; $functionID; $params)
		$result:=$nomWorker
	End if 
	
	
Function AppelerWorker($nomWorker : Text; $objetClass : Object; $functionID : Text; $params : Object)
	var $class : Object
	var $data : Object
	var $trace : cs.$trace
	
	$trace:=cs.$trace.me.Créer(0; Current method name; "")
	
	// fixer $class ; rmk : $class est valide (sinon erreur de compilation)
	Try
		If ($objetClass.isSingleton)
			$class:=$objetClass.me
		Else 
			$class:=$objetClass.new()
		End if 
		
	Catch
		$class:=Null
		$trace.Error:=-15068
		$trace.ErrorDescription:="Impossible d'instancier de la classe "+JSON Stringify($objetClass)
	End try
	$trace.FixerSuccess()
	
	// fixer .execute
	$data:=New object("params"; $params; "execute"; Null)
	Case of 
		: (Not($trace.success))
		: (Not(OB Is defined($class; $functionID)))
			$trace.Error:=-15068
			$trace.ErrorDescription:="'"+$functionID+"' n'est pas une function de la classe '"+$objetClass.name+"'"
			
		: ($params=Null)
			$data.execute:=Formula($class[$functionID]())
			
		Else 
			$data.execute:=Formula($class[$functionID](This.params))
	End case 
	$trace.FixerSuccess()
	
	Case of 
		: (Not($trace.success))
		: (Not(OB Is defined($params; "initProcess")))
			// déjà initilialisé (ou pas !)
		: (Not(OB Instance of($params.initProcess; 4D.Function)))
			$trace.Error:=-15068
			$trace.ErrorDescription:="Le paramètre 'initProcess' (pour initialiser le process du worker) n'est pas une 4D.Function"
			
		Else 
			// initialiser les données du process
			cs.$processData.me.InscrireProcess($nomWorker)
			
			// (re)créer, (re)initialiser le WK (ccopératif ou pré-emptif selon $params.initProcess)
			CALL WORKER($nomWorker; $params.initProcess.source)
			cs.$trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Initialisation du worker '"+$nomWorker+"'"; Current method name; JSON Stringify(Process info(Process number($nomWorker))))
	End case 
	$trace.FixerSuccess()
	
	If ($trace.success)
		// exécuter la function demandée
		cs.$trace.me.EnvoyerMessages([msgk_event; msgk_log]; "debug '"+$nomWorker+"'"+". "+$functionID; Current method name; JSON Stringify(Process info(Process number($nomWorker))))
		CALL WORKER($nomWorker; Formula($data.execute()))
		
		// appeler un callBack
		Case of 
			: (Not(OB Is defined($params; "nomProcessAppelant")))
			: (Not(OB Is defined($params; "CallBack")))
			Else 
				$data:=$params
				// ici on doit être thread-safe
				This.AppelerFormulaire($params.nomProcessAppelant; $params.CallBack; $class)
		End case 
	End if 
	
	$trace.FixerSuccess()
	$trace.LeverException([msgk_event; msgk_log])
	
	
	// ----------------------
	//MARK:Communication
	// -----------------------
	
Function AppelerFormulaire($process : Variant; $functionID : Text; $params : Object)
	var $wndNum : Integer
	var $nomProcess : Text:=""
	
	Case of 
		: (Storage.System.typeApplication=ALV Serveur APP)
		: (Storage.System.typeApplication=ALV Serveur HTTP)
			// non concernés, filtrer
			
		: (Value type($process)=Is text)
			$nomProcess:=$process
			
		: (Value type($process)=Is longint)
			$nomProcess:=Process info($process).name
	End case 
	
	If ($nomProcess#"")
		$wndNum:=cs.$processData.me.LireNumFenetre($nomProcess)
		This._AppelerFormulaire($wndNum; $functionID; $params)
	End if 
	
	
Function _AppelerFormulaire($wndNum : Integer; $functionID : Text; $params : Object)
	var $data : Object
	
	If ($wndNum#0)
		$data:=New object("params"; $params; "functionID"; $functionID)
		$data.execute:=Formula(cs.$process.new().ExecuterDansFormulaire(This.functionID; This.params))
		
		CALL FORM($wndNum; Formula($data.execute()))
	End if 
	
	
Function ExecuterDansFormulaire($functionID : Text; $params : Object)
	// on est dans le worker demandé , possédant une fenêtre
	// appeler la function $functionID de Form (Form est un objet de classe)
	
	Case of 
		: ($functionID="")
			cs.$trace.me.Créer(-15068; Current method name; "$functionID est une chaine vide").LeverException([msgk_event; msgk_log])
			
		: (Not(OB Instance of(Form[$functionID]; 4D.Function)))
			CALL WORKER(Worker Services; Formula(traceHandler); [msgk_event; msgk_log]; $functionID; Current method name; $functionID+" n'est pas une function de la classe du process "+Current process name; New object("nomProcess"; Current process name; "numProcess"; Current process))
			
		: ($params=Null)
			ASSERT(cs.$trace.me.DebugerMethode($functionID; Current method name; "Appel sans paramètres"))
			Form[$functionID]()
			
		Else 
			ASSERT(cs.$trace.me.DebugerMethode($functionID; Current method name; "Appel avec paramètres"))
			Form[$functionID]($params)
	End case 
	
	
	// ----------------------
	//MARK:Suppression Process
	// -----------------------
	
Function TuerUserProcesses()
	// Tuer tous les process utilisateur (process de la session)
	var $numProc; $timeOut : Integer
	var $continuer : Boolean
	
	// durée totale de la tuerie
	$timeOut:=Milliseconds+(2*1000)
	
	Repeat 
		$continuer:=False
		// chaque tuerie le passe à true ; reste false si plus aucun process
		
		// passer en revue tous les process
		For ($numProc; 1; Count tasks)
			$continuer:=$continuer | This.TuerAvecNumero($numProc)
			// continuer vaut vrai si le process a été tué
		End for 
		
		// en final, $continuer vaut false si cette boucle n'a rien fait
	Until (($continuer=False) | (Milliseconds>$timeOut))
	
	
Function TuerAvecNom($nomProc : Text)
	var $c : Collection
	
	$c:=Process activity.processes.query("name = :1"; $nomProc)
	Case of 
		: ($c.length=0)
		: ($c[0].state<0)
			// c'est tué
			
		: (This.TuerAvecNumero($c[0].number))
			// c'est fait
		: (This._TuerWorker($c[0]))
	End case 
	
	
Function TuerAvecNumero($numProc : Integer)->$result : Boolean
	// tuer le process $numProc ; renvoyer faux si le process est déjà tué (la function n'a rien fait)
	// attention ici on ne tue pas les worker systeme ; et on n'est pas thread-safe 
	var $c : Collection
	
	$result:=False
	
	$c:=Process activity.processes.query("number = :1"; $numProc)
	Case of 
		: ($c.length=0)
		: ($c[0].state<0)
			// c'est tué
		Else 
			
			Case of 
					// tuer un process utilisateur à fenêtre : "Nav_" "Modifier" et "Palette"
				: (This._TuerFormProcess($c[0]))
					$result:=True
					
					// tuer un process sans fenêtre
				: (This._TuerAppProcess($c[0]))
					$result:=True
			End case 
	End case 
	
	
Function _TuerFormProcess($process : Object)->$result : Boolean
	
	$result:=(cs.$processData.me.existeFenetre($process.name))
	
	If ($result)
		// fermer un éventuel formulaire
		CALL FORM(cs.$processData.me.LireNumFenetre($process.name); Formula(CANCEL))
	End if 
	
	
Function _TuerAppProcess($process : Object)->$result : Boolean
	var $Progress : Object
	
	$result:=(($process.name="ALV_@") | ($process.name="$ALV_@"))
	
	If ($result)
		$Progress:=Storage.Processes[$process.name]
		
		If (Not(OB Is empty($Progress)))  // en debug, ça peut être chaud !
			Use ($Progress)
				$Progress.Commande:="Tuer process"
			End use 
		End if 
		
		RESUME PROCESS($process.number)  // au cas où il dort
	End if 
	
	
	// ----------------------
	//MARK:Suppression Worker
	// -----------------------
	
Function TuerWorkers()
	var $numProc : Integer
	var $c : Collection
	
	// arrêter les monitorings (termine la function en cours d'exécution)
	Use (Storage.System)
		Storage.System.ArrêtAPP:=True
	End use 
	Waiting(60)
	
	// passer en revue tous les process
	For ($numProc; 1; Count tasks)
		$c:=Process activity.processes.query("number = :1"; $numProc)
		Case of 
			: ($c.length=0)
			: ($c[0].state<0)
				// c'est tué
			Else 
				
				This._TuerWorker($c[0])
		End case 
	End for 
	
	
Function _TuerWorker($process : Object)->$result : Boolean
	
	$result:=($process.type=Worker process)
	
	If ($result)
		// tuer le worker (purge les messages en attente, reste éventuellement une tâche en cours)
		KILL WORKER($process.name)
	End if

⇧ [class]CommandesEditeur - 08/05/2026 12:56:26

      Class extends $formulaire

Class constructor()
	// construction commune
	Super()
	
	
Function getDataClassInfos()->$result : Object
	$result:=Super.getDataClassInfos("Commandes")
	
	
	// ----------------------
	// MARK:Clic 
	// -----------------------
	
Function ActionClicZS($action : Integer)->$result : Boolean
	// retour = vrai si commande traitée
	
	$result:=ds.Commandes.estMonID($action)
	
	Case of 
		: (Not($result))
			// passer
			
		: (Current process#Process number(Process Principal ALV))
			// ces commandes s'exécutent dans le process utilisateur principal (actuellement inutile : les ZS sont sur $accueil du process principal)
			ALERT(Current method name+" 8-05-2026 obsolette?")
			Appeler_Le_Formulaire(Process number(Process Principal ALV); "callCommandes"; New object("functionID"; "ActionClicZS"; "Commande"; $action))
			
		: (This.ExécuterClicZSsystem($action))
			
		: (This.ExécuterClicZSedition($action))
			
		Else 
			$result:=False
	End case 
	
	
Function ExécuterClicZSsystem($itemRef : Integer)->$result : Boolean
	// commandes liées à une ZS système
	// dans cette version une ZS système correspond forcément à un menu
	var $entité; $menu : Object
	var $c : Collection
	
	$result:=False
	$entité:=ds.Commandes.get($itemRef & 0x00FFFFFF)
	
	Case of 
		: ($entité=Null)
		: ($entité.commande<128)
		: ($entité.methode="")
		Else 
			// ok on prend l'action
			$result:=True
			
			// .methode est de la forme IDmenu+nomBarreMenus
			// lire l'ID de ce menu
			$c:=Split string($entité.methode; "/")
			
			// lire les paramètres du menu
			$menu:=cs.$menu.new()
			$menu.LireParamètresMenu($c[0]; Storage.BarresMenus[$c[1]])
			
			// exécuter le menu
			$menu.Exécuter()
	End case 
	
	
Function ExécuterClicZSedition($itemRef : Integer)->$result : Boolean
	// commandes liées à une ZS édition
	var $entité; $sélection : Object
	
	$result:=False
	$entité:=ds.Commandes.get($itemRef & 0x00FFFFFF)
	
	Case of 
		: ($entité=Null)
		: ($entité.commande>128)
			// il faut un numTable
		Else 
			// ok on prend l'action
			$result:=True
			
			// passer dans le monde "Edition", domaine "numTable"
			$sélection:=This.session.LireSélectionTable($entité.commande)
			cs.$editeur.new().EditerSélection($sélection.sélection; $sélection.index)
	End case 
	
	
	// ----------------------
	// MARK:Menus status système 
	// -----------------------
	
Function ExécuterMenu($params : Object)->$result : Boolean
	// retour = vrai si commande traitée
	// on reçoit les paramètres d'un menu
	
	$result:=($params.type="System")
	
	Case of 
		: (Not($result))
		: (Not(OB Is defined(This; $params.functionID)))
		Else 
			
			This[$params.functionID]($params)
	End case 
	
	
Function EditerAttributsNonFonctionnels($params : Object)
	// afficher / masquer les attributs non fonctionnels des classes de ds
	var $SessionStatus : Integer
	// fixer l'état de l'aide technique
	
	$SessionStatus:=This.session.prefs.Session_Etat
	If ($SessionStatus ?? 5)
		$SessionStatus:=$SessionStatus ?- 5
	Else 
		$SessionStatus:=$SessionStatus ?+ 5
	End if 
	Use (This.session.prefs)
		This.session.prefs.Session_Etat:=$SessionStatus
	End use 
	$params.marque:=($SessionStatus ?? 5)
	
	
Function EditerInfoBulles($params : Object)
	// afficher / masquer les info-bulles des champs et boutons
	var $SessionStatus : Integer
	// fixer l'état des bulle-info
	
	$SessionStatus:=This.session.prefs.Session_Etat
	If ($SessionStatus ?? 4)
		$SessionStatus:=$SessionStatus ?- 4
	Else 
		$SessionStatus:=$SessionStatus ?+ 4
	End if 
	SET DATABASE PARAMETER(Tips enabled; Num($SessionStatus ?? 4))
	Use (This.session.prefs)
		This.session.prefs.Session_Etat:=$SessionStatus
	End use 
	$params.marque:=($SessionStatus ?? 4)
	
	
Function EditerTraduction()
	cs.xSDK.TraductionsEditeur.new().ModifierTraductions()
	
	
Function EditerNotesMobile()
	cs.xMOB.$notesEditeur.new().Modifier()
	
	
Function FixerModeDebug($params : Object)
	// activer / déactiver le mode debug
	var $SessionStatus : Integer
	
	$SessionStatus:=This.session.prefs.Session_Etat
	$SessionStatus:=Choose(($SessionStatus ?? 2) | ($SessionStatus ?? 6); $SessionStatus ?- 6; $SessionStatus ?+ 6)
	Use (This.session.prefs)
		This.session.prefs.Session_Etat:=$SessionStatus
	End use 
	
	cs.$formulaire_3119.new().NettoyerOptionsdebug()
	
	// mettre à jour l'état du menu
	$params.marque:=($SessionStatus ?? 2) | ($SessionStatus ?? 6)
	
	
Function ActiverDeveloppement()
	This.OuvrirDeveloppement()
	
	
	// ----------------------
	// MARK:Menus consoles
	// -----------------------
	
Function OuvrirAdminServer()
	// ouvrir la fenêtre admin du serveur
	OPEN ADMINISTRATION WINDOW
	
	
Function OuvrirConsoleAPP()
	// afficher la console de l'application
	var $params : Object
	
	$params:=New object
	$params.Commande:="Afficher"
	$params.sourceLogs:=ALV Client APP
	$params.wndTitre:="Logs application ALV"
	This.rsc.SetObjet(Est Ressource APP; "Ressources_Communes/nbrMaxLogs"; Is longint; $params; "nbrMaxLogs")
	
	cs.xSDK.EvenementsALV.new().AfficherEditeur($params)
	
	
Function OuvrirConsoleSRV()
	//  afficher la console du serveur sur le client
	var $params : Object
	
	$params:=New object
	$params.Commande:="Afficher"
	$params.sourceLogs:=ALV Serveur APP
	$params.wndTitre:="Logs serveur ALV"
	This.rsc.SetObjet(Est Ressource APP; "Ressources_Communes/nbrMaxLogs"; Is longint; $params; "nbrMaxLogs")
	
	cs.xSDK.EvenementsALV.me.AfficherEditeur($params)
	Waiting(10)  // attendre que le process se crée
	// activer la connexion au serveur APP
	CALL WORKER("WK_EtatConnexionHTTP"; Formula(cs.$requeteHTTP.me.FixerEtatConnexion()))
	
	
Function MontrerLogs()
	// dossier des fichiers Logs
	SHOW ON DISK(Get 4D folder(Logs folder))

⇧ [class]LieuxEntity - 13/04/2026 11:48:28

      Class extends Entity

Function IDcodé()->$ID : Integer
	$ID:=cs._ds.me.IDcodé(This)
	
	
Function Libellé($userFormats : Object)->$libellé : Text
	// renvoie le nom formaté suivant les options $1
	// $formats
	// .Options
	// bit 17 = ajouter la commune
	// bit 18 = ajouter le site
	var $texte : Text
	var $formats : Object
	var $options : Integer
	
	$formats:=New object("Options"; 0)
	Case of 
		: (Count parameters=0)
		: (OB Is defined($userFormats; "Options"))
			$formats:=$userFormats
	End case 
	$options:=$formats.Options
	
	$libellé:=This.nom
	$texte:=This.leSite.nom*Num(This.leSite#Null)
	$libellé:=$libellé+(Num(($options ?? 18) & ($texte#""))*(" ("+$texte+")"))
	$texte:=This.Le("Communes").Libellé($formats)
	$libellé:=$libellé+((Localized string("1015")+$texte)*Num(($options ?? 17) & ($texte#"")))
	
	
Function LibelléEncyclo($attribut : Text)->$result : Text
	var $texte : Text
	
	$texte:="<span style="+Char(Double quote)+"-d4-ref-user:'"+String(cs._ds.me.IDcodé(This))+"'"+Char(Double quote)+">"+This.Libellé(New object("Options"; 0x00020000))+"</span>"
	// verrue temporaire, on peut peut-être faire plus classe !
	$result:=cs.$hyperTexteEditeur.new().LibelléEncyclo($attribut; $texte)
	
	
Function LibellésGeoLoc($userFormats : Object)->$data : Object
	// renvoie les positions formatés de l'entité, suivant les paramètres $formats
	// $formats :
	// .FormatGeoLoc
	var $formats : Object
	var $c : Collection
	var $attribut : Text
	var $coordonnéeIN; $coordonnéeOUT : Real
	
	$formats:=New object
	If (Count parameters>0)
		$formats:=$userFormats
	End if 
	// ajouter les formats manquants
	ds._FixerParamètresLibellé($formats)
	
	$data:=New object
	
	// attributs de géoLoc
	$c:=New collection("latitude"; "longitude")
	For each ($attribut; $c)
		$coordonnéeIN:=Abs(This[$attribut])
		Case of 
			: ($formats.FormatGeoLoc=1)  // coder en en degrés décimaux
				$data[$attribut]:=This[$attribut]  //!
				
			: ($formats.FormatGeoLoc=2)  // coder $1 dans $3 en degrés/minutes/secondes
				// valeurs limitées au 1/100 de "
				$coordonnéeOUT:=Int($coordonnéeIN)*10000
				$coordonnéeIN:=Dec($coordonnéeIN)*60
				$coordonnéeOUT:=$coordonnéeOUT+(Int($coordonnéeIN)*100)
				$coordonnéeIN:=Dec($coordonnéeIN)*60
				$coordonnéeOUT:=$coordonnéeOUT+($coordonnéeIN)
				If (This[$attribut]<0)
					$coordonnéeOUT:=-$coordonnéeOUT
				End if 
				$data[$attribut]:=$coordonnéeOUT
				
			: ($formats.FormatGeoLoc=3)  // coder $3 dans $1 en degrés décimaux
				// valeurs limitées à 6 chiffres après la virgule
				$coordonnéeIN:=Abs(This[$attribut])
				$coordonnéeOUT:=Dec($coordonnéeIN/100)*100/60  //les secondes
				$coordonnéeIN:=Int($coordonnéeIN/100)
				$coordonnéeOUT:=(Dec($coordonnéeIN/100)*100+$coordonnéeOUT)/60
				$coordonnéeOUT:=$coordonnéeOUT+Int($coordonnéeIN/100)  //les degrés
				If (This[$attribut]<0)
					$coordonnéeOUT:=-$coordonnéeOUT
				End if 
				$data[$attribut]:=$coordonnéeOUT
		End case 
	End for each 
	
	
Function RédigerCommentaire($formats : Object)->$result : Text
	$result:=""
	
	
	// ----------------------
	//MARK:Sélections
	// -----------------------
	
Function LesLieux()->$result : Object
	// renvoie la sélection des lieux de la commune du lieu (sélection entity [Sites])
	$result:=This.leSite.lesLieux.orderBy("nom")
	
	
Function LesSites()->$result : Object
	// renvoie la sélection des sites de la commune du lieu (sélection entity [Sites])
	$result:=This.leSite.laCommune.lesSites.orderBy("nom")
	
	
Function Le($DataClassNom : Text)->$result : Object
	// renvoie l'entité [$DataClassNom]
	$result:=This.leSite.Le($DataClassNom)
	
	
Function LesPatronymes()->$result : Text
	var $c1; $c2 : Collection
	
	// évènements perso
	$c1:=This.lesEvenements.leEventPersonnel.laPersonne.lePatronyme.distinct("patronyme")
	// ajouter les évènements familiaux
	$c2:=$c1.combine(This.lesEvenements.leEventFamilial.laFamille.leGroupe.lesMembres.laPersonne.lePatronyme.distinct("patronyme"))
	$c2:=$c2.distinct().orderBy(ck ascending)
	// créer la liste
	$result:=$c2.join(", ")
	
	
Function CréerListeDeroulanteSites($params : Object)
	// pas de function générique ; tout est fait ici
	var $liste : Object
	
	$liste:=New object
	$liste.values:=This.LesSites().extract("nom")
	$liste.values.unshift(Localized string("39"))
	$liste.codes:=This.LesSites().extract("ID")
	$liste.codes.unshift(-1)
	
	Case of 
		: ($params.tousLieux)
			// tous les lieux de la commune
			$liste.index:=0
			
		Else 
			// ici, Form.entité.LesSites et .menuSites sont synchrones
			$liste.index:=$liste.values.indexOf(This.leSite.nom)
	End case 
	$params.liste:=$liste
	
	
Function CréerListBoxLieux($params : Object)
	var $sélection : cs.LieuxSelection
	
	If ($params.tousLieux)
		// les lieux du lieu courant
		$sélection:=This.LesSites().lesLieux
	Else 
		$sélection:=This.LesLieux()
	End if 
	$sélection:=$sélection.orderBy("nom")
	
	// demander la LB
	$params.liste:=$sélection.CréerListBox()
	
	
	// ----------------------
	//MARK:Modification DataStore
	// -----------------------
	
Function Ajouter($quoi : Integer; $qui : Object; $params : Object)->$result : Object
	// créer un parent, conjoint, patronyme de this
	// $1 = code de la création, $2 = entité (peut-être null), $3 paramètres
	ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "Début de l'ajout à ["+This.getDataClass().getInfo().name+"]"))
	
	$result:=ds.initResult()
	// fixer Qui
	If ($qui=Null)
		// créer qui
		$result:=ds.Créer($quoi; ""; $params)
		$qui:=$result.entitéAjoutée
	End if 
	
	Case of 
		: ($qui=Null)
		: ($quoi=imk Illustration)
			// on a un media (qui a été créé  s'il n'existait pas) ; le lier à this
			// attention pour ajouter la zone il faut un aQui de type entité
			$params.aQui:=This
			$result:=$qui.Ajouter(imk Zone; Null; $params)
			$result.entitéAjoutée:=$qui
			// pour le journal
			$params.aQui:=New object("DataClassNom"; This.getDataClass().getInfo().name; "IDunique"; This.IDunique)
			$params.Description_Action:=Localized string("3045")+Localized string("33")+This.Libellé()+", fichier '"+$params.cheminDuMediaAjouté+"'"
			
		: ($quoi=dsk Private)
			// on a dans $qui , le lier à this
			// créer le lien
			$qui.IDunique:=This.IDunique
			$qui.save()
			// pour le journal
			$params.Description_Action:=Localized string("3113")+Localized string("33")+This.Libellé()
			
	End case 
	
	$result.success:=($result.Error=0)
	ds.NotifierResultat(This; $quoi; $result)
	
	
Function _FixerDonnées($quoi : Integer; $params : Object)->$result : Object
	// un lieu a été créé : on initialise ses données suivant 2 cas
	$result:=ds._FixerDonnées(This; $quoi; $params)
	// ici, pour les 2 cas "Ajout DataStore" ou "Modifier DataStore_Extérieur", $params a les mêmes informations
	
	
Function _TriggerCreer()
	This.nom:=Localized string("41")+" ID_"+String(This.ID)
	This.type:=60300
	This.save()
	
	
Function ModifierAutre()->$result : Object
	// Edition / modification des autres informations par FORM
	// renvoie les entités modifiables
	$result:=New object
	$result.leDepartement:=This.Le("Departements")
	$result.laRegion:=This.Le("Regions")
	$result.lePays:=This.Le("Pays")
	// attributs modifiables
	$result.Modifications:=New collection($result.leDepartement; $result.laRegion; $result.lePays)
	
	
	// ----------------------
	//MARK:Interface externe
	// -----------------------
	
Function CopierVersObjet($entitéExt : Object)
	// recopier les attributs de this dans $entitéExt (pour une utilisation hors BDD mère)
	var $entité : Object
	
	$entitéExt.ID:=This.ID
	$entitéExt.IDunique:=This.IDunique
	
	$entitéExt.type:=This.type
	$entitéExt.nom:=This.nom
	$entitéExt.latitude:=This.latitude
	$entitéExt.longitude:=This.longitude
	
	// le site
	// demander à l'appelant sa classe Sites
	$entité:=OB Copy($entitéExt.protoSite)
	// faire compléter
	This.leSite.CopierVersObjet($entité)
	$entitéExt.leSite:=$entité
	
	
	// ----------------------
	//MARK:APP mobile
	// -----------------------
	
exposed local Function get labeledNom($event : Object)->$result : Text
	$result:=This.nom+" ("+This.label+")"
	
	
exposed local Function get label($event : Object)->$result : Text
	$result:=Localized string(String(This.type))
	
	
exposed local Function NombreEvents($event : Object)->$result : Text
	$result:="N évènements..."
	
	If (estAppelMobile)
		$result:=""
		$result:=$result+This.AddEventsType(22000; 1220)
		$result:=$result+This.AddEventsType(22300; 1223)
		$result:=$result+This.AddEventsType(33600; 1236)
		$result:=$result+This.AddEventsType(33700; 1237)
		$result:=$result+This.AddEventsType(33800; 1238)
		$result:=$result+This.AddEventsType(22100; 1221)
		$result:=$result+This.AddEventsType(22200; 1222)
		$result:=Replace string($result; Char(Line feed); ""; 1)
		
		If ($result="")
			$result:=Char(Line feed)+Localized string("1073")
		End if 
	End if 
	
	
exposed local Function AddEventsType($type : Integer; $typeLabel : Integer)->$result : Text
	var $sélection : Object  //cs.EventsSelection interdit !
	
	$result:=""
	$sélection:=This.lesEvenements.query("type >= :1 and type <= :2"; $type; $type+99)
	If ($sélection.length>0)
		$result:=(2*Char(Line feed))+String($sélection.length)+" "+Lowercase(cs._cfct.me.LireLocatedSTR($typeLabel; New object("genre"; False; "plur"; ($sélection.length>1))); *)+" : "+Char(Line feed)+$sélection.LesMembres()
	End if 
	
	
Function etatCivil()->$result : Text
	var $c : Collection
	var $type : Integer
	var $sélection : Object  // cs.EventsSelection interdit !
	
	$result:="L'état civil..."
	
	If (estAppelMobile)
		$result:=""
		// lister tous les types d'events de ce lieu
		$c:=This.lesEvenements.type.distinct().orderBy(ck ascending)
		
		// pour chaque type, lister les events
		If ($c.length>0)
			For each ($type; $c)
				$result:=$result+(2*Char(Line feed))+Localized string(String($type))+", "+Localized string(String(16000000+$type))+Char(Line feed)
				$sélection:=This.lesEvenements.query("type = :1"; $type).orderBy("dateNum asc")
				$result:=$result+$sélection.etatCivil()
			End for each 
			$result:=Replace string($result; 2*Char(Line feed); ""; 1)
		End if 
	End if

⇧ [class]MediasEntity - 30/04/2026 13:51:35

      Class extends Entity

Function IDcodé()->$ID : Integer
	$ID:=cs._ds.me.IDcodé(This)
	
	
Function Libellé($formats : Object)->$libellé : Text
	// renvoie le nom formaté suivant les options $formats
	$libellé:=This.titre
	
	
Function LibelléEncyclo($attribut : Text)->$result : Text
	var $texte : Text
	
	$texte:="<span style="+Char(Double quote)+"-d4-ref-user:'"+String(cs._ds.me.IDcodé(This))+"'"+Char(Double quote)+">"+This.Libellé()+"</span>"
	$result:=cs.$hyperTexteEditeur.new().LibelléEncyclo($attribut; $texte)
	
	
Function RédigerCommentaire($formats : Object)->$result : Text
	$result:=$formats.séparateurBloc+$formats.débutComment+This.commentaire+$formats.finComment
	$result:=$result+ds._FinirTexteFormDetail()
	
	
Function Icone()->$pict : Picture
	// renvoyer l'icone de l'entité
	var $result : Object
	
	$result:=ds.LeIcone(This; "vignette")
	$pict:=$result.icone
	
	
Function CréerListBox($attribut : Text)->$result : Object
	var $pict : Picture
	
	$result:=New object
	$result.itemText:=This.Libellé()
	$result.itemRef:=cs._ds.me.IDcodé(This)
	Case of 
		: ($attribut="icone")
			$pict:=This.icone
			
		: ($attribut="photo")
			// rappel : en client-serveur, c'est le client qui doit faire la requête FTP à l'hébergeur des media
			CLEAR VARIABLE($pict)
	End case 
	$result.pict:=CoDecBase64_Objet($pict)
	$result.DataClassNom:=This.getDataClass().getInfo().name
	$result.ID:=This.ID
	
	
	// ----------------------
	//MARK:Sélections
	// -----------------------
	
Function LeFichier()->$result : 4D.File
	// renvoyer le fichier de this
	$result:=This.leFichier[0].LeFichier()
	
	
Function LeDossier()->$result : Object
	// renvoyer le fichier de this
	$result:=This.leFichier[0].LeDossier()
	
	
Function LeVolume()->$dossier : Object
	// renvoie le dossier media de this (volume>0)
	$dossier:=This.leFichier[0].leDossier
	If ($dossier.volume<0)
		$dossier:=$dossier.leDossierParent.leDossier.LeVolume()
	End if 
	
	
	// ----------------------
	//MARK:Créer sélections
	// -----------------------
	
Function LesZonesDeLaPage($numPage : Integer)->$result
	$result:=This.lesZones.query("page = :1"; $numPage)
	
	
	// ----------------------
	//MARK:Modification DataStore
	// -----------------------
	
Function Ajouter($quoi : Integer; $qui : Object; $params : Object)->$result : Object
	// créer un illustré, zone de this
	// $1 = code de la création, $2 = entité (peut-être null), $3 paramètres
	var $chemin : Text
	var $fichier : Object
	ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "Début de l'ajout à ["+This.getDataClass().getInfo().name+"]"))
	
	$result:=ds.initResult()
	
	// fixer Qui
	If ($qui=Null)
		// créer qui
		$result:=ds.Créer($quoi; ""; $params)
		$qui:=$result.entitéAjoutée
	End if 
	
	Case of 
			// ici pas besoin de $qui
		: ($quoi=imk Ressource)
			$result:=This.CréerRessources()
			$params.Description_Action:=Localized string("3056")+Localized string("33")+"Media ID "+String(This.ID)
			// pour la suite
			$result.entitéAjoutée:=This
			
		: ($quoi=imk Fichier)
			// on modifie le fichier de this
			// ici on a un chemin de document (sur DD, URL...)
			$chemin:=$params.cheminDocument
			$params.fichier:=File($chemin; fk platform path)
			// mettre à jour les formats
			$result:=This.FixerFormats($params)
			// remplacer le fichier
			If ($result.Error=0)
				// déplacer l'ancien fichier dans le dossier temporaire de 4D (au cas où pb) et on mémorise son chemin
				$fichier:=This.LeFichier().moveTo(cs.$document.new().GetSessionFolder(); String(Random)+".tempALV")
				$params.cheminDuMediaAncien:=$fichier.platformPath
				// mettre le nouveau fichier
				$result.fichierAjouté:=$params.fichier.moveTo(This.LeDossier(); This.leFichier[0].nom)
				// pour la suite
				$result.entitéAjoutée:=This
				$result.Error:=-15042*Num($result.fichierAjouté=Null)
			End if 
			
			// à partir d'ici il faut un $qui
		: ($qui=Null)
		: ($quoi=imk Illustration)
			// $qui est un media (qui a été créé s'il n'existait pas) ; ajouter à this une ZS liée à $qui
			// attention pour ajouter la zone il faut un aQui de type entité
			$params.aQui:=$qui
			$result:=This.Ajouter(imk Zone; Null; $params)
			$result.entitéAjoutée:=$qui
			// pour le journal
			$params.aQui:=New object("DataClassNom"; This.getDataClass().getInfo().name; "IDunique"; This.IDunique)
			$params.Description_Action:=Localized string("3029")+Localized string("33")+"Media ID "+String(This.ID)+", fichier '"+$params.cheminDuMediaAjouté+"'"
			
		: ($quoi=imk Zone)
			// $qui est une ZS (qui a été créée si elle n'existait pas) ; faire le lien avec this
			$qui.media:=This.ID
			$qui.save()
			// fixer la taile de la zone
			$qui.Positionner(This; $params)
			// pour le journal
			$params.Description_Action:=cs._cfct.me.LireLocatedSTR(5203; New object("param_1"; String(This.ID); "param_2"; $qui.LeLien().Libellé()))
			//  $qui = zone ajoutée
			$result.entitéAjoutée:=$qui
			
		: ($quoi=dsk Private)
			// on a dans $qui , le lier à this
			// créer le lien
			$qui.IDunique:=This.IDunique
			$qui.save()
			// pour le journal
			$params.Description_Action:=Localized string("3113")+Localized string("33")+This.Libellé()
			
	End case 
	
	$result.success:=($result.Error=0)
	ds.NotifierResultat(This; $quoi; $result)
	
	
local Function CréerRessources()->$result : Object
	// créer la vignette et l'icone de this
	// mêmes codes d'erreur que "lire Media"
	var $chemin : Text
	var $image; $pict : Picture
	
	$result:=ds.initResult()
	$result.image:=0
	
	// attention, ici on est POSIX
	$chemin:=This.leFichier[0].CheminDuFichier()
	Case of 
		: (This.private#0)
			// *** document privé; créer une imagette brouillée
			// attention cette imagette est brouillée même pour le proprio du media
			$image:=cs._rsc.me.image(16203)
			
			// *** document public
			// ici on est sur application ALV, serveur HTTP ou Client ALV ; on doit être thread-safe
		: (This.type=mdk Est un flux Video)
			// ici on ne sait pas lire une image de video
			$image:=cs._rsc.me.image(16205)
			
		: (This.type=mdk Est un flux Audio)
			// une image de son n'existe pas
			$image:=cs._rsc.me.image(16206)
			
		: (This.type=mdk Est un Document externe)
			// un document externe peut être une URL
			$image:=cs._rsc.me.image(16213)
			
		: (File($chemin).exists)
			// utiliser le chemin plateform du fichier
			$chemin:=Convert path POSIX to system($chemin)
			READ PICTURE FILE($chemin; $image)
			$result.Error:=Erreur de lecture du fichier*Num(ok=0)
			
		Else 
			// on est mal ; comme dirait David, il faut que le soft renvoie toujours quelque chose !
			$image:=cs._rsc.me.image(16201)
	End case 
	
	Case of 
		: ($result.Error#0)
		: (Picture size($image)=0)
			$result.ErrorDescription:=Current method name+" absence d'image"
		Else 
			// on y va
			// PNGf est un format natif 4D
			CREATE THUMBNAIL($image; $pict; 120; 120; 6)
			// mettre au format png impératif (ce format gère les bords transparents, utiles dans la palette en particulier)
			CONVERT PICTURE($pict; "image/png")
			This.vignette:=$pict
			// les bords sont transparents
			
			CREATE THUMBNAIL($image; $pict; 16; 16; 6)
			// mettre au format png
			CONVERT PICTURE($pict; "image/png")
			// les bords sont transparents
			This.icone:=$pict
			This.save()
	End case 
	
	
Function _FixerDonnées($quoi : Integer; $params : Object)->$result : Object
	// un media a été créé : on initialise ses données suivant 2 cas
	// ajout dans BDD mère : données déduites de aQui, ou ajout par le serveur WEB : données lues dans le journal $params
	// dans les 2 cas on complète le journal
	var $chemin : Text
	var $document : Object
	var $media : cs.$media
	
	$result:=ds._FixerDonnées(This; $quoi; $params)
	$media:=cs.$media.new()
	
	This.private:=0  // public
	This.largeur:=-1
	This.hauteur:=-1
	This.taille:=-1
	This.compression:=1
	This.NombreDePages:=1
	This.dateChaine:=""
	This.dateNum:=!00-00-00!
	This.dateNumValid:=False
	This.save()
	
	// BDD mère ou le serveur APP (serveur HTTP non concerné dans cette version)
	Case of 
		: (OB Is defined($params; "cheminDocument"))
			// chemin du fichier dans $params (import par la palette)
			
		: (OB Is defined($params; "fichierDocument"))
			// remarque : a priori ici on est sur le serveur ou BDD mère (depuis le journal)
			// on a un contenu de fichier, l'enregistrer sur le DD
			$document:=cs.$document.new(Créer un dossier ALV; Temporary folder; New collection("ALV_tempo"))
			$result.contenu:=$document.EcrireLeContenu($params)
			// rappel : ici .cheminDocument est fixé
			$result.Error:=$result.contenu.Error
			$result.ErrorDescription:=$result.contenu.ErrorDescription
			// nettoyer
			OB REMOVE($params; "fichierDocument")
	End case 
	// ici "cheminDocument" doit exister dans $params
	
	Case of 
		: ($result.Error#0)
		: (Not(OB Is defined($params; "cheminDocument")))
			$result:=ds.initResult(-15068; "$params n'a pas d'attribut 'cheminDocument'"; False)
			
		: ($params.cheminDocument="")
			$result:=ds.initResult(-15043; cs._cfct.me.LireLocatedSTR(5081; New object("param_1"; "en ajout"; "param_2"; $params.cheminDocument)); False)
		Else 
			// fixer les formats du media
			
			// ici on a un chemin de document (sur DD, URL...)
			$chemin:=$params.cheminDocument
			$params.fichier:=File($chemin; fk platform path)
			OB REMOVE($params; "cheminDocument")
			
			// propriétés du media (dépend du type)
			$media.estReconnu($chemin)
			This.type:=$media.typeObjet
			This.format:=$media.MIME
			$params.typeDoc:=$media.typeDoc
			
			Case of 
				: ($quoi=imk URL)
					// URL !
					This.titre:=Localized string("81")+" ID_"+String(This.ID)
					This.taille:=0  // en kOctets
					// un fichier est toujours associé à une URL
					$result.fichier:=ds.Créer($quoi; "Fichiers"; $params)
					If ($result.fichier.success)
						// faire le lien avec le media
						$result.fichier.entitéAjoutée.media:=This.ID
						// le nom du fichier = URL
						$result.fichier.entitéAjoutée.nom:=$chemin
						$result.fichier.entitéAjoutée.dossier:=-1
						$result.fichier.entitéAjoutée.save()
						// charger le lien fichier : dans l'ordre
						This.save()
						This.reload()
						
						// créer les ressources
						$result.ressources:=This.CréerRessources()
						
						// pour le journal : l'URL ajoutée
						$params.cheminDocument:=$chemin
						// surcharger la valeur
						$params.Description_Action:=Localized string("3038")+", fichier '"+$chemin+"'"
					End if 
					
				: (Test path name($chemin)=Is a document)
					// document sur disque dur
					This.titre:=$params.fichier.name
					
					// fixer les données liées au fichier
					$result:=This.FixerFormats($params)
					
					// un media est toujours accroché à un [Fichiers]
					// et réciproquement un fichier est toujours accroché à un media de la BDD
					// un nouveau media est toujours ajouté au volume 0
					Case of 
						: ($result.Error#0)
						: (Not(Storage.System.Status ?? 2))
							// le dossier d'ajout est absent
							$result.Error:=-15042
							$result.ErrorDescription:="Le dossier d'ajout des media est absent"
						Else 
							// c'est ok
							$result.fichier:=ds.Créer(0; "Fichiers"; $params)
							If ($result.fichier.success)
								$result.fichier.entitéAjoutée.dossier:=ds.Dossiers.query("volume = :1"; 0)[0].ID
								$result.fichier.entitéAjoutée.media:=This.ID
								
								// fixer le nom du fichier
								$chemin:="00000"+String(This.ID)
								$chemin:=Substring($chemin; Length($chemin)-4)+$media.typeDoc
								$result.fichier.entitéAjoutée.nom:=$chemin
								
								$result.fichier.entitéAjoutée.save()
								// charger le lien fichier : dans l'ordre
								This.save()
								This.reload()
								
								// copier le document dans le dossier des importés
								// un nouveau fichier est toujours dans le dossier du volume = 0
								$result.dossier:=ds.Dossiers.query("volume = :1"; 0)[0].LeDossier()
								// nettoyer, au cas où
								$document:=File($result.dossier.path+$result.fichier.entitéAjoutée.nom; fk posix path)
								$document.delete()
								// déplacer le fichier dans la BDD
								$document:=$params.fichier.moveTo($result.dossier; $result.fichier.entitéAjoutée.nom)
								$result.fichierAjouté:=$document
								
								If ($result.fichierAjouté#Null)
									$params.cheminDuMediaAjouté:=$result.fichierAjouté.platformPath
									// surcharger la valeur
									$params.Description_Action:=Localized string("3045")+", fichier '"+$params.cheminDuMediaAjouté+"'"
									
									// maintenant que le media est en BDD, créer les ressources
									$result.ressources:=This.CréerRessources()
									$result.Error:=$result.ressources.Error
									$result.ErrorDescription:=$result.ressources.ErrorDescription
									
									// enregistrer le contenu dans le journal
									$result.contenu:=cs.$document.new(Est un document ALV; $params.cheminDuMediaAjouté).LireLeContenu($params)
									$result.Error:=$result.contenu.Error
									$result.ErrorDescription:=$result.contenu.ErrorDescription
									
								Else 
									$result.ErrorDescription:=ErrorDescription
									$result.Error:=ErrorNum
								End if 
								
								// s'il y a eu un pb, restaurer le fichier sur DD
								Case of 
									: ($result.Error=0)
									: ($params.fichier.exists)
										// il n'y a pas eu de déplacement
									Else 
										// remettre le fichier
										File($params.cheminDuMediaAjouté; fk platform path).moveTo($params.fichier.parent; $params.fichier.fullName)
								End case 
							End if 
					End case 
			End case 
	End case 
	
	This.save()
	cs.$trace.me.Créer($result.Error; Current method name; $result.ErrorDescription).LeverException([msgk_event; msgk_log])
	// ici, pour les 2 cas "Ajout DataStore" ou "Modifier DataStore_Extérieur", $params a les mêmes informations
	
	
Function FixerFormats($params : Object)->$result : Object
	// un fichier a été sélectionné : on initialise ses formats
	var $chemin; $RacineXML : Text
	var $Error; $largeur; $hauteur; $NbrePages; $Mode : Integer
	var $image : Picture
	
	$result:=ds.initResult()
	
	$result.Error:=-15042
	Case of 
		: (Not(OB Is defined($params; "fichier")))
		: (Not($params.fichier.exists))
		Else 
			$result.Error:=0
			
			$chemin:=$params.fichier.platformPath
			This.taille:=Round(Get document size($chemin)/1024; 1)  // en kOctets
			Case of 
				: (This.type=mdk Est une Image)
					// ne pas utiliser .LireLeFichier qui compresse le media
					READ PICTURE FILE($chemin; $image)
					$result.Error:=Erreur de lecture du fichier*Num(ok=0)
					
					// le reste !
					If ($result.Error=0)
						PICTURE PROPERTIES($image; $largeur; $hauteur)
						This.largeur:=$largeur
						This.hauteur:=$hauteur
						This.taille:=Round(Picture size($image)/1024; 1)  // en kOctets
						This.compression:=Round(3*($largeur)*($hauteur)/1024/This.taille; 3)
					End if 
					
				: (This.type=mdk Est un document PDF)
					This.taille:=Round(Get document size($chemin)/1024; 1)  // en kOctets
					
					If (Storage.System.Status ?? 21)  // test MacOS = test présence PlugIn
						$Error:=0
						$Error:=cs.$wrapperPlugIn.me.PropriétésPDF($chemin; ->$largeur; ->$hauteur; ->$NbrePages; ->$Mode)
						$result.Error:=Erreur de lecture du fichier*Num($Error#0)
						
						// le reste
						If ($result.Error=0)
							This.largeur:=$largeur
							This.hauteur:=$hauteur
							// en DUR : résolution du PDF = 300 dpi, et résolution écran = 72 dpi
							This.compression:=Round($NbrePages*3*($largeur)*300/72*($hauteur)*300/72/1024/This.taille; 3)  // taux de compression, ou échelle!
							This.NombreDePages:=$NbrePages
							
						Else 
							$result.ErrorDescription:="erreur de lecture des Propriétés du document PDF "+$chemin
						End if 
					End if 
					
				: (This.type=mdk Est un flux Video)
					This.taille:=Round(Get document size($chemin)/1024; 1)  // en kOctets
					
					If (Storage.System.Status ?? 21)  // test MacOS = test présence PlugIn
						// créer la vignette et renvoyer les dimensions
						$Error:=0
						$Error:=cs.$wrapperPlugIn.me.PropriétésVideo($chemin; ->$largeur; ->$hauteur; ->$image)
						$result.Error:=Fichier de sortie indisponible*Num($Error#0)
					Else 
						$result.Error:=Fichier de sortie indisponible
					End if 
					
					// le reste
					If ($result.Error=0)
						This.largeur:=$largeur
						This.hauteur:=$hauteur
					End if 
					
				: (This.type=mdk Est un flux Audio)
					$image:=cs._rsc.me.image(16206)
					PICTURE PROPERTIES($image; $largeur; $hauteur)
					This.largeur:=$largeur
					This.hauteur:=$hauteur
					
				: (This.type=mdk Est un document SVG)
					ErrorNum:=0
					$RacineXML:=DOM Parse XML source($chemin)
					$result.Error:=Erreur de lecture du fichier*Num(ErrorNum#0)
					If ($result.Error=0)
						SVG EXPORT TO PICTURE($RacineXML; $image; Copy XML data source)
						DOM CLOSE XML($RacineXML)
						PICTURE PROPERTIES($image; $largeur; $hauteur)
						This.largeur:=$largeur
						This.hauteur:=$hauteur
					Else 
						$result.ErrorDescription:="erreur de lecture du fichier SVG <"+$chemin+">"
					End if 
					
				: (This.type=mdk Est un Document externe)
					This.taille:=0  // en kOctets
					
				Else 
					$result.Error:=Chemin externe invalide
			End case 
			This.save()
	End case 
	
	
Function ModifierAutre()->$result : Object
	// Edition / modification des autres informations par FORM
	$result:=New object
	// pas de contexte
	$result.Contexte:=New object
	// attributs modifiables
	$result.Modifications:=New collection
	
	
	// ----------------------
	//MARK:BDD media
	// -----------------------
	
Function existeFichierSurDD()->$result : Boolean
	var $errorDescription : Text
	
	If (This.leFichier=Null)
		$result:=False
		$errorDescription:=cs._cfct.me.LireLocatedSTR(5074; New object("param_1"; String(This.ID)))
		cs.$trace.me.Créer(Chemin dans la BDD invalide; Current method name; $errorDescription).LeverException([msgk_event; msgk_log])
		
	Else 
		$result:=This.leFichier[0].existeSurDD()
	End if 
	
	
	// ----------------------
	//MARK:APP mobile
	// -----------------------
	
exposed Function get vignetteMedia($event : Object)->$result : Picture
	$result:=This.vignette
	// passer en jpeg
	CONVERT PICTURE($result; "image/jpeg"; 0.8)
	
	
exposed Function get photo($event : Object)->$result : Picture
	// sur android la photo ne s'affiche pas
	// v10.7.17 la table [Medias] n'est pas chargée à la construction de l'app.
	var $path; $nomFichier : Text
	var $pict : Picture
	
	$path:=cs.$document.new().GetMobileMediaFolder().platformPath
	$nomFichier:="media_"+String(This.ID)+".jpg"
	// cas normal
	READ PICTURE FILE($path+$nomFichier; $pict)
	$result:=$pict
	
	
exposed Function get description($event : Object)->$result : Text
	// décrire les zones accrochées à this
	var $sélection : Object
	var $texte : Text
	var $c : Collection
	var $ID : Integer
	
	$sélection:=This.lesZones
	Case of 
		: ($sélection.lesInstantanes.length=1)
			// lié à un event
			$texte:=$sélection.lesInstantanes.leEvent[0].Libellé(New object("Options"; 0x0103DD00))
			$result:="Photo prise lors "+$texte
			
		: ($sélection.lesPaysages.length=1)
			// un lieu
			$texte:=$sélection.lesPaysages.leLieu[0].Libellé(New object("Options"; 0x00CA0000))
			$result:="Photo prise à "+$texte
	End case 
	
	// récupérer les zones personnages
	If ($sélection.lesPersonnages.length>0)
		// attention : éviter de mettre le bazar dans les sélections utilisées
		// ici, on n'utilise pas les liens pour remonter aux personnes ; cela perturbe les autres fonctions (tri par la date en particulier)
		$c:=$sélection.lesPersonnages.orderBy("laZone.gauche asc").extract("personne")
		$texte:=""
		For each ($ID; $c)
			$texte:=$texte+", "+ds.Personnes.get($ID).Libellé(New object("Options"; 0x0003))
		End for each 
		// nettoyer
		$texte:=Substring($texte; 3)
		
		$texte:=Choose($c.length=1; "Personne présente : "; "Personnes présentes (de gauche à droite) : ")+$texte
		$result:=$result+(". "*Num(Length($result)>0))+$texte
	End if

⇧ [class]MediasSelection - 10/05/2026 19:38:17

      Class extends EntitySelection

Function IDcodés()->$c : Collection
	$c:=cs._ds.me.IDcodés(This)
	
	
	// ----------------------
	// MARK:Sélections
	// -----------------------
	
Function GetData($params : Object)
	// ici on est sur le serveur, ou BDD mère
	var $c : Collection
	var $entité; $objet : Object
	var $image : Picture
	var $blob : Blob
	var $dataTexte : Text
	
	$c:=New collection
	For each ($entité; This)
		$objet:=New object
		$objet.index:=$entité.indexOf(This)
		$objet.ID:=$entité.ID
		$objet.titre:=$entité.titre
		$objet.dateNum:=$entite.dateNum
		$objet.IDcodé:=$entité.IDcodé()
		$objet.private:=$entité.private
		
		// ajouter la vignette (encodée B64 pour passer dans un objet)
		SET BLOB SIZE($blob; 0)
		$image:=$entité.vignette
		VARIABLE TO BLOB($image; $blob)
		BASE64 ENCODE($blob; $dataTexte)
		$objet.vignette:=$dataTexte
		$c.push($objet)
	End for each 
	$params.sélection:=$c
	
	
Function LesLieux()->$result : cs.LieuxSelection
	$result:=This.lesZones.lesPaysages.leLieu
	
	
Function LesMedias()->$result : cs.MediasSelection
	$result:=This
	
	
Function Filtrer($params : Object)->$result : cs.MediasSelection
	// filtrer le type de zone
	
	$result:=This
	Case of 
		: (This.length=0)
		: (Count parameters=0)
		: (OB Is defined($params; "IDgroupe"))
			$result:=This.query("private = :1 or private = :2"; 0; $params.IDgroupe)
	End case 
	
	
	// ----------------------
	// MARK:Affichage
	// -----------------------
	
Function CréerListBox($attribut : Text)->$result : Collection
	var $entité : cs.MediasEntity
	var $élément : Object
	
	$result:=New collection
	
	For each ($entité; This)
		$élément:=$entité.CréerListBox($attribut)
		$result.push($élément)
	End for each 
	
	
	// ----------------------
	// MARK:BDD media
	// -----------------------
	
Function TesterCheminFichiers($tache : cs.xSDK.Tache)
	// vérifier que chaque media de la sélection a un fichier sur le DD
	var $entité : cs.MediasEntity
	var $c : Collection
	var $data : Object
	var $errorDescription : Text
	
	// collection des dossiers media non accessibles
	$c:=New collection
	For each ($entité; This) While (Not($tache.Tuer.signaled))
		Case of 
			: ($entité.type=200)
				// document externe ; pas de chemin par principe
				
			: ($entité.existeFichierSurDD())
				// ok
				
			Else 
				// le dossier medias ne semble pas accessible
				If ($c.query("volume = :1"; $entité.LeVolume().volume).length=0)
					$c.push($entité.LeVolume())
				End if 
		End case 
		
		$tache.FixerTime(Int(2000*$entité.indexOf(This)/This.length))
	End for each 
	
	// dossiers media non accessibles
	For each ($data; $c)
		$errorDescription:=Convert path POSIX to system($data.LeChemin(""))
		cs.$trace.me.Créer(Chemin externe invalide; Current method name; $errorDescription).LeverException([msgk_event; msgk_log])
	End for each 
	
	
Function TesterFichier($tache : cs.xSDK.Tache)
	// vérifier que chaque media de la sélection n'a qu'un fichier sur le DD
	var $entité : cs.MediasEntity
	var $fichier : cs.FichiersEntity
	var $selection : Object
	var $errorDescription : Text
	
	For each ($entité; This) While (Not($tache.Tuer.signaled))
		$selection:=ds.Fichiers.query("media = :1"; $entité.ID)
		
		If ($selection.length>1)
			
			For each ($fichier; $selection)
				$errorDescription:=cs._cfct.me.LireLocatedSTR(5075; New object("param_1"; String($entité.ID); "param_2"; $fichier.LeFichier().platformPath))
				cs.$trace.me.Créer(-15042; Current method name; $errorDescription).LeverException([msgk_event; msgk_log])
			End for each 
			
			$tache.FixerState($tache.State+1)
		End if 
	End for each 
	
	
Function TesterPagesPDF($tache : cs.xSDK.Tache)
	// vérifier que tous les medias PDF ont leurs pages dans un dossier "xxxPDF_Images" 
	var $entité : cs.MediasEntity
	var $data : Object
	var $i; $SystemStatus : Integer
	
	// forcer la lecture des dossiers "xxxPDF_Images"
	$SystemStatus:=Storage.System.Status
	Use (Storage.System)
		Storage.System.Status:=Storage.System.Status ?- 21
	End use 
	
	For each ($entité; This) While (Not($tache.Tuer.signaled))
		If ($entité.NombreDePages>0)
			
			For ($i; 1; $entité.NombreDePages)
				$data:=New object("param_1"; String($i)+" / media PDF "+String($entité.ID))
				$tache.FixerEtat(cs._cfct.me.LireLocatedSTR(5105; $data))
				
				If (Length(cs.$media.new().FichierDePagePDF($entité.LeFichier().platformPath; $i))=0)  // récupérer le chemin du doc. JPEG
					$data:=New object("param_1"; String($i); "param_2"; String($entité.ID))
					cs.$trace.me.Créer(Chemin dans la BDD invalide; Current method name; cs._cfct.me.LireLocatedSTR(5104; $data)).LeverException([msgk_event; msgk_log])
					
					$tache.FixerState($tache.State+1)
				End if 
			End for 
		End if 
		
		Waiting(3)
		$tache.FixerTime(4000+Int(2000*$entité.indexOf(This)/This.length))
	End for each 
	
	//restaurer l'état
	Use (Storage.System)
		Storage.System.Status:=$SystemStatus
	End use 
	
	
Function TesterLecture($tache : cs.xSDK.Tache)
	// vérifier que chaque media de la sélection est lisible
	var $entité : cs.MediasEntity
	var $fichier : 4D.File
	var $pict : Picture
	var $errorDescription : Text
	
	For each ($entité; This) While (Not($tache.Tuer.signaled))
		$fichier:=$entité.LeFichier()
		
		If ($fichier.extension#".xfam")  // les documents cryptés sont ignorés
			$errorDescription:=cs._cfct.me.LireLocatedSTR(5107; New object("param_1"; "image "+String($entité.ID)))
			$tache.FixerEtat($errorDescription)
			
			READ PICTURE FILE($fichier.platformPath; $pict)
			If (ok=0)
				$errorDescription:=cs._cfct.me.LireLocatedSTR(5106; New object("param_1"; "image "+String($entité.ID)))
				cs.$trace.me.Créer(Erreur de lecture du fichier; Current method name; $errorDescription).LeverException([msgk_event; msgk_log])
				
				$tache.FixerState($tache.State+1)
			End if 
		End if 
		
		Waiting(3)
		$tache.FixerTime(6000+Int(2000*$entité.indexOf(This)/This.length))
	End for each

⇧ [class]$formulaire_SF_Activities - 26/02/2026 09:06:06

      property choixActivities; Web_serveur : Object
property InformationsServeurHTTP : Object
property listeServeursWeb : Collection
property listeServeursWebPosition : Integer
property Affichage : Text

Class extends $formulaire

Class constructor()
	
	Super()
	This.listeServeursWeb:=New collection
	
	
	
	// ----------------------
	//MARK:FORMevents FORM
	// ----------------------
	
Function _FORM()
	
	Case of 
		: (FORM Event.code=On Load)
			
			This.onEndLoad()
			This.MettreAjour()
			
	End case 
	
	
Function onEndLoad()
	var $c : Collection
	
	$c:=New collection("choixActivities"; "listeServeursWeb")
	Super.onEndEventForm($c)
	
	
	// ----------------------
	//MARK:Fond
	// ----------------------
	
Function _FORM_choixActivities()
	var $c : Collection
	var $texte : Text
	
	Case of 
		: (FORM Event.code=On Load)
			Form[This.nomOBJ]:=New object
			Form[This.nomOBJ].values:=New collection(Localized string("10801"); Localized string("10802"); Localized string("10803"))
			Form[This.nomOBJ].index:=0
			Form.Pages:=New collection(1; 2; 3)
	End case 
	
	If ((FORM Event.code=On Load) | (FORM Event.code=On Clicked))
		// remarque (cf doc 4D) : en 4Dclient 'Sur chargement' est appelé uniquement quand cette page est affichée
		// dans les autres cas (la page est en n°2) 'Sur chargement' est appelé quand les pages autres que 1 sont affichées (=> ré init de la page 1)
		FORM GOTO PAGE(Form.Pages[Form[This.nomOBJ].index]; *)
		// remarque : * change de page du sous formulaire
		
		// créer le contenu de l'affichage
		Case of 
			: (Form[This.nomOBJ].index=0)
				// voir méthode objet
				
			: (Form[This.nomOBJ].index=1)
				$c:=Process activity(Processes only).processes
				$texte:=String($c.length)+" process, dont "+String($c.query("type < 0").length)+" process 4D, et "+String($c.query("name = :1"; "process web").length)+" process Web"
				$c:=$c.insert(0; New object("Détails"; $texte))
				Form.processes:=JSON Stringify($c; *)
				
			: (Form[This.nomOBJ].index=2)
				If (Process activity(Sessions only)=Null)
					Form.sessions:="Aucune session"
				Else 
					$c:=Process activity(Sessions only).sessions
					Form.sessions:=JSON Stringify($c; *)
				End if 
		End case 
	End if 
	
	
	// ----------------------
	//MARK:Page 1
	// ----------------------
	
Function _FORM_listeServeursWeb()
	var $serveur : Object
	var $dataTexte : Text:=""
	
	Case of 
		: (FORM Event.code=On Load)
			This.listeServeursWeb:=New collection
			
			Case of 
				: (This.InformationsServeurHTTP=Null)
				: (This.InformationsServeurHTTP.length=0)
				Else 
					Form.listeServeursWeb:=OB Keys(This.InformationsServeurHTTP)
					
					LISTBOX SELECT ROW(*; "listeServeursWeb"; 1; lk replace selection)
					Form.listeServeursWebPosition:=1
			End case 
	End case 
	
	Case of 
		: (Form.listeServeursWebPosition=0)
		: ((FORM Event.code=On Load) | (FORM Event.code=On Selection Change))
			$serveur:=This.InformationsServeurHTTP[Form.listeServeursWeb[Form.listeServeursWebPosition-1]]
			
			cs.xSDK.ResourceALV.me.SetVariable(Est Ressource WEB; "Serveur_web/nomDossierSSL"; Is text; ->$dataTexte)
			If ($serveur.serveurWeb.name=WEB Server(Web server host database).name)
				cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Serveurs_ALV/nomDossierSSLserveurAPP"; Is text; ->$dataTexte)
			End if 
			
			Form.Web_serveur:=New object("serveur"; $serveur; "afficher"; True; "nomCertificat"; $dataTexte; "iconeVisible"; False; "clignotant"; 0; "data"; New object("isRunning"; False))
	End case 
	
	
	// ----------------------
	// MARK:Gestion formulaire
	// -----------------------
	
Function MettreAjour()
	Case of 
		: (This.InformationsServeurHTTP=Null)
		: (This.InformationsServeurHTTP.length=0)
			// pas d'info du formulaire maitre
		: (This.listeServeursWeb.length=0)
			// sous formulaire non actif
		Else 
			// infos disponibles
			This.Web_serveur.data.isRunning:=This.InformationsServeurHTTP[This.listeServeursWeb[This.listeServeursWebPosition-1]].serveurWeb.isRunning
	End case

⇧ [class]CommunesEntity - 16/04/2026 09:23:20

      Class extends Entity

Function IDcodé()->$ID : Integer
	$ID:=cs._ds.me.IDcodé(This)
	
	
Function Libellé($userFormats : Object)->$libellé : Text
	// renvoie le nom formaté suivant les options $formats
	// $formats
	// .Options
	//   bit  9 = entête lieu   :" à "
	//   bit 16 = ajouter le n° de département à la commune
	var $formats : Object
	var $texte : Text
	
	$libellé:=""
	$texte:=""
	$formats:=New object("Options"; 0x00010000)
	Case of 
		: (Count parameters=0)
		: (OB Is defined($userFormats; "Options"))
			$formats:=$userFormats
	End case 
	
	Case of 
		: (This=Null)
		: (This.nom="")
		Else 
			$libellé:=Localized string("1012")*Num($formats.Options ?? 9)
			$libellé+=(("("+String(This.Le("Departements").numero)+") ")*Num($formats.Options ?? 16)*Num(This.Le("Departements").numero#0))
			$libellé+=This.nom
			$texte:=This.Le("Departements").Libellé($formats)
			$libellé+=($texte*Num(Length($texte)>0))
	End case 
	
	
Function Icone()->$pict : Picture
	// renvoyer l'icone de l'entité
	var $result : Object
	
	$result:=ds.LeIcone(This; "blason")
	$pict:=$result.icone
	
	
	// ----------------------
	//MARK:Sélections
	// -----------------------
	
Function Le($DataClassNom : Text)->$result : Object
	// renvoie l'entité [$DataClassNom]
	If ($DataClassNom=This.getDataClass().getInfo().name)
		$result:=This
	Else 
		$result:=This.leDepartement.Le($DataClassNom)
	End if 
	
	
	// ----------------------
	// MARK:Modification DataStore
	// -----------------------
	
Function Ajouter($quoi : Integer; $qui : Object; $params : Object)->$result : Object
	// ajouter un lieu à this
	ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "Début de l'ajout à ["+This.getDataClass().getInfo().name+"]"))
	$result:=ds.initResult()
	
	Case of 
		: ($quoi=geok Site)
			// sous traiter
			$result:=ds.AjouterLienRetour($quoi; This; $qui; $params)
			// retour sur le lieu du site créé
			$result.entitéRetour:=$result.entitéAjoutée.lesLieux[0]
			
		: ($quoi=geok Département)
			// créer un département à la région courante
			$result:=ds.AjouterLienRetour($quoi; This.leDepartement.laRegion; Null; $params)
			// accrocher la commune à ce département
			If ($result.Error=0)
				This.departement:=$result.entitéAjoutée.ID
				This.save()
			End if 
	End case 
	// pour le journal
	$params.Description_Action:=Localized string(String($quoi))+Localized string("33")+This.Libellé()
	
	$result.success:=($result.Error=0)
	ds.NotifierResultat(This; $quoi; $result)
	
	
Function _FixerDonnées($quoi : Integer; $params : Object)->$result : Object
	// une commune a été créée: on initialise ses données suivant 2 cas
	var $entité : Object
	var $JALV_UUID : Text
	
	$result:=ds._FixerDonnées(This; $quoi; $params)
	
	// pour le journal
	$result.LectureJournal:=False
	
	// rappel : un site et un lieu ont été créés ; les taguer 'autres'
	This.reload()
	If (This.lesSites.length=1)
		$entité:=This.lesSites[0]
		$entité.type:=50500
		$entité.save()
		
		// pour le journal
		$JALV_UUID:="JALV_UUID_"+String(geok Site)
		If (OB Is defined($params; $JALV_UUID))
			// cas ajout par lecture du journal
			$result.LectureJournal:=True
			$entité.IDunique:=$params[$JALV_UUID]  // utiliser cet UUID
			$entité.save()
			
		Else 
			// cas ajout par BDD mère, le serveur APP ou par le site Web
			// renseigner le journal
			$params[$JALV_UUID]:=$entité.IDunique
		End if 
		
		If ($entité.lesLieux.length=1)
			$entité:=$entité.lesLieux[0]
			$entité.type:=60700
			$entité.save()
			
			// pour le journal
			$JALV_UUID:="JALV_UUID_"+String(geok Lieu)
			If (OB Is defined($params; $JALV_UUID))
				// cas ajout par lecture du journal
				$result.LectureJournal:=True
				$entité.IDunique:=$params[$JALV_UUID]  // utiliser cet UUID
				$entité.save()
				
			Else 
				// cas ajout par BDD mère, le serveur APP ou par le site Web
				// renseigner le journal
				$params[$JALV_UUID]:=$entité.IDunique
			End if 
		End if 
	End if 
	// ici, pour les 2 cas "Ajout DataStore" ou "Modifier DataStore_Extérieur", $params a les mêmes informations
	
	
Function _TriggerCreer()
	var $entité : cs.SitesEntity
	
	This.nom:=Localized string("39")+" ID_"+String(This.ID)
	
	// ajouter un site
	$entité:=ds.Sites.new()
	ds._TriggerHoroDater($entité)
	
	// fixer l'identifiant
	ds.FixerIDentification($entité)
	$entité.commune:=This.ID
	// appeler le trigger du site
	$entité._TriggerCreer()
	
	$entité.save()
	
	
	// ----------------------
	//MARK:Interface externe
	// -----------------------
	
Function CopierVersObjet($entitéExt : Object)
	// recopier les attributs de this dans $entitéExt (pour une utilisation hors BDD mère)
	var $entité : Object
	
	$entitéExt.ID:=This.ID
	$entitéExt.IDunique:=This.IDunique
	
	$entitéExt.nom:=This.nom
	$entitéExt.blason:=This.blason
	
	// le departement
	// demander à l'appelant sa classe Departements
	$entité:=OB Copy($entitéExt.protoDepartement)
	// faire compléter
	This.leDepartement.CopierVersObjet($entité)
	$entitéExt.leDepartement:=$entité
	
	
	// ----------------------
	//MARK:APP mobile
	// -----------------------
	
exposed Function get photo($event : Object)->$result : Picture
	var $pict : Picture
	
	If (estAppelMobile)
		$pict:=This.blason
		
		If (Picture size($pict)=0)
			// mettre un blason standard
			$pict:=cs._rsc.me.image(17100)
			
		Else 
			// convertir le format d'origine en jpeg
			CONVERT PICTURE($pict; "image/jpeg")
			$result:=$pict
		End if 
		
		CREATE THUMBNAIL($pict; $result; 128; 128)
	End if 
	
	
exposed Function get administration($event : Object)->$result : Text
	// département, région et pays
	$result:=This.leDepartement.Libellé(New object("Options"; 0x00C90000))
	
	
exposed Function get commentaire($event : Object)->$result : Text
	// rappel : un lieu type 60700 existes pour toutes les communes
	// il sert de commentaire à la commune
	var $sélection : Object
	
	$result:=""
	$sélection:=This.lesSites.lesLieux.query("type = :1"; 60700)
	If ($sélection.length>0)
		$result:=$sélection[0].commentaire
		$result:=$result+ds._FinirTexteFormDetail()
	End if

⇧ [class]FichiersEntity - 15/04/2026 09:29:44

      Class extends Entity

Function IDcodé()->$ID : Integer
	$ID:=cs._ds.me.IDcodé(This)
	
	
	// ----------------------
	// MARK:Sélections
	// -----------------------
	
Function LeVolume()->$dossier : Object
	// renvoie le dossier media de this (volume>0)
	$dossier:=This.leDossier
	If ($dossier.volume<0)
		$dossier:=$dossier.leDossierParent.leDossier.LeVolume()
	End if 
	
	
local Function CheminDuFichier()->$chemin : Text
	// rappel important : les classes s'exécutent par défaut sur le serveur. Forcer l'exécution en local pour avoir accès au DD du client
	// -> pas utile avec la BDDmère
	// renvoie le chemin POSIX de this sur le DD
	If (This.dossier=-1)
		// document externe
		$chemin:=This.nom
		
	Else 
		// document en BDD
		$chemin:=This.leDossier.LeChemin(This.nom)
	End if 
	
	
local Function LeFichier()->$result : 4D.File
	// renvoie l'objet fichier de this sur le DD
	$result:=File(This.CheminDuFichier())
	
	
local Function LeDossier()->$result : Object
	// renvoie l'objet dossier de this sur le DD
	$result:=Folder(This.leDossier.LeChemin(""))
	
	
	// ----------------------
	// MARK:Modification DataStore
	// -----------------------
	
Function _FixerDonnées($quoi : Integer; $params : Object)->$result : Object
	// un fichier a été créé : on initialise ses données
	var $typeObjet : Integer
	var $media : cs.$media
	
	$result:=ds._FixerDonnées(This; $quoi; $params)
	$media:=cs.$media.new()
	
	$result.Error:=-15068
	$typeObjet:=0
	Case of 
		: (Not(OB Is defined($params; "fichier")))
			// il faut un chemin de fichier
			$result.ErrorDescription:="Absence du paramètre 'fichier'"
			
		: ($quoi=imk URL)
			// lien externe
			$result.Error:=0
			
		: (Not($params.fichier.isFile))
			$result.ErrorDescription:="'fichier' n'est pas un chemin de dossier"
		: (Not($params.fichier.exists))
			$result.ErrorDescription:="'fichier' n'existe pas"
		: (Not($media.estReconnu($params.fichier.platformPath)))
			$result.ErrorDescription:="le type  de media 'fichier' n'est pas connu"
		Else 
			$result.Error:=0
	End case 
	
	If ($result.Error=0)
		This.nom:=$params.fichier.fullName
		
		Case of 
			: (Not(OB Is defined($params; "IDvolume")))
				// lien vers le media
				This.media:=Num(This.nom)
				
			: (($params.IDvolume>=0) & ($params.IDvolume<=80))
				// medias de la BDD !!! en dur
				// lien vers le media
				This.media:=Num(This.nom)
				
			: ($params.volume=82)
				// medias d'un dossier extérieur
				This.media:=-$media.typeObjet
		End case 
	End if 
	This.save()
	
	
	// ----------------------
	// MARK:BDD media
	// -----------------------
	
local Function existeSurDD()->$result : Boolean
	// rappel important : les classes s'exécutent par défaut sur le serveur. Forcer l'exécution en local pour avoir accès au DD du client
	var $errorDescription; $chemin : Text
	var $cheminObjet : Object
	
	$result:=False
	
	Case of 
		: (This.dossier=-1)
			// le fichier est externe à la BDD
			
		: (Storage.System.typeApplication=ALV Serveur APP)
			// filtrer ces cas
			
		: (Storage.System.typeApplication=ALV BDD mère)
			//  il faut que le chemin soit valide
			$chemin:=This.CheminDuFichier()
			$cheminObjet:=Path to object($chemin)
			
			Case of 
				: (($cheminObjet.isFolder) | ($cheminObjet.extension=""))
					//  $chemin n'est pas un nom de fichier valide
					$errorDescription:=cs._cfct.me.LireLocatedSTR(5081; New object("param_1"; String(This.media); "param_2"; $chemin))
					cs.$trace.me.Créer(Chemin externe invalide*Num(Not($result)); Current method name; $errorDescription).LeverException([msgk_event; msgk_log])
					
				: (Not(File($chemin).exists))
					//  le fichier n'existe pas sur le DD
					cs.$trace.me.Créer(Erreur de lecture du fichier*Num(Not($result)); Current method name; "Le fichier n'existe pas sur le DD ("+$chemin+")").LeverException([msgk_event; msgk_log])
					
				Else 
					$result:=True
			End case 
			
		: (Storage.System.typeApplication=ALV Client APP)
			$chemin:=This.CheminDuFichier()
			$result:=File($chemin).exists
	End case

⇧ [class]EventsSelection - 16/04/2026 11:46:22

      Class extends EntitySelection


Function IDcodés()->$c : Collection
	$c:=cs._ds.me.IDcodés(This)
	
	
	// ----------------------
	// MARK:Affichage
	// -----------------------
	
Function CréerListBox($params : Object)
	// créer la listBox
	var $entité : cs.EventsEntity
	var $c : Collection
	var $élément : Object
	
	$params.formats:=New object("Options"; 19)
	$params.styleEvent:="'font-weight:bold;font-size:14pt'"
	
	$c:=New collection
	For each ($entité; This)
		// un item
		$élément:=$entité.CréerListBox($params)
		$c.push($élément)
	End for each 
	$params.liste:=$c
	
	
Function CréerListBoxPerso($params : Object)
	// créer la listBox
	var $entité : cs.EventsEntity
	var $c : Collection
	var $élément : Object
	
	$params.formats:=New object("Options"; 0)
	$params.styleEvent:="'font-weight:bold;font-size:14pt'"
	
	$c:=New collection
	For each ($entité; This)
		// un item
		$élément:=$entité.CréerListBoxPerso($params)
		$c.push($élément)
	End for each 
	$params.liste:=$c
	
	
Function CréerListBoxMedia($params : Object)
	var $sélection : cs.MediasSelection
	
	// sélectionner les media de this de type $params.typeZone
	$sélection:=This.lesIllustrations.laZone.query("type= :1"; $params.typeZone).leMedia
	// filtrer les medias privés
	$sélection:=$sélection.query("private = :1 or private = :2"; 0; $params.IDgroupe)
	// trier
	$sélection:=$sélection.orderBy("dateNum asc, heure asc")
	
	// demander la LB
	$params.liste:=$sélection.CréerListBox($params.attribut)
	
	
	// ----------------------
	// MARK:Sélections
	// -----------------------
	
Function LesPatronymes()->$result : Text
	var $c1; $c2 : Collection
	
	// évènements perso
	$c1:=This.leEventPersonnel.laPersonne.lePatronyme.distinct("patronyme")
	// ajouter les évènements familiaux
	$c2:=$c1.combine(This.leEventFamilial.laFamille.leGroupe.lesMembres.laPersonne.lePatronyme.distinct("patronyme"))
	$c2:=$c2.distinct().orderBy(ck ascending)
	// créer la liste
	$result:=$c2.join(", ")
	
	
Function LesPersonnes()->$result : cs.PersonnesSelection
	var $sélection : cs.PersonnesSelection
	
	// les personnes des évènements perso
	$sélection:=This.leEventPersonnel.laPersonne
	// ajouter celles des évènements familiaux
	$result:=$sélection.or(This.leEventFamilial.laFamille.leGroupe.lesMembres.laPersonne)
	
	
Function LesMembres()->$result : Text
	var $event : Object
	var $c : Collection
	
	$c:=New collection
	For each ($event; This)
		$c:=$c.push($event.LesProtagonistes().orderBy("sexe asc").nom.join("-"))
	End for each 
	$c:=$c.distinct().orderBy(ck ascending)
	// créer la liste
	$result:=$c.join(", ")
	
	
Function LesMedias($params : Object)->$result : cs.MediasSelection
	// sélectionner les media de this de type $params.typeZone, eventuellement privé
	$result:=This.lesIllustrations.laZone.Filtrer($params).leMedia.Filtrer($params)
	$result:=$result.orderBy("dateNum asc, heure asc")
	
	
Function LesLieux($params : Object)->$result : cs.LieuxSelection
	// sélectioner les lieux de ces events
	$result:=ds.Lieux.newSelection()
	
	// les lieux liés aux events
	$result:=$result.add(This.leLieu)
	
	
Function Filtrer($params : Object; $filtreID : Collection)->$result : cs.EventsSelection
	
	$result:=ds.Events.newSelection()
	
	If (OB Is defined($params; "type"))
		$params.typeMin:=$params.type
		$params.typeMax:=$params.type
	End if 
	
	Case of 
		: (Not(OB Is defined($params; "date")))
			cs.$trace.me.Créer(-15068; Current method name; "'date' n'est pas défini dans $1").LeverException([msgk_event; msgk_log])
			
		: (Not(OB Is defined($params.date; "StartNum")))
			cs.$trace.me.Créer(-15068; Current method name; "'StartNum' n'est pas défini dans $1.date").LeverException([msgk_event; msgk_log])
			
		: (Not(OB Is defined($params.date; "StopNum")))
			cs.$trace.me.Créer(-15068; Current method name; "'StopNum' n'est pas défini dans $1.date").LeverException([msgk_event; msgk_log])
			
		: (Not(OB Is defined($params; "typeMin")))
			cs.$trace.me.Créer(-15068; Current method name; "'typeMin' n'est pas défini dans $1").LeverException([msgk_event; msgk_log])
			
		: (Not(OB Is defined($params; "typeMax")))
			cs.$trace.me.Créer(-15068; Current method name; "'typeMax' n'est pas défini dans $1").LeverException([msgk_event; msgk_log])
			
		Else 
			// ok on a tout
			$result:=This.query("dateNum >= :1 and dateNum <= :2 and  type >= :3 and type <= :4"; $params.date.StartNum; $params.date.StopNum; $params.typeMin; $params.typeMax)
			
			If (Count parameters>1)
				$result:=$result.query("ID in :1"; $filtreID)
			End if 
	End case 
	
	
	// ----------------------
	//MARK:APP mobile
	// -----------------------
	
exposed local Function etatCivil()->$result : Text
	// lister les events 'date' 'libellé protagonistes'
	var $formats : Object
	var $event : Object  // cs.EventsEntity interdit !
	
	$result:=""
	// on veut le symbole event, 'le'
	$formats:=New object("Options"; 0x00109000; "FormatDate"; Internal date short)
	For each ($event; This)
		$result:=$result+Char(Line feed)+"  "+($event.FormaterHeure($formats)+" "+$event.Libellé($formats))
	End for each 
	$result:=Replace string($result; Char(Line feed); ""; 1)

⇧ [class]$processUser - 08/05/2026 11:18:16

      property params : Object

Class extends $process

Class constructor()
	
	Super()
	
	
	// ----------------------
	// MARK:Navigation
	// -----------------------
	
Function FixerNomProcess($type : Text; $params : Object)->$result : Text
	// le nom d'un process editeur est de la forme $type {?numTable+?} contexte {+?rang}
	var $i : Integer
	
	// nom du process par défaut (en particulier les formulaires n'ont pas de numTable)
	$result:=$type+(Num($params.numTable>0)*("?"+String($params.numTable)))+"?"+$params.Contexte
	
	Case of 
		: (Not(OB Is defined($params; "nouveauProcess")))
		: (Not($params.nouveauProcess))
		: (Process number($result)=0)
			// on utilise ce process
		Else 
			// nouveau process demandé
			$i:=0
			Repeat 
				$i:=$i+1
			Until (Process number($result+"?"+String($i))=0)
			$result:=$result+"?"+String($i)
	End case 
	
	
Function FixerNavigationDeQui($nomProcess : Text; $data : Object)
	var $process : Object
	
	$process:=This.getNavigationProcess($nomProcess)
	sharedObject($data; $process.Informations)
	
	
Function getNavigationProcess($nomProcess : Text)->$result : Object
	var $processes; $data; $params : Object
	
	$processes:=Storage.System.Navigation.Process
	Use ($processes)
		If ($processes[$nomProcess]=Null)
			$processes[$nomProcess]:=New shared object
			$data:=$processes[$nomProcess]
			Use ($data)
				// peut être surchargé par la suite
				$data.Informations:=New shared object
			End use 
			$params:=$data.Informations
			Use ($params)
				$params.deQui:=New shared object
			End use 
		End if 
	End use 
	
	$result:=$processes[$nomProcess]
	
	
Function FixerSélection($params : Object)
	// fixer .deQui du process 
	var $process : Object
	
	Case of 
		: (Not(OB Is defined($params; "nomProcess")))
		: (Not(OB Is defined($params; "deQui")))
		Else 
			$process:=This.getNavigationProcess($params.nomProcess)
			sharedObject($params.deQui; $process.Informations.deQui)
	End case 
	
	
Function LireSélection()->$result : Object
	// renvoyer le .deQui du process 
	$result:=OB Copy(Storage.System.Navigation.Process[Current process name].Informations.deQui)
	
	
	// ----------------------
	// MARK:Formulaires
	// -----------------------
	
Function ExécuterMenu($params : Object)->$result : Boolean
	// on reçoit les paramètres d'un menu
	
	$result:=True
	Case of 
		: (This.AfficherVisualisateur($params))
			// c'est ouvert
			
		: (This.ModifierVisualisateur())
			// c'est fait
			
		: (This.AfficherPalette($params))
			
		: (This.AfficherFormulaire($params))
			
		: (This.ActionSession($params))
			
		: (This.AfficherDialogue($params))
			
		: (This.AfficherFormulaireComposant($params))
			
		Else 
			$result:=False
	End case 
	
	
Function AfficherVisualisateur($params : Object)->$result : Boolean
	// ici un visualisateur = un éditeur ou un consulteur
	// la fonction affiche dans un visualisateur avec une nouvelle sélection
	
	$result:=($params.type="Visualisateur")
	
	If ($result)
		// exécuter la commande
		This.params:=$params
		This.ModifierVisualisateur($params)
	End if 
	
	
Function ModifierVisualisateur($params : Object)->$result : Boolean
	// ici un visualisateur = un éditeur ou un consulteur
	// la fonction affiche dans un visualisateur une sélection construite à partir de .deQui
	var $class : Object
	
	$result:=False
	Case of 
		: ($params.type#"Visualisateur")
		: (OB Keys(cs).indexOf($params.DataClassNom)=-1)
		Else 
			$result:=True
			
			// nom de classe reconnu
			// renseigner le formulaire à utiliser
			$class:=cs[$params.DataClassNom].new()
			// .params a été initialisé
			$class.params:=$class.informations
			
			// nouveau process ?
			If (OB Is defined($params; "nouveauProcess"))
				$class.params.nouveauProcess:=$params.nouveauProcess
			End if 
			
			// fixer deQui, le(s) IDcodés
			// puisque l'appel vient d'un menu, on a toujours une sélection d'entités courante
			// rappel : une option utilisateur peut la réduire à l'entité courante
			$class.params.deQui:=$params.deQui
			
			This.LancerVisualisateur($class)
	End case 
	
	
Function AfficherPalette($params : Object)->$result : Boolean
	// ouvrir une palette
	var $class : Object
	
	$result:=($params.type="Palette")
	
	If ($result)
		// renseigner le formulaire à utiliser
		$class:=cs[$params.DataClassNom+$params.nomClass].new()
		// .params a été initialisé
		$class.FixerParamètres($params)
		
		// on n'ouvre qu'une fois
		If (Not(cs.$processData.me.existeFenetre($class.informations.nomForm)))
			// données de la class / function à utiliser
			$class.params.functionID:="OuvrirPalette"
			This.LancerFormulaire($class)
		End if 
	End if 
	
	
Function OuvrirPalette($params : Object)
	var $class : Object
	// process de la palette
	
	$class:=$params.class
	// fixer la table par défaut (en particulier nécessaire à la création des formulaires, commande DIALOGUE)
	If ($class.informations.numTable=0)
		// formulaire projet
		NO DEFAULT TABLE
	Else 
		// formulaire de table
		DEFAULT TABLE(Table($class.informations.numTable)->)
	End if 
	
	// les user paramètres de la palette
	If ($class.menu.params.actionOption)  //This.ActionUtilisateur("[option]"))
		// réinitialiser les paramètres de la palette dans les userPrefs
		cs.$session.me.InitialiserPalettes($class.menu.params.commande)
	End if 
	// lire dans les userPrefs les données de la palette 
	$class.UserPrefs:=cs.$session.me.InfosPalettes($class.menu.params.commande)
	
	cs.$dialogue_3001.new().Ouvrir($class.informations.nomForm; -Palette window; $params.titre; $class)
	
	ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "Fin du process"))
	
	
Function AfficherFormulaire($params : Object)->$result : Boolean
	// ouvrir dans un nouveau process un formulaire autre qu'un visualisateur ou une palette
	var $data : Object
	
	$result:=($params.type="Formulaire")
	
	If ($result)
		// renseigner le formulaire à utiliser
		$data:=cs[$params.nomClass].new()
		// .params a été initialisé
		$data.FixerParamètres($params)
		
		// données de la class / function à utiliser
		$data.params.functionID:="OuvrirFormulaire"
		This.LancerFormulaire($data)
	End if 
	
	
Function OuvrirFormulaire($data : Object)
	// process du formulaire 
	
	// formulaire de projet
	NO DEFAULT TABLE
	
	// attention : dans cette version, un seul formulaire par hypothèse
	// 'Movable form dialog box' est aussi 'Modal'
	cs.$dialogue_3001.new().Ouvrir(Current process name; Movable form dialog box; $data.titre; $data.class)
	
	
Function ActionSession($params : Object)->$result : Boolean
	// exécuter la function $params .nomClas.functionID
	
	$result:=($params.type="Session")
	
	Case of 
		: (Not($result))
		: (Not(OB Is defined(cs; $params.nomClass)))
		: (Not($params.nomClass=OB Class(cs.$session.me).name))
			//: (Not(OB Is defined(cs[$params.nomClass].new(); $params.functionID)))// toto
		: (Not(OB Is defined(cs.$session.me; $params.functionID)))
		Else 
			
			//$class[$params.functionID]($params) // toto
			cs.$session.me[$params.functionID]($params)
	End case 
	
	
Function AfficherDialogue($params : Object)->$result : Boolean
	// ouvrir, dans ce process, le dialogue de $params.nomClass
	var $class : Object
	
	$result:=($params.type="Dialogue")
	
	If ($result)
		$class:=cs[$params.nomClass].new()
		cs.$dialogue_3001.new().Ouvrir("U_Dialogue?"+String($params.numCommande); Movable dialog box; $class.titre; $class)
	End if 
	
	
Function AfficherFormulaireComposant($params : Object)->$result : Boolean
	// ouvrir un formulaire de composant
	var $class : Object
	
	$result:=($params.type="FormulaireComposant")
	
	Case of 
		: (Not($result))
		: (Not(OB Is defined($params; "Namespace")))
		: (Not(OB Is defined(cs; $params.Namespace)))
		: (Not(OB Is defined($params; "nomClass")))
		: (Not(OB Is defined(cs[$params.Namespace]; $params.nomClass)))
		Else 
			// renseigner la classe à utiliser
			$class:=cs[$params.Namespace][$params.nomClass].new()
			// on délègue le reste
			$class["OuvrirFormulaire"]($params)
	End case 
	
	
	// ----------------------
	// MARK:Process
	// -----------------------
	
Function LancerVisualisateur($data : Object)
	// démarrer ou appeler un process de visualisation (édition ou consultation)
	var $process; $object; $params : Object
	var $nomProc : Text
	
	Case of 
		: (Not(OB Is defined($data; "params")))
			cs.$trace.me.Créer(-15068; Current method name; "'params' n'est pas défini dans $data").LeverException([msgk_event; msgk_log])
			
		: (Not(OB Is defined($data.params; "numTable")))
			cs.$trace.me.Créer(-15068; Current method name; "'numTable' n'est pas défini dans $data.params").LeverException([msgk_event; msgk_log])
			
		: (Not(OB Is defined($data.params; "Contexte")))
			cs.$trace.me.Créer(-15068; Current method name; "'Contexte' n'est pas défini dans $data.params").LeverException([msgk_event; msgk_log])
			
		: (Not(OB Is defined($data.params; "deQui")))
			cs.$trace.me.Créer(-15068; Current method name; "'deQui' n'est pas défini dans $data.params").LeverException([msgk_event; msgk_log])
			
		Else 
			// renseigner les paramètres du process
			$params:=$data.params
			// .params contient la sélection à l'origine de la visualisation : deQui
			// ici les IDcodés des deQui existent
			
			// rappel : ici on peut demander à visualiser dans un mode Edition ou Consultation
			$nomProc:=This.FixerNomProcess("U_Nav"; $params)
			$process:=Null
			For each ($object; Process activity.processes.query("name = :1"; "U_Nav@")) While ($process=Null)
				Case of 
					: ($object.Status<-1)
						// process tué
						
					: (Not($object.name=$nomProc))
						// pas le bon
						
					: (Not(cs.$processData.me.existeFenetre($nomProc)))
						// pas de fenetre
					Else 
						// on a un worker ouvert du nom recherché
						$process:=$object
				End case 
			End for each 
			
			// fixer le num du process à appeler
			Case of 
				: ($process=Null)
					// l'appelant ne sait pas qui appeler ET pas de visualisateur en cours, créer le process
					$object:=New object
					// nommer le process et poster le deQui
					$object.nomProcess:=This.FixerNomProcess("U_Nav"; $data.params)
					$object.initProcess:=Formula(InitProcessCooperative)
					This.FixerSélection(New object("nomProcess"; $object.nomProcess; "deQui"; $data.params.deQui))
					
					// passer la classe du process
					$object.class:=$data
					// lancer le process
					This.NouveauProcess(cs.$processUser; "Visualisateur_process"; $object)
					// rappel : l'origine de la visualisation est fixée à la création de la sélection des entités
					
				Else 
					// $process.number est un visualisateur capable d'afficher deQui, l'utiliser
					// poster la nouvelle sélection
					This.FixerSélection(New object("nomProcess"; $process.name; "deQui"; $data.params.deQui))
					
					// appeler le process
					This.AppelerFormulaire($nomProc; "NouvelleSélection")
					BRING TO FRONT(Process number($nomProc))
			End case 
	End case 
	
	
Function Visualisateur_process($data : Object)
	// ici on est dans le process ; $data.class est une classe de type éditeur ou consulteur
	
	// créer la sélection à afficher
	$data.class.FixerSélectionVisualisable()
	// ouvrir la fenêtre
	$data.class.OuvrirFormulaire()
	// c'est fini ; formulaire fermé
	
	
Function LancerFormulaire($data : Object)
	var $params : Object
	
	$params:=New object
	$params.nomProcess:=$data.informations.nomForm
	$params.initProcess:=Formula(InitProcessCooperative)
	
	$params.titre:=$data.menu.params.titre
	
	// passer la classe du process et ses paramètres
	$params.class:=$data
	
	This.NouveauProcess(cs.$processUser; $data.params.functionID; $params)
	// le process existait peut être ; le mettre au premier plan
	BRING TO FRONT(Process number($params.nomProcess))
	
	
	// ----------------------
	// MARK:Mise à jour
	// -----------------------
	
Function AfficherModificationBDD($quoi : Integer; $result : Object)
	var $itemRef : Integer
	
	If ($result.success)
		
		Case of 
				// suite des opérations
			: (($quoi=imk Volume) | ($quoi=imk Dossier) | ($quoi=dsk Commande))
				// cas des formulaires projet
				//BRING TO FRONT(Current process)
				// ne rien faire de plus
				
			: (($quoi=agk Individu) | ($quoi=agk EventPersonnel) | ($quoi=agk EventFamilial) | ($quoi=geok Lieu) | ($quoi=geok Site) | ($quoi=geok Commune) | ($quoi=imk Media) | ($quoi=2) | ($quoi=6))
				// ce qui a été ajouté
				$itemRef:=ds.EntitéAvecUUID($result.entitéRetour).IDcodé()
				// afficher un autre domaine
				cs.$editeur.new().EditerSélection($itemRef; 0)
		End case 
		
		// mettre à jour les éditeurs
		CALL WORKER("WK_Communication"; Formula(cs.$processUser.new().MettreAJourEditeurs()))
	End if 
	
	// mettre à jour les autres formulaires
	Case of 
		: (Not($result.success))
			$itemRef:=-1
			
			// ajout d'une entité?
		: (OB Is defined($result; "entitéAjoutée"))
			Case of 
				: (Not(OB Is defined($result.entitéAjoutée; "DataClassNom")))
				: (Not(OB Is defined($result.entitéAjoutée; "IDunique")))
				Else 
					
					$itemRef:=ds.EntitéAvecUUID($result.entitéAjoutée).IDcodé()
			End case 
			
		: (OB Is defined($result; "entitéRetour"))
			Case of 
				: (Not(OB Is defined($result.entitéRetour; "DataClassNom")))
				: (Not(OB Is defined($result.entitéRetour; "IDunique")))
				Else 
					
					$itemRef:=cs._ds.me.EntitéAvecUUID($result.entitéRetour).IDcodé()
			End case 
			
		Else 
			// par défaut on suppose que c'est l'entité du FORM qui a été modifiée
			$itemRef:=Form.entité.IDcodé()
	End case 
	
	// mettre à jour les palettes
	CALL WORKER("WK_Communication"; Formula(cs.$processUser.new().MettreAJourPalettes($itemRef)))
	
	
Function MettreAJourEditeurs()
	// mettre à jour les éditeurs
	var $c : Collection
	var $process : Object
	
	$c:=Process activity.processes.query("name = :1"; "U_Nav@")
	For each ($process; $c)
		// on a un process Editeur, mise à jour de l'éditeur
		Appeler_Le_Formulaire($process.number; "MettreAjourSelection")
	End for each 
	
	
Function MettreAJourPalettes($refItem : Integer)
	// mettre à jour les palettes
	var $c : Collection
	var $process; $params : Object
	
	$c:=Process activity.processes.query("name = :1"; "U_Palette@")
	
	Case of 
		: ($refItem=-1)
		: ($c.length=0)
		Else 
			
			For each ($process; $c)
				// on a un process Palette, mise à jour de la palette avec $2
				If ($process.state<0)
					// n'existe plus
					
				Else 
					// ok; demander une mise à jour de l'itemRef $refItem de la palette
					$params:=New object("refItem"; $refItem)
					Appeler_Le_Formulaire($process.number; "MettreAjour"; $params)
				End if 
			End for each 
	End case

⇧ [class]ZonesEditeur - 11/04/2026 15:55:48

      property media : cs.MediasEntity
property xml : cs.xSDK.XML
property trace : cs.$trace
property cheminFichier : Text
property imageSVG : Picture
property racineXML : Text:=""
// chemin de la structure de sauvegarde des données
property xPath : Text:="/svg/ImageData/"

Class constructor()
	
	This.xml:=cs.xSDK.XML.me
	This.trace:=cs.$trace.me
	
	
	// -----------------------------
	// MARK:Création
	// -----------------------------
	
Function Afficher($mediaPath : Text; $nomObjet : Text; $contrasteZS : Real)
	var $ElémentXML; $chemin : Text
	var $pict; $imagette : Picture
	var $entité : cs.ZonesEntity
	var $gauche; $haut; $largeur; $hauteur; $largeurZS; $hauteurZS : Integer
	
	This.racineXML:=""
	This.cheminFichier:=$mediaPath
	
	Case of 
			// initialiser le fichier SVG
		: (This._InitialiserStructureSVG($nomObjet))
			// ajouter l'image de fond
		: (This._AjouterImage())
			
		Else 
			// c'est ok, récupérer la structure créée
			
			// fixer l'opacité de l'image de fond
			$ElémentXML:=DOM Find XML element(This.racineXML; "/svg/image")
			DOM SET XML ATTRIBUTE($ElémentXML; "opacity"; String($contrasteZS; "&xml"))
			// récupérer l'image initiale, telle que lue précédemment
			DOM GET XML ELEMENT VALUE(DOM Find XML element(This.racineXML; This.xPath+"CheminMedia"); $chemin)
			READ PICTURE FILE($chemin; $pict)
			DOM GET XML ELEMENT VALUE(DOM Find XML element(This.racineXML; This.xPath+"LargeurImage"); $largeur)
			DOM GET XML ELEMENT VALUE(DOM Find XML element(This.racineXML; This.xPath+"HauteurImage"); $hauteur)
			
			// visualiser les HotSpots (imagettes superposées à l'image)
			For each ($entité; Form.entité.LesZonesDeLaPage(Form.numPageMedia))
				$imagette:=$pict
				$gauche:=$entité.gauche*$largeur
				$haut:=$entité.haut*$hauteur
				$largeurZS:=($entité.droite-$entité.gauche)*$largeur
				$hauteurZS:=($entité.bas-$entité.haut)*$hauteur
				
				TRANSFORM PICTURE($imagette; Crop; $gauche; $haut; $largeurZS; $hauteurZS)
				PICTURE PROPERTIES($imagette; $largeurZS; $hauteurZS)
				
				// ajouter l'imagette
				$chemin:=Temporary folder+String(Form.entité.ID)+"_ZS_"+String($entité.ID)+".png"
				WRITE PICTURE FILE($chemin; $imagette; "image/png")
				$ElémentXML:=This.xml.AjouterImage(This.racineXML; $chemin; $gauche; $haut; $largeurZS; $hauteurZS)
			End for each 
			
			// construire et dessiner l'image dans la variable de destination
			This._ExporterStructureSVG()
	End case 
	
	
Function AfficherIHS($mediaPath : Text; $nomObjet : Text)
	var $zoom; $scrollX; $scrollY : Real
	
	This.racineXML:=""
	This.cheminFichier:=$mediaPath
	
	Case of 
			// initialiser le fichier SVG
		: (This._InitialiserStructureSVG($nomObjet))
			// ajouter l'image
		: (This._AjouterImage())
			// ajouter les ZS
		: (This._AjouterZones())
			// Fixer la taille de l'image SVG
		: (This._FixerTailleViewBox())
			
		Else 
			// c'est ok
			// initialiser le dessin
			$zoom:=-Scaled to fit prop centered
			$scrollX:=0.5
			$scrollY:=0.5
			// construire l'image
			This._ConstruireStructureSVG(->$zoom; ->$scrollX; ->$scrollY)
	End case 
	
	
Function Fermer()
	Case of 
		: (This.racineXML="")
		: (Match regex("[0-9ABCDEF]{32}"; This.racineXML))
			DOM CLOSE XML(This.racineXML)
	End case 
	
	
	// -----------------------------
	// MARK:Modifications ZS
	// -----------------------------
	
Function ZoomerImage($zoomAction : Integer)
	var $zoom : Real:=0
	var $scrollX; $scrollY : Real
	
	Form.EffacerMessageUtilisateur()
	
	If (Not(This.LireValeurDOM("Zoom"; ->$zoom; Current method name)))
		Case of   // la taille est doublée en 4 coups
			: ($zoomAction=1)  //zoom +
				$zoom:=$zoom*1.189207115
				
			: ($zoomAction=-1)  //zoom -
				$zoom:=$zoom/1.189207115
				
			Else 
				$zoom:=-1
		End case 
		
		If (Form.ZoneSélectionnée#Null)  // zoomer la ZS sélectionnée
			$scrollX:=-1  //appliquer le zoom au centre de la ZS
			$scrollY:=-1
			This._ConstruireStructureSVG(->$zoom; ->$scrollX; ->$scrollY)
			
		Else 
			Form.AfficherMessageUtilisateur(New object("ID"; 5128))
		End if 
	End if 
	
	
Function SélectionnerZone($refZone : Integer)
	var $ElémentXML : Text
	var $ID : Integer
	var $zoom; $scrollX; $scrollY : Real
	
	// désélectionner la zone courante
	If (Form.ZoneSélectionnée#Null)
		// une ZS est sélectionnée
		$ElémentXML:=DOM Find XML element by ID(This.racineXML; "ZS_"+String(Form.ZoneSélectionnée.ID))
		// Form.ZoneSélectionnée.ID peut être une zone d'une ancienne structure (ex changement de page dans l'edituer de media)
		If (ok=1)
			// $ElémentXML existe, désélectionner
			This._MasquerAncresZone($ElémentXML)
		End if 
	End if 
	
	// Sélectionner la ZS ID $3
	If ($refZone>0)
		Form.ZoneSélectionnée:=Form.entité.LesZonesDeLaPage(Form.numPageMedia).query("ID = :1"; $refZone)[0]
	Else 
		Form.ZoneSélectionnée:=Null
	End if 
	
	// sélectionner la nouvelle zone
	If (Form.ZoneSélectionnée#Null)  // il y a une ZS à sélectionner
		$ID:=Form.ZoneSélectionnée.ID
		$ElémentXML:=DOM Find XML element by ID(This.racineXML; "ZS_"+String($ID))
		// sélectionner
		This._AfficherAncresZone($ElémentXML)
		// utiliser le zone courant
		$zoom:=-1
		
	Else 
		$ID:=-1
		// re initialiser l'image
		$zoom:=-Scaled to fit prop centered
	End if 
	
	DOM SET XML ELEMENT VALUE(This.racineXML; This.xPath+"AncreDeplacee"; "")
	$scrollX:=-1
	$scrollY:=-1
	This._ConstruireStructureSVG(->$zoom; ->$scrollX; ->$scrollY)
	
	
Function RedimensionnerStructureSVG()
	var $zoom; $scrollX; $scrollY : Real
	
	If (This.racineXML#"")  // structure existante
		This._FixerTailleViewBox()
		
		$zoom:=-Scaled to fit prop centered
		$scrollX:=-1  // centrage courant
		$scrollY:=-1
		This._ConstruireStructureSVG(->$zoom; ->$scrollX; ->$scrollY)
	End if 
	
	
Function surDébutDéplacementAncre()
	var $nomObjet : Text:=""
	var $varName : Text
	
	If (Not(This.LireValeurDOM("nomObjetFORM"; ->$nomObjet; Current method name)))
		$varName:=SVG Find element ID by coordinates(*; $nomObjet; MouseX; MouseY)
		
		If ($varName="@_Ancre_@")
			DOM SET XML ELEMENT VALUE(This.racineXML; This.xPath+"AncreDeplacee"; $varName)
		End if 
	End if 
	
	
Function surDéplacementAncre()->$result : Integer
	var $varname : Text:=""
	var $nomImageSVG : Text:=""
	var $largeur : Integer:=0
	var $hauteur : Integer:=0
	var $zoom : Real:=0
	var $scrollX : Real:=0
	var $scrollY : Real:=0
	var $entité : cs.ZonesEntity
	var $sourisX; $sourisY : Real
	var $SourisBtn; $gauche; $haut; $droite; $bas : Integer
	
	$result:=0
	Case of 
		: (FORM Get current page#2)
		: (Form.ZoneSélectionnée=Null)
		Else 
			// c'est ok
			$entité:=Form.ZoneSélectionnée
			// une zone sélectionnée : une ancre en déplacement?
			This.LireValeurDOM("AncreDeplacee"; ->$varName; Current method name)
			MOUSE POSITION($sourisX; $sourisY; $SourisBtn)
			// $VarName = ID de l'ancre glissée
			Case of 
				: (($varName#"") & ($SourisBtn=1))
					// scroll en cours
					// v6.9.7 la table Zones est mise en LECTURE ÉCRITURE dans "Modifier EntitéSélection"
					Case of 
						: (ok=0)
							// récupérer le nom de l'image de FORM
						: (This.LireValeurDOM("nomObjetFORM"; ->$nomImageSVG; Current method name))
							// récupérer la position, par rapport à l'objet, de l'image zommée / scrollée :
						: (This.LireValeurDOM("LargeurImage"; ->$largeur; Current method name))
						: (This.LireValeurDOM("HauteurImage"; ->$hauteur; Current method name))
						: (This.LireValeurDOM("Zoom"; ->$zoom; Current method name))
						: (This.LireValeurDOM("ScrollX"; ->$scrollX; Current method name))
						: (This.LireValeurDOM("ScrollY"; ->$scrollY; Current method name))
						Else 
							OBJECT GET COORDINATES(*; $nomImageSVG; $gauche; $haut; $droite; $bas)
							
							$scrollX:=-($scrollX-0.5)*$largeur*$zoom
							$scrollY:=-($scrollY-0.5)*$hauteur*$zoom
							// calculer les marges de l'image / objet :
							cs.xSDK.Outils.me.CalculerRectangleMedia(->$gauche; ->$haut; ->$droite; ->$bas; $largeur; $hauteur; ->$zoom; ->$scrollX; ->$scrollY)
							// calculer la position réduite de la souris dans l'image
							$scrollX:=($sourisX-$gauche)/$largeur/$zoom
							$scrollY:=($sourisY-$haut)/$hauteur/$zoom
							// enregistrer la position courante de la souris (nouvelles dimensions réduites de la zone)
							// attention : le stockage en BDD se fait en fin de déplacement
							Case of 
								: ($varName="@Ancre_GH")
									$entité.gauche:=$scrollX
									$entité.haut:=$scrollY
									
								: ($varName="@Ancre_DH")
									$entité.droite:=$scrollX
									$entité.haut:=$scrollY
									
								: ($varName="@Ancre_GB")
									$entité.gauche:=$scrollX
									$entité.bas:=$scrollY
									
								: ($varName="@Ancre_DB")
									$entité.droite:=$scrollX
									$entité.bas:=$scrollY
							End case 
							
							// traiter les cas extrèmes
							$scrollX:=$entité.gauche
							Case of 
								: ($scrollX<0.001)  //forcer à 0
									$scrollX:=0
									
								: (($entité.droite-$scrollX)<0.01)  //zone nulle
									$scrollX:=$entité.droite-0.05
							End case 
							$entité.gauche:=$scrollX
							
							$scrollY:=$entité.haut
							Case of 
								: ($scrollY<0.001)  //forcer à 0
									$scrollY:=0
									
								: (($entité.bas-$scrollY)<0.01)  //zone nulle
									$scrollY:=$entité.bas-0.05
							End case 
							$entité.haut:=$scrollY
							
							$scrollX:=$entité.droite
							Case of 
								: ($scrollX>1)  //zone trop large
									$scrollX:=1
									
								: (($scrollX-$entité.gauche)<0.01)  //zone nulle
									$scrollX:=$entité.gauche+0.01
							End case 
							$entité.droite:=$scrollX
							
							$scrollY:=$entité.bas
							Case of 
								: ($scrollY>1)  //forcer à 1
									$scrollY:=1
									
								: (($scrollY-$entité.haut)<0.01)  //zone nulle
									$scrollY:=$entité.haut+0.01
							End case 
							$entité.bas:=$scrollY
							
							// les coordonnées réduites sont ok : calculer la nouvelle position de la ZS et les ancres de la ZS
							This._FixerPositionZonesEntity($entité)
							// mettre à jour l'image SVG
							This._ExporterStructureSVG()
							
							Form.ZoneSélectionnée:=$entité
					End case 
					
				: (($varName#"") & ($SourisBtn=0))
					// mouse up sur une ancre => fin du déplacement
					This.surFinDéplacementAncre()
			End case 
	End case 
	
	
Function surFinDéplacementAncre()
	// modifier l'enregistrement courant
	Case of 
		: (cs._ds.me.Modifier(cdk Modifier; New collection(Form.ZoneSélectionnée); Null)=False)
			
		Else 
			// c'est ok
			DOM SET XML ELEMENT VALUE(This.racineXML; This.xPath+"AncreDeplacee"; "")
	End case 
	
	
	// -----------------------------
	// MARK:Construction
	// -----------------------------
	
Function _InitialiserStructureSVG($nomImageSVG : Text)->$result : Boolean
	
	This.Fermer()
	This.racineXML:=This.xml.CréerArbreSVG(0; 0)
	
	// la viewBox est fixée plus tard
	DOM SET XML ATTRIBUTE(This.racineXML; "width"; "100%"; "height"; "100%"; "viewBox"; "0 0 0 0")
	// faire les liens entre SVG This.racineXML, et l'objet du formulaire
	DOM SET XML ELEMENT VALUE(This.racineXML; This.xPath+"nomObjetFORM"; $nomImageSVG)
	
	$result:=False  // pas d'erreur
	
	
Function _AjouterImage()->$result : Boolean
	// renvoie vrai si une erreur a eu lieu
	var $media : cs.$media
	var $image : Picture
	var $fichierPath : Text
	var $largeur; $hauteur : Integer
	
	$media:=cs.$media.me
	$media.LireAvecIDmedia(Form.entité.ID; Form.numPageMedia)
	$result:=$media.trace.success
	$image:=$media.imagePageMedia
	
	If ($result)
		// image de la BDD
		PICTURE PROPERTIES($image; $largeur; $hauteur)
		
	Else 
		$result:=True
		// page WEB
		$largeur:=800
		$hauteur:=600
	End if 
	
	If ($result)  // on a une image
		// temporiser l'image (nécessaire si l'image est une page de pdf)
		$fichierPath:=Temporary folder+String(Form.entité.ID)+"_ZS.png"
		WRITE PICTURE FILE($fichierPath; $image; "image/png")
		
		// insérer le chemin de l'image dans le SVG (éviter les accents dans $varName)
		This.xml.AjouterImage(This.racineXML; $fichierPath; 0; 0; $largeur; $hauteur)
		
		// initialiser les données de la zone affichée
		DOM SET XML ELEMENT VALUE(This.racineXML; This.xPath+"CheminMedia"; $fichierPath)
		DOM SET XML ELEMENT VALUE(This.racineXML; This.xPath+"LargeurImage"; $largeur)
		DOM SET XML ELEMENT VALUE(This.racineXML; This.xPath+"HauteurImage"; $hauteur)
		// initialiser la viewBox (pourra être surchargée
		DOM SET XML ATTRIBUTE(This.racineXML; "viewBox"; "0 0 "+String($largeur)+" "+String($hauteur))
		
		// initialiser pour la suite
		DOM SET XML ELEMENT VALUE(This.racineXML; This.xPath+"EpaisseurRectangle"; "3")
		DOM SET XML ELEMENT VALUE(This.racineXML; This.xPath+"TailleAncre"; "10")
		DOM SET XML ELEMENT VALUE(This.racineXML; This.xPath+"Zoom"; -Scaled to fit prop centered)
		DOM SET XML ELEMENT VALUE(This.racineXML; This.xPath+"ScrollX"; 0.5)
		DOM SET XML ELEMENT VALUE(This.racineXML; This.xPath+"ScrollY"; 0.5)
		
	Else 
		This.trace.Créer(-15076; Current method name; "Le fichier '"+This.cheminFichier+"' n'a pas été lu").LeverException([msgk_event; msgk_log])
	End if 
	$result:=Not($result)  // faux = ok !
	
	
Function _AjouterZones()->$result : Boolean
	var $épaisseurRectangle : Real:=0
	var $tailleAncre : Real:=0
	var $entité : cs.ZonesEntity
	var $ElémentXML; $EnfantXML; $petitEnfantXML : Text
	
	Case of 
		: (This.LireValeurDOM("EpaisseurRectangle"; ->$épaisseurRectangle; Current method name))
		: (This.LireValeurDOM("TailleAncre"; ->$tailleAncre; Current method name))
		Else 
			
			For each ($entité; Form.entité.LesZonesDeLaPage(Form.numPageMedia))
				// créer la Zone Sensible dans un groupe
				$ElémentXML:=DOM Create XML element(This.racineXML; "g"; "id"; "ZS_"+String($entité.ID))
				$EnfantXML:=This.xml.AjouterRectangle($ElémentXML; 0; 0; 0; 0; 2; 2; "red"; "gray"; $épaisseurRectangle)
				DOM SET XML ATTRIBUTE($EnfantXML; "id"; "ZS_"+String($entité.ID)+"_Cadre")
				
				// créer les 4 poignées de modification dans un groupe
				$EnfantXML:=DOM Create XML element($ElémentXML; "g"; "id"; "ZS_"+String($entité.ID)+"_Ancres")
				$petitEnfantXML:=This.xml.AjouterRectangle($EnfantXML; 0; 0; $tailleAncre; $tailleAncre; 0; 0; "royalblue"; "royalblue"; 1)
				DOM SET XML ATTRIBUTE($petitEnfantXML; "id"; "ZS_"+String($entité.ID)+"_Ancre_GH")
				$petitEnfantXML:=This.xml.AjouterRectangle($EnfantXML; 0; 0; $tailleAncre; $tailleAncre; 0; 0; "royalblue"; "royalblue"; 1)
				DOM SET XML ATTRIBUTE($petitEnfantXML; "id"; "ZS_"+String($entité.ID)+"_Ancre_DH")
				$petitEnfantXML:=This.xml.AjouterRectangle($EnfantXML; 0; 0; $tailleAncre; $tailleAncre; 0; 0; "royalblue"; "royalblue"; 1)
				DOM SET XML ATTRIBUTE($petitEnfantXML; "id"; "ZS_"+String($entité.ID)+"_Ancre_DB")
				$petitEnfantXML:=This.xml.AjouterRectangle($EnfantXML; 0; 0; $tailleAncre; $tailleAncre; 0; 0; "royalblue"; "royalblue"; 1)
				DOM SET XML ATTRIBUTE($petitEnfantXML; "id"; "ZS_"+String($entité.ID)+"_Ancre_GB")
				
				// positionner la ZS
				This._FixerPositionZonesEntity($entité)
				// dé sélectionner la ZS
				This._MasquerAncresZone($ElémentXML)
			End for each 
	End case 
	
	
Function _FixerTailleViewBox()->$result : Boolean
	var $nomObjet : Text:=""
	var $gauche; $haut; $droite; $bas; $largeur; $hauteur : Integer
	
	$result:=This.LireValeurDOM("nomObjetFORM"; ->$nomObjet; Current method name)
	If (Not($result))
		OBJECT GET COORDINATES(*; $nomObjet; $gauche; $haut; $droite; $bas)
		$largeur:=$droite-$gauche
		$hauteur:=$bas-$haut
		// mémoriser = définir la viewBox
		DOM SET XML ATTRIBUTE(This.racineXML; "viewBox"; "0 0 "+String($largeur)+" "+String($hauteur))
	End if 
	
	
Function _ConstruireStructureSVG($ptrZoom : Pointer; $ptrScrollX : Pointer; $ptrScrollY : Pointer)
	var $nomObjet : Text:=""
	var $largeur : Integer:=0
	var $hauteur : Integer:=0
	var $zoom : Real:=0
	var $zoomPleinEcran : Real:=0
	var $scrollX : Real:=0
	var $scrollY : Real:=0
	var $isOK : Boolean
	var $gauche; $haut; $droite; $bas : Integer
	
	$isOK:=False
	If (Not(This.LireValeurDOM("nomObjetFORM"; ->$nomObjet; Current method name)))
		OBJECT GET COORDINATES(*; $nomObjet; $gauche; $haut; $droite; $bas)
		
		Case of 
			: (This.LireValeurDOM("LargeurImage"; ->$largeur; Current method name))
			: (This.LireValeurDOM("HauteurImage"; ->$hauteur; Current method name))
			Else 
				$isOK:=True
		End case 
	End if 
	
	// * traitement du zoom : calculer $zoom
	$zoom:=0
	Case of 
		: ($ptrZoom->=-Scaled to fit prop centered)
			// calculer le zoom
			If ($isOK)
				$zoom:=$ptrZoom->
				cs.xSDK.Outils.me.CalculerRectangleMedia(->$gauche; ->$haut; ->$droite; ->$bas; $largeur; $hauteur; ->$zoom)
				
				If ($zoom>1)
					$zoom:=1  // on n'agrandit pas une image plus petite que ObjetImage
				End if 
				DOM SET XML ELEMENT VALUE(This.racineXML; This.xPath+"ZoomPleinEcran"; $zoom)
			End if 
			
		: ($ptrZoom->=-1)  // utiliser le zoom courant
			$isOK:=Not(This.LireValeurDOM("Zoom"; ->$zoom; Current method name))
			
		Else 
			// limiter le zoom de l'image au ZoomMinimal
			$isOK:=Not(This.LireValeurDOM("ZoomPleinEcran"; ->$zoom; Current method name))
			If ($isOK & ($ptrZoom->>$zoom))
				// utiliser le zoom demandé
				$zoom:=$ptrZoom->
			Else 
				$ptrScrollX->:=0.5
				$ptrScrollY->:=0.5
			End if 
	End case 
	
	// * traitement du scroll : calculer $scrollX et $scrollY
	$zoomPleinEcran:=0  //init variable
	If ($isOK)
		This.LireValeurDOM("ZoomPleinEcran"; ->$zoomPleinEcran; Current method name)
		
		Case of 
			: ($ptrScrollX->=-1)
				Case of 
					: ($zoom=$zoomPleinEcran)
						This.LireValeurDOM("ScrollX"; ->$scrollX; Current method name)
						
					: (Form.ZoneSélectionnée=Null)
					Else 
						$scrollX:=(Form.ZoneSélectionnée.droite+Form.ZoneSélectionnée.gauche)/2
				End case 
				
			Else 
				$scrollX:=$ptrScrollX->
		End case 
		
		Case of 
			: ($ptrScrollY->=-1)
				Case of 
					: ($zoom=$zoomPleinEcran)
						This.LireValeurDOM("ScrollY"; ->$scrollY; Current method name)
						
					: (Form.ZoneSélectionnée=Null)
					Else 
						$scrollY:=(Form.ZoneSélectionnée.bas+Form.ZoneSélectionnée.haut)/2
				End case 
				
			Else 
				$scrollY:=$ptrScrollY->
		End case 
		
		// * mémoriser l'état des transformations : $zoom, $scrollX, $scrollY
		DOM SET XML ELEMENT VALUE(This.racineXML; This.xPath+"Zoom"; $zoom)
		DOM SET XML ELEMENT VALUE(This.racineXML; This.xPath+"ScrollX"; $scrollX)
		DOM SET XML ELEMENT VALUE(This.racineXML; This.xPath+"ScrollY"; $scrollY)
		
		// * maintenir la taille des ancres constantes (sinon sont difficilement sélectionnables sous fort zoom)
		This._FixerTailleFormes()
		// * appliquer les transformations : en théorie : d'abord zoom puis déplacement
		// il semble que l'ordre soit TRANSLATE puis SCALE => il faut corriger TRANSLATE du zoom
		// homothétie des axes centrée sur 0,0
		This.xml.AjouterTransform(This.racineXML; "scale"; [$zoom; $zoom])
		
		//placer le centre de l'image au point du scroll
		$scrollX:=-$scrollX*$largeur
		$scrollY:=-$scrollY*$hauteur
		$scrollX:=$scrollX+(($droite-$gauche)/2/$zoom)
		$scrollY:=$scrollY+(($bas-$haut)/2/$zoom)
		This.xml.AjouterTransform(This.racineXML; "translate"; [$scrollX; $scrollY])
		
		// * finalement dessiner l'image
		This._ExporterStructureSVG()
	End if 
	
	
Function _ExporterStructureSVG()
	// dessiner l'image
	var $nomObjet : Text:=""
	var $image : Picture
	
	If (Not(This.LireValeurDOM("nomObjetFORM"; ->$nomObjet; Current method name)))
		SVG EXPORT TO PICTURE(This.racineXML; $image; Copy XML data source)
		Form[$nomObjet]:=$image
		This.imageSVG:=$image
		// pour des tests
		//DOM EXPORT TO FILE(This.racineXML; Folder(fk documents folder).folder("tempo_ALV/ZS").file(Timestamp+Current method name+".svg").platformPath)
	End if 
	
	
	// -----------------------------
	// MARK:IHS Image HotSpotée
	// -----------------------------
	
Function _FixerPositionZonesEntity($entité : cs.ZonesEntity)
	var $largeur : Integer:=0
	var $hauteur : Integer:=0
	var $gauche; $haut; $droite; $bas : Integer
	var $ElémentXML : Text
	
	// récupérer les dimensions des objets dessinés
	Case of 
		: (This.LireValeurDOM("LargeurImage"; ->$largeur; Current method name))
		: (This.LireValeurDOM("HauteurImage"; ->$hauteur; Current method name))
		Else 
			
			// calculer la position de la ZS
			$gauche:=$entité.gauche*$largeur
			$haut:=$entité.haut*$hauteur
			$droite:=($entité.droite-$entité.gauche)*$largeur  // la largeur!
			$bas:=($entité.bas-$entité.haut)*$hauteur  // la hauteur!
			// écrire la position de la ZS
			$ElémentXML:=DOM Find XML element by ID(This.racineXML; "ZS_"+String($entité.ID))
			If (ok=1)
				DOM SET XML ATTRIBUTE($ElémentXML; "transform"; "translate("+String($gauche; "&xml")+","+String($haut; "&xml")+")")
			End if 
			// écrire la taille de la ZS
			$ElémentXML:=DOM Find XML element by ID(This.racineXML; "ZS_"+String($entité.ID)+"_Cadre")
			If (ok=1)
				DOM SET XML ATTRIBUTE($ElémentXML; "width"; String($droite; "&xml"); "height"; String($bas; "&xml"))
			End if 
			// écrire la position des ancres de la ZS
			// remarque : "_Ancre_GH" est toujours à la position 0,0
			$ElémentXML:=DOM Find XML element by ID(This.racineXML; "ZS_"+String($entité.ID)+"_Ancre_DH")
			If (ok=1)
				DOM SET XML ATTRIBUTE($ElémentXML; "x"; String($droite; "&xml"))
			End if 
			$ElémentXML:=DOM Find XML element by ID(This.racineXML; "ZS_"+String($entité.ID)+"_Ancre_DB")
			If (ok=1)
				DOM SET XML ATTRIBUTE($ElémentXML; "x"; String($droite; "&xml"); "y"; String($bas; "&xml"))
			End if 
			$ElémentXML:=DOM Find XML element by ID(This.racineXML; "ZS_"+String($entité.ID)+"_Ancre_GB")
			If (ok=1)
				DOM SET XML ATTRIBUTE($ElémentXML; "y"; String($bas; "&xml"))
			End if 
	End case 
	
	
Function _FixerTailleFormes()
	var $épaisseurRectangle : Real:=0
	var $tailleAncre : Real:=0
	var $zoom : Real:=0
	var $ElémentXML : Text
	var $i; $ID : Integer
	
	// lire les données de l'image
	Case of 
		: (This.LireValeurDOM("EpaisseurRectangle"; ->$épaisseurRectangle; Current method name))
		: (This.LireValeurDOM("TailleAncre"; ->$tailleAncre; Current method name))
		: (This.LireValeurDOM("Zoom"; ->$zoom; Current method name))
		Else 
			
			ARRAY TEXT($ElementsXML; 0)
			$ElémentXML:=DOM Find XML element(This.racineXML; "/svg/g"; $ElementsXML)
			If (Size of array($ElementsXML)>0)
				For ($i; 1; Size of array($ElementsXML))
					// lire l'élément rect
					$ElémentXML:=DOM Find XML element($ElementsXML{$i}; "g/rect")
					
					If (ok=1)
						// fixer l'épaisseur dé zoomée
						DOM SET XML ATTRIBUTE($ElémentXML; "stroke-width"; String(3/$zoom; "&xml"))
					End if 
				End for 
			End if 
			
			// cas de la zone courante
			If (Form.ZoneSélectionnée#Null)  // une ZS est sélectionnée
				$ID:=Form.ZoneSélectionnée.ID
				// lire l'élément groupe des ancres
				$ElémentXML:=DOM Find XML element by ID(This.racineXML; "ZS_"+String($ID)+"_Ancres")
				
				If (ok=1)
					// le groupe est décalé vers gauche/haut d'une demi taille de l'ancre pour centrer les ancres aux coins du rectangle
					DOM SET XML ATTRIBUTE($ElémentXML; "transform"; "translate("+String(-$tailleAncre/$zoom/2; "&xml")+","+String(-$tailleAncre/$zoom/2; "&xml")+")")
					// fixer la taille des ancres
					// lister les éléments <rect> du groupe des ancres
					ARRAY TEXT($ElementsXML; 0)
					$ElémentXML:=DOM Find XML element($ElémentXML; "/g/rect"; $ElementsXML)
					If (Size of array($ElementsXML)>0)
						// pour chaque ancre
						For ($i; 1; Size of array($ElementsXML))
							// fixer la taille dé zoomée
							DOM SET XML ATTRIBUTE($ElementsXML{$i}; "width"; String(10/$zoom; "&xml"); "height"; String(10/$zoom; "&xml"))
						End for 
					End if 
				End if 
				
			End if 
	End case 
	
	
Function _MasquerAncresZone($racineXML : Text)
	var $VarName; $ElémentXML : Text
	
	DOM GET XML ATTRIBUTE BY NAME($racineXML; "id"; $VarName)
	$ElémentXML:=DOM Find XML element by ID($racineXML; $VarName+"_Cadre")
	DOM SET XML ATTRIBUTE($ElémentXML; "fill-opacity"; "0.75")
	$ElémentXML:=DOM Find XML element by ID($racineXML; $VarName+"_Ancres")
	DOM SET XML ATTRIBUTE($ElémentXML; "visibility"; "hidden")
	
	
Function _AfficherAncresZone($racineXML : Text)
	var $VarName; $ElémentXML : Text
	
	DOM GET XML ATTRIBUTE BY NAME($racineXML; "id"; $VarName)
	$ElémentXML:=DOM Find XML element by ID($racineXML; $VarName+"_Cadre")
	DOM SET XML ATTRIBUTE($ElémentXML; "fill-opacity"; "0")
	$ElémentXML:=DOM Find XML element by ID($racineXML; $VarName+"_Ancres")
	DOM SET XML ATTRIBUTE($ElémentXML; "visibility"; "visible")
	
	
Function LireValeurZoom($ptrZoom : Pointer)
	var $zoom : Real:=-1
	
	If (Not(This.LireValeurDOM("Zoom"; ->$zoom; Current method name)))
		$ptrZoom->:=$zoom
	End if 
	
	
	// -----------------------------
	// MARK:Utilitaires
	// -----------------------------
	
Function LireValeurDOM($xPath : Text; $ptrValeur : Pointer; $IDfunction : Text)->$result : Boolean
	var $text : Text:=""
	var $real : Real:=0
	var $integer : Integer:=0
	
	$result:=False
	
	Try
		Case of 
			: (Type($ptrValeur->)=Is text)
				DOM GET XML ELEMENT VALUE(DOM Find XML element(This.racineXML; This.xPath+$xPath); $text)
				$ptrValeur->:=$text
				
			: (Type($ptrValeur->)=Is real)
				DOM GET XML ELEMENT VALUE(DOM Find XML element(This.racineXML; This.xPath+$xPath); $real)
				$ptrValeur->:=$real
				
			: (Type($ptrValeur->)=Is longint)
				DOM GET XML ELEMENT VALUE(DOM Find XML element(This.racineXML; This.xPath+$xPath); $integer)
				$ptrValeur->:=$integer
				
			Else 
				This.trace.Créer(-15068; Current method name; "Le type "+String(Type($ptrValeur->))+" n'es pas traité").LeverException([msgk_event; msgk_log])
		End case 
		
	Catch
		$result:=True
		This.trace.Créer(-15012; $IDfunction; "Absence de valeur de type "+String(Type($ptrValeur->))+" au xPath '"+This.xPath+$xPath+"' dans This.racineXML").LeverException([msgk_event; msgk_log])
	End try

⇧ [class]UnionsSelection - 16/04/2026 19:01:23

      Class extends EntitySelection

Function trierParDate($params : Object)->$result : Object
	// trier la sélection d'unions par la date de l'event fam le plus ancien
	var $sensDuTri : Integer
	
	$sensDuTri:=dk ascending
	//$sensDuTri:=dk descending  // pour test !
	Case of 
		: (This.length=0)
		: (Count parameters=0)
		: (OB Is defined($params; "sensDuTri"))
			$sensDuTri:=$params.sensDuTri
	End case 
	
	$result:=This.orderByFormula("this.LeMariage().dateNum"; $sensDuTri)
	
	
	// ----------------------
	// MARK:Sélection
	// -----------------------
	
Function CréerListBoxUnions($params : Object)
	var $entité : cs.UnionsEntity
	// renvoie une collection ListBox de la sélection courante
	// ici la LB est complexe, contruite par l'entité
	
	$params.formats:=New object("Options"; 0)
	$params.styleEvent:="'font-style: italic;font-size:14pt'"
	$params.stylePersonne:="'font-weight:bold;font-size:14pt'"
	
	$params.genre:=ds.Personnes.get($params.entitéID).sexe
	$params.plur:=False
	
	$params.liste:=New collection
	For each ($entité; This)
		$entité.CréerListBox($params)
	End for each 
	
	
Function CréerLH($LH : Collection; $params : Object)
	// renvoie une collection hiérarchique de la sélection courante (image d'une liste hiérarchique)
	var $entité; $élément; $data; $sélection; $information; $paramsPlusUn : Object
	
	For each ($entité; This)
		// pour chaque entité, ajouter à $LH les données de l'union, et les collections (= sous liste H) des membres de l'union
		// *  ajouter les unionData :
		If ($params.Options ?? 5)
			$information:=$entité.LeMariage()
			
			If ($information#Null)
				// mettre la date du mariage
				$élément:=New object
				$élément.itemText:=$information.Libellé(New object("Options"; $params.FormatEvent))
				$élément.itemRef:=cs._ds.me.IDcodé($information)
				$élément.iconeRef:=$information.IconeRef()
				
				// ajouter les données de l'item
				$data:=New object
				// les properties de l'item
				$data.properties:=New object("saisissable"; False; "style"; Italic)
				$élément.data:=CoDecBase64_Objet($data)
				
				//Fixer source valide($information.source; $4)
				
				$LH.push($élément)
				
				// mettre le lieu du mariage
				$information:=$information.leLieu
				If (($information#Null) & Not($params.Options ?? 11))
					$élément:=New object
					$élément.itemText:=$information.Le("Communes").Libellé(New object("Options"; $params.FormatLieu))
					$élément.itemRef:=cs._ds.me.IDcodé($information)
					
					// ajouter les données de l'item
					$data:=New object
					// les properties de l'item
					$data.properties:=New object("saisissable"; False; "style"; Italic)
					$élément.data:=CoDecBase64_Objet($data)
					
					$LH.push($élément)
				End if 
				
			Else 
				// pas d'event
				$élément:=New object
				$élément.itemText:=Localized string("33613")
				$élément.itemRef:=CodeEnreg(0; [Table(->[Events])])
				
				// ajouter les données de l'item
				$data:=New object
				// les properties de l'item
				$data.properties:=New object("saisissable"; False; "style"; Italic)
				$élément.data:=CoDecBase64_Objet($data)
				
				$LH.push($élément)
			End if 
		End if 
		
		// *  ajouter le conjoint :
		If (($params.Options ?? 2) & ($params.Options ?? 31))
			// son nom
			If ($entité.LeConjoint($params.entité)=Null)
				$élément:=New object
				$élément.itemText:="   "+Localized string("1013")+cs._cfct.me.LireLocatedSTR(1004)
				$élément.itemRef:=CodeEnreg(0; [204])
				
			Else 
				$élément:=New object
				$élément.itemText:="  "+$entité.LeConjoint($params.entité).Libellé(New object("Options"; $params.FormatConjoint))
				$élément.itemRef:=CodeEnreg($entité.LeConjoint($params.entité).ID; [128+$entité.indexOf()+1])
			End if 
			
			// ajouter les données de l'item
			$data:=New object
			// les properties de l'item
			$data.properties:=New object("saisissable"; False; "style"; Bold)
			$élément.data:=CoDecBase64_Objet($data)
			
			$LH.push($élément)
		End if 
		
		// *  ajouter les membres :
		$sélection:=Null
		If ($params.Options ?? 31)
			// descendance : liste des enfants
			Case of 
				: ($entité.SansEnfant=True)
				: ($entité.LesEnfants()=Null)
				Else 
					$sélection:=$entité.LesEnfants()
					$params.FormatPersonne:=$params.FormatEnfant
			End case 
			
		Else 
			// ascendance : liste des membres de $entité
			$sélection:=$entité._lesMembres(agk Tout)
			$params.FormatPersonne:=$params.FormatParent
		End if 
		
		Case of 
			: ($sélection=Null)
				//: ($c=Null)
			Else 
				// paramètres pour les générations suivantes
				$params.Options:=$params.Options ?- 0
				// génération suivante
				$paramsPlusUn:=OB Copy($params)
				$paramsPlusUn.IDunion:=$entité.ID
				$paramsPlusUn.génération:=$paramsPlusUn.génération+1
				// relancer
				$sélection.CréerLH($LH; $paramsPlusUn)
		End case 
		
	End for each

⇧ [class]UtilisateursALVEntity - 23/04/2026 11:32:07

      Class extends Entity

Function IDcodé()->$ID : Integer
	$ID:=cs._ds.me.IDcodé(This)
	
	
Function Libellé($userFormats : Object)->$libellé : Text
	// renvoie le nom formaté suivant les options $formats
	// $formats
	// .Options 
	//   bit  0 = ajouter le nom
	//   bit  1 = ajouter le prénom
	//   bit  2 = ajouter les autres prénoms
	//   bit  3 = d'abord le prénom
	var $formats : Object
	var $options : Integer
	
	$libellé:=""
	$formats:=New object("Options"; 3)
	Case of 
		: (Count parameters=0)
		: (OB Is defined($userFormats; "Options"))
			$formats:=$userFormats
	End case 
	
	If (This#Null)
		$options:=$formats.Options
		
		$libellé:=(This.First_Name)*Num($options ?? 1)  //  bit 1 = ajouter le prénom
		
		If ($options ?? 3)  // d'abord le prénom
			$libellé:=$libellé+((" "*Num($options ?? 1))+This.Name)*Num($options ?? 0)  //  bit 0 = ajouter le nom
		Else 
			$libellé:=(This.Name+(" "*Num($options ?? 1)))*Num($options ?? 0)+$libellé  //  bit 0 = ajouter le nom
		End if 
		
	Else 
		$libellé:=Lowercase(cs._cfct.me.LireLocatedSTR(1004))
	End if 
	
	
	// ----------------------
	// MARK:Sélection
	// -----------------------
	
Function AppartenancesAPP()->$result : cs.GroupesAPPSelection
	$result:=This.lesGroupes.leGroupe
	
	
Function AppartenancesALV()->$result : Object
	$result:=OB Copy(This.leGroupe)
	
	
Function estDansGroupeAPP($nom : Text)->$result : Boolean
	var $selection : cs.GroupesAPPSelection
	
	$selection:=This.AppartenancesAPP()
	$result:=$selection.contient($nom)
	
	Case of 
		: ($result)
			// c'est ok
		: ($selection.lesSurGroupes=Null)
		Else 
			// essayer les sur groupes
			$selection:=$selection.lesSurGroupes.leGroupe
			$result:=$selection.contient($nom)
	End case 
	
	
	// ----------------------
	// MARK:modification DataStore
	// -----------------------
	
Function Ajouter($quoi : Integer; $qui : Object; $params : Object)->$result : Object
	// créer un utilisateur de this
	// $1 = code de la création, $2 = entité (peut-être null), $3 paramètres
	ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; "Début de l'ajout à ["+This.getDataClass().getInfo().name+"]"))
	
	$result:=ds.initResult()
	
	// fixer Qui
	If ($qui=Null)
		// créer qui
		$result:=ds.Créer($quoi; ""; $params)
		$qui:=$result.entitéAjoutée
	End if 
	
	// créer le lien entre $qui et this
	Case of 
		: ($qui=Null)
		Else 
			This.Groupe:=$qui.ID
			This.save()
	End case 
	
	// pour le journal
	$params.Description_Action:=Localized string("3077")
	
	$result.success:=($result.Error=0)
	ds.NotifierResultat(This; $quoi; $result)
	
	
Function _FixerDonnées($quoi : Integer; $params : Object)->$result : Object
	// un utilisateur a été créé : on initialise ses données suivant 2 cas
	// ajout dans BDD mère : données déduites de aQui, ou ajout par le serveur WEB : données lues dans le journal $params
	// dans les 2 cas on complète le journal
	var $c : Collection
	
	$result:=ds._FixerDonnées(This; $quoi; $params)
	
	This.Name:=Localized string("2")+"..."
	This.First_Name:=Localized string("3")+"..."
	
	// initialiser les données obligatoires
	This.LogIn:="User "+String(Random)  // doit être unique
	This.Password:="Bonjour"
	
	// fixer son ID
	// chercher le ID user suivant. Rappel : les ID démarrent à 1000 et croissent
	$c:=ds.UtilisateursALV.query("ID > :1"; 1000).orderBy("ID asc").extract("ID")
	This.ID:=Choose($c.length>0; $c[$c.length-1]+1; 1000)
	
	This.save()
	
	
	// ----------------------
	// MARK:Interface externe
	// -----------------------
	
Function CopierVersObjet($entitéExt : Object)
	// recopier les attributs de this dans $entitéExt (pour une utilisation hors BDD mère)
	
	$entitéExt.ID:=This.ID
	
	$entitéExt.Name:=This.Name
	$entitéExt.First_Name:=This.First_Name
	$entitéExt.LogIn:=This.LogIn
	$entitéExt.Password:=This.Password

⇧ [class]$sonorisation - 18/04/2026 10:55:17

      // ----------------------------------------------------
// Nom utilisateur (OS) : Philippe
// Date et heure : 23/02/23, 10:56:21
// ----------------------------------------------------
// Méthode : $sonorisation
// Description
//
// Paramètres
// ----------------------------------------------------
property canauxAudio : Collection
property prefs : Object

Class constructor()
	// une classe gère les canaux sonores de l'APP, dont ambiance, alerte, message
	This.canauxAudio:=New collection
	This.prefs:=cs.$session.me.prefs
	
	
	
	// ----------------------
	// MARK:Flux
	// -----------------------
	
Function AjouterCanal($IDnomCanal : Text; $source : Integer; $IDnomFichier : Text; $préférences : Object)
	// ajouter à la collection un canal avec les paramètres $i
	var $canal : cs.$canalAudio
	
	$canal:=cs.$canalAudio.new($IDnomCanal; $source; $IDnomFichier; $préférences)
	This.canauxAudio.push($canal)
	
	
Function getCanal($IDnom : Text)->$canal : cs.$canalAudio
	// renvoyer le canal ID $IDnom
	$canal:=This.canauxAudio.find(Formula($1.value[$3]=$2); $IDnom; "IDnomCanal")
	
	
Function LireLeCanal($IDnomCanal : Text; $IDnomFichier : Text)
	// activer le canal $1, et lire le son programmé ou le fichier $2
	var $canal : cs.$canalAudio
	
	$canal:=This.getCanal($IDnomCanal)
	Case of 
		: ($canal=Null)
			// pas géré dans ce formulaire
		: (Count parameters>1)
			$canal.LireSon($IDnomFichier)
		Else 
			$canal.LireSon()
	End case 
	
	
Function LirePlayList($IDnomCanal : Text)
	// lire la playList du canal $1
	var $canal : cs.$canalAudio
	
	Case of 
		: (Not(OB Is defined(This.prefs.SonorisationPrefs.Ambiance; "PlayList")))
		: (This.prefs.SonorisationPrefs.Ambiance.PlayList.length=0)
		Else 
			// IDnomCanal et source sont renseignés
			$canal:=This.getCanal($IDnomCanal)
			$canal.IDnomFichier:=$canal.préférences.PlayList[$canal.préférences.indexPlay].morceau
			$canal.LireSon()
	End case 
	
	
Function FixerNiveaux()
	// rafraichir le niveau de chaque canal du process (une modification des préférences a pu avoir eu lieu)
	var $canal : cs.$canalAudio
	
	For each ($canal; This.canauxAudio)
		// si le canal est en lecture, fixer le niveau des UserPréférences
		
		Case of 
			: ($canal.LireLecturePause()=-2)
				// pas de canal
			: ($canal.LireLecturePause()=0)
				// canal en pause
			Else 
				// canal en lecture, mettre le niveau à la valeur demandée
				$canal.FixerNiveau($canal.préférences.Niveau)
				// il semble qu'on ne puisse modifier à la volée le niveau du synthétiseur vocal => verrue
				If ($canal.source=Is text)
					//  relancer la lecture, avec le nouveau niveau
					$canal.LireSon()
				End if 
		End case 
	End for each 
	
	
Function StopSonorisation()
	// arrêter chaque canal du process du process courant
	var $data : Object
	
	If (This.canauxAudio.length>0)
		For each ($data; This.canauxAudio)
			$data.Fermer()
		End for each 
	End if 
	
	
	// ----------------------
	// MARK:Demande d'actions
	// -----------------------
	
Function demanderAction($IDaction : Text)
	// répercuter la demande $IDaction à tous les formulaires
	var $c : Collection
	var $process : Object
	
	$c:=Process activity.processes.query("name = :1"; "U_@")
	For each ($process; $c)
		// on a un process Editeur ou Visualisateur, mise à jour de ses paramètres
		Appeler_Le_Formulaire($process.number; "MettreAjourPage"; New object("ActionID"; $IDaction))
		ASSERT(cs.$trace.me.DebugerMethode(""; Current method name; $IDaction))
	End for each 
	
	
Function MettreAJour($params : Object)->$result : Object
	// appel de ce formulaire depuis quelque part
	$result:=ds.initResult()
	
	$result.success:=True
	Case of 
		: (Not(OB Is defined($params; "ActionID")))
			$result.success:=False
			
		: ($params.ActionID="MettreAjourSelection")
			// relancer la lecture de la playlist, en particulier si on a eu un téléchargemnt
			This.LirePlayList("DiaporamaAmbiance")
			
		: ($params.ActionID="StopSonorisation")
			This.StopSonorisation()
			
		: ($params.ActionID="FixerNiveaux")
			This.FixerNiveaux()
			
		Else 
			$result.success:=False
	End case

⇧ Supprimer De DataStore - 31/01/2026 09:51:04

⇧ Intercepter Erreur SAVE - 22/06/2025 19:23:29

⇧ _Démarrer Application - 04/05/2026 12:09:57

⇧ InitProcessThreadSafe - 20/05/2026 12:38:37

Capable de process préemptif

⇧ errorHandler_checkData - 01/06/2025 12:30:33

⇧ Lire_MarkersData - 30/01/2026 11:38:38

Disponible via les balises HTML et les URLs 4D (4DACTION...) Capable de process préemptif

⇧ InitProcessCooperative - 20/05/2026 12:39:05

⇧ Bac à sable - 23/07/2026 09:43:09

⇧ estAppelMobile - 18/04/2026 14:34:46

Capable de process préemptif

⇧ aTester - 19/02/2026 09:21:25

⇧ Bac à sable Client - 07/05/2026 16:14:24

⇧ Afficher Progression Process - 12/05/2026 09:38:30

⇧ Afficher aPropos - 14/03/2026 12:03:47

⇧ Appeler_Le_Formulaire - 08/03/2026 11:55:59

⇧ Données Hôte Partagées - 18/04/2026 14:32:42

Partagée entre composants et base hôte Capable de process préemptif

⇧ Liens HyperText - 24/03/2026 15:01:13

⇧ Installer_LesServeurs - 26/02/2026 08:16:42

Partagée entre composants et base hôte Disponible via les balises HTML et les URLs 4D (4DACTION...) Capable de process préemptif

⇧ ExecuterSurServeur - 26/02/2026 14:32:44

⇧ Intercepter Erreur WEB - 09/01/2026 12:01:04

Partagée entre composants et base hôte Capable de process préemptif

⇧ errorHandler_DS - 01/05/2025 12:49:05

⇧ errorHandler_COMP - 29/01/2026 13:10:41

⇧ traceHandler - 08/05/2026 18:05:03

Capable de process préemptif

⇧ CoDecBase64_Objet - 18/04/2026 12:08:12

Capable de process préemptif

⇧ Créer Liste Hiérarchique - 18/05/2026 12:48:15

⇧ COMPILER_WEB - 18/12/2025 18:49:18

⇧ EcrireElementHTML - 07/12/2025 09:49:53

Disponible via les balises HTML et les URLs 4D (4DACTION...) Capable de process préemptif

⇧ Attendre - 14/03/2026 12:43:37

Capable de process préemptif

⇧ errorHandler_APP - 07/03/2026 09:57:48

Partagée entre composants et base hôte Capable de process préemptif

⇧ Fenêtre du process - 27/11/2025 14:57:53

⇧ [class]PersonnagesEntity - 30/04/2026 14:28:08

⇧ [class]$sauvegarde - 21/05/2026 10:55:07

⇧ [class]Encyclopedia - 30/01/2026 19:19:23

⇧ [class]$application - 08/06/2026 09:54:38

⇧ [class]$formulaire - 18/05/2026 10:08:39

⇧ [class]$formulaire_SF_OptionsAG - 18/04/2026 18:35:48

⇧ [class]$processData - 09/06/2026 09:33:34

⇧ [class]$pageWebDOC - 18/04/2026 18:34:15

⇧ [class]$maintenance - 08/06/2026 10:22:13

⇧ [class]$editeur - 09/06/2026 09:12:09

⇧ [class]$serveurWEB - 18/06/2026 08:19:38

⇧ [class]_cfct - 20/05/2026 09:20:52

⇧ [class]EventsFamEntity - 12/04/2026 11:36:27

⇧ [class]$canalAudio - 18/04/2026 18:18:24

⇧ [class]_main - 23/07/2026 19:44:57

⇧ [class]wwwGroupes - 22/04/2026 19:00:01

⇧ [class]DossiersEntity - 12/04/2026 15:57:37

⇧ [class]UtilisateursALVSelection - 30/01/2026 18:30:54

⇧ [class]PaysagesEntity - 30/04/2026 14:29:26

⇧ [class]DicoDesNoms - 12/04/2026 19:12:10

⇧ [class]LieuxSelection - 06/04/2026 15:48:24

⇧ [class]_ds_EXT - 06/07/2026 11:55:50

⇧ [class]$dialogue_3105 - 18/04/2026 18:16:35

⇧ [class]$session - 23/07/2026 17:23:29

⇧ [class]$dialogue_3001 - 06/05/2026 16:21:00

⇧ [class]$gedcom - 08/06/2026 11:58:52

⇧ [class]$certificatSSL - 07/05/2026 17:21:40

⇧ [class]SitesEntity - 12/04/2026 13:10:20

⇧ [class]ZonesEntity - 30/04/2026 14:22:56

⇧ [class]$texteEditeur - 15/06/2026 12:35:58

⇧ [class]UtilisateursALVEditeur - 06/05/2026 11:26:02

⇧ [class]EncyclopediaPalette - 19/05/2026 08:18:14

⇧ [class]$hyperTexteEditeur - 30/01/2026 19:38:36

⇧ [class]$generationAPP - 23/07/2026 11:45:58

⇧ [class]Events - 18/05/2026 17:23:40

⇧ [class]$menu - 06/05/2026 11:25:13

⇧ [class]Zones - 16/05/2024 14:36:41

⇧ [class]$menus - 18/04/2026 18:30:36

⇧ [class]CommunesSelection - 21/04/2026 11:25:17

⇧ [class]PersonnesPalette - 06/05/2026 11:05:06

Disponible via les balises HTML et les URLs 4D (4DACTION...)

Capable de process préemptif

Partagée entre composants et base hôte

Capable de process préemptif

Partagée entre composants et base hôte

Disponible via les balises HTML et les URLs 4D (4DACTION...)

Capable de process préemptif

Partagée entre composants et base hôte

Capable de process préemptif

Disponible via les balises HTML et les URLs 4D (4DACTION...)

Capable de process préemptif

Partagée entre composants et base hôte

Capable de process préemptif