Archives départementales

Vous avez développé un logiciel en PureBasic et vous souhaitez le faire connaitre ?
pierre003
Messages : 60
Inscription : ven. 27/mai/2016 8:27
Localisation : 03

Archives départementales

Message par pierre003 »

Bonsoir a toutes et a tous,
Je vous ai pas mal cassé les pieds avec mes questions depuis quelques temps.
Donc je vais vous faire voir sur quoi je bossais.
Ça aide à déchiffrer des documents des archives départementales, sur la copie d’écran c’est 1705, il n’invente rien il compare les bouts de noms ou prénoms avec ce que j’ai dans ma base généalogique.
J’ai actuellement plus de 4400 personnes et avec mon petit cerveau je n’arrive plus à suivre, (plus de 300 noms de familles).
Donc ça me sert aussi a savoir si un nom de famille a des chances de m’intéresser, aujourd’hui, demain ou jamais.
Les infos sortent d’un fichier GedCom (plus ou moins un standard) pour ceux qui connaissent.
Je ne suis pas trop fort pour déchiffrer les écrits, j’ai trouvé ‘don’ à la fin du nom, ‘benoi’ pour le prénom et ‘marie’ pour le prénom du conjoint (après vérif. c’est le premier de la liste).
J’épluche les documents depuis 1684 sur cette commune d’une partie de ma famille et tous les individus que je trouve passent dans la moulinette, ça va bien plus vite que de passer a chaque fois dans le logiciel de généalogie et comme il n’est pas trop large et j’ai un grand écran il peut rester avec l’archive.
Bonne semaine a toutes et a tous.
Pierre
Image
Image
Image
Toshiba satellite Windows 7 64bits
Avatar de l’utilisateur
Ar-S
Messages : 9477
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Archives départementales

Message par Ar-S »

On est content pour toi mais si tu ne proposes pas de téléchargement, on est pas à même de tester ;)
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Ollivier
Messages : 4190
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: Archives départementales

Message par Ollivier »

Ce n'est pas parce que la section Hors-Sujet a été mise à privation pour des raisons absolument manquées de sens, que les gens changent et n'ont pas des sujets périphériques.

Je trouve très sympa de partager cette passion. Par contre, c'est sûr que si on perd les illustrations, l'article n'a plus grand chose !

@pierre003

Est-ce que tu as quelques chiffres? Le temps de programmation de ce projet par exemple.

Est-ce que ça t'a fait germer une idée d'amélioration et qu'il te manque quelques explications techniques ? (faisabilité, complexité).
pierre003
Messages : 60
Inscription : ven. 27/mai/2016 8:27
Localisation : 03

Re: Archives départementales

Message par pierre003 »

Ollivier a écrit :Ce n'est pas parce que la section Hors-Sujet a été mise à privation pour des raisons absolument manquées de sens, que les gens changent et n'ont pas des sujets périphériques.

Je trouve très sympa de partager cette passion. Par contre, c'est sûr que si on perd les illustrations, l'article n'a plus grand chose !

@pierre003

Est-ce que tu as quelques chiffres? Le temps de programmation de ce projet par exemple.

Est-ce que ça t'a fait germer une idée d'amélioration et qu'il te manque quelques explications techniques ? (faisabilité, complexité).
Bonjour,
J’ai un peu honte de présenter les sources car ça fait fouillis, j’ai changé plusieurs fois de fichiers d’entrées, modifié plusieurs fois aussi de format de fichier…
Donc c’est la pagaille, des procédures, des variables… qui ne servent plus. Donc ça fait 3 semaines que je le chantier est ouvert.
Mais ça a l’air de fonctionner.
Je pensai y mettre aussi les enfants, mais ça va faire trop gros pour l’affichage, et comme de préférence il vaut mieux avoir a l’écran l’archive et le programme. Pour moi je n’ai pas de problème j’ai un écran de 58cm.
Si quelqu'un est intéressé par la généalogie et qu’il puisse trouver un fichier GEDCOM je mettrai les sources. (Un programme pour créer un fichier plus digeste que le GedCom, et l’autre qui appelle le premier si besoin d’une mise à jour et l’affichage)
Pierre003
PS, Je ne sais pas comment envoyer un fichier sinon j’aurai mis un exemple de fichier GEDCOM.
Toshiba satellite Windows 7 64bits
Ollivier
Messages : 4190
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: Archives départementales

Message par Ollivier »

Peut-être prendre le temps suffisant pour obtenir un code source facilement lisible. Mon humble conseil est de le commenter généreusement, non pas pour les autres, mais pour soi-même, pour se laisser libre de se concentrer sur autre chose et faciliter un "retour" vers ce code, ne pas se sentir perdu.

C'est souvent l'erreur que je fais : je ne commente rien, et puis, les semaines passant ça devient pénible de modifier quoique ce soit.

Il m'arrive de travailler par procédures, mais même dans ce cas, la complexité des appels peut être piégeuse.

Il y a 4 ans, je me suis trouvé une manière de programmer qui a son inconvénient dans l'éditeur classique, mais qui reste limpide pour moi à la relecture.

J'utilise les macros, et je pars sur le principe suivant :

Code : Tout sélectionner

MainBegin()
MainStart()
MainEnd()
Et chaque objet sous-jacent de programmation se construit avec ces même trois parties. Ça fait une arborescence et je m'y retrouve impeccablement sauf... Quand il y a une erreur !

Le seul inconvénient est dans le déboguage parce que l'IDE est "tout-ou-rien" : soit il ne déplie aucune macro quand une erreur survient hors macro, soit il déplie tout quand une erreur survient au sein d'une macro.

Ce principe peut être fait avec les procédures. Mais 2 inconvénients se présentent :
1) c'est plus lent qu'une macro (malgré tous les débats possibles, c'est ainsi)
2) j'utilise aussi les procédures quand il y a récursivité, donc si tout devient procédure, les procédures récursives sont noyées là-dedans, et ça me perd...

N'hésite pas à observer quelques codes aboutis sur ce site, et voir s'il n'y a pas des structurations de code qui te semblent assez limpides.

Une dernière technique, la technique << on s'en fout un peu >>. Il n'y a pas d'exigences de présentation en fait !

A toi de voir. :D
pierre003
Messages : 60
Inscription : ven. 27/mai/2016 8:27
Localisation : 03

Re: Archives départementales

Message par pierre003 »

Ollivier a écrit :Peut-être prendre le temps suffisant pour obtenir un code source facilement lisible. Mon humble conseil est de le commenter généreusement, non pas pour les autres, mais pour soi-même, pour se laisser libre de se concentrer sur autre chose et faciliter un "retour" vers ce code, ne pas se sentir perdu.

C'est souvent l'erreur que je fais : je ne commente rien, et puis, les semaines passant ça devient pénible de modifier quoique ce soit.

Il m'arrive de travailler par procédures, mais même dans ce cas, la complexité des appels peut être piégeuse.

Il y a 4 ans, je me suis trouvé une manière de programmer qui a son inconvénient dans l'éditeur classique, mais qui reste limpide pour moi à la relecture.

J'utilise les macros, et je pars sur le principe suivant :

Code : Tout sélectionner

MainBegin()
MainStart()
MainEnd()
Et chaque objet sous-jacent de programmation se construit avec ces même trois parties. Ça fait une arborescence et je m'y retrouve impeccablement sauf... Quand il y a une erreur !

Le seul inconvénient est dans le déboguage parce que l'IDE est "tout-ou-rien" : soit il ne déplie aucune macro quand une erreur survient hors macro, soit il déplie tout quand une erreur survient au sein d'une macro.

Ce principe peut être fait avec les procédures. Mais 2 inconvénients se présentent :
1) c'est plus lent qu'une macro (malgré tous les débats possibles, c'est ainsi)
2) j'utilise aussi les procédures quand il y a récursivité, donc si tout devient procédure, les procédures récursives sont noyées là-dedans, et ça me perd...

N'hésite pas à observer quelques codes aboutis sur ce site, et voir s'il n'y a pas des structurations de code qui te semblent assez limpides.

Une dernière technique, la technique << on s'en fout un peu >>. Il n'y a pas d'exigences de présentation en fait !

A toi de voir. :D
Une macro dans Purebasic, je ne connais pas, je connais les macros dans Excel pas celle qui s’écrivent en auto qui sont il faut l’avouer du bricolage, mais les macros VBA-Excel, c’est super et Système-central=>Business-Object=>VBA=>VB6 ça donnait des supers résultats (mais j’étais plus jeune).
Vous allez être déçu, et surtout indigeste comme code, car fait n’importe comment.
Voici le premier, création du fichier d’après GedCom (mais je m’arrête actuellement à la fin de ‘0@Ixxx@INDI’ individus N°xxx en langage clair).
Jusque là nous avons pas mal d’infos :
Nom, prénom, sexe, N° des conjoints (j’ai limité à 3), naissance, lieux, latitude du lieu, longitude du lieu, (idem pour baptême, décès, inhumation) et un code famille.
Le Code famille (qui est après) et que je n’ai pas trop étudiée (je me plante peut être mais je pense que d’après le N° de famille on trouve les N° de l’individu, de son conjoint, de ses parents, de ses enfants, date et lieu mariage..).
Donc pas mal d’infos pour s’amuser et se faire chauffer le neurone.

Code : Tout sélectionner

EnableExplicit

Declare Enregistrement()
Declare SelectDataNB()
Declare SelectDataDI()

Global NoINDI.i
Global Prenom.s
Global Nom.s
Global Sexe.s
Global Couple1.u
Global Couple2.u
Global Couple3.u
Global DateNB.s
Global LieuNB.s
Global LatiNB.d
Global longNB.d
Global DateDI.s
Global LieuDI.s
Global LatiDI.d
Global longDI.d
Global Fratrie.u
; Global NoFichier.b
Global  aa.s,bb.s, NbNoms.i, LgMxEnreg.i, LgEnregistementAjuste.i
Global  LgGedCom.s, LgGedComSuivant.s, fc.u
Global a.i, i.i, Nb.i, z.i,LgEnr.i
Global Lati.d, Long.d, annee.u, LongEnr.u, CptCouple.u, CptEven.u
Global Dim Infos.s(100)
Global Dim NbFiches.u(2)
CreateFile (2,"GEDversDCA1.txt",#PB_UTF8)
OpenFile (2,"GEDversDCA1.txt",#PB_UTF8)
OpenFile(1,"Arbre1.ged",#PB_UTF8   ); lecture arbre 1
fc=1 
Enregistrement()
NbFiches(1)=NbFiches(1)
CloseFile(1)
CloseFile(2)
CreateFile (2,"GEDversDCA2.txt",#PB_UTF8)
OpenFile (2,"GEDversDCA2.txt",#PB_UTF8)
OpenFile(1,"Arbre2.ged",#PB_UTF8   ); lecture arbre 2
fc=2
Enregistrement()
NbFiches(2)=NbFiches(2)
CloseFile(1)
CloseFile(2)
Debug "Longueur maxi enregistrement : "+Str(LgMxEnreg)
Debug "Longueur prévue : "+ Str(LongEnr)
Debug "Longueur d'enregistrement ajusté : " + Str(LgEnregistementAjuste)
Debug " "
Debug " "
For a=1 To 2
  Debug "Nombre d'enregistrements fichier N°"+ Str(a) + "  Nombres d'individus : "+ NbFiches(a)
Next

Procedure Enregistrement()
  For a=1 To 50; passe l'en-tête *********************
    LgGedCom=ReadString(1)
    If Left(LgGedCom,3)= "0 @"
      LgGedComSuivant=LgGedCom
      Break
    EndIf 
  Next
  ; fin passe l'entête **********************************
  NbNoms=0
  CptCouple=0
  CptEven=0
  LgMxEnreg=0
  LongEnr=200
  NbFiches(fc)=0
  NoINDI = Val(StringField(LgGedCom,2,"I"))
  While Eof(1) = 0  
    LgGedCom=ReadString(1)
    If Mid(LgGedCom,1,6) ="2 GIVN";  Prénom
      Prenom = ReplaceString(Mid(LgGedCom,8),","," ")
    ElseIf Mid(LgGedCom,1,6) ="2 SURN";  Nom
      Nom = ReplaceString(Mid(LgGedCom,8),","," ")
    ElseIf Mid(LgGedCom,1,5) ="1 SEX";  Sexe
      Sexe = Mid(LgGedCom,7)
    ElseIf  Mid(LgGedCom,1,6)="1 FAMS"; Unions 3 maxi
      CptCouple+1
      If CptCouple = 1
        Couple1=Val( Mid(LgGedCom,10))
      ElseIf CptCouple=2
        Couple2=Val( Mid(LgGedCom,10))
      ElseIf CptCouple=3
        Couple3=Val( Mid(LgGedCom,10))
      EndIf
    ElseIf  Mid(LgGedCom,1,6)="1 BIRT"
      CptEven=0
      SelectDataNB()
    ElseIf  Mid(LgGedCom,1,5)="1 CHR"
      If CptEven<>3
        SelectDataNB()
        CptEven=0
      EndIf
    ElseIf  Mid(LgGedCom,1,6)="1 DEAT" 
      CptEven=0
      SelectDataDI()
    ElseIf  Mid(LgGedCom,1,6)="1 BURI"
      If CptEven<>3
        SelectDataDI()
        CptEven=0
      EndIf
    ElseIf Mid(LgGedCom,1,6)="1 FAMC"
      Fratrie=Val( Mid(LgGedCom,10))
    ElseIf Left(LgGedCom,3)= "0 @"
      LgGedComSuivant=LgGedCom
      ;                                         Enregistrement
      NbFiches(fc)+1
      If Len(aa)>LgMxEnreg
        LgMxEnreg=Len(aa)
      EndIf
      bb= Str(NoINDI)+","+ Nom + ","+Prenom+","+Sexe+","+Str(Couple1) +","+Str(Couple2)+","+Str(Couple3)+","+ DateNB+","+ LieuNB+","
      aa=bb+StrD(LatiNB)+","+StrD(longNB)+"," +DateDI + "," + LieuDI +","+StrD(LatiDI)+","+StrD(longDI) +"," + Str(Fratrie)+","+Str(fc)
      If Len(aa)>LongEnr
        Debug aa
        nom = Left(nom,20): Prenom =Left(prenom,30) : LieuDI= Left(LieuDI,30): LieuNB = Left(LieuNB,30)
        bb= Str(NoINDI)+","+ Nom + ","+Prenom+","+Sexe+","+Str(Couple1) +","+Str(Couple2)+","+Str(Couple3)+","+ DateNB+","+ LieuNB+","
        aa=bb+StrD(LatiNB)+","+StrD(longNB)+"," +DateDI + "," + LieuDI +","+StrD(LatiDI)+","+StrD(longDI) +"," + Str(Fratrie)+","+Str(fc)
        Debug aa
      EndIf
      aa=LSet(aa,LongEnr,"*")
  ;     Debug aa
      WriteStringN(2, aa)
      nom="":Prenom=""
      sexe="":NoINDI=0
      Couple1=0:Couple2=0:Couple3=0
      DateDI="": DateNB=""
      LieuDI="":LieuNB=""
      LatiDI=0:LatiNB=0
      longDI=0:longDI=0
      Fratrie=0
      CptCouple=0
      NoINDI = Val(StringField(LgGedCom,2,"I"))
    EndIf
    If Mid(LgGedCom,1,4) ="0 @F"; fin des INDI (noms), début fam
      Break
    EndIf 
  Wend
EndProcedure

Procedure SelectDataDI() ; décès, inhumation
    CptEven=0
    For i= 1 To 10
        LgGedCom=ReadString(1)
        If Left(LgGedCom,6)="2 DATE"
            DateDI= Mid(LgGedCom,8)
        ElseIf  Left(LgGedCom,6)="2 PLAC"
            StringField(Mid(LgGedCom,7), 1, ",")
            LieuDI = StringField(Mid(LgGedCom,7), 1, ",")
        ElseIf  Left(LgGedCom,6)="4 LATI"
            LatiDI = ValD(Mid(LgGedCom,7))
            CptEven=1
        ElseIf  Left(LgGedCom,6)="4 LONG"
            longDI = ValD(Mid(LgGedCom,7))
            CptEven+2
            Break
        ElseIf  Right(LgGedCom,6)="FNA NO"
            Break
        ElseIf Right(LgGedCom,7)="FNA YES"
            Break
        EndIf
    Next
EndProcedure

Procedure SelectDataNB(); Naissance/baptême
    CptEven=0
    For i= 1 To 10
        LgGedCom=ReadString(1)
        If Left(LgGedCom,6)="2 DATE"
            DateNB= Mid(LgGedCom,8)
        ElseIf  Left(LgGedCom,6)="2 PLAC"
          LieuNB = StringField(Mid(LgGedCom,7), 1, ",")
        ElseIf  Left(LgGedCom,6)="4 LATI"
            LatiNB = ValD(Mid(LgGedCom,7))
            CptEven=1
        ElseIf  Left(LgGedCom,6)="4 LONG"
            longNB = ValD(Mid(LgGedCom,7))
            CptEven+2
            Break
        ElseIf  Right(LgGedCom,6)="FNA NO"
            Break
        ElseIf Right(LgGedCom,7)="FNA YES"
            Break
        EndIf
    Next
EndProcedure
Toshiba satellite Windows 7 64bits
Ollivier
Messages : 4190
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: Archives départementales

Message par Ollivier »

C'est un code tout à fait correct. Sincèrement, aucune honte à avoir. Là, on a la partie important un extrait d'une base de données spécifique. C'est opérationnel et c'est quelque part le principal.

Les macros dans ce langage permettent de recopier des morceaux de code durant la phase de compilation avec quelques subtilités possibles de spécialisation. C'est gagner du temps d'exécution et de programmation contre quelques instructions supplémentaires répétitives dans le fichier exécutable.

Code : Tout sélectionner

Macro  Init(Device)
   If Init#Device() = 0
      MessageRequester("Erreur", "Initialisation impossible" )
   EndIf
EndMacro


Init(Sprite)
Init(Keyboard)
Init(Mouse)
Les macros ressemblent vaguement aux procédures. Device n'est ici qu'un nom d'argument qui peut être remplacé librement.

Il y a plus de précisions dans l'aide et dans la section info/tuto. Un autre outil à y découvrir aussi (et peut-être plus dans tes besoins immédiats) : les structures.
Avatar de l’utilisateur
Ar-S
Messages : 9477
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Archives départementales

Message par Ar-S »

+1 pour les structures. ça aide bien pour ce genre de classement.

Petite remarque.

Code : Tout sélectionner

CreateFile (x,"xxxxx",#PB_UTF8)
OpenFile (x,"xxxxx",#PB_UTF8)
Vu que si ton fichier CreateFile te crée un nouveau fichier s'il n'existe pas ou réinitialise ce dernier s'il existe déjà, ton openfile devient caduc ici.

Sinon je n'aime pas bien le fait d'ouvrir x fichiers puis de les fermer ensuite tous. J'aime en ouvrir/lire un, stocker les données qui m'intéressent, le fermer puis ouvrir/créer le fichier 2 etc mais dans l'absolue ça ne gêne pas ton code, c'est ce qui importe.

En tout cas si c'est fonctionnel, pour un soft de ce genre c'est déjà très bien.
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Ollivier
Messages : 4190
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: Archives départementales

Message par Ollivier »

Il peut y aller. Techniquement, on peut en ouvrir un paquet de fichiers ensemble. Si l'OS crash, de toute façon, fermé ou pas, le fichier est susceptible d'être foutu si l'OS n'a pas synchronisé l'enregistrement.

Par contre, cette histoire de CreateFile() OpenFile(), c'est sûr que OpenFile() ne sert qu'à rajouter une ligne inutile : CreateFile() crée un fichier vide et l'ouvre.

Il y a aussi quelquechose d'étrange avec NbFiches(xxx) = NbFiches(xxx). Quelquechose m'échappe mais je me demande si ce ne sont pas des repères pour de futures évolutions de code.
pierre003
Messages : 60
Inscription : ven. 27/mai/2016 8:27
Localisation : 03

Re: Archives départementales

Message par pierre003 »

Ar-S a écrit :+1 pour les structures. ça aide bien pour ce genre de classement.

Petite remarque.

Code : Tout sélectionner

CreateFile (x,"xxxxx",#PB_UTF8)
OpenFile (x,"xxxxx",#PB_UTF8)
Vu que si ton fichier CreateFile te crée un nouveau fichier s'il n'existe pas ou réinitialise ce dernier s'il existe déjà, ton openfile devient caduc ici.

Sinon je n'aime pas bien le fait d'ouvrir x fichiers puis de les fermer ensuite tous. J'aime en ouvrir/lire un, stocker les données qui m'intéressent, le fermer puis ouvrir/créer le fichier 2 etc mais dans l'absolue ça ne gêne pas ton code, c'est ce qui importe.

En tout cas si c'est fonctionnel, pour un soft de ce genre c'est déjà très bien.
C’est noté pour les createfile, merci bien je vais essayer de m’en rappeler.
Pour les structures, on s’aperçoit que je n’ai pas beaucoup de suite dans les idées car sur le programme 1 il n’y en a pas mais dans celui là oui même si elle est dimensionnée a 1.
Pour le nombre de fichiers ouverts en même temps, sur ce programme c’est un seul, mais je l’ouvre dans 'validation' et le fichier étant toujours ouvert je l’ouvre de nouveau sous un autre N° dans 'recherchecouple' ce qui est je pense encore plus vicieux, bon le principal ça fonctionne.
Dernière modification par pierre003 le jeu. 18/oct./2018 8:31, modifié 1 fois.
Toshiba satellite Windows 7 64bits
pierre003
Messages : 60
Inscription : ven. 27/mai/2016 8:27
Localisation : 03

Re: Archives départementales

Message par pierre003 »

Ollivier a écrit :Il peut y aller. Techniquement, on peut en ouvrir un paquet de fichiers ensemble. Si l'OS crash, de toute façon, fermé ou pas, le fichier est susceptible d'être foutu si l'OS n'a pas synchronisé l'enregistrement.

Par contre, cette histoire de CreateFile() OpenFile(), c'est sûr que OpenFile() ne sert qu'à rajouter une ligne inutile : CreateFile() crée un fichier vide et l'ouvre.

Il y a aussi quelquechose d'étrange avec NbFiches(xxx) = NbFiches(xxx). Quelquechose m'échappe mais je me demande si ce ne sont pas des repères pour de futures évolutions de code.
Je pensai bien que ça en ferait tiquer quelques uns, oui on trouve des trucs comme a=a fichier=fichier, c’est des vieilles habitudes pour pouvoir y mettre un point d’arrêt et voir une variable au dessus ou même le x=x, et bien souvent j’oublie de faire le ménage. Bien sûr il y a mieux dans Purebasic mais avec l’âge on a du mal à changer ses habitudes. :oops:
Toshiba satellite Windows 7 64bits
pierre003
Messages : 60
Inscription : ven. 27/mai/2016 8:27
Localisation : 03

Re: Archives départementales

Message par pierre003 »

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
Toshiba satellite Windows 7 64bits
Avatar de l’utilisateur
MLD
Messages : 1103
Inscription : jeu. 05/févr./2009 17:58
Localisation : Bretagne

Re: Archives départementales

Message par MLD »

@Pierre 003
Je trouve ta passion intéressante.
Tes codes sont OK. Simplement commente le plus possible. Évite les global car cela peut faire des cafouillages.
Écoute le professeur Ollivier, il est de très bon conseil :wink:
Ollivier
Messages : 4190
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: Archives départementales

Message par Ollivier »

Je ne suis quand même pas le seul à être de bon conseil !

C'est à plusieurs que l'on apporte les meilleurs idées. Il n'y a donc pas de professeur. Et très souvent, il se crée un échange idée/algo plus qu'une transmission pure et simple : là, personnellement je ne connaissais absolument pas ces fichiers Gedcom (et je ne dois pas être le seul !).

Donc on peut remercier Pierre003 pour ce partage, un de plus.
pierre003
Messages : 60
Inscription : ven. 27/mai/2016 8:27
Localisation : 03

Re: Archives départementales

Message par pierre003 »

Je viens de réussir à trouver des fichiers GED sur gogol, si vous voulez tester ou bien par curiosité pour voir comment est fait un fichier GEDCOM, (c’est du texte).

Voici un fichier avec 326 individus :
http://www.ahnen4.de/web/sara_v/sara_v.ged

Et un autre avec 24265 individus (Attention, c’est du lourd, mais Purebasic l’a quand même avalé en 251 secondes mais sans critères, ce qui est inutile mais c’était juste pour voir)
Sans critères : 24265 individus en 251 secondes
‘Ar’ comme critère dans prénom : 8181 individus en 84 secondes
‘Ar’ comme critère dans prénom mais en cliquant sur ‘au début’ : 81 individus en 1.37 secondes. (Donc 1.37 secondes pour passer 24265 fiches en revue et afficher sans que le programme soit optimisé, Purebasic est quand même très performant)
http://www.eisenburger-online.de/eisenb ... burger.ged
Bon WE et merci pour votre aide.
Pierre003
Toshiba satellite Windows 7 64bits
Répondre