Voilà le programme2 celui qui est dans le premier message.
Les CheckBoxGadget placés a droite des noms& prénoms oblige le critère à être au début, sinon par défaut il peut être n’ importe où.
Ça peut être surement optimisé en vitesse (surtout la procédure ‘RechercheCouple’ qui m’a bien fait chauffer le neurone).
J’ai essayé de le faire le moins encombrant possible car en utilisation il y a le logiciel de généalogie, le navigateur sur les archives, la capture d’écran et ce programme au minimum, donc pour les petites configurations ça peu coincer.
Peut être que par la suite je collerais le contenu de la ListIconGadget dans le presse-papier pour pouvoir la sauvegarder ou imprimer..
Code : Tout sélectionner
EnableExplicit
Enumeration Window
#MainForm
EndEnumeration
Enumeration gadget
#Nom
#Prenom
#Nom2
#Prenom2
#ListeNoms
#Validation
#TexteInfos
#DebutNom
#DebutPrenom
#DebutNom2
#DebutPrenom2
#Efface
EndEnumeration
Declare Start()
Declare Validation()
Declare Efface()
Declare RechercheCouple()
Declare RecheSelonCriteres()
Structure xx
NoINDI.u
Nom.s
Prenom.s
Sexe.s
Couple1.u
Couple2.u
Couple3.u
DateNaiss.s
LieuNaissance.s
DateDc.s
LieuDeces.s
NomPere.s
PrenomPere.s
NomMere.s
PrenomMere.s
NoFichier.b
EndStructure
Global Dim Fiche.xx(1)
Global Dim Couple.s(3)
Global Temps.d
Global a.i, NbEnrTrouve.i, z.i,u.i,fc.i, NbPers.i, NoCouple.u , LgEnr.u, CptCouple.u, OkCouple.u
Global aa.s,bb.s, sep.s, r.s, zz.s
Global Dim Criteres.s(3)
Global Dim Option.u(3)
Global Dim FichierDCA.s(2)
Global Dim FichierGED.s(2)
Global Dim FichierDCANb.i(2)
Global tab.s,Sl.s
Global TestNom.s, ok.u,NoCritere.s
Global Champ.u
Global OptionNom2.u, OptionPrenom2.u
LgEnr=200
sep=Chr(9)
tab=Chr(9)
Sl=Chr(13)+Chr(10)
FichierGED(1)="Arbre1.ged"
FichierGED(2)="Arbre2.ged"
FichierDCA(1)="GEDversDCA1.txt"
FichierDCA(2)="GEDversDCA2.txt"
a=0; controle si fichier GEDversDCA.txt a jour
u=1
For fc=1 To 2
If GetFileDate(FichierDCA(fc), #PB_Date_Modified )<GetFileDate(FichierGED(fc), #PB_Date_Modified)
a=1
ElseIf GetFileDate(FichierDCA(fc), #PB_Date_Modified )<GetFileDate(FichierGED(fc), #PB_Date_Modified)
a=1
EndIf
Next
If a=1
RunProgram("GEDversDCA.exe","","",#PB_Program_Wait)
EndIf
; ********************
For fc= 1 To 2
OpenFile (1,FichierDCA(fc),#PB_UTF8 )
; Recherche Nb enregistrements GEDversDCA1 et GEDversDCA2
NbPers=0
a=1
While Eof(1) = 0
aa=ReadString(1)
NbPers+1
Wend
FichierDCANb(fc)=NbPers
Next
start()
Procedure start()
aa= "Liste individus V1."+ Str(#PB_editor_buildcount)
aa=LSet(aa,120," ")+ "DCA - St Pourçain/Sioule "
OpenWindow(#MainForm, 50, 50, 600, 600, aa, #PB_Window_SystemMenu)
ButtonGadget(#Efface, 20, 10, 130, 40, "Efface")
TextGadget(#PB_Any, 20, 55, 110, 20, "Nom ou partiel", #PB_Text_Border)
StringGadget(#Nom, 20, 75, 130, 20, "")
TextGadget(#PB_Any, 20, 110, 110, 20, "Prénom ou partiel", #PB_Text_Border)
StringGadget(#Prenom, 20, 130, 130, 20, "")
TextGadget(#PB_Any, 20, 165, 110, 20, "Nom conjoint(e)", #PB_Text_Border)
StringGadget(#Nom2, 20, 185, 130, 20, "")
TextGadget(#PB_Any, 20, 215, 110, 20, "Prénom conjoint(e)", #PB_Text_Border)
StringGadget(#Prenom2, 20, 235, 130, 20, "")
ButtonGadget(#Validation, 20, 265, 130, 40, "Validation")
CheckBoxGadget(#DebutNom, 135, 55, 20, 20, "" )
CheckBoxGadget(#DebutPrenom, 135, 110, 20, 20, "")
CheckBoxGadget(#DebutNom2, 135, 165, 20, 20, "" )
CheckBoxGadget(#DebutPrenom2, 135, 215, 20, 20, "")
GadgetToolTip(#DebutNom, "Les critères seront au début du nom")
GadgetToolTip(#DebutPrenom, "Les critères seront au début du prénom")
GadgetToolTip(#DebutNom2, "Les critères seront au début du nom")
GadgetToolTip(#DebutPrenom2, "Les critères seront au début du prénom")
TextGadget(#TexteInfos, 20, 315, 130, 245, "", #PB_Text_Border)
ListIconGadget(#listeNoms, 160, 10, 420, 550, "", 0,#PB_ListIcon_GridLines)
AddGadgetColumn(#ListeNoms,0, "Nom& prénom ==> nom& prénom Conjoint(e)",270)
AddGadgetColumn(#ListeNoms,1, "Date N/B& D/I ",90)
AddGadgetColumn(#ListeNoms,2, "Arbre",50)
SetActiveGadget(#Nom)
SetGadgetText(#TexteInfos,bb)
BindGadgetEvent(#Validation, @Validation())
BindGadgetEvent(#Efface, @Efface())
bb= "Nombre d'individus : "+ sl+Str(NbPers)+sl+ "Dernière mise à jour :"+sl+"le "+FormatDate("%dd/%mm/%yyyy %hh:%ii",GetFileDate(FichierDCA(1), #PB_Date_Modified ))
bb= bb+ sl+"Arbre1 : "+ Str(FichierDCANb(1)) + sl + "Arbre2 : " + Str(FichierDCANb(2))
SetGadgetText(#TexteInfos,bb)
Repeat : Until WaitWindowEvent(10) = #PB_Event_CloseWindow
EndProcedure
Procedure Validation()
Option(0)=GetGadgetState(#DebutNom)
Option(1)=GetGadgetState(#DebutPrenom)
Option(2)=GetGadgetState(#DebutNom2)
Option(3)=GetGadgetState(#DebutPrenom2)
sep=","
NbEnrTrouve=0
Temps=ElapsedMilliseconds()
ClearGadgetItems(#ListeNoms)
ClearGadgetItems(#TexteInfos)
Criteres(0) = UCase(GetGadgetText(#Nom))
Criteres(1) = UCase(GetGadgetText(#Prenom))
Criteres(2) = UCase(GetGadgetText(#Nom2))
Criteres(3) = UCase(GetGadgetText(#Prenom2))
For fc=1 To 2
OpenFile (1,FichierDCA(fc),#PB_UTF8|#PB_File_SharedRead| #PB_File_SharedWrite )
For z= 1 To FichierDCANb(fc)
Dim Fiche(1)
aa=ReadString(1)
; Nom
TestNom=StringField(aa,2,",")
champ=0 ;Criteres(0)
RecheSelonCriteres()
If ok=0
Fiche(1)\Nom=TestNom
Else
Continue
EndIf
; Prénom
TestNom=StringField(aa,3,",")
champ=1 ;Criteres(0)
RecheSelonCriteres()
If ok=0
Fiche(1)\Prenom=TestNom
Else ; ok=1
Continue
EndIf
; *****************************
Fiche(1)\DateNaiss=StringField(aa,8,sep)
Fiche(1)\LieuNaissance = StringField(aa,9,sep)
Fiche(1)\DateDc=StringField(aa,12,sep)
Fiche(1)\LieuDeces = StringField(aa,13,sep)
Fiche(1)\NoINDI= Val(StringField(aa,1,","))
fiche(1)\Couple1= Val(StringField(aa,5,sep))
fiche(1)\Couple2= Val(StringField(aa,6,sep))
fiche(1)\Couple3= Val(StringField(aa,7,sep))
Fiche(1)\NoFichier= Val(StringField(aa,17,sep))
; ************************ couples
CptCouple=1
If fiche(1)\Couple1<>0
NoCouple=fiche(1)\Couple1
RechercheCouple()
EndIf
If fiche(1)\Couple2<>0
NoCouple=fiche(1)\Couple2
RechercheCouple()
EndIf
If fiche(1)\Couple3<>0
NoCouple=fiche(1)\Couple3
RechercheCouple()
EndIf
; ******************************
aa= fiche(1)\Nom+" "+ Fiche(1)\Prenom+sl+ Right(fiche(1)\DateNaiss,4)+" / "+Right(Fiche(1)\DateDc,4)+ sl+" "+Str(Fiche(1)\NoFichier)
AddGadgetItem(#ListeNoms,-1,aa)
For a=1 To 3
If Couple(a)<>""
AddGadgetItem(#ListeNoms,-1,couple(a))
EndIf
Next
NbEnrTrouve+1
For a=1 To 3
couple(a)=""
Next
Next
CloseFile(1)
Next
ClearGadgetItems(#TexteInfos)
temps=(ElapsedMilliseconds()-temps)/1000
bb = "Critère nom : "+sl+ Criteres(0)+ sl+ "Critère prénom : "+sl+ Criteres(1)+sl
bb=bb+ "Nb selon critères : "+ Str(NbEnrTrouve)+sl+ "Sur un total de : "+ Str(FichierDCANb(1)+FichierDCANb(2))+sl+"Temps de traitement "+ sl
bb=bb+FormatNumber(temps)+" s"+sl+"Dernière mise à jour :"+sl+"le "+FormatDate("%dd/%mm/%yyyy %hh:%ii",GetFileDate(FichierDCA(1), #PB_Date_Modified ))
bb= bb+ sl+ "Arbre1 : "+ Str(FichierDCANb(1)) + sl + "Arbre2 : " + Str(FichierDCANb(2))
SetGadgetText(#TexteInfos,bb)
EndProcedure
Procedure Efface()
SetGadgetText(#Nom,"")
SetGadgetText(#Prenom,"")
SetGadgetText(#Nom2,"")
SetGadgetText(#Prenom2,"")
SetGadgetState(#DebutNom,0)
SetGadgetState(#DebutPrenom,0)
SetGadgetState(#DebutNom2,0)
SetGadgetState(#DebutPrenom2,0)
SetActiveGadget(#Nom)
EndProcedure
Procedure RecheSelonCriteres()
; En reception champ, TestNom, ok en sortie, 1 pas 0 bon
ok=1 ; 1 = pas dans les critères
If Option(Champ)=1 ; début du nom/prénom
If Left(UCase(TestNom),Len(Criteres(Champ)))=Criteres(Champ)
ok=0
Else
ok=1
EndIf
Else ; option(champ) = 0
If FindString(UCase(TestNom),Criteres(Champ),1)<>0 Or Criteres(champ)=""
ok = 0
Else
ok=1
EndIf
EndIf
EndProcedure
Procedure RechercheCouple()
Define Teste.s
Define NoFichier
OkCouple=0
OpenFile (2,FichierDCA(fc),#PB_UTF8|#PB_File_SharedRead| #PB_File_SharedWrite )
NoFichier= Val(StringField(aa,17,","))
For a=0 To FichierDCANb(NoFichier)
bb= ReadString(2)
If Val(StringField(bb,1,","))<>Fiche(1)\NoINDI
If Val(StringField(bb,5,","))=NoCouple
TestNom=StringField(bb,2,",")
champ=2 ; Nom conjoint(e)
RecheSelonCriteres()
If ok=0
TestNom=StringField(bb,3,",")
champ=3 ; prénom conjoint(e)
RecheSelonCriteres()
If ok=0
zz= " ==> "+StringField(bb,2,",")+ " "+ StringField(bb,3,",")+sl+Right(StringField(bb,8,","),4)+" / "
Couple(CptCouple)= zz+Right(StringField(bb,12,","),4)
CptCouple+1
EndIf
EndIf
Continue
ElseIf Val(StringField(bb,6,","))=NoCouple
TestNom=StringField(bb,2,",")
champ=1 ;Criteres(0)
RecheSelonCriteres()
If ok=0
zz= " ==> "+StringField(bb,2,",")+ " "+ StringField(bb,3,",")+sl+Right(StringField(bb,8,","),4)+" / "
Couple(CptCouple)= zz+Right(StringField(bb,12,","),4)
CptCouple+1
EndIf
Continue
EndIf
EndIf
Next
CloseFile(2)
EndProcedure