Disponible via SQL
Capable de process préemptif
#DECLARE($nomTab : Text; $valeur : Integer)->$result : Integer
// test si $2 est dans le tableau de nom $1
var $ptr : Pointer
$ptr:=Get pointer($nomTab)
If (Type($ptr->)=LongInt array)
$result:=Find in array($ptr->; $valeur)
Else
$result:=-1
End if
Disponible via SQL
Capable de process préemptif
// interception d'une erreur
var $erreur : Integer
$erreur:=cs.xSDK.Traces.new().Intercepter("SQL"; Error; Error method; Error line; Error formula)
cs.xSDK.TraductionsEditeur.new().ModifierTraductions()
// attributs de la classe
property nom : Text
property Proprietaire; IDfamille : Integer
Class extends _SQLentite
Class constructor($IDentity : Variant)
// initialiser l'objet avec les données de l'entité $IDunique de la BDD
var $ID : Integer
Super("wwwGroupes"; $IDentity; 24)
// les infos
$ID:=This.ID
This.InitVarProcessSQL()
Try
Begin SQL
SELECT nom, Proprietaire, IDfamille FROM wwwGroupes WHERE ID = :$ID INTO :varText1, :varInteger1, :varInteger2;
End SQL
Catch
// la table n'existe pas (test des composants)
varText1:="Vampires"
varInteger1:=12345
varInteger2:=67890
End try
// enregistrer ce qu'on a trouvé (ou les valeurs par défaut)
This.nom:=varText1
This.Proprietaire:=varInteger1
This.IDfamille:=varInteger2
Class constructor()
var varInteger1; varInteger2; varInteger3; varInteger4 : Integer
var varReal1; varReal2 : Real
var varText1; varText2; varText3; varText4; varText5; varText6; varText7 : Text
var varPicture1; varPicture2 : Picture
var varDate : Date
var varTime : Time
var varBool : Boolean
Function InitVarProcessSQL()
varInteger1:=-Random
varInteger2:=0
varInteger3:=0
varInteger4:=0
varText1:=Generate UUID
varText2:=""
varText3:=""
varText4:=""
varText5:=""
varText6:=""
varText7:=""
CLEAR VARIABLE(varPicture1)
varReal1:=0
varReal2:=0
CLEAR VARIABLE(varDate)
CLEAR VARIABLE(varTime)
varBool:=False
// ----------------------
//MARK:Création
// -----------------------
Function setEntités($DataClassNom : Text; $c : Collection)->$result : Collection
var $ID : Integer
$result:=New collection
Case of
: ($DataClassNom="")
: ($c.length=0)
Else
For each ($ID; $c)
$result.push(cs[$DataClassNom].new($ID))
End for each
End case
property DataClassNom; IDunique : Text
property numTable; ID : Integer
Class extends _SQL_DataStore
Class constructor($DataClassNom : Text; $IDentity : Variant; $numTable : Integer)
var $UUID; $texte : Text
var $ID : Integer
Super()
This.DataClassNom:=$DataClassNom
This.numTable:=$numTable
// si $IDentity n'existe pas en BDD (nouvelle entité pour la saisie), initialiser les ID et IDunique d'une entité vide
// trouver ID / IDunique de l'entité demandée
// construire la requête (les variables locales ne sont pas admises, cf doc 4D)
$texte:=""
Case of
: ($IDentity=Null)
// cette classe a ni ID, ni IDunique
: (Value type($IDentity)=Is text)
// il faut retyper $IDentity
$UUID:=$IDentity
$texte:="SELECT ID, IDunique FROM "+This.DataClassNom+" WHERE IDunique = '"+$UUID+"' INTO :varInteger1, :varText1;"
: ((Value type($IDentity)=Is longint) | (Value type($IDentity)=Is real))
// il faut retyper $IDentity
$ID:=$IDentity
$texte:="SELECT ID, IDunique FROM "+This.DataClassNom+" WHERE ID = "+String($ID)+" INTO :varInteger1, :varText1;"
End case
If ($texte#"")
This.InitVarProcessSQL()
Try
Begin SQL
EXECUTE IMMEDIATE :$texte;
End SQL
Catch
// la table n'existe pas (test des composants)
varInteger1:=-Random
varText1:="00000000000000000000000000000000"
End try
// enregistrer ce qu'on a trouvé (ou les valeurs par défaut)
This.ID:=varInteger1
This.IDunique:=varText1
End if
Function IDcodé()->$IDcodé : Integer
$IDcodé:=(This.numTable << 24) | This.ID
// ----------------------
//MARK:Entité
// -----------------------
Function LireLocatedSTR($ID : Integer; $options : Object)->$result : Text
var $début; $fin : Integer
var $libellé; $texte; $balise; $newTexte : Text
var $UserPrefs : Object
var $c; $cEl : Collection
$UserPrefs:=New object // vide
$texte:=Localized string(String($ID))
// rechercher dans $texte une balise d'un type de $c à partir de $début
// une balise est la forme :typeBalise?xxxx:
// d'abord chercher les balises xCode, référant un élément de langages
$c:=New collection(":xCode")
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:=""
// 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")
Case of
: (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.CodeLangue="fr")
$newTexte:="e"*Num($options.genre)
Else
$newTexte:="?"
End case
: ($cEl[1]="plur")
Case of
: (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.CodeLangue="fr")
$newTexte:="s"*Num($options.plur)
: ($UserPrefs.Apparence.CodeLangue="en")
$newTexte:="s"*Num($options.plur)
Else
$newTexte:="?"
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
Else
// on ne sait pas
$newTexte:="err locatedSTR "
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
$result:=$texte
// ----------------------
//MARK:Sélection
// -----------------------
Function setEntités($DataClassNom : Text; $prtTab : Pointer)->$result : Collection
// créer une sélection d'entités de this avec les ID de $ptrTab
var $c : Collection
$result:=New collection
If (Type($prtTab->)=LongInt array)
$c:=New collection
ARRAY TO COLLECTION($c; $prtTab->)
$result:=Super.setEntités($DataClassNom; $c)
End if
// attributs de la classe
property nom : Text
property blason : Picture
property latitude; longitude : Real
property lePays : cs.Pays
Class extends _SQLentite
Class constructor($IDentity : Variant)
// initialiser l'objet avec les données de l'entité $IDunique de la BDD
var $ID : Integer
Super("Regions"; $IDentity; 15)
$ID:=This.ID
This.InitVarProcessSQL()
Try
Begin SQL
SELECT nom, blason, pays, latitude, longitude FROM Regions WHERE Regions.ID = :$ID INTO :varText1, :varPicture1, :varInteger1, :varReal1, :varReal2;
End SQL
Catch
// la table n'existe pas (test des composants)
varText1:="Mordor"
READ PICTURE FILE(Folder(fk resources folder).folder("Images").file("19200.png").platformPath; varPicture1)
varInteger1:=-2
varReal1:=45.2
varReal2:=0.2
End try
// enregistrer ce qu'on a trouvé (ou les valeurs par défaut)
This.nom:=varText1
This.blason:=varPicture1
This.latitude:=varReal1
This.longitude:=varReal2
// reconstituer la hiérarchie administrative : pays de la région
// le pays
This.lePays:=cs.Pays.new(varInteger1)
Function Libellé($formats : Object)->$libellé : Text
// renvoie le nom formaté suivant les options $1
// function identique à celle de la BDDmère
// $formats
// .Options
// bit 19 = ajouter le pays
// bit 23 = région
$libellé:=(This.nom*Num($formats.Options ?? 23))+((" ("+This.lePays.nom+")")*Num($formats.Options ?? 19))
// ----------------------
//MARK:Sélections
// -----------------------
Function Le($DataClassNom : Text)->$result : Object
// renvoie l'entité [$DataClassNom]
If ($DataClassNom=This.DataClassNom)
$result:=This
Else
$result:=This.lePays.Le($DataClassNom)
End if
Class extends _SQLentiteSelect
Class constructor($requête : Variant)
Super("Events"; $requête; 9)
Function Chercher($params : Object)->$result : cs.EventsSelect
var $typeMin; $typeMax : Integer
var $dateMin; $dateMax : Date
// par défaut on prend tout
$typeMin:=0
$typeMax:=99999
$dateMin:=!100-01-01!
$dateMax:=!3000-01-01! // y a de la marge !
This._ValiderSaisie($params; ->$typeMin; ->$typeMax; ->$dateMin; ->$dateMax)
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT ID FROM Events WHERE (type >= :$typeMin) AND (type <= :$typeMax) AND (dateNum >= :$dateMin) AND (dateNum <= :$dateMax) INTO :$tabID;
End SQL
ARRAY TO COLLECTION(This.collection; $tabID)
// il peut y avoir la valeur 0 (un NULL quelque part?)
// ?????? This.collection:=This.collection.filter(Formula($1.value>$2); 0)
// pour le chainage des functions
$result:=This
Function _ValiderSaisie($params : Object; $ptrTypeMin : Pointer; $ptrTypeMax : Pointer; $ptrDateMin : Pointer; $ptrDateMax : Pointer)
Case of
: (Not(OB Is defined($params; "typeMin")))
: (Not(OB Is defined($params; "typeMax")))
Else
$ptrTypeMin->:=OB Get($params; "typeMin"; Is longint)
$ptrTypeMax->:=OB Get($params; "typeMax"; Is longint)
End case
If (OB Is defined($params; "dateMin"))
$ptrDateMin->:=OB Get($params; "dateMin"; Is date)
End if
If (OB Is defined($params; "dateMax"))
$ptrDateMax->:=OB Get($params; "dateMax"; Is date)
End if
Function LesProtagonistes()->$result : Collection
// trouver toutes les personnes associées à cette sélection d'events
var $c : Collection
ARRAY LONGINT(tabID; 0)
COLLECTION TO ARRAY(This.collection; tabID)
ARRAY LONGINT($tabID1; 0)
ARRAY LONGINT($tabID2; 0)
Try
// ceux des events mariage puis ceux des events perso
Begin SQL
SELECT Relations.membre FROM EventsFam
LEFT OUTER JOIN (Unions LEFT OUTER JOIN Relations ON Unions.couple = Relations.groupe)
ON EventsFam.famille = Unions.ID
WHERE {fn EstDansTableauNumeric('tabID',EventsFam.evenement) AS NUMERIC} > -1
INTO :$tabID1;
SELECT DISTINCT Personnes.ID
FROM EventsPerso
INNER JOIN Personnes ON EventsPerso.personne = Personnes.ID
WHERE {fn EstDansTableauNumeric('tabID',EventsPerso.evenement) AS NUMERIC} > -1
INTO :$tabID2;
End SQL
Catch
APPEND TO ARRAY($tabID1; -1)
APPEND TO ARRAY($tabID2; -1)
End try
// créer la collection globale
$result:=New collection
ARRAY TO COLLECTION($result; $tabID1)
$c:=New collection
ARRAY TO COLLECTION($c; $tabID2)
$result:=$result.concat($c).distinct()
Class extends _SQLentiteSelect
Class constructor($requête : Variant)
Super("Dossiers"; $requête; 27)
// attributs de la classe
property evenement; Groupe1; Groupe2; famille : Integer
Class extends _SQLentite
Class constructor($IDentity : Integer)
// initialiser l'objet avec les données de l'entité $IDentity de la BDD
var $ID : Integer
// attention, cette classe a ni ID, ni IDunique. ici super() ne fonctionne pas
Super("EventsFam"; Null; 8)
This.evenement:=$IDentity
// lire les données de l'event
$ID:=This.evenement
This.InitVarProcessSQL()
Try
Begin SQL
SELECT Groupe1, Groupe2, famille FROM EventsFam WHERE evenement = :$ID INTO :varInteger1, :varInteger2, :varInteger3;
End SQL
Catch
// la table n'existe pas (test des composants)
varInteger1:=Random
varInteger2:=Random
varInteger3:=1000
End try
// enregistrer ce qu'on a trouvé (ou les valeurs par défaut)
This.Groupe1:=varInteger1
This.Groupe2:=varInteger2
This.famille:=varInteger3
Function LesTémoins($groupe : Text)->$result : Collection
var $ID : Integer
$ID:=This[$groupe]
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT membre FROM Relations WHERE groupe = :$ID INTO :$tabID;
End SQL
$result:=This.setEntités("Personnes"; ->$tabID)
// attributs de la classe
property type : Integer
property nom : Text
property laCommune : cs.Communes
Class extends _SQLentite
Class constructor($IDentity : Variant)
// initialiser l'objet avec les données de l'entité $IDunique de la BDD
var $ID : Integer
Super("Sites"; $IDentity; 12)
// lire les données du site
$ID:=This.ID
This.InitVarProcessSQL()
Try
Begin SQL
SELECT type, nom, commune FROM Sites WHERE Sites.ID = :$ID INTO :varInteger2, :varText1, :varInteger1;
End SQL
Catch
// la table n'existe pas (test des composants)
varText1:="Citadelle"
varInteger2:=50200
varInteger1:=-2
End try
// enregistrer ce qu'on a trouvé (ou les valeurs par défaut)
This.type:=varInteger2
This.nom:=varText1
// reconstituer la hiérarchie administrative : commune, département, région et pays du site
// la commune
This.laCommune:=cs.Communes.new(varInteger1)
// ----------------------
//MARK:Sélections
// -----------------------
Function Le($DataClassNom : Text)->$result : Object
// renvoie l'entité [$DataClassNom]
If ($DataClassNom=This.DataClassNom)
$result:=This
Else
$result:=This.laCommune.Le($DataClassNom)
End if
Function LesLieux()->$result : Collection
// créer la collection des lieux du site
var $ID : Integer
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Try
Begin SQL
SELECT Lieux.ID
FROM Lieux
WHERE Lieux.site = :$ID
INTO :$tabID;
End SQL
Catch
APPEND TO ARRAY($tabID; -1)
APPEND TO ARRAY($tabID; -2)
End try
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
// attributs de la classe
property SansEnfant : Boolean
Class extends _SQLentite
Class constructor($IDentity : Variant)
// initialiser l'objet avec les données de l'entité $IDunique de la BDD
var $ID : Integer
Super("Unions"; $IDentity; 5)
// lire les données de l'union
$ID:=This.ID
This.InitVarProcessSQL()
Try
Begin SQL
SELECT SansEnfant FROM Unions WHERE ID = :$ID INTO :varBool;
End SQL
Catch
// la table n'existe pas (test des composants)
varBool:=False
End try
// enregistrer ce qu'on a trouvé (ou les valeurs par défaut)
This.SansEnfant:=varBool
Function LesEvents()->$result : Collection
// récupérer les events fam
// attention il peut ne pas y en avoir
var $ID : Integer
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT Events.ID FROM Events
INNER JOIN EventsFam ON Events.ID = EventsFam.evenement
WHERE EventsFam.famille = :$ID
ORDER BY Events.dateNum ASC
INTO :$tabID;
End SQL
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
Function LesProtagonistes()->$result : Collection
// collectionner les personnes de l'union
var $ID : Integer
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT DISTINCT Relations.membre
FROM Relations
WHERE groupe IN (SELECT couple FROM Unions WHERE ID = :$ID)
INTO :$tabID;
End SQL
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
Function LesEnfants()->$result : Collection
// collecter les enfants de l'union
// attention il peut ne pas y en avoir
var $ID : Integer
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT Personnes.ID FROM Personnes
WHERE Personnes.parents = :$ID
INTO :$tabID;
End SQL
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
// attributs de la classe
property evenement; Groupe1; Groupe2; personne : Integer
Class extends _SQLentite
Class constructor($IDentity : Integer)
// initialiser l'objet avec les données de l'entité $IDentity de la BDD
var $ID : Integer
// attention, cette classe a ni ID, ni IDunique. ici super() ne fonctionne pas
Super("EventsPerso"; Null; 7)
This.evenement:=$IDentity
// lire les données de l'event
$ID:=This.evenement
This.InitVarProcessSQL()
Try
Begin SQL
SELECT Groupe1, Groupe2, personne FROM EventsPerso WHERE evenement = :$ID INTO :varInteger1, :varInteger2, :varInteger3;
End SQL
Catch
// la table n'existe pas (test des composants)
varInteger1:=Random
varInteger2:=Random
varInteger3:=1
End try
// enregistrer ce qu'on a trouvé (ou les valeurs par défaut)
This.Groupe1:=varInteger1
This.Groupe2:=varInteger2
This.personne:=varInteger3
Function LesTémoins($groupe : Text)->$result : Collection
var $ID : Integer
$ID:=This[$groupe]
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT membre FROM Relations WHERE groupe = :$ID INTO :$tabID;
End SQL
$result:=This.setEntités("Personnes"; ->$tabID)
Class extends _SQLentiteSelect
Class constructor($requête : Variant)
Super("DicoDesNoms"; $requête; 3)
// attributs de la classe
property LogIn; Password; Name; First_Name; AdresseEmail; IDunique; privileges : Text
property droits : Integer
property leGroupe : cs.wwwGroupes
Class extends _SQLentite
Class constructor($IDentity : Variant)
// initialiser l'objet avec les données de l'entité $IDunique de la BDD
var $ID : Integer
var $LogIn : Text
Super("UtilisateursALV"; $IDentity; 31)
// cas où la classe est créée avec un LogIn
Case of
: (This.ID>0)
// on a l'entité de BDD
: (Value type($IDentity)#Is text)
// il faut un login
Else
$LogIn:=$IDentity
This.InitVarProcessSQL()
Try
Begin SQL
SELECT ID FROM UtilisateursALV WHERE LogIn = :$LogIn INTO :varInteger1;
End SQL
Catch
varInteger1:=-Random
End try
This.ID:=varInteger1
End case
// récupérer les données de l'utilisateur
$ID:=This.ID
This.InitVarProcessSQL()
Try
Begin SQL
SELECT LogIn, Password, Name, First_Name, Adresse_eMail, IDunique, droits, Groupe, privileges FROM UtilisateursALV WHERE ID = :$ID INTO :varText6, :varText2, :varText3, :varText4, :varText5, :varText1, :varInteger2, :varInteger1, :varText7;
End SQL
Catch
// la table n'existe pas (test des composants)
varText7:=""
varText6:=""
varText2:=""
varText3:="Lucifer"
varText4:="Biibiipsou"
varText5:="Lucifer.Biibiipsou@pipo.fr"
varText1:=Generate UUID
varInteger1:=-2
varInteger2:=40
End try
// enregistrer ce qu'on a trouvé (ou les valeurs par défaut)
This.LogIn:=varText6
This.Password:=varText2
This.Name:=varText3
This.First_Name:=varText4
This.AdresseEmail:=varText5
This.IDunique:=varText1
This.droits:=varInteger2
This.privileges:=varText7
// ajouter le groupe familial
This.leGroupe:=cs.wwwGroupes.new(varInteger1)
Function Libellé($formats : 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 3 = d'abord le prénom
$libellé:=""
If (This#Null)
$libellé:=(This.First_Name)*Num($formats.Options ?? 1) // bit 1 = ajouter le prénom
If ($formats.Options ?? 3) // d'abord le prénom
$libellé:=$libellé+((" "*Num($formats.Options ?? 1))+This.Name)*Num($formats.Options ?? 0) // bit 0 = ajouter le nom
Else
$libellé:=(This.Name+(" "*Num($formats.Options ?? 1)))*Num($formats.Options ?? 0)+$libellé // bit 0 = ajouter le nom
End if
Else
$libellé:=Lowercase(Localized string("1004"))
End if
// attributs de la classe
property volume : Integer
Class extends _SQLentite
Class constructor($IDentity : Variant)
// initialiser l'objet avec les données de l'entité $IDunique de la BDD
var $ID : Integer
Super("Dossiers"; Null; 27)
$ID:=$IDentity
This.ID:=$ID
// récupérer les données du dossier
Begin SQL
SELECT volume FROM Dossiers WHERE id = :$ID INTO :varInteger2;
End SQL
This.volume:=varInteger2
// attributs de la classe
property nom; prenom; autres_prenoms; metier; commentaire : Text
property sexe : Boolean
Class extends _SQLentite
Class constructor($IDentity : Variant)
// initialiser l'objet avec les données de l'entité $IDunique de la BDD
var $UUID : Text
Super("Personnes"; $IDentity; 1)
// récupérer les données de la personne
$UUID:=This.IDunique
This.InitVarProcessSQL()
Try
Begin SQL
SELECT nom, prenom, autres_prenoms, sexe , metier, commentaire FROM Personnes WHERE IDunique = :$UUID INTO :varText1, :varText2, :varText3, :varBool, :varText4, :varText5;
End SQL
Catch
// la table n'existe pas (test des composants)
varText1:="Sacquet"
varText2:="Bilbon"
varText3:="Le Hobbit"
varBool:=False
varText4:="aventurier"
varText5:="héros des 'seigneurs des anneaux'"
End try
// enregistrer ce qu'on a trouvé (ou les valeurs par défaut)
This.nom:=varText1
This.prenom:=varText2
This.autres_prenoms:=varText3
This.sexe:=varBool
This.metier:=varText4
This.commentaire:=varText5
// rappel : dans le constructeur on ne peut pas appeler une function
Function Libellé($formats : Object)->$libellé : Text
// renvoie le nom formaté suivant les options $formats
var $options : Integer
$options:=$formats.Options
$libellé:=""
$libellé:=(This.prenom)*Num($options ?? 1) // bit 1 = ajouter le prénom
$libellé:=$libellé+(Num($options ?? 2)*Num(This.autres_prenoms#"")*(" "+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é:=(This.LireLocatedSTR(1013)*Num($options ?? 5))+$libellé // bit 5 = conjoint
// ----------------------
//MARK:Sélection
// ----------------------
Function LesEvents()->$result : Collection
// récupérer les events perso
var $ID : Integer
// attention il peut ne pas y en avoir
ARRAY LONGINT($tabID; 0)
Try
$ID:=This.ID
Begin SQL
SELECT Events.ID FROM Events
INNER JOIN EventsPerso ON Events.ID = EventsPerso.evenement
WHERE EventsPerso.personne = :$ID
ORDER BY Events.dateNum ASC
INTO :$tabID;
End SQL
Catch
APPEND TO ARRAY($tabID; -1)
End try
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
Function LesParents()->$result : Integer
var $ID : Integer
// lire le ID de l'union parentale
$ID:=This.ID
This.InitVarProcessSQL()
Try
Begin SQL
SELECT parents FROM Personnes WHERE ID = :$ID INTO :varInteger1;
End SQL
Catch
// la table n'existe pas (test des composants)
varInteger1:=-2
End try
// les parents peuvent ne pas exister
$result:=varInteger1*Num(varInteger1>0)
Function LesUnions()->$result : Collection
// créer la collection des unions triées par date
var $ID : Integer
$ID:=This.ID
// attention il peut ne pas y en avoir
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT ID FROM Unions
WHERE Unions.couple IN
(SELECT groupe FROM Relations
INNER JOIN Personnes ON Personnes.ID = Relations.membre
WHERE Personnes.ID = :$ID)
INTO :$tabID;
End SQL
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
Function LesMediasDeTypeZone($type : Integer)->$result : Collection
// sélectionner les events de la personne, les events familiaux, concatainer
// puis sélectionner les medias
var $ID; $typeSQL : Integer
$typeSQL:=$type
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Try
If ($type>0)
Begin SQL
SELECT media
FROM Zones
WHERE Zones.ID IN
(SELECT Personnages.zone FROM Personnages WHERE Personnages.personne = :$ID) AND type = :$typeSQL
INTO :$tabID;
End SQL
Else
Begin SQL
SELECT media
FROM Zones
WHERE Zones.ID IN
(SELECT Personnages.zone FROM Personnages WHERE Personnages.personne = :$ID)
INTO : $tabID;
End SQL
End if
Catch
APPEND TO ARRAY($tabID; -1)
End try
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
Function LesMedias()->$result : Collection
// chercher les medias à afficher de la personne
var $ID : Integer
// sélectionner les events de la personne, les events familiaux, concatainer
// puis sélectionner les medias
$ID:=This.ID
ARRAY LONGINT(tabID; 0)
ARRAY LONGINT(tabEvents; 0)
ARRAY LONGINT($tabID; 0)
Try
Begin SQL
SELECT DISTINCT EventsPerso.evenement
FROM EventsPerso
INNER JOIN Personnes ON EventsPerso.personne = Personnes.ID
WHERE Personnes.ID = :$ID
INTO :tabID;
SELECT EventsFam.evenement
FROM Relations
LEFT OUTER JOIN (Unions LEFT OUTER JOIN EventsFam ON Unions.ID = EventsFam.famille)
ON Relations.groupe = Unions.couple
WHERE Relations.membre = :$ID
INTO :tabEvents;
SELECT ID
FROM Events
WHERE ({fn EstDansTableauNumeric('tabID',ID) AS NUMERIC} > -1 OR {fn EstDansTableauNumeric('tabEvents',ID) AS NUMERIC} > -1) AND type > 20000 AND type < 39999
INTO :tabID;
SELECT DISTINCT Zones.media
FROM Zones
INNER JOIN Instantanes ON Zones.ID = Instantanes.zone
WHERE {fn EstDansTableauNumeric('tabID',Instantanes.event) AS NUMERIC} > -1
INTO :tabID;
SELECT DISTINCT ID
FROM Medias
WHERE {fn EstDansTableauNumeric('tabID',ID) AS NUMERIC} > -1
ORDER BY dateNum ASC, heure ASC
INTO :$tabID;
End SQL
Catch
APPEND TO ARRAY($tabID; -1)
End try
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
Class extends _SQLentiteSelect
Class constructor($requête : Variant)
Super("Sites"; $requête; 12)
Class extends _SQLentiteSelect
Class constructor($requête : Variant)
Super("Unions"; $requête; 5)
Function Chercher($params : Object)
var $nom; $prenom : Text
var $sexe : Boolean
$nom:=""
$prenom:=""
This._ValiderSaisie($params; ->$nom; ->$prenom)
// retyper le sexe
$sexe:=(Num($params.sexe)=1)
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT Unions.ID FROM Unions
INNER JOIN Relations ON Relations.groupe=Unions.couple
WHERE Relations.membre IN
(SELECT Personnes.ID FROM Personnes
WHERE nom LIKE :$nom AND prenom LIKE :$prenom AND sexe = :$sexe)
INTO :$tabID
End SQL
ARRAY TO COLLECTION(This.collection; $tabID)
// il peut y avoir la valeur 0 (un NULL quelque part?)
This.collection:=This.collection.filter(Formula($1.value>$2); 0)
Class extends _SQLentiteSelect
Class constructor($requête : Variant)
Super("Departements"; $requête; 14)
// attributs de la classe
property type : Integer
property dateChaine; commentaire; source : Text
property dateNum : Date
property heure : Time
property leLieu : cs.Lieux
Class extends _SQLentite
Class constructor($IDentity : Variant)
// initialiser l'objet avec les données de l'entité $IDunique de la BDD
// rappel : l'event est genré dynamiquement (voir le getEvent() de la classe Personne)
var $ID : Integer
Super("Events"; $IDentity; 9)
// lire les données de l'event
$ID:=This.ID
This.InitVarProcessSQL()
Try
Begin SQL
SELECT type, dateChaine, dateNum, heure, commentaire, source, lieu FROM Events WHERE ID = :$ID INTO :varInteger2, :varText1, :varDate, :varTime, :varText2, :varText3, :varInteger1;
End SQL
Catch
// la table n'existe pas (test des composants)
varText1:="23 septembre 1956"
varInteger2:=22000
varDate:=Current date
varTime:=Time("16:00:00")
varText2:="Commentaire de l'évènement "+String(varInteger2)
varText3:="Source Event"
varInteger1:=-2
End try
// enregistrer ce qu'on a trouvé (ou les valeurs par défaut)
This.type:=varInteger2
This.dateChaine:=varText1
This.dateNum:=varDate
This.heure:=varTime
This.commentaire:=varText2
This.source:=varText3
This.leLieu:=cs.Lieux.new(varInteger1)
Function Libellé($formats : Object)->$libellé : Text
var $options : Integer
var $sélection : Collection
$options:=$formats.Options
$libellé:=""
If ($options ?? 12)
If ($options ?? 13) // & (This.estEventPersonnel()))
$libellé:=This.LireLocatedSTR(Int(This.type/100)%100+1000; New object("genre"; $formats.genre; "plur"; False))
Else
$libellé:=This.LireLocatedSTR(This.type)
If ($options ?? 24)
$libellé[[1]]:=Lowercase($libellé[[1]])
$libellé:=This.LireLocatedSTR(Int(This.type/100)%100+1100)+$libellé
End if
End if
End if
If ($options ?? 20)
$libellé:=Localized string(String(16000000+This.type))+" "
End if
If ($options ?? 10)
$libellé:=$libellé+This.FormaterDate($formats)
End if
If ($options ?? 14)
$libellé:=$libellé+This.FormaterHeure($formats)
End if
If (($options ?? 11) & (This.leLieu.ID>0))
// créer la sélection commune
$libellé:=$libellé+($formats.SymbolDateLieu*Num(Not($options ?? 9)))+This.leLieu.Le("Communes").Libellé($formats)
End if
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é+This.LireLocatedSTR(1001)+$sélection[0].Libellé($formats)
: ($sélection.length=2)
// un event de famille
$libellé:=$libellé+This.LireLocatedSTR(1001)+This.Libellés($sélection; $formats).result
End case
End if
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 $texte; $date; $jour; $mois; $année; $nomDuMois; $nomMois : Text
var $options; $i : Integer
var $dateValide : Boolean
$options:=$Formats.Options
$texte:=""
$date:=This.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)
$mois:="01"
$dateValide:=False
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)
$dateValide:=True
$i:=0
End if
End for
If (Num($année)=0)
$année:="100"
$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)))
$dateValide:=False
End if
// mettre au format demandé
Case of
: ($Formats.FormatDate=0) // la date de la BDD au format numérique
$formats.dateValide:=$dateValide
$formats.dateNum:=Add to date(!00-00-00!; Num($année); Num($mois); Num($jour))
: ($Formats.FormatDate=Internal date long) // la date mémorisée en la BDD
$texte:=Choose(($options ?? 8) & $dateValide; This.LireLocatedSTR(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
: ($dateValide)
$texte:=(This.LireLocatedSTR(1008)*Num($options ?? 8))+$jour+"-"+$mois+"-"+$année
: (This.dateChaine="")
$texte:=This.LireLocatedSTR(1004) // inconnu
Else
$texte:=(" "*Num($options ?? 8))+This.dateChaine
End case
: ($Formats.FormatDate=11) // la date de la BDD au format numérique = "aaaa"
$texte:=$année
End case
$result:=$texte
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:=(This.LireLocatedSTR(33)*Num($options ?? 8))+$texte
$result:=$texte*Num(Not(Time(This.heure)=?00:00:00?))
Function Libellés($sélection : Collection; $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é : Object
// trier homme / femme
// remarque : si on a un élément vide, le tri le passe en second
$sélection:=$sélection.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
Function _LesProtagonistes()->$result : Collection
var $c : Collection
var $PersonnesSelect : cs.PersonnesSelect
$c:=This.LesProtagonistes()
$PersonnesSelect:=cs.PersonnesSelect.new($c)
$result:=$PersonnesSelect.Créer().selection
// ----------------------
//MARK:Sélection
// ----------------------
Function parent()->$result : Object
// chercher le parent de this
var $ID; $i : Integer
$result:=Null
If (This.ID>0)
$ID:=This.ID
If (This.type<29999)
// la personne de l'event perso
Begin SQL
SELECT personne FROM EventsPerso WHERE evenement = :$ID INTO :$i;
End SQL
$result:=cs.Personnes.new($i)
Else
Begin SQL
SELECT EventsFam.famille FROM EventsFam WHERE EventsFam.evenement = :$ID INTO :$i;
End SQL
$result:=cs.Unions.new($i)
End if
End if
Function LesProtagonistes()->$result : Collection
var $ID : Integer
$result:=New collection
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Try
If (This.type<29999)
// la personne de l'event perso
Begin SQL
SELECT personne FROM EventsPerso WHERE evenement = :$ID INTO :$tabID;
End SQL
Else
// les conjoints de l'event fam
Begin SQL
SELECT Relations.membre
FROM EventsFam
LEFT OUTER JOIN (Unions LEFT OUTER JOIN Relations ON Unions.couple = Relations.groupe)
ON EventsFam.famille = Unions.ID
WHERE EventsFam.evenement = :$ID
INTO :$tabID;
End SQL
End if
Catch
APPEND TO ARRAY($tabID; -1)
End try
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
Function LesTémoins($groupe : Text)->$result : Collection
var $entité : Object
$entité:=This.getEventType()
$result:=$entité.LesTémoins($groupe)
Function getEventType()->$result : Object
var $ID; $i : Integer
$result:=Null
// essayer un type Perso
$ID:=This.ID
$i:=-1
Begin SQL
SELECT EventsPerso.evenement
FROM EventsPerso
WHERE EventsPerso.evenement = :$ID
INTO :$i;
End SQL
If ($i>0)
$result:=cs.EventsPerso.new($ID)
Else
// essayer un type Fam
$i:=-1
Begin SQL
SELECT EventsFam.evenement
FROM EventsFam
WHERE EventsFam.evenement = :$ID
INTO :$i;
End SQL
If ($i>0)
$result:=cs.EventsFam.new($ID)
End if
End if
Function estEventPersonnel()->$result : Boolean
$result:=(This.getEventType().DataClassNom="EventsPerso")
Class extends _SQLentiteSelect
Class constructor($requête : Variant)
Super("Medias"; $requête; 19)
// attributs de la classe
property nom : Text
property drapeau : Picture
property latitude; longitude : Real
Class extends _SQLentite
Class constructor($IDentity : Variant)
// initialiser l'objet avec les données de l'entité $IDunique de la BDD
var $ID : Integer
Super("Pays"; $IDentity; 16)
$ID:=This.ID
This.InitVarProcessSQL()
Try
Begin SQL
SELECT nom, drapeau, latitude, longitude FROM Pays WHERE Pays.ID = :$ID INTO :varText1, :varPicture1, :varReal1, :varReal2;
End SQL
Catch
// la table n'existe pas (test des composants)
varText1:="Terres du Milieu"
READ PICTURE FILE(Folder(fk resources folder).folder("Images").file("19200.png").platformPath; varPicture1)
varReal1:=45.3
varReal2:=0.3
End try
// enregistrer ce qu'on a trouvé (ou les valeurs par défaut)
This.nom:=varText1
This.drapeau:=varPicture1
This.latitude:=varReal1
This.longitude:=varReal2
Function Libellé($formats : Object)->$libellé : Text
// renvoie le nom formaté suivant les options $1
// function identique à celle de la BDDmère
// pas d'options
$libellé:=This.nom
// ----------------------
//MARK:Sélections
// -----------------------
Function Le($DataClassNom : Text)->$result : Object
// renvoie l'entité [$DataClassNom]
If ($DataClassNom=This.DataClassNom)
$result:=This
End if
Function LesDepartements()->$result : Collection
// renvoie la collection de tous les départements de this
var $ID : Integer
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT Departements.ID From Departements INNER JOIN Regions ON Departements.region=Regions.ID WHERE Regions.pays = :$ID INTO :$tabID;
End SQL
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
property DataClassNom : Text
property numTable : Integer
property collection : Collection
Class extends _SQL_DataStore
Class constructor($DataClassNom : Text; $request : Variant; $numTable : Integer)
var $texte : Text
Super()
This.DataClassNom:=$DataClassNom
This.numTable:=$numTable
This.collection:=New collection
// construire la collection de ID suivant la requête
Case of
: ($request=Null)
: (Value type($request)=Is text)
// $request est la clause 'where' de la requête SQL
// créer la requête
$texte:="SELECT ID FROM "+This.DataClassNom+" WHERE "+$request+" INTO :tabID;"
ARRAY LONGINT(tabID; 0)
Try
Begin SQL
EXECUTE IMMEDIATE :$texte;
End SQL
Catch
APPEND TO ARRAY(tabID; -1)
APPEND TO ARRAY(tabID; -2)
APPEND TO ARRAY(tabID; -3)
End try
ARRAY TO COLLECTION(This.collection; tabID)
: (Value type($request)=Is collection)
// $request est une collection d'ID
This.collection:=$request
End case
Function Créer()->$result : Object
// renvoyer la collection des entités de .collection
$result:=New object
$result.DataClassNom:=This.DataClassNom
$result.selection:=This.setEntités(This.DataClassNom; This.collection)
$result.length:=This.collection.length
Function FiltrerSurID($filtre : Collection)
// attention, pas forcément appelé dans le composant
var $c : Collection
$c:=This.collection.filter(Formula($2.indexOf($1.value)>-1); $filtre)
This.collection:=$c
Function _ValiderSaisie($params : Object; $nom : Pointer; $prenom : Pointer)
// rappel : les commandes SQL sont diacritiques
var $c; $cc : Collection
var $texte : Text
$nom->:=""
$prenom->:=""
// les noms sont stockés en majuscule
If (OB Is defined($params; "Nom"))
$nom->:=Uppercase($params.Nom; *)
$nom->:=Replace string($nom->; "@"; "")+"%"
End if
// le prénom (peut être vide)
If (OB Is defined($params; "Prenom"))
$prenom->:=$params.Prenom
// les prénoms sont stockés avec la première lettre en majuscule
$c:=Split string($prenom->; "-")
$cc:=New collection
For each ($texte; $c)
$texte[[1]]:=Uppercase($texte[[1]])
$cc.push($texte)
End for each
$prenom->:=$cc.join("-")
$prenom->:=Replace string($prenom->; "@"; "")+"%"
End if
Class extends _SQLentiteSelect
Class constructor($request : Variant)
Super("Communes"; $request; 13)
Function Chercher($params : Object)->$result : cs.CommunesSelect
var $nomCommune : Text:=""
This._ValiderSaisie($params; ->$nomCommune)
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT ID FROM Communes WHERE nom Like :$nomCommune INTO :$tabID;
End SQL
ARRAY TO COLLECTION(This.collection; $tabID)
// pour le chainage des functions
$result:=This
Function _ValiderSaisie($params : Object; $nomCommune : Pointer)
If (OB Is defined($params; "Nom"))
$nomCommune->:=OB Get($params; "Nom"; Is text)
$nomCommune->[[1]]:=Uppercase($nomCommune->[[1]]; *)
$nomCommune->:=Replace string($nomCommune->; "@"; "")+"%"
End if
Function CollecterNomsSurID()->$result : Collection
ARRAY LONGINT(tabID; 0)
COLLECTION TO ARRAY(This.collection; tabID)
ARRAY TEXT($tabNom; 0)
Begin SQL
SELECT DISTINCT nom FROM Communes WHERE {fn EstDansTableauNumeric('tabID',Communes.ID) AS NUMERIC} > -1 INTO :$tabNom;
End SQL
$result:=New collection
ARRAY TO COLLECTION($result; $tabNom)
Function LesEvents()->$result : Collection
var $ID : Integer
var $c : Collection
$result:=New collection
For each ($ID; This.collection)
$c:=cs.Communes.new($ID).LesEvents()
$result:=$result.combine($c)
End for each
// attributs de la classe
property nom : Text
property blason : Picture
property leDepartement : cs.Departements
Class extends _SQLentite
Class constructor($IDentity : Variant)
// initialiser l'objet avec les données de l'entité $IDunique de la BDD
var $ID : Integer
Super("Communes"; $IDentity; 13)
$ID:=This.ID
This.InitVarProcessSQL()
Try
Begin SQL
SELECT nom, blason, departement FROM Communes WHERE Communes.ID = :$ID INTO :varText1, :varPicture1, :varInteger1;
End SQL
Catch
// la table n'existe pas (test des composants)
varText1:="MinasTirith"
READ PICTURE FILE(Folder(fk resources folder).folder("Images").file("19200.png").platformPath; varPicture1)
varInteger1:=-2
End try
// enregistrer ce qu'on a trouvé (ou les valeurs par défaut)
This.nom:=varText1
This.blason:=varPicture1
// reconstituer la hiérarchie administrative : département, région et pays de la commune
// le département
This.leDepartement:=cs.Departements.new(varInteger1)
Function Libellé($formats : Object)->$libellé : Text
// renvoie le nom formaté suivant les options $formats
// function identique à celle de la BDDmère
// $formats
// .Options
// bit 9 = entête lieu :" à "(sinon le symbole séparationDateLieu)
// bit 16 = ajouter le n° de département à la commune
var $texte : Text
$libellé:=""
Case of
: (This=Null)
: (This.nom="")
Else
$libellé:=Localized string("1012")*Num($formats.Options ?? 9)
$libellé:=$libellé+(("("+String(This.leDepartement.numero)+") ")*Num($formats.Options ?? 16)*Num(This.leDepartement.numero#0))
$libellé:=$libellé+This.nom
// la suite, au besoin
$texte:=This.leDepartement.Libellé($formats)
$libellé:=$libellé+((" - "+$texte)*Num(Length($texte)>0))
End case
// ----------------------
//MARK:Sélection
// ----------------------
Function LesEvents()->$result : Collection
// créer la collection des events liés à la commune
var $ID : Integer
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Try
Begin SQL
SELECT Events.ID FROM Events WHERE Events.lieu IN
(SELECT T1.ID FROM Lieux AS T1 LEFT OUTER JOIN Sites as T2 ON T1.site = T2.ID WHERE T2.commune = :$ID)
ORDER BY Events.dateNum ASC
INTO :$tabID;
End SQL
Catch
APPEND TO ARRAY($tabID; -1)
End try
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
Function LesSites()->$result : Collection
var $ID : Integer
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Try
Begin SQL
SELECT DISTINCT Sites.ID
FROM Sites
WHERE Sites.commune = :$ID
INTO :$tabID;
End SQL
Catch
APPEND TO ARRAY($tabID; -1)
APPEND TO ARRAY($tabID; -2)
End try
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
Function LesLieux()->$result : Collection
// créer la collection des lieux de la commune
var $ID : Integer
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Try
Begin SQL
SELECT Lieux.ID
FROM Lieux
WHERE Lieux.site IN
(
SELECT DISTINCT Sites.ID
FROM Sites
INNER JOIN Communes ON Sites.commune = Communes.ID
WHERE Communes.ID = :$ID
)
INTO :$tabID;
End SQL
Catch
APPEND TO ARRAY($tabID; -1)
End try
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
Function LesMedias()->$result : Collection
// créer la collection des medias de la commune
var $ID : Integer
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Try
Begin SQL
SELECT Paysages.zone
FROM Sites
LEFT OUTER JOIN (Paysages LEFT OUTER JOIN Lieux ON Paysages.lieu = Lieux.ID)
ON Sites.ID = Lieux.site
WHERE Sites.commune = :$ID
INTO :tabID;
SELECT media FROM Zones
WHERE {fn EstDansTableauNumeric('tabID',Zones.ID) AS NUMERIC} > -1
INTO :tabID;
SELECT DISTINCT ID
FROM Medias
WHERE {fn EstDansTableauNumeric('tabID',ID) AS NUMERIC} > -1
ORDER BY dateNum ASC, heure ASC
INTO :$tabID;
End SQL
Catch
APPEND TO ARRAY($tabID; -1)
End try
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
Function Le($DataClassNom : Text)->$result : Object
// renvoie l'entité [$DataClassNom]
If ($DataClassNom=This.DataClassNom)
$result:=This
Else
$result:=This.leDepartement.Le($DataClassNom)
End if
Function LieuParDefaut()->$result : Integer
// trouver son lieu de type 60700 (existe toujours)
var $ID : Integer
Try
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT Lieux.ID
FROM Lieux
WHERE Lieux.type = 60700 AND Lieux.site IN
(
SELECT DISTINCT Sites.ID
FROM Sites
INNER JOIN Communes ON Sites.commune = Communes.ID
WHERE Communes.ID = :$ID
)
INTO :$tabID;
End SQL
Catch
APPEND TO ARRAY($tabID; -1)
End try
$result:=-1
// renvoyer le premier ID
If (Size of array($tabID)>0)
$result:=$tabID{1}
End if
Class extends _SQLentiteSelect
Class constructor($requête : Variant)
Super("Lieux"; $requête; 10)
Class extends _SQLentiteSelect
Class constructor($requête : Variant)
Super("Pays"; $requête; 16)
Function CollecterTousLesPays()
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT ID FROM Pays ORDER BY nom INTO :$tabID;
End SQL
// renvoyer la collection d'ID
This.collection:=New collection
ARRAY TO COLLECTION(This.collection; $tabID)
// attributs de la classe
property type : Integer
property nom; commentaire : Text
property latitude; longitude : Real
property leSite : cs.Sites
Class extends _SQLentite
Class constructor($IDentity : Variant)
// initialiser l'objet avec les données de l'entité $IDunique de la BDD
var $ID : Integer
Super("Lieux"; $IDentity; 10)
// lire les données du lieu
$ID:=This.ID
This.InitVarProcessSQL()
Try
Begin SQL
SELECT type, nom, site, latitude, longitude, commentaire FROM Lieux WHERE Lieux.ID = :$ID INTO :varInteger2, :varText1, :varInteger1, :varReal1, :varReal2, :varText2;
End SQL
Catch
// la table n'existe pas (test des composants)
varText1:="Tour d'Ecthélion"
varInteger2:=60300
varInteger1:=-2
varText2:="Commentaire du lieu "+String(varInteger2)
End try
// enregistrer ce qu'on a trouvé (ou les valeurs par défaut)
This.type:=varInteger2
This.nom:=varText1
This.latitude:=varReal1
This.longitude:=varReal2
This.commentaire:=varText2
// reconstituer la hiérarchie administrative : site, commune, département, région et pays du lieu
// le site
This.leSite:=cs.Sites.new(varInteger1)
Function Créer()->$result : Object
$result:=This
Function Libellé($formats : Object)->$libellé : Text
// renvoie le nom formaté suivant les options $formats
// function identique à celle de la BDDmère
// $formats
// .Options
// bit 17 = ajouter la commune
// bit 18 = ajouter le site
var $texte : Text
$libellé:=""
Case of
: (This=Null)
: (This.nom="")
Else
$libellé:=This.nom
$texte:=This.leSite.nom*Num(This.leSite#Null)
$libellé:=$libellé+(Num(($formats.Options ?? 18) & ($texte#""))*(" ("+$texte+")"))
$texte:=This.Le("Communes").Libellé($formats)
$libellé:=$libellé+((Localized string("1015")+$texte)*Num(($formats.Options ?? 17) & ($texte#"")))
End case
// ----------------------
//MARK:Selection
// ----------------------
Function Le($DataClassNom : Text)->$result : Object
// renvoie l'entité [$DataClassNom]
$result:=This.leSite.Le($DataClassNom)
Function LesLieux()->$result : Collection
// créer la collection de this !
$result:=New collection
$result.push(This.ID)
Function LesEvents()->$result : Collection
var $ID : Integer
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Try
Begin SQL
SELECT Events.ID FROM Events WHERE Events.lieu = :$ID INTO :$tabID;
End SQL
Catch
APPEND TO ARRAY($tabID; -1)
End try
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
//$result:=This.setEntités("Events"; ->$tabID)
Function LesMedias()->$result : Collection
var $ID : Integer
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT Zones.media FROM Zones WHERE Zones.ID IN
(SELECT zone FROM Paysages WHERE Paysages.lieu = :$ID)
INTO :$tabID;
End SQL
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
//$result:=This.setEntités("Medias"; ->$tabID)
// attributs de la classe
property type; largeur; hauteur; private : Integer
property titre; dateChaine; Credits; nomFichier; commentaire : Text
property dateNum : Date
property dateNumValid : Boolean
property vignette : Picture
Class extends _SQLentite
Class constructor($IDentity : Variant)
// initialiser l'objet avec les données de l'entité $IDentity de la BDD
var $ID : Integer
Super("Medias"; $IDentity; 19)
// lire les données du media
$ID:=This.ID
This.InitVarProcessSQL()
Try
Begin SQL
SELECT type, titre, dateChaine, dateNum, dateNumValid, largeur, hauteur, vignette, private, Credits, commentaire FROM Medias WHERE ID = :$ID INTO :varInteger1, :varText1, :varText2, :varDate, :varBool, :varInteger2, :varInteger3, :varPicture1, :varInteger4, :varText3, :varText4;
End SQL
Catch
// la table n'existe pas (test des composants)
varText1:="Vue générale de Trifouilly-lès-Oies"
varText2:="20 septembre 2025"
varDate:=Current date
READ PICTURE FILE(Folder(fk resources folder).folder("Images").file("19200.png").platformPath; varPicture1)
varText4:="Commentaire du media"
End try
// nom du fichier
Try
Begin SQL
SELECT nom FROM Fichiers WHERE Fichiers.media = :$ID INTO :varText5;
End SQL
Catch
// la table n'existe pas (test des composants)
This.ID:=19200
varText5:="19200.jpg"
End try
// enregistrer ce qu'on a trouvé (ou les valeurs par défaut)
This.type:=varInteger1
This.titre:=varText1
This.dateChaine:=varText2
This.dateNum:=varDate
This.dateNumValid:=varBool
This.largeur:=varInteger2
This.hauteur:=varInteger3
This.vignette:=varPicture1
This.private:=varInteger4
This.Credits:=varText3
This.commentaire:=varText4
This.nomFichier:=varText5
Function Libellé($formats : Object)->$libellé : Text
// renvoie le nom formaté suivant les options $formats
$libellé:=This.titre
// ----------------------
//MARK:Selection
// ----------------------
Function LesPersonnes()->$result : Collection
// rechercher les personnes zonées dans ce media
// elles sont de gauche à droite
var $ID; $i; $zone : Integer
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Try
// pas trouvé comment faire avec les functions SQL ; le trie se fait avec un tableau $tabZones intermédiaire pour conserver l'ordre
ARRAY LONGINT(tabID; 0)
ARRAY REAL($tabZones; 0)
Begin SQL
SELECT ID, gauche FROM Zones WHERE Zones.media = :$ID INTO :tabID, :$tabZones;
End SQL
SORT ARRAY($tabZones; tabID; >)
For ($i; 1; Size of array(tabID))
$zone:=tabID{$i}
$ID:=-1
Begin SQL
SELECT personne FROM Personnages WHERE zone = :$zone INTO :$ID;
End SQL
If ($ID>0)
APPEND TO ARRAY($tabID; $ID)
End if
End for
Catch
APPEND TO ARRAY($tabID; -1)
End try
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
Function LesEvents()->$result : Collection
// rechercher les events zonés dans ce media
var $ID : Integer
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Try
Begin SQL
SELECT Instantanes.event FROM Instantanes WHERE zone IN
(SELECT ID FROM Zones WHERE Zones.media = :$ID)
INTO : $tabID;
End SQL
Catch
APPEND TO ARRAY($tabID; -1)
End try
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
Function LesLieux()->$result : Collection
// rechercher les lieux zonés dans ce media
var $ID : Integer
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Try
Begin SQL
SELECT Paysages.lieu FROM Paysages WHERE zone IN
(SELECT ID FROM Zones WHERE Zones.media = :$ID)
INTO : $tabID;
End SQL
Catch
APPEND TO ARRAY($tabID; -1)
End try
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
Function LesMedias()->$result : Collection
// rechercher les medias zonés dans ce media
var $ID : Integer
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Try
Begin SQL
SELECT Details.media FROM Details WHERE zone IN
(SELECT ID FROM Zones WHERE Zones.media = :$ID)
INTO : $tabID;
End SQL
Catch
APPEND TO ARRAY($tabID; -1)
End try
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
// attributs de la classe
property nom : Text
property numero : Integer
property blason : Picture
property latitude; longitude : Real
property laRegion : cs.Regions
Class extends _SQLentite
Class constructor($IDentity : Variant)
// initialiser l'objet avec les données de l'entité $IDunique de la BDD
var $ID : Integer
Super("Departements"; $IDentity; 14)
$ID:=This.ID
This.InitVarProcessSQL()
Try
Begin SQL
SELECT nom, numero, blason, region, latitude, longitude FROM Departements WHERE Departements.ID = :$ID INTO :varText1, :varInteger2, :varPicture1, :varInteger1, :varReal1, :varReal2;
End SQL
Catch
varInteger1:=-2
varText1:="Anorien"
varInteger2:=7000
READ PICTURE FILE(Folder(fk resources folder).folder("Images").file("19200.png").platformPath; varPicture1)
varReal1:=45.1
varReal2:=0.1
End try
// enregistrer ce qu'on a trouvé (ou les valeurs par défaut)
This.nom:=varText1
This.numero:=varInteger2
This.blason:=varPicture1
This.latitude:=varReal1
This.longitude:=varReal2
// reconstituer la hiérarchie administrative : région et pays du lieu du département
// la région
This.laRegion:=cs.Regions.new(varInteger1)
Function Libellé($formats : Object)->$libellé : Text
// renvoie (n° département) nom département - suite
// function identique à celle de la BDDmère
// suivant les options $1 :
// $formats
// .Options
// bit 22 = département
// bit 24 = ajouter le n° de département au département
var $texte : Text
$libellé:=("("+String(This.numero)+") ")*Num((This.numero#0) & ($formats.Options ?? 24))
$libellé:=($libellé+This.nom)*Num($formats.Options ?? 22)
$texte:=This.laRegion.Libellé($formats)
$libellé:=$libellé+((" - "+$texte)*Num((Length($texte)>0)))
// ----------------------
//MARK:Sélections
// -----------------------
Function Le($DataClassNom : Text)->$result : Object
// renvoie l'entité [$DataClassNom]
If ($DataClassNom=This.DataClassNom)
$result:=This
Else
$result:=This.laRegion.Le($DataClassNom)
End if
Function LesCommunes()->$result : Collection
var $ID : Integer
$ID:=This.ID
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT Communes.ID From Communes WHERE Communes.departement = :$ID INTO :$tabID;
End SQL
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
Class extends _SQLentiteSelect
Class constructor($requête : Variant)
Super("Personnes"; $requête; 1)
Function Chercher($params : Object)->$result : cs.PersonnesSelect
var $nom; $prenom : Text
var $sexe1; $sexe2 : Boolean
$nom:=""
$prenom:=""
This._ValiderSaisie($params; ->$nom; ->$prenom)
// l'info sexe est optionnelle
Case of
: (OB Is defined($params; "sexe"))
// homme ou bien femme
$sexe1:=($params.sexe="true")
$sexe2:=($params.sexe="true")
Else
// homme ou femme
$sexe1:=True
$sexe2:=False
End case
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT ID FROM Personnes WHERE nom LIKE :$nom AND prenom LIKE :$prenom AND (sexe = :$sexe1 OR sexe = :$sexe2) INTO :$tabID;
End SQL
ARRAY TO COLLECTION(This.collection; $tabID)
// il peut y avoir la valeur 0 (un NULL quelque part?)
// ?????? This.collection:=This.collection.filter(Formula($1.value>$2); 0)
// pour le chainage des functions
$result:=This
Function CollecterNomsSurID()->$result : Collection
ARRAY LONGINT(tabID; 0)
COLLECTION TO ARRAY(This.collection; tabID)
ARRAY TEXT($tabNom; 0)
Begin SQL
SELECT DISTINCT nom FROM Personnes WHERE {fn EstDansTableauNumeric('tabID',Personnes.ID) AS NUMERIC} > -1 INTO :$tabNom;
End SQL
$result:=New collection
ARRAY TO COLLECTION($result; $tabNom)
Function LesPatronymes()->$result : Collection
// trouver tous les patronymes distincts de la sélection
var $i : Integer
var $patronyme : Text
ARRAY LONGINT(tabID; 0)
COLLECTION TO ARRAY(This.collection; tabID)
ARRAY TEXT($tabNom; 0)
Try
Begin SQL
SELECT DISTINCT patronyme FROM DicoDesNoms
INNER JOIN Personnes ON DicoDesNoms.nom = Personnes.nom
WHERE {fn EstDansTableauNumeric('tabID',Personnes.ID) AS NUMERIC} > -1
INTO :$tabNom;
End SQL
// créer la collection des ID de $tabNom
$result:=New collection
For ($i; 1; Size of array($tabNom))
$patronyme:=$tabNom{$i}
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT ID FROM DicoDesNoms
WHERE patronyme = :$patronyme
INTO :$tabID;
End SQL
// par principe il y a plusieurs ID de même $patronyme ; on prend le premier
$result.push($tabID{1})
End for
Catch
$result:=[-1]
End try
// attributs de la classe
property patronyme : Text
property lesNoms : Collection
Class extends _SQLentite
Class constructor($IDentity : Variant)
// initialiser l'objet avec les données de l'entité $IDunique de la BDD
var $ID : Integer
var $patronyme : Text
Super("DicoDesNoms"; $IDentity; 3)
$ID:=This.ID
This.InitVarProcessSQL()
Try
Begin SQL
SELECT patronyme FROM DicoDesNoms WHERE DicoDesNoms.ID = :$ID INTO :varText1;
End SQL
Catch
// la table n'existe pas (test des composants)
varText1:="Les Hobbits"
End try
// enregistrer ce qu'on a trouvé (ou les valeurs par défaut)
This.patronyme:=varText1
// retyper en texte
$patronyme:=This.patronyme
// lister les noms ayant le même patronyme
Try
ARRAY TEXT(tabNom; 0)
Begin SQL
SELECT DISTINCT nom FROM DicoDesNoms
WHERE DicoDesNoms.patronyme = :$patronyme
INTO :tabNom;
End SQL
Catch
APPEND TO ARRAY(tabNom; $patronyme)
End try
This.lesNoms:=New collection
ARRAY TO COLLECTION(This.lesNoms; tabNom)
Function Libellé($formats : Object)->$result : Text
$result:=This.patronyme
// ----------------------
//MARK:Selection
// ----------------------
Function LesPersonnes()->$result : Collection
var $patronyme : Text
$patronyme:=This.patronyme
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT Personnes.ID FROM Personnes
INNER JOIN DicoDesNoms ON DicoDesNoms.nom = Personnes.nom
WHERE DicoDesNoms.patronyme = :$patronyme
ORDER BY prenom ASC, autres_prenoms ASC
INTO :$tabID;
End SQL
// renvoyer la collection d'ID
$result:=New collection
ARRAY TO COLLECTION($result; $tabID)
ON ERR CALL(Formula(traceHandler).source; ek global)
// ne s'exécute pas dans une base hôte
// exporter le code du composant si pas compilé
ON ERR CALL(Formula(traceHandler).source; ek local)
cs.xSDK.ExportCode4D.new().DémarrerComposant()
#DECLARE($numEvent : Integer)
// ici, s'exécute dans une base hôte
Case of
: ($numEvent=On before host database startup)
ON ERR CALL(Formula(traceHandler).source; ek global)
: ($numEvent=On after host database startup)
// attention : le composant est exécuté dans une base hôte APP ou un autre composant (en debug)
: ($numEvent=On after host database exit)
End case