KGF_dll - nouvelles versions

Sujet: Re: KGF_dll - nouvelles versions Lun 9 Mar 2015 - 22:55

En attendant, je mets au point une petite application de démo, selon le modèle ci-dessus.

Ce qu'il y a de bien avec un fichier XML utilisé comme support de stockage de données structurées, c'est qu'on peut facilement ajouter des champs, voir de nouveaux sous-arbres, sans pour autant avoir à changer le code existant, ni de mettre à jour tous les enregistrements déjà existants, dans un fichier qui est déjà potentiellement grand. Il suffit de coder ce qu'il faut pour le ou les nouveaux champs. Et les éléments nouvellement créés ou modifiés contiendront cette information, les autres resteront inchangés. Et lors de leur prochaine utilisation, le ou les nouveaux champs sont simplement considérés comme "vides" et l'application en fera ce qu'elle est censée faire. C'est une des causes de la grande souplesse des fichiers XML.

Sujet: Re: KGF_dll - nouvelles versions Mer 11 Mar 2015 - 13:19

Nouvelle version:
KGF.dll V4.45 du 11/03/2015

Nouveautés:
XML: 1 nouvelle fonction, correction de quelques bugs

Modules modifiés:
KGF.dll
KGF.chm

Les sources et la doc sont à jour.

L'objet XML commence à être réellement exploitable. J'ai commencé la petite appli "contacts", dont voici le source:

Code:: ' Contacts_avec_XML.bas

' Ce petit programme implémente un carnet d'adresses à l'aide de l'objet XML.
'
' 1. Pour chaque "contact", on va créer une "fiche" qui est représentée par
' un "noeud" dans le fichier XML.
' 2. Chacun de ces noeuds "contact" contient plusieurs noeuds "fille" qui
' représentent chacun un ensemble logique de données.
' 3. Chacun de ces noeuds "fille" est potentiellement composé d'autres noeuds
' "fille" contenant des informations détaillées de plus bas niveau, etc.
' 4. Un "historique" sera réalisé sous forme d'un noeud "fille" au "contact",
' avec, à son tour, un noeud "fille" par mois, contenant des noeuds "fille"
' pour chaque évènement, qui à leur tour sont décomposés en noeuds "fille"
' décrivant chacun une information de détail pour l'évènement.
' 5. les informations spécifiques sont introduites par un $ pour les éléments
' et les attributs, et un # pour les données. Ceci est géré utomatiquement.
'
' Ceci conduit à la structure suivante:
' Root // noeud virtuel de "racine" créé automatiquement
' $entête // noeud technique contenant l'entête du fichier XML
' contact1 // le nom de ce noeud est l'identification du contact
' $attributs // divers attributs en nombre variable
' $type=client
' ...
' $...
' etatcivil
' civilite
' #mme
' patronyme
' #dupond
' naissance
' #devergne
' prenoms
' #marie hélène
' datenaissance
' #1953/07/23
' lieunaissance
' ville
' #bourges
' departement
' #18
' contacter
' telephone
' #0123456789
' mail
' #mh.dupond@ttest.fr
' ...
' historique
' 2015
' 12
' achat
' date
' #2015/12/17
' objet
' #cartouches
' achat
' date
' #2015/12/03
' objet
' #recharges
' 09
' commande
' date
' #2015/09/23
' objet
' #recharges
' 02
' retour
' date
' #2015/02/19
' objet
' #perceuse
' 2014
' 10
' achat
' date
' #2014/10/04
' objet
' #perceuse
' 08
' achat
' date
' #2014/08/25
' objet
' #huile de chaîne
' 2013
' 11
' commande
' date
' #2013/11/14
' objet
' #poste soudure
' ...
' contactx // le nom de ce noeud est l'identification du contact
' ...
'
' Ceci conduit au fichier XML suivant:
' <?xml version="1.0" encoding="UTF-8"?>
' <contact $type="client" ...$xxx="yyy">
' <id>#1</id>
' <etatcivil>
' <civilite>#mme</civilite>
' <patronyme>#dupond</patronyme>
' <naissance>#devergne</naissance>
' <prenoms>#marie hélène</prenoms>
' <datenaissance>#1953/07/23</datenaissance>
' <lieunaissance>
' <ville>#bourges</ville>
' <departement>#18</departement>
' </lieunaissance>
' </etatcivil>
' <contact>
' <telephone>#0123456789</telephone>
' <mail>#mh.dupond@ttest.fr</mail>
' </contact>
' ...
' <historique>
' <2015>
' <12>
' <achat>
' <date>#2015/12/17</date>
' <obje>#cartouches</objet>
' </achat>
' <achat>
' <date>#2015/12/03</date>
' <objet>#recharges</objet>
' </achat>
' </12>
' <09>
' <commande>
' <date>#2015/09/23</date>
' <objet>#recharges</objet>
' </commande>
' </09>
' <02>
' <retour>
' <date>#2015/02/19</date>
' <objet>#perceuse</objet>
' </retour>
' </02>
' </2015>
' <2014>
' <10>
' <achat>
' <date>#2014/10/04</date>
' <objet>#perceuse</objet>
' </achat>
' </10>
' <08>
' <achat>
' <date>#2014/08/25/date>
' <objet>#huile de chaîne</objet>
' <achat>
' </08>
' </2014>
' <2013>
' <11>
' <commande>
' <date>#2013/11/14</date>
' <objet>#poste soudure</objet>
' </comande>
' </11>
' </2013>
' </historique>
' </contact>
' ...
' <contact $type="fournisseur">
' ...
' </Root>

constantes()

dll_on KGF$

labels()
variables()
menu()
invisibles()
GUI()
initialiser()

end

sub labels()
label nouveau, ouvrir, sortir, enregistrer, enregistrersous, fermer
label select_contact, nouveau_contact, supprimer_contact
end_sub

sub constantes()
dim KGF$ : KGF$ = "KGF.dll"
dim dir$ : dir$ = "C:\Users\klausgunther\Documents\Mes projets\Mes projets Delphi\KGF\"
dim crit_patronyme$ : crit_patronyme$ = "Root\contact\etatcivil\patronyme"
dim crit_prenoms$ : crit_prenoms$ = "Root\contact\etatcivil\prenoms"
dim sep$ : sep$ = "\"
end_sub

sub variables()
dim contacts$ : ' nom du fichier XML
dim res%, no%, XML%, modif%, s$, sub_res%, start%
dim no_open%, no_save%, no_StatusBar%, no_StatusText%, no_StatusCount%
dim no_Index%, no_IndexList%, no_debug%
dim no_contact%, no_ContactEtatCivil%, no_ContactCivilite%, no_ContactPatronyme%
dim no_ContactNaissance%, no_ContactPrenoms%, no_ContactDateNaissance%,
dim no_ContactVilleNaissance%, no_ContactDepartementNaissance%

dim nombre_contacts%
end_sub

sub menu()
dim_local no1%, no2%
full_space 0
no% = 0
no% = no% + 1 : main_menu no% : no1% = no%
no% = no% + 1 : sub_menu no% : no2% = no% : parent no%,no1% : caption no%,"Fichiers"
no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"Nouveau"
on_click no%,nouveau
no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"Ouvrir"
on_click no%,ouvrir
no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"Enregister"
on_click no%,enregistrer
no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"Enregister sous..."
on_click no%,enregistrersous
no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"Fermer"
on_click no%,fermer
no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"-"
no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"Sortir"
on_click no%,sortir

end_sub

sub invisibles()
no% = no% + 1 : open_dialog no% : no_open% = no%
no% = no% + 1 : save_dialog no% : no_save% = no%
end_sub

sub GUI()
GUI_StatusBar()
GUI_Index()
GUI_contact()
GUI_debug()
end_sub

sub GUI_StatusBar()
dim_local no1%
no% = no% + 1 : no1% = no% : panel no% : no_StatusBar% = no%
height no%,30 : top no%,height(0) - 90 : width no%,width(0)-25
color no%,220,220,220 : inactive no%
no% = no% + 1 : alpha no% : parent no%,no1% : no_StatusText% = no%
left no%,10 : top no%,3 : color no%,255,255,255
no% = no% + 1 : alpha no% : parent no%,no1% : no_StatusCount% = no%
left no%,210 : top no%,3 : color no%,255,255,255

end_sub

sub GUI_Index()
dim_local no1%
no% = no% + 1 : container no% : no1% = no% : caption no%,"Contacts"
font_color no%,0,0,255 : no_Index% = no%
top no%,10 : left no%,10 : width no%,300 : height no%,top(no_StatusBar%)-20
no% = no% + 1 : list no% : parent no%,no1% : no_IndexList% = no%
top no%,15 : left no%,10 : width no%,280 : height no%,height(no1%)-100
on_click no%,select_contact : sort_on no% : font_color no%,0,0,0
no% = no% + 1 : button no% : parent no%,no1% : caption no%,"Nouveau"
top no%,top(no_Index%+1)+height(no_Index%+1)+10 : left no%,10
on_click no%,nouveau_contact
no% = no% + 1 : button no% : parent no%,no1% : caption no%,"Supprimer"
top no%,top(no_Index%+1)+height(no_Index%+1)+10 : left no%,110
on_click no%,supprimer_contact
end_sub

sub GUI_contact()
dim_local no1%, no2%
no% = no% + 1 : container no% : no1% = no% : caption no%,"Contact choisi"
font_color no%,0,0,255 : no_contact% = no%
top no%,10 : left no%,left(no_index%)+width(no_index%)+10
width no%,600 : height no%,top(no_StatusBar%)-20 : no_ContactEtatCivil% = no%

no% = no% + 1 : container no% : no2% = no% : parent no%,no1%
font_color no%,0,0,255 : caption no%,"Etat civil" : top no%,20 : left no%,10
width no%,width(no_contact%)-20 : height no%,140 : color no%,220,220,220
no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
top no%,20 : left no%,10 : caption no%,"Civilité:"
no% = no% + 1 : edit no% : parent no%,no2% : no_ContactCivilite% = no%
top no%,20 : left no%,50 : width no%,50 : font_color no%,0,0,0
no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
top no%,20 : left no%,120 : caption no%,"Patronyme:"
no% = no% + 1 : edit no% : parent no%,no2% : no_ContactPatronyme% = no%
top no%,20 : left no%,220 : width no%,300 : font_color no%,0,0,0
no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
top no%,50 : left no%,120 : caption no%,"Nom de naissance:"
no% = no% + 1 : edit no% : parent no%,no2% : no_ContactNaissance% = no%
top no%,50 : left no%,220 : width no%,300 : font_color no%,0,0,0
no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
top no%,80 : left no%,120 : caption no%,"Prénoms:"
no% = no% + 1 : edit no% : parent no%,no2% : no_ContactPrenoms% = no%
top no%,80 : left no%,220 : width no%,300 : font_color no%,0,0,0
no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
top no%,110 : left no%,20 : caption no%,"Né le:"
no% = no% + 1 : edit no% : parent no%,no2% : no_ContactDateNaissance% = no%
top no%,110 : left no%,60 : width no%,80 : text no%,"aaaa/mm/jj" : font_color no%,0,0,0
no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
top no%,110 : left no%,160 : caption no%,"à:"
no% = no% + 1 : edit no% : parent no%,no2% : no_ContactVilleNaissance% = no%
top no%,110 : left no%,180 : width no%,200 : font_color no%,0,0,0
no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
top no%,110 : left no%,400 : caption no%,"Dép."
no% = no% + 1 : edit no% : parent no%,no2% : no_ContactDepartementNaissance% = no%
top no%,110 : left no%,440 : width no%,80 : font_color no%,0,0,0
end_sub

sub GUI_debug()
no% = no% + 1 : list no% : no_debug% = no% : hide no%
top no_debug%,top(no_IndexLIst%)
left no_debug%,left(no_IndexLIst%)
width no_debug%,width(no_IndexLIst%)
height no_debug%,height(no_IndexList%)
end_sub

sub debug()
dim_local ident$
show no_debug%
clear no_debug%
start% = 0
repeat
ident$ = string$(200," ")
start% = dll_call3("GetXmlElementByAddress",XML%,start%+1,adr(ident$))
item_add no_debug%,trim$(ident$)
until start%=0
exit_sub
end_sub

sub initialiser()
caption 0,"Suivi des contacts"
XML% = 0
contacts$ = ""
caption no_StatusText%,"En attente..."
caption no_StatusCount%,"0/0"
end_sub

sub ChargerIndex()
dim_local start%, ident$
if XML%=0 then return

clear no_IndexList%
nombre_contacts% = 0
caption no_StatusCount%,"0/"+str$(nombre_contacts%)
start% = 0 : ' exclure Root
while 1<3 : ' boucle infinie
start% = dll_call4("SelectXmlElementByPath",XML%,start%+1,adr(crit_patronyme$),adr(sep$))
if start%<1 then exit_while
s$ = string$(300," ")
res% = dll_call2("GetXmlData",XML%,adr(s$))
ident$ = trim$(s$)
start% = dll_call4("SelectXmlElementByPath",XML%,start%,adr(crit_prenoms$),adr(sep$))
s$ = string$(300," ")
res% = dll_call2("GetXmlData",XML%,adr(s$))
ident$ = ident$ + ", "+trim$(s$)
nombre_contacts% = nombre_contacts% + 1
item_add no_IndexList%,ident$
end_while
res% = dll_call1("GetXmlTop",XML%)
caption no_StatusCount%,"0/"+str$(nombre_contacts%)
end_sub

sub chercher_patronyme(nom$)
dim_local tmp$, tmp1$
sub_res% = 0
while res%>0 : ' chercher le patronyme
start% = dll_call4("SelectXmlElementByPath",XML%,start%+1,adr(crit_patronyme$),adr(sep$))
if start%<1
caption no_StatusText%,"Erreur de recherche"
message "oups 1: "+str$(start%)
sub_res% = 1
exit_sub
end_if
tmp$ = string$(100," ")
res% = dll_call2("GetXmlData",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
' message "tmp1$="+tmp1$+" tmp$="+tmp$+" nom$="+nom$+" "+crit_patronyme$
if tmp$=nom$ then res% = 0
end_while
if tmp$<>nom$
caption no_StatusText%,"Erreur de recherche"
message "oups 2"
sub_res% = 1
exit_sub
end_if
end_sub

sub chercher_prenoms(nom$,prenom$,aff%)
dim_local item$, pre$
sub_res% = 0
res% = 1
while res%>0 : ' chercher le prénom pour le patronyme trouvé
res% = dll_call1("GetNextXmlSister",XML%)
' message "b "+str$(res%)
if res%>0
item$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(item$))
item$ = trim$(item$)
' message "c "+str$(res%)+" ["+item$+"]"
' if item$="prenoms" then exit_while
end_if
if item$="prenoms"
pre$ = string$(100," ")
res% = dll_call2("GetXmlData",XML%,adr(pre$))
pre$ = trim$(pre$)
' message "d "+str$(res%)+" ["+pre$+"] ["+prenom$+"]"
if pre$=prenom$
if aff%=1
text no_ContactPatronyme%,nom$
text no_ContactPrenoms%,prenom$
end_if
caption no_StatusText%,"Contact sélectionné"
exit_sub
end_if
end_if
end_while
end_sub

sub charger_civilite()
dim_local tmp$
res% = dll_call1("GetXmlParent",XML%)
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
tmp$ = trim$(tmp$)

res% = dll_call1("GetFirstXmlChild",XML%)
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
if tmp$<>"civilite"
while res%>0
res% = dll_call1("GetNextXmlSister",XML%)
if res%<1 then exit_sub
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
if tmp$="civilite"
tmp$ = string$(20," ")
res% = dll_call2("GetXmlData",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
exit_while
end_if
end_while
exit_sub
else
tmp$ = string$(20," ")
res% = dll_call2("GetXmlData",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
end_if
text no_ContactCivilite%,tmp$
end_sub

sub charger_naissance()
dim_local tmp$
while res%>0
res% = dll_call1("GetNextXmlSister",XML%)
if res%<1 then exit_sub
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
if tmp$="naissance"
tmp$ = string$(20," ")
res% = dll_call2("GetXmlData",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
exit_while
end_if
end_while
text no_ContactNaissance%,tmp$
res% = 1
end_sub

sub charger_DateNaissance()
dim_local tmp$
while res%>0
res% = dll_call1("GetNextXmlSister",XML%)
if res%<1 then exit_sub
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
if tmp$="datenaissance"
tmp$ = string$(20," ")
res% = dll_call2("GetXmlData",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
exit_while
end_if
end_while
text no_ContactDateNaissance%,tmp$
end_sub

sub charger_VilleNaissance()
dim_local tmp$
while res%>0
res% = dll_call1("GetNextXmlSister",XML%)
if res%<1 then exit_sub
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
if tmp$="lieunaissance"
res% = dll_call1("GetFirstXmlChild",XML%)
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
while tmp$<>"ville"
res% = dll_call1("GetNextXmlSister",XML%)
tmp$ = string$(20," ")
res% = dll_call2("GetXmlData",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
if tmp$="ville" then exit_while
end_while
tmp$ = string$(20," ")
res% = dll_call2("GetXmlData",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
text no_ContactVilleNaissance%,tmp$
exit_sub
end_if
end_while
end_sub

sub charger_DepartementNaissance()
dim_local tmp$
while res%>0
res% = dll_call1("GetNextXmlSister",XML%)
if res%<1 then exit_sub
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
if tmp$="departement"
tmp$ = string$(20," ")
res% = dll_call2("GetXmlData",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
exit_while
end_if
end_while
text no_ContactDepartementNaissance%,tmp$
end_sub

sub chercher_contact(aff%)
dim_local s$, nom$, prenom$, i%

text no_ContactCivilite%,""
text no_ContactPatronyme%,""
text no_ContactNaissance%,""
text no_contactPrenoms%,""
text no_ContactDateNaissance%,""
text no_ContactVilleNaissance%,""
text no_ContactDepartementNaissance%,""

s$ = item_index$(no_IndexList%)
i% = instr(s$,",")
nom$ = left$(s$,i%-1)
prenom$ = trim$(mid$(s$,i%+1,len(s$)))
' message nom$ + " / " + prenom$
start% = 0
res% = 1

chercher_patronyme(nom$)
if sub_res%=1 then exit_sub
chercher_prenoms(nom$,prenom$,1)
if sub_res%=1 then exit_sub
if aff%=0 then exit_sub

charger_civilite()
charger_naissance()
charger_DateNaissance()
charger_VilleNaissance()
charger_DepartementNaissance()
end_sub

sub supprimer_contact()
dim_local tmp$
chercher_contact(0)
if sub_res%=1 then exit_sub
repeat
res% = dll_call1("GetXmlParent",XML%)
if res%<1 then exit_sub
tmp$ = string$(100," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
until trim$(tmp$)="contact"
res% = dll_call1("DeleteXmlElement",XML%)
item_delete no_IndexList%,item_index(no_IndexList%)
caption no_StatusText%,"Elément supprimé"
end_sub

sub creer_contact()
dim_local tmp$, bad%, item$, old$
bad% = 0
if XML%=0 then exit_sub

if trim$(text$(no_ContactPatronyme%))="" then bad% = 1
if trim$(text$(no_ContactPrenoms%)) ="" then bad% = 1
if bad%=1
caption no_StatusText%,"Patronyme et prénoms sont obligatoires"
exit_sub
end_if

res% = dll_call1("GetXmlTop",XML%)

' N1
tmp$ = "contact"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))

' N2
tmp$ = "id"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = "x"
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))

res% = dll_call1("GetXmlParent",XML%)
' N2
tmp$ = "etatcivil"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))

' N3
tmp$ = "civilite"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = trim$(text$(no_ContactCivilite%))
if len(tmp$)>0
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
end_if

res% = dll_call1("GetXmlParent",XML%)
' N3
tmp$ = "patronyme"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = trim$(text$(no_ContactPatronyme%))
item$ = tmp$
if len(tmp$)>0
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
end_if

res% = dll_call1("GetXmlParent",XML%)
' N3
tmp$ = "naissance"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = trim$(text$(no_ContactNaissance%))
if len(tmp$)>0
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
end_if

res% = dll_call1("GetXmlParent",XML%)
' N3
tmp$ = "prenoms"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = trim$(text$(no_ContactPrenoms%))
if len(tmp$)>0
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
end_if

item$ = item$ + ", " + tmp$
item_add no_IndexList%,item$
nombre_contacts% = nombre_contacts% + 1
caption no_StatusCount%,"0/"+str$(nombre_contacts%)

res% = dll_call1("GetXmlParent",XML%)
' N3
tmp$ = "datenaissance"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = trim$(text$(no_ContactDateNaissance%))
if len(tmp$)>0
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
end_if

res% = dll_call1("GetXmlParent",XML%)
' N3
tmp$ = "lieunaissance"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))

' N4
tmp$ = "ville"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = trim$(text$(no_ContactVilleNaissance%))
if len(tmp$)>0
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
end_if

res% = dll_call1("GetXmlParent",XML%)
' N4
tmp$ = "departement"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = trim$(text$(no_ContactDepartementNaissance%))
if len(tmp$)>0
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
end_if

res% = dll_call1("GetXmlParent",XML%)
' N3

res% = dll_call1("GetXmlParent",XML%)
' N2

res% = dll_call1("GetXmlParent",XML%)
' N2
tmp$ = "contacter"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))

' N3
tmp$ = "telephone"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = "1234567890"
if len(tmp$)>0
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
end_if

res% = dll_call1("GetXmlParent",XML%)
' N3
tmp$ = "mail"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = "monmail"
if len(tmp$)>0
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
end_if
end_sub

nouveau:
if XML%<>0
if message_confirmation_yes_no("La base est modifiée. Voulez-vous la sauvegarder ?")=1
if contacts$=""
filter no_save%,"Fichier XML|*.xml"
s$ = file_name$(no_save%)
if s$="_" then return
if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
contacts$ = s$
end_if
res% = dll_call1("SaveXmlToFile",adr(contacts$))
end_if
end_if
s$ = "<?xml version="+chr$(34)+"1.0"+chr$(34)+" encoding="+chr$(34)+"UTF-8"+chr$(34)+"?>"
res% = dll_call1("LoadXmlFromString",adr(s$))
XML% = res%
contacts$ = ""
caption 0,"Suivi des contacts - <nouveau> *"
modif% = 1
caption no_StatusText%,"Nouvelle base vide"
ChargerIndex()
return

ouvrir:
if XML%<>0
if message_confirmation_yes_no("La base est modifiée. Voulez-vous la sauvegarder ?")=1
if contacts$=""
filter no_save%,"Fichier XML|*.xml"
s$ = file_name$(no_save%)
if s$="_" then return
if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
contacts$ = s$
end_if
res% = dll_call1("SaveXmlToFile",adr(contacts$))
end_if
end_if
res% = dll_call1("FreeXml",XML%)
modif% = 0
filter no_open%,"fichier XML|*.xml"
s$ = file_name$(no_open%)
if s$="_" then return
if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
if file_exists(s$)=0 then return
contacts$ = s$
res% = dll_call1("LoadXmlFromFile",adr(contacts$))
if res%<>0 then XML% = res%
s$ = file_extract_name$(contacts$)
caption 0,"Suivi des contacts - "+s$
caption no_StatusText%,"Base ouverte"
ChargerIndex()
return

sortir:
if modif%=1
if message_confirmation_yes_no("La base est modifiée. Voulez-vous la sauvegarder ?")=1
if contacts$=""
filter no_save%,"Fichier XML|*.xml"
s$ = file_name$(no_save%)
if s$="_" then return
if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
contacts$ = s$
end_if
res% = dll_call1("SaveXmlToFile",adr(contacts$))
end_if
end_if
terminate
return

enregistrer:
modif% = 0
if contacts$=""
filter no_save%,"Fichier XML|*.xml"
s$ = file_name$(no_save%)
if s$="_" then return
if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
contacts$ = s$
end_if
res% = dll_call2("SaveXmlToFile",XML%,adr(contacts$))
s$ = file_extract_name$(contacts$)
caption 0,"Suivi des contacts - "+s$
caption no_StatusText%,"Base enregistrée"
return

enregistrersous:
modif% = 0
filter no_save%,"Fichier XML|*.xml"
s$ = file_name$(no_save%)
if s$="_" then return
if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
contacts$ = s$
res% = dll_call2("SaveXmlToFile",XML%,adr(contacts$))
s$ = file_extract_name$(contacts$)
caption 0,"Suivi des contacts - "+s$
caption no_StatusText%,"Base enregistrée"
return

fermer:
if modif%=1
if message_confirmation_yes_no("La base est modifiée. Voulez-vous la sauvegarder ?")=1
if contacts$=""
filter no_save%,"Fichier XML|*.xml"
s$ = file_name$(no_save%)
if s$="_" then return
if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
contacts$ = s$
end_if
res% = dll_call1("SaveXmlToFile",adr(contacts$))
end_if
end_if
if XML%<>0 then res% = dll_call1("FreeXml",XML%)
XML% = 0
caption 0,"Suivi des contacts"
modif% = 0
caption no_StatusText%,"En attente..."
return

select_contact:
chercher_contact(1)
return

nouveau_contact:
creer_contact()
return

supprimer_contact:
supprimer_contact()
return

Et voici un petit fichier XML avec deux contacts que l'on peut charger dans le programme, par le menu Fichiers\Ouvrir:

Code:: <?xml version="1.0" encoding="UTF-8"?>
<contact type="client">
<id>1</id>
<etatcivil>
<civilite>mme</civilite>
<patronyme>dupond</patronyme>
<naissance>devergne</naissance>
<prenoms>marie hélène</prenoms>
<datenaissance>1953/07/23</datenaissance>
<lieunaissance>
<ville>bourges</ville>
<departement>18</departement>
</lieunaissance>
</etatcivil>
<contacter>
<telephone>0123456789</telephone>
<mail>mh.dupond@ttest.fr</mail>
</contacter>
</contact>
<contact type="fournisseur">
<id>2</id>
<etatcivil>
<civilite>mr</civilite>
<patronyme>Letellier</patronyme>
<naissance></naissance>
<prenoms>Jean-Jacques</prenoms>
<datenaissance>1972/09/13</datenaissance>
<lieunaissance>
<ville>Marseille</ville>
<departement>13</departement>
</lieunaissance>
</etatcivil>
<contacter>
<telephone>0123456789</telephone>
<telephone>0678901234</telephone>
<mail>jj.letellier@service.org</mail>
</contacter>
</contact>

On peut ajouter des contacts, en remplissant le formulaire puis bouton "Nouveau". La suppression marche aussi.

Sujet: Re: KGF_dll - nouvelles versions Mer 11 Mar 2015 - 18:02

Testé et approuvé.
Merci Klaus.

Petite remarque.
J’ai toujours le problème du TERMINATE avec KGF.dll (plantage systématique !).
J’oublie toujours de remplacer TERMINATE par

Code:: res% = dll_call1("KillProcessByHandle",handle(0))

Sujet: Re: KGF_dll - nouvelles versions Mer 11 Mar 2015 - 20:54

en fait avec la mise en place de ServiceNow dans mon boulot, je crois que ça tombe carrément bien tes fonction XML car tous les objets peuvent être exportés dans ce format. Donc je ne teste pas pour le moment mais je t'en remercie par avance Wink

Sujet: Re: KGF_dll - nouvelles versions Jeu 12 Mar 2015 - 1:31

Nouvelle version:
KGF.dll V4.46 du 12/03/2015

Nouveautés:
XML: 1 nouvelle fonction

Modules modifiés:
KGF.dll
KGF.chm

Les sources et la doc sont à jour.

La nouvelle fonction permet de retourner l'indice absolu de l'élément XML actif. Cela correspond à une "adresse", bien que ce ne soit pas forcément lié au numéro de ligne du fchier XML. Cette adresse reste fixe tant que l'objet XML n'est pas modifié par l'ajout ou la suppression d'éléments. Et donc, en phase de recherche,on peut l'utiliser facilement comme un "signet" pour mémoriser une position dans l'objet XML, continuer les recherches, puis revenir directement à l'endroit mémorisé.

Cette fonction est utilisée de façon intensive dans la nouvelle version du programme de démo par gestion de fiches de contact. En effet, j'ai ajouté l'affichage de l'historique présent dans l'objet XML. Voici le fichier XML qui contient un historique pour le premier des deux contacts:

Code:: <?xml version="1.0" encoding="UTF-8"?>
<contact type="client">
<id>1</id>
<etatcivil>
<civilite>mme</civilite>
<patronyme>dupond</patronyme>
<naissance>devergne</naissance>
<prenoms>marie hélène</prenoms>
<datenaissance>1953/07/23</datenaissance>
<lieunaissance>
<ville>bourges</ville>
<departement>18</departement>
</lieunaissance>
</etatcivil>
<contacter>
<telephone>0123456789</telephone>
<mail>mh.dupond@ttest.fr</mail>
</contacter>
<historique>
<2015>
   <12>
   <achat>
<date>2015/12/17</date>
<obje>cartouches</objet>
</achat>
<achat>
<date>2015/12/03</date>
<objet>recharges</objet>
</achat>
   </12>
<09>
<commande>
<date>2015/09/23</date>
<objet>recharges</objet>
</commande>
</09>
<02>
<retour>
<date>2015/02/19</date>
<objet>perceuse</objet>
</retour>
</02>
</2015>
<2014>
<10>
<achat>
<date>2014/10/04</date>
<objet>perceuse</objet>
</achat>
</10>
<08>
<achat>
<date>2014/08/25</date>
<objet>huile de chaîne</objet>
</achat>
</08>
</2014>
<2013>
   <11>
<commande>
<date>2013/11/14</date>
<objet>poste soudure</objet>
</comande>
</11>
</2013>
</historique>
</contact>
<contact type="fournisseur">
<id>2</id>
<etatcivil>
<civilite>mr</civilite>
<patronyme>Letellier</patronyme>
<naissance></naissance>
<prenoms>Jean-Jacques</prenoms>
<datenaissance>1972/09/13</datenaissance>
<lieunaissance>
<ville>Marseille</ville>
<departement>13</departement>
</lieunaissance>
</etatcivil>
<contacter>
<telephone>0123456789</telephone>
<telephone>0678901234</telephone>
<mail>jj.letellier@service.org</mail>
</contacter>
</contact>

Et voici le source du programme qui va avec:

Code:: ' Contacts_avec_XML.bas

' Ce petit programme implémente un carnet d'adresses à l'aide de l'objet XML.
'
' 1. Pour chaque "contact", on va créer une "fiche" qui est représentée par
' un "noeud" dans le fichier XML.
' 2. Chacun de ces noeuds "contact" contient plusieurs noeuds "fille" qui
' représentent chacun un ensemble logique de données.
' 3. Chacun de ces noeuds "fille" est potentiellement composé d'autres noeuds
' "fille" contenant des informations détaillées de plus bas niveau, etc.
' 4. Un "historique" sera réalisé sous forme d'un noeud "fille" au "contact",
' avec, à son tour, un noeud "fille" par mois, contenant des noeuds "fille"
' pour chaque évènement, qui à leur tour sont décomposés en noeuds "fille"
' décrivant chacun une information de détail pour l'évènement.
' 5. les informations spécifiques sont introduites par un $ pour les éléments
' et les attributs, et un # pour les données. Ceci est géré utomatiquement.
'
' Ceci conduit à la structure suivante:
' Root // noeud virtuel de "racine" créé automatiquement
' $entête // noeud technique contenant l'entête du fichier XML
' contact1 // le nom de ce noeud est l'identification du contact
' $attributs // divers attributs en nombre variable
' $type=client
' ...
' $...
' etatcivil
' civilite
' #mme
' patronyme
' #dupond
' naissance
' #devergne
' prenoms
' #marie hélène
' datenaissance
' #1953/07/23
' lieunaissance
' ville
' #bourges
' departement
' #18
' contacter
' telephone
' #0123456789
' mail
' #mh.dupond@ttest.fr
' ...
' historique
' 2015
' 12
' achat
' date
' #2015/12/17
' objet
' #cartouches
' achat
' date
' #2015/12/03
' objet
' #recharges
' 09
' commande
' date
' #2015/09/23
' objet
' #recharges
' 02
' retour
' date
' #2015/02/19
' objet
' #perceuse
' 2014
' 10
' achat
' date
' #2014/10/04
' objet
' #perceuse
' 08
' achat
' date
' #2014/08/25
' objet
' #huile de chaîne
' 2013
' 11
' commande
' date
' #2013/11/14
' objet
' #poste soudure
' ...
' contactx // le nom de ce noeud est l'identification du contact
' ...
'
' Ceci conduit au fichier XML suivant:
' <?xml version="1.0" encoding="UTF-8"?>
' <contact $type="client" ...$xxx="yyy">
' <id>#1</id>
' <etatcivil>
' <civilite>#mme</civilite>
' <patronyme>#dupond</patronyme>
' <naissance>#devergne</naissance>
' <prenoms>#marie hélène</prenoms>
' <datenaissance>#1953/07/23</datenaissance>
' <lieunaissance>
' <ville>#bourges</ville>
' <departement>#18</departement>
' </lieunaissance>
' </etatcivil>
' <contact>
' <telephone>#0123456789</telephone>
' <mail>#mh.dupond@ttest.fr</mail>
' </contact>
' ...
' <historique>
' <2015>
' <12>
' <achat>
' <date>#2015/12/17</date>
' <obje>#cartouches</objet>
' </achat>
' <achat>
' <date>#2015/12/03</date>
' <objet>#recharges</objet>
' </achat>
' </12>
' <09>
' <commande>
' <date>#2015/09/23</date>
' <objet>#recharges</objet>
' </commande>
' </09>
' <02>
' <retour>
' <date>#2015/02/19</date>
' <objet>#perceuse</objet>
' </retour>
' </02>
' </2015>
' <2014>
' <10>
' <achat>
' <date>#2014/10/04</date>
' <objet>#perceuse</objet>
' </achat>
' </10>
' <08>
' <achat>
' <date>#2014/08/25/date>
' <objet>#huile de chaîne</objet>
' <achat>
' </08>
' </2014>
' <2013>
' <11>
' <commande>
' <date>#2013/11/14</date>
' <objet>#poste soudure</objet>
' </comande>
' </11>
' </2013>
' </historique>
' </contact>
' ...
' <contact $type="fournisseur">
' ...
' </Root>

constantes()

dll_on KGF$

labels()
variables()
menu()
invisibles()
GUI()
initialiser()

end

sub labels()
label nouveau, ouvrir, sortir, enregistrer, enregistrersous, fermer
label select_contact, nouveau_contact, supprimer_contact
end_sub

sub constantes()
dim KGF$ : KGF$ = "KGF.dll"
dim dir$ : dir$ = "C:\Users\klausgunther\Documents\Mes projets\Mes projets Delphi\KGF\"
dim crit_patronyme$ : crit_patronyme$ = "Root\contact\etatcivil\patronyme"
dim crit_prenoms$ : crit_prenoms$ = "Root\contact\etatcivil\prenoms"
dim sep$ : sep$ = "\"
end_sub

sub variables()
dim contacts$ : ' nom du fichier XML
dim res%, no%, XML%, modif%, s$, sub_res%, start%
dim no_open%, no_save%, no_StatusBar%, no_StatusText%, no_StatusCount%
dim no_Index%, no_IndexList%, no_debug%
dim no_contact%, no_ContactEtatCivil%, no_ContactCivilite%, no_ContactPatronyme%
dim no_ContactNaissance%, no_ContactPrenoms%, no_ContactDateNaissance%,
dim no_ContactVilleNaissance%, no_ContactDepartementNaissance%
dim no_HistoriqueList%

dim nombre_contacts%
end_sub

sub menu()
dim_local no1%, no2%
full_space 0
no% = 0
no% = no% + 1 : main_menu no% : no1% = no%
no% = no% + 1 : sub_menu no% : no2% = no% : parent no%,no1% : caption no%,"Fichiers"
no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"Nouveau"
on_click no%,nouveau
no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"Ouvrir"
on_click no%,ouvrir
no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"Enregister"
on_click no%,enregistrer
no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"Enregister sous..."
on_click no%,enregistrersous
no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"Fermer"
on_click no%,fermer
no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"-"
no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"Sortir"
on_click no%,sortir

end_sub

sub invisibles()
no% = no% + 1 : open_dialog no% : no_open% = no%
no% = no% + 1 : save_dialog no% : no_save% = no%
end_sub

sub GUI()
GUI_StatusBar()
GUI_Index()
GUI_contact()
GUI_debug()
end_sub

sub GUI_StatusBar()
dim_local no1%
no% = no% + 1 : no1% = no% : panel no% : no_StatusBar% = no%
height no%,30 : top no%,height(0) - 90 : width no%,width(0)-25
color no%,220,220,220 : inactive no%
no% = no% + 1 : alpha no% : parent no%,no1% : no_StatusText% = no%
left no%,10 : top no%,3 : color no%,255,255,255
no% = no% + 1 : alpha no% : parent no%,no1% : no_StatusCount% = no%
left no%,210 : top no%,3 : color no%,255,255,255

end_sub

sub GUI_Index()
dim_local no1%
no% = no% + 1 : container no% : no1% = no% : caption no%,"Contacts"
font_color no%,0,0,255 : no_Index% = no%
top no%,10 : left no%,10 : width no%,300 : height no%,top(no_StatusBar%)-20
no% = no% + 1 : list no% : parent no%,no1% : no_IndexList% = no%
top no%,15 : left no%,10 : width no%,280 : height no%,height(no1%)-100
on_click no%,select_contact : sort_on no% : font_color no%,0,0,0
no% = no% + 1 : button no% : parent no%,no1% : caption no%,"Nouveau"
top no%,top(no_Index%+1)+height(no_Index%+1)+10 : left no%,10
on_click no%,nouveau_contact
no% = no% + 1 : button no% : parent no%,no1% : caption no%,"Supprimer"
top no%,top(no_Index%+1)+height(no_Index%+1)+10 : left no%,110
on_click no%,supprimer_contact
end_sub

sub GUI_contact()
dim_local no1%, no2%
no% = no% + 1 : container no% : no1% = no% : caption no%,"Contact choisi"
font_color no%,0,0,255 : no_contact% = no%
top no%,10 : left no%,left(no_index%)+width(no_index%)+10
width no%,600 : height no%,top(no_StatusBar%)-20 : no_ContactEtatCivil% = no%

no% = no% + 1 : container no% : no2% = no% : parent no%,no1%
font_color no%,0,0,255 : caption no%,"Etat civil" : top no%,20 : left no%,10
width no%,width(no_contact%)-20 : height no%,140 : color no%,220,220,220
no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
top no%,20 : left no%,10 : caption no%,"Civilité:"
no% = no% + 1 : edit no% : parent no%,no2% : no_ContactCivilite% = no%
top no%,20 : left no%,50 : width no%,50 : font_color no%,0,0,0
no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
top no%,20 : left no%,120 : caption no%,"Patronyme:"
no% = no% + 1 : edit no% : parent no%,no2% : no_ContactPatronyme% = no%
top no%,20 : left no%,220 : width no%,300 : font_color no%,0,0,0
no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
top no%,50 : left no%,120 : caption no%,"Nom de naissance:"
no% = no% + 1 : edit no% : parent no%,no2% : no_ContactNaissance% = no%
top no%,50 : left no%,220 : width no%,300 : font_color no%,0,0,0
no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
top no%,80 : left no%,120 : caption no%,"Prénoms:"
no% = no% + 1 : edit no% : parent no%,no2% : no_ContactPrenoms% = no%
top no%,80 : left no%,220 : width no%,300 : font_color no%,0,0,0
no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
top no%,110 : left no%,20 : caption no%,"Né le:"
no% = no% + 1 : edit no% : parent no%,no2% : no_ContactDateNaissance% = no%
top no%,110 : left no%,60 : width no%,80 : text no%,"aaaa/mm/jj" : font_color no%,0,0,0
no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
top no%,110 : left no%,160 : caption no%,"à:"
no% = no% + 1 : edit no% : parent no%,no2% : no_ContactVilleNaissance% = no%
top no%,110 : left no%,180 : width no%,200 : font_color no%,0,0,0
no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
top no%,110 : left no%,400 : caption no%,"Dép."
no% = no% + 1 : edit no% : parent no%,no2% : no_ContactDepartementNaissance% = no%
top no%,110 : left no%,440 : width no%,80 : font_color no%,0,0,0

no% = no% + 1 : container no% : no2% = no% : parent no%,no1%
font_color no%,0,0,255 : caption no%,"Historique" : top no%,155 : left no%,10
width no%,width(no_contact%)-20 : height no%,300 : color no%,220,220,220
no% = no% + 1 : alpha no% : parent no%,no2% : top no%,20 : left no%,15
font_name no%,"Courier" : font_color no%,0,0,0
caption no%,"Ann. M. Nature Date Objet"
no% = no% + 1 : list no% : parent no%,no2% : top no%,40 : left no%,10
width no%,width(no2%)-20 : height no%,height(no2%) - 50
font_name no%,"Courier" : font_color no%,0,0,0 : no_HistoriqueList% = no%
' item_add no%,"2015 12 Commande 2015/12/17 Cartouches" : ' maquette

end_sub

sub GUI_debug()
no% = no% + 1 : list no% : no_debug% = no% : hide no%
top no_debug%,top(no_IndexLIst%)
left no_debug%,left(no_IndexLIst%)
width no_debug%,width(no_IndexLIst%)
height no_debug%,height(no_IndexList%)
end_sub

sub debug()
dim_local ident$
show no_debug%
clear no_debug%
start% = 0
repeat
ident$ = string$(200," ")
start% = dll_call3("GetXmlElementByAddress",XML%,start%+1,adr(ident$))
item_add no_debug%,trim$(ident$)
until start%=0
exit_sub
end_sub

sub initialiser()
caption 0,"Suivi des contacts"
XML% = 0
contacts$ = ""
caption no_StatusText%,"En attente..."
caption no_StatusCount%,"0/0"
end_sub

sub ChargerIndex()
dim_local start%, ident$
if XML%=0 then return

clear no_IndexList%
nombre_contacts% = 0
caption no_StatusCount%,"0/"+str$(nombre_contacts%)
start% = 0 : ' exclure Root
while 1<3 : ' boucle infinie
start% = dll_call4("SelectXmlElementByPath",XML%,start%+1,adr(crit_patronyme$),adr(sep$))
if start%<1 then exit_while
s$ = string$(300," ")
res% = dll_call2("GetXmlData",XML%,adr(s$))
ident$ = trim$(s$)
start% = dll_call4("SelectXmlElementByPath",XML%,start%,adr(crit_prenoms$),adr(sep$))
s$ = string$(300," ")
res% = dll_call2("GetXmlData",XML%,adr(s$))
ident$ = ident$ + ", "+trim$(s$)
nombre_contacts% = nombre_contacts% + 1
item_add no_IndexList%,ident$
end_while
res% = dll_call1("GetXmlTop",XML%)
caption no_StatusCount%,"0/"+str$(nombre_contacts%)
end_sub

sub chercher_patronyme(nom$)
dim_local tmp$, tmp1$
sub_res% = 0
while res%>0 : ' chercher le patronyme
start% = dll_call4("SelectXmlElementByPath",XML%,start%+1,adr(crit_patronyme$),adr(sep$))
if start%<1
caption no_StatusText%,"Erreur de recherche"
message "oups 1: "+str$(start%)
sub_res% = 1
exit_sub
end_if
tmp$ = string$(100," ")
res% = dll_call2("GetXmlData",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
' message "tmp1$="+tmp1$+" tmp$="+tmp$+" nom$="+nom$+" "+crit_patronyme$
if tmp$=nom$ then res% = 0
end_while
if tmp$<>nom$
caption no_StatusText%,"Erreur de recherche"
message "oups 2"
sub_res% = 1
exit_sub
end_if
end_sub

sub chercher_prenoms(nom$,prenom$,aff%)
dim_local item$, pre$
sub_res% = 0
res% = 1
while res%>0 : ' chercher le prénom pour le patronyme trouvé
res% = dll_call1("GetNextXmlSister",XML%)
' message "b "+str$(res%)
if res%>0
item$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(item$))
item$ = trim$(item$)
' message "c "+str$(res%)+" ["+item$+"]"
' if item$="prenoms" then exit_while
end_if
if item$="prenoms"
pre$ = string$(100," ")
res% = dll_call2("GetXmlData",XML%,adr(pre$))
pre$ = trim$(pre$)
' message "d "+str$(res%)+" ["+pre$+"] ["+prenom$+"]"
if pre$=prenom$
if aff%=1
text no_ContactPatronyme%,nom$
text no_ContactPrenoms%,prenom$
end_if
caption no_StatusText%,"Contact sélectionné"
exit_sub
end_if
end_if
end_while
end_sub

sub charger_civilite()
dim_local tmp$
res% = dll_call1("GetXmlParent",XML%)
res% = dll_call1("GetFirstXmlChild",XML%)
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
if tmp$<>"civilite"
while res%>0
res% = dll_call1("GetNextXmlSister",XML%)
if res%<1 then exit_sub
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
if tmp$="civilite"
tmp$ = string$(20," ")
res% = dll_call2("GetXmlData",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
exit_while
end_if
end_while
exit_sub
else
tmp$ = string$(20," ")
res% = dll_call2("GetXmlData",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
end_if
text no_ContactCivilite%,tmp$
end_sub

sub charger_naissance()
dim_local tmp$
while res%>0
res% = dll_call1("GetNextXmlSister",XML%)
if res%<1 then exit_sub
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
if tmp$="naissance"
tmp$ = string$(20," ")
res% = dll_call2("GetXmlData",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
exit_while
end_if
end_while
text no_ContactNaissance%,tmp$
res% = 1
end_sub

sub charger_DateNaissance()
dim_local tmp$
while res%>0
res% = dll_call1("GetNextXmlSister",XML%)
if res%<1 then exit_sub
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
if tmp$="datenaissance"
tmp$ = string$(20," ")
res% = dll_call2("GetXmlData",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
exit_while
end_if
end_while
text no_ContactDateNaissance%,tmp$
end_sub

sub charger_VilleNaissance()
dim_local tmp$
while res%>0
res% = dll_call1("GetNextXmlSister",XML%)
if res%<1 then exit_sub
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
if tmp$="lieunaissance"
res% = dll_call1("GetFirstXmlChild",XML%)
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
while tmp$<>"ville"
res% = dll_call1("GetNextXmlSister",XML%)
tmp$ = string$(20," ")
res% = dll_call2("GetXmlData",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
if tmp$="ville" then exit_while
end_while
tmp$ = string$(20," ")
res% = dll_call2("GetXmlData",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
text no_ContactVilleNaissance%,tmp$
exit_sub
end_if
end_while
end_sub

sub charger_DepartementNaissance()
dim_local tmp$
while res%>0
res% = dll_call1("GetNextXmlSister",XML%)
if res%<1 then exit_sub
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
if tmp$="departement"
tmp$ = string$(20," ")
res% = dll_call2("GetXmlData",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
exit_while
end_if
end_while
text no_ContactDepartementNaissance%,tmp$
end_sub

sub charger_EtatCivil()
charger_civilite()
charger_naissance()
charger_DateNaissance()
charger_VilleNaissance()
charger_DepartementNaissance()
end_sub

sub localiser_Historique()
dim_local tmp$
sub_res% = 1
repeat
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
res% = dll_call1("GetXmlParent",XML%)
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
until trim$(tmp$)="contact"
res% = dll_call1("GetFirstXmlChild",XML%)
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
if tmp$<>"historique"
while res%>0
res% = dll_call1("GetNextXmlSister",XML%)
if res%<1 then exit_sub
tmp$ = string$(20," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
tmp$ = trim$(tmp$)
if tmp$="historique"
sub_res% = 0
exit_sub
end_if
end_while
end_if
end_sub

sub charger_Historique()
dim_local ligne$, a_adr%, a_tmp$, m_adr%, m_tmp$, n_adr%, n_tmp$, d_tmp$, o_tmp$
clear no_HistoriqueList%
localiser_Historique()
if sub_res%=1 then exit_sub : ' pas de historique ?
res% = dll_call1("GetFirstXmlChild",XML%) : ' chercher la première "année"
if res%<1 then exit_sub : ' historique vide ?
a_adr% = dll_call1("GetXmlElementAddress",XML%) : ' prendre l'indexe du premier élément "année"
while a_adr%>0 : ' boucle sur les années
' ici, l'élément actif est une "année" de l'historique
a_tmp$ = string$(4," ")
ligne$ = a_tmp$
res% = dll_call2("GetXmlName",XML%,adr(a_tmp$))
res% = dll_call1("GetFirstXmlChild",XML%) : ' chercher le premier "mois"
if res%>=1
m_adr% = dll_call1("GetXmlElementAddress",XML%) : ' prendre l'indexe du premier élément "mois"
while m_adr%>0 : ' boucle sur les mois d'une année
m_tmp$ = string$(2," ")
res% = dll_call2("GetXmlName",XML%,adr(m_tmp$))

' ici, prendre le détail d'un mois
res% = dll_call1("GetFirstXmlChild",XML%) : ' chercher le premier "détail"
if res%>=1
n_adr% = dll_call1("GetXmlElementAddress",XML%) : ' prendre l'indexe du premier élément "détail"
while n_adr%>0 : ' boucle sur le détail d'un mois
n_tmp$ = string$(100," ")
res% = dll_call2("GetXmlName",XML%,adr(n_tmp$)) : ' prendre la "nature" du "détail"
n_tmp$ = Left$(n_tmp$,10)

' prendre ici les infos du "détail"
res% = dll_call1("GetFirstXmlChild",XML%) : ' chercher la date du "détail"
d_tmp$ = string$(10," ")
res% = dll_call2("GetXmlData",XML%,adr(d_tmp$))
res% = dll_call1("GetNextXmlSister",XML%) : ' chercher "l'objet" du "détail"
o_tmp$ = string$(100," ")
res% = dll_call2("GetXmlData",XML%,adr(o_tmp$))
o_tmp$ = trim$(o_tmp$)

ligne$ = a_tmp$ + " "+ m_tmp$+" "+n_tmp$+" "+d_tmp$+" "+o_tmp$
item_add no_HistoriqueList%,ligne$

res% = dll_call3("GetXmlElementByAddress",XML%,n_adr%,adr(n_tmp$)) : ' relire le détail traité
res% = dll_call1("GetNextXmlSister",XML%) : ' chercher le détail suivant
n_adr% = 0 : ' supposer "pas de détail suivant"
if res%=1 then n_adr% = dll_call1("GetXmlElementAddress",XML%) : ' si, alors on prend l'indice
end_while : ' fin boucle sur le détail d'un mois
end_if

res% = dll_call3("GetXmlElementByAddress",XML%,m_adr%,adr(m_tmp$)) : ' relire le mois traité
res% = dll_call1("GetNextXmlSister",XML%) : ' chercher le mois suivant
m_adr% = 0 : ' supposer "pas de mois suivant dans l'annnée"
if res%=1 then m_adr% = dll_call1("GetXmlElementAddress",XML%) : ' si, alors on prend l'indice
end_while : ' fin boucle sur les mois d'une année
res% = dll_call3("GetXmlElementByAddress",XML%,a_adr%,adr(m_tmp$)) : ' relire l'année traitée
res% = dll_call1("GetNextXmlSister",XML%) : ' chercher l'année suivante
a_adr% = 0 : ' supposer "pas d'année suivante dans l'historique"
if res%=1 then a_adr% = dll_call1("GetXmlElementAddress",XML%) : ' si, alors on prend l'indice
end_if
end_while : ' fin boucle sur les années

end_sub

sub chercher_contact(aff%)
dim_local s$, nom$, prenom$, i%

text no_ContactCivilite%,""
text no_ContactPatronyme%,""
text no_ContactNaissance%,""
text no_contactPrenoms%,""
text no_ContactDateNaissance%,""
text no_ContactVilleNaissance%,""
text no_ContactDepartementNaissance%,""

s$ = item_index$(no_IndexList%)
i% = instr(s$,",")
nom$ = left$(s$,i%-1)
prenom$ = trim$(mid$(s$,i%+1,len(s$)))
' message nom$ + " / " + prenom$
start% = 0
res% = 1

chercher_patronyme(nom$)
if sub_res%=1 then exit_sub
chercher_prenoms(nom$,prenom$,1)
if sub_res%=1 then exit_sub
if aff%=0 then exit_sub

charger_EtatCivil()
charger_Historique()

end_sub

sub supprimer_contact()
dim_local tmp$
chercher_contact(0)
if sub_res%=1 then exit_sub
repeat
res% = dll_call1("GetXmlParent",XML%)
if res%<1 then exit_sub
tmp$ = string$(100," ")
res% = dll_call2("GetXmlName",XML%,adr(tmp$))
until trim$(tmp$)="contact"
res% = dll_call1("DeleteXmlElement",XML%)
item_delete no_IndexList%,item_index(no_IndexList%)
caption no_StatusText%,"Elément supprimé"
end_sub

sub creer_contact()
dim_local tmp$, bad%, item$, old$
bad% = 0
if XML%=0 then exit_sub

if trim$(text$(no_ContactPatronyme%))="" then bad% = 1
if trim$(text$(no_ContactPrenoms%)) ="" then bad% = 1
if bad%=1
caption no_StatusText%,"Patronyme et prénoms sont obligatoires"
exit_sub
end_if

res% = dll_call1("GetXmlTop",XML%)

' N1
tmp$ = "contact"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))

' N2
tmp$ = "id"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = "x"
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))

res% = dll_call1("GetXmlParent",XML%)
' N2
tmp$ = "etatcivil"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))

' N3
tmp$ = "civilite"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = trim$(text$(no_ContactCivilite%))
if len(tmp$)>0
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
end_if

res% = dll_call1("GetXmlParent",XML%)
' N3
tmp$ = "patronyme"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = trim$(text$(no_ContactPatronyme%))
item$ = tmp$
if len(tmp$)>0
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
end_if

res% = dll_call1("GetXmlParent",XML%)
' N3
tmp$ = "naissance"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = trim$(text$(no_ContactNaissance%))
if len(tmp$)>0
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
end_if

res% = dll_call1("GetXmlParent",XML%)
' N3
tmp$ = "prenoms"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = trim$(text$(no_ContactPrenoms%))
if len(tmp$)>0
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
end_if

item$ = item$ + ", " + tmp$
item_add no_IndexList%,item$
nombre_contacts% = nombre_contacts% + 1
caption no_StatusCount%,"0/"+str$(nombre_contacts%)

res% = dll_call1("GetXmlParent",XML%)
' N3
tmp$ = "datenaissance"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = trim$(text$(no_ContactDateNaissance%))
if len(tmp$)>0
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
end_if

res% = dll_call1("GetXmlParent",XML%)
' N3
tmp$ = "lieunaissance"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))

' N4
tmp$ = "ville"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = trim$(text$(no_ContactVilleNaissance%))
if len(tmp$)>0
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
end_if

res% = dll_call1("GetXmlParent",XML%)
' N4
tmp$ = "departement"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = trim$(text$(no_ContactDepartementNaissance%))
if len(tmp$)>0
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
end_if

res% = dll_call1("GetXmlParent",XML%)
' N3

res% = dll_call1("GetXmlParent",XML%)
' N2

res% = dll_call1("GetXmlParent",XML%)
' N2
tmp$ = "contacter"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))

' N3
tmp$ = "telephone"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = "1234567890"
if len(tmp$)>0
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
end_if

res% = dll_call1("GetXmlParent",XML%)
' N3
tmp$ = "mail"
res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
tmp$ = "monmail"
if len(tmp$)>0
old$ = string$(20," ")
res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
end_if
end_sub

nouveau:
if XML%<>0
if message_confirmation_yes_no("La base est modifiée. Voulez-vous la sauvegarder ?")=1
if contacts$=""
filter no_save%,"Fichier XML|*.xml"
s$ = file_name$(no_save%)
if s$="_" then return
if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
contacts$ = s$
end_if
res% = dll_call1("SaveXmlToFile",adr(contacts$))
end_if
end_if
s$ = "<?xml version="+chr$(34)+"1.0"+chr$(34)+" encoding="+chr$(34)+"UTF-8"+chr$(34)+"?>"
res% = dll_call1("LoadXmlFromString",adr(s$))
XML% = res%
contacts$ = ""
caption 0,"Suivi des contacts - <nouveau> *"
modif% = 1
caption no_StatusText%,"Nouvelle base vide"
ChargerIndex()
return

ouvrir:
if XML%<>0
if message_confirmation_yes_no("La base est modifiée. Voulez-vous la sauvegarder ?")=1
if contacts$=""
filter no_save%,"Fichier XML|*.xml"
s$ = file_name$(no_save%)
if s$="_" then return
if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
contacts$ = s$
end_if
res% = dll_call1("SaveXmlToFile",adr(contacts$))
end_if
end_if
res% = dll_call1("FreeXml",XML%)
modif% = 0
filter no_open%,"fichier XML|*.xml"
s$ = file_name$(no_open%)
if s$="_" then return
if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
if file_exists(s$)=0 then return
contacts$ = s$
res% = dll_call1("LoadXmlFromFile",adr(contacts$))
if res%<>0 then XML% = res%
s$ = file_extract_name$(contacts$)
caption 0,"Suivi des contacts - "+s$
caption no_StatusText%,"Base ouverte"
ChargerIndex()
return

sortir:
if modif%=1
if message_confirmation_yes_no("La base est modifiée. Voulez-vous la sauvegarder ?")=1
if contacts$=""
filter no_save%,"Fichier XML|*.xml"
s$ = file_name$(no_save%)
if s$="_" then return
if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
contacts$ = s$
end_if
res% = dll_call1("SaveXmlToFile",adr(contacts$))
end_if
end_if
terminate
return

enregistrer:
modif% = 0
if contacts$=""
filter no_save%,"Fichier XML|*.xml"
s$ = file_name$(no_save%)
if s$="_" then return
if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
contacts$ = s$
end_if
res% = dll_call2("SaveXmlToFile",XML%,adr(contacts$))
s$ = file_extract_name$(contacts$)
caption 0,"Suivi des contacts - "+s$
caption no_StatusText%,"Base enregistrée"
return

enregistrersous:
modif% = 0
filter no_save%,"Fichier XML|*.xml"
s$ = file_name$(no_save%)
if s$="_" then return
if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
contacts$ = s$
res% = dll_call2("SaveXmlToFile",XML%,adr(contacts$))
s$ = file_extract_name$(contacts$)
caption 0,"Suivi des contacts - "+s$
caption no_StatusText%,"Base enregistrée"
return

fermer:
if modif%=1
if message_confirmation_yes_no("La base est modifiée. Voulez-vous la sauvegarder ?")=1
if contacts$=""
filter no_save%,"Fichier XML|*.xml"
s$ = file_name$(no_save%)
if s$="_" then return
if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
contacts$ = s$
end_if
res% = dll_call1("SaveXmlToFile",adr(contacts$))
end_if
end_if
if XML%<>0 then res% = dll_call1("FreeXml",XML%)
XML% = 0
caption 0,"Suivi des contacts"
modif% = 0
caption no_StatusText%,"En attente..."
return

select_contact:
chercher_contact(1)
return

nouveau_contact:
creer_contact()
return

supprimer_contact:
supprimer_contact()
return

Ouvrez le fichier XML par le menu Fichiers\Ouvrir, puis sélectionnés le premier contact...

Sujet: Re: KGF_dll - nouvelles versions Jeu 12 Mar 2015 - 1:53

Testé et OK.

Sujet: Re: KGF_dll - nouvelles versions Jeu 12 Mar 2015 - 19:05

Objet XML:
Voici une évolution du programme de gestion des contacts: toujours avec le même fichier XML, on a maintenant un volet de détail en bas à droite. On procède comme suit:
- charger contacts.xml par le menu Fichiers\Ouvrir
- cliquer sur le premier des deux contacts qui s'affichent dans la liste à gauche
- cliquer sur un des évènements dans l'historique qui s'affiche à droite
==> le volet "détail" est renseigné.

Un clic sur une autre ligne de l'historique modifie les données en bas.

Le bouton "Supprimer" est fonctionnel: il supprime la ligne de détail sélectionnée. Elle disparaît de l'écran, mais également de l'objet TAB. Les deux autres boutons ne sont pas encore fonctionnels.

Code:: ' Contacts_avec_XML.bas

' Ce petit programme implémente un carnet d'adresses à l'aide de l'objet XML.
'
' 1. Pour chaque "contact", on va créer une "fiche" qui est représentée par
' un "noeud" dans le fichier XML.
' 2. Chacun de ces noeuds "contact" contient plusieurs noeuds "fille" qui
' représentent chacun un ensemble logique de données.
' 3. Chacun de ces noeuds "fille" est potentiellement composé d'autres noeuds
' "fille" contenant des informations détaillées de plus bas niveau, etc.
' 4. Un "historique" sera réalisé sous forme d'un noeud "fille" au "contact",
' avec, à son tour, un noeud "fille" par mois, contenant des noeuds "fille"
' pour chaque évènement, qui à leur tour sont décomposés en noeuds "fille"
' décrivant chacun une information de détail pour l'évènement.
' 5. les informations spécifiques sont introduites par un $ pour les éléments
' et les attributs, et un # pour les données. Ceci est géré utomatiquement.
'
' Ceci conduit à la structure suivante:
' Root // noeud virtuel de "racine" créé automatiquement
' $entête // noeud technique contenant l'entête du fichier XML
' contact1 // le nom de ce noeud est l'identification du contact
' $attributs // divers attributs en nombre variable
' $type=client
' ...
' $...
' etatcivil
' civilite
' #mme
' patronyme
' #dupond
' naissance
' #devergne
' prenoms
' #marie hélène
' datenaissance
' #1953/07/23
' lieunaissance
' ville
' #bourges
' departement
' #18
' contacter
' telephone
' #0123456789
' mail
' #mh.dupond@ttest.fr
' ...
' historique
' 2015
' 12
' achat
' date
' #2015/12/17
' objet
' #cartouches
' achat
' date
' #2015/12/03
' objet
' #recharges
' 09
' commande
' date
' #2015/09/23
' objet
' #recharges
' 02
' retour
' date
' #2015/02/19
' objet
' #perceuse
' 2014
' 10
' achat
' date
' #2014/10/04
' objet
' #perceuse
' 08
' achat
' date
' #2014/08/25
' objet
' #huile de chaîne
' 2013
' 11
' commande
' date
' #2013/11/14
' objet
' #poste soudure
' ...
' contactx // le nom de ce noeud est l'identification du contact
' ...
'
' Ceci conduit au fichier XML suivant:
' <?xml version="1.0" encoding="UTF-8"?>
' <contact $type="client" ...$xxx="yyy">
' <id>#1</id>
' <etatcivil>
' <civilite>#mme</civilite>
' <patronyme>#dupond</patronyme>
' <naissance>#devergne</naissance>
' <prenoms>#marie hélène</prenoms>
' <datenaissance>#1953/07/23</datenaissance>
' <lieunaissance>
' <ville>#bourges</ville>
' <departement>#18</departement>
' </lieunaissance>
' </etatcivil>
' <contact>
' <telephone>#0123456789</telephone>
' <mail>#mh.dupond@ttest.fr</mail>
' </contact>
' ...
' <historique>
' <2015>
' <12>
' <achat>
' <date>#2015/12/17</date>
' <obje>#cartouches</objet>
' </achat>
' <achat>
' <date>#2015/12/03</date>
' <objet>#recharges</objet>
' </achat>
' </12>
' <09>
' <commande>
' <date>#2015/09/23</date>
' <objet>#recharges</objet>
' </commande>
' </09>
' <02>
' <retour>
' <date>#2015/02/19</date>
' <objet>#perceuse</objet>
' </retour>
' </02>
' </2015>
' <2014>
' <10>
' <achat>
' <date>#2014/10/04</date>
' <objet>#perceuse</objet>
' </achat>
' </10>
' <08>
' <achat>
' <date>#2014/08/25/date>
' <objet>#huile de chaîne</objet>
' <achat>
' </08>
' </2014>
' <2013>
' <11>
' <commande>
' <date>#2013/11/14</date>
' <objet>#poste soudure</objet>
' </comande>
' </11>
' </2013>
' </historique>
' </contact>
' ...
' <contact $type="fournisseur">
' ...
' </Root>

constantes()

dll_on KGF$

labels()
variables()
menu()
invisibles()
GUI()
initialiser()

end

sub labels()
  label nouveau, ouvrir, sortir, enregistrer, enregistrersous, fermer
  label select_contact, nouveau_contact, supprimer_contact
  label select_detail, modifier_detail, creer_detail, supprimer_detail
end_sub

sub constantes()
  dim KGF$ : KGF$ = "KGF.dll"
  dim dir$ : dir$ = "C:\Users\klausgunther\Documents\Mes projets\Mes projets Delphi\KGF"
  dim crit_patronyme$ : crit_patronyme$ = "Root\contact\etatcivil\patronyme"
  dim crit_prenoms$ : crit_prenoms$ = "Root\contact\etatcivil\prenoms"
  dim sep$ : sep$ = ""
end_sub

sub variables()
  dim contacts$ : ' nom du fichier XML
  dim res%, no%, XML%, modif%, s$, sub_res%, start%, detail_choisi%
  dim no_open%, no_save%, no_StatusBar%, no_StatusText%, no_StatusCount%
  dim no_Index%, no_IndexList%, no_debug%
  dim no_contact%, no_ContactEtatCivil%, no_ContactCivilite%, no_ContactPatronyme%
  dim no_ContactNaissance%, no_ContactPrenoms%, no_ContactDateNaissance%,
  dim no_ContactVilleNaissance%, no_ContactDepartementNaissance%
  dim no_HistoriqueList%
  dim no_DetailNature%, no_DetailDate%, no_DetailObjet%
  dim no_AdrAnnee%, no_AdrMois%, no_AdrNature%, no_AdrDate%, no_AdrObjet%
  dim AdrAnnee%, AdrMois%, AdrNature%, AdrDate%, AdrObjet%

  dim nombre_contacts%
end_sub

sub menu()
  dim_local no1%, no2%
  full_space 0
  no% = 0
  no% = no% + 1 : main_menu no% : no1% = no%
   no% = no% + 1 : sub_menu no% : no2% = no% : parent no%,no1% : caption no%,"Fichiers"
   no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"Nouveau"
   on_click no%,nouveau
   no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"Ouvrir"
   on_click no%,ouvrir
   no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"Enregister"
   on_click no%,enregistrer
   no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"Enregister sous..."
   on_click no%,enregistrersous
   no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"Fermer"
   on_click no%,fermer
   no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"-"
   no% = no% + 1 : sub_menu no% : parent no%,no2% : caption no%,"Sortir"
   on_click no%,sortir

end_sub

sub invisibles()
  no% = no% + 1 : open_dialog no% : no_open% = no%
  no% = no% + 1 : save_dialog no% : no_save% = no%
  no% = no% + 1 : dlist no% : no_AdrAnnee% = no%
  no% = no% + 1 : dlist no% : no_AdrMois% = no%
  no% = no% + 1 : dlist no% : no_AdrNature% = no%
  no% = no% + 1 : dlist no% : no_AdrDate% = no%
  no% = no% + 1 : dlist no% : no_AdrObjet% = no%
end_sub

sub GUI()
  GUI_StatusBar()
  GUI_Index()
  GUI_contact()
  GUI_debug()
end_sub

sub GUI_StatusBar()
  dim_local no1%
  no% = no% + 1 : no1% = no% : panel no% : no_StatusBar% = no%
   height no%,30 : top no%,height(0) - 90 : width no%,width(0)-25
   color no%,220,220,220 : inactive no%
  no% = no% + 1 : alpha no% : parent no%,no1% : no_StatusText% = no%
   left no%,10 : top no%,3 : color no%,255,255,255
  no% = no% + 1 : alpha no% : parent no%,no1% : no_StatusCount% = no%
   left no%,210 : top no%,3 : color no%,255,255,255

end_sub

sub GUI_Index()
  dim_local no1%
  no% = no% + 1 : container no% : no1% = no% : caption no%,"Contacts"
   font_color no%,0,0,255 : no_Index% = no%
   top no%,10 : left no%,10 : width no%,300 : height no%,top(no_StatusBar%)-20
  no% = no% + 1 : list no% : parent no%,no1% : no_IndexList% = no%
   top no%,15 : left no%,10 : width no%,280 : height no%,height(no1%)-100
   on_click no%,select_contact : sort_on no% : font_color no%,0,0,0
  no% = no% + 1 : button no% : parent no%,no1% : caption no%,"Nouveau"
   top no%,top(no_Index%+1)+height(no_Index%+1)+10 : left no%,10
   on_click no%,nouveau_contact
  no% = no% + 1 : button no% : parent no%,no1% : caption no%,"Supprimer"
   top no%,top(no_Index%+1)+height(no_Index%+1)+10 : left no%,110
   on_click no%,supprimer_contact
end_sub

sub GUI_contact()
  dim_local no1%, no2%
  no% = no% + 1 : container no% : no1% = no% : caption no%,"Contact choisi"
   font_color no%,0,0,255 : no_contact% = no%
   top no%,10 : left no%,left(no_index%)+width(no_index%)+10
   width no%,600 : height no%,top(no_StatusBar%)-20 : no_ContactEtatCivil% = no%

  no% = no% + 1 : container no% : no2% = no% : parent no%,no1%
   font_color no%,0,0,255 : caption no%,"Etat civil" : top no%,20 : left no%,10
   width no%,width(no_contact%)-20 : height no%,140 : color no%,220,220,220
  no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
   top no%,20 : left no%,10 : caption no%,"Civilité:"
  no% = no% + 1 : edit no% : parent no%,no2% : no_ContactCivilite% = no%
   top no%,20 : left no%,50 : width no%,50 : font_color no%,0,0,0
  no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
   top no%,20 : left no%,120 : caption no%,"Patronyme:"
  no% = no% + 1 : edit no% : parent no%,no2% : no_ContactPatronyme% = no%
   top no%,20 : left no%,220 : width no%,300 : font_color no%,0,0,0
  no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
   top no%,50 : left no%,120 : caption no%,"Nom de naissance:"
  no% = no% + 1 : edit no% : parent no%,no2% : no_ContactNaissance% = no%
   top no%,50 : left no%,220 : width no%,300 : font_color no%,0,0,0
  no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
   top no%,80 : left no%,120 : caption no%,"Prénoms:"
  no% = no% + 1 : edit no% : parent no%,no2% : no_ContactPrenoms% = no%
   top no%,80 : left no%,220 : width no%,300 : font_color no%,0,0,0
  no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
   top no%,110 : left no%,20 : caption no%,"Né le:"
  no% = no% + 1 : edit no% : parent no%,no2% : no_ContactDateNaissance% = no%
   top no%,110 : left no%,60 : width no%,80 : text no%,"aaaa/mm/jj" : font_color no%,0,0,0
  no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
   top no%,110 : left no%,160 : caption no%,"à:"
  no% = no% + 1 : edit no% : parent no%,no2% : no_ContactVilleNaissance% = no%
   top no%,110 : left no%,180 : width no%,200 : font_color no%,0,0,0
  no% = no% + 1 : alpha no% : parent no%,no2% : font_color no%,0,0,0
   top no%,110 : left no%,400 : caption no%,"Dép."
  no% = no% + 1 : edit no% : parent no%,no2% : no_ContactDepartementNaissance% = no%
   top no%,110 : left no%,440 : width no%,80 : font_color no%,0,0,0

  no% = no% + 1 : container no% : no2% = no% : parent no%,no1%
   font_color no%,0,0,255 : caption no%,"Historique" : top no%,155 : left no%,10
   width no%,width(no_contact%)-20 : height no%,300 : color no%,220,220,220
  no% = no% + 1 : alpha no% : parent no%,no2% : top no%,20 : left no%,15
   font_name no%,"Courier" : font_color no%,0,0,0
   caption no%,"Ann. M. Nature Date Objet"
  no% = no% + 1 : list no% : parent no%,no2% : top no%,40 : left no%,10
   width no%,width(no2%)-20 : height no%,height(no2%) - 50
   font_name no%,"Courier" : font_color no%,0,0,0 : no_HistoriqueList% = no%
   on_click no%,select_detail
' item_add no%,"2015 12 Commande 2015/12/17 Cartouches" : ' maquette

  no% = no% + 1 : container no% : parent no%,no1%
   font_color no%,0,0,255 : caption no%,"Evènement" : top no%,450 : left no%,10
   height no%,height(0)-top(no2%)-height(no2%)-110 : color no%,220,220,220
   width no%,width(no_contact%)-20 : no2% = no%
  no% = no% + 1 : alpha no% : parent no%,no2% : caption no%,"Nature:"
   top no%,20 : left no%,10 : font_color no%,0,0,0
  no% = no% + 1 : edit no% : parent no%,no2% : width no%,100
   top no%,20 : left no%,60 : font_color no%,0,0,0 : no_DetailNature% = no%
  no% = no% + 1 : alpha no% : parent no%,no2% : caption no%,"Date:"
   top no%,20 : left no%,210 : font_color no%,0,0,0
  no% = no% + 1 : edit no% : parent no%,no2% : width no%,80
   top no%,20 : left no%,260 : font_color no%,0,0,0 : no_DetailDate% = no%
   text no%,"aaaa/mm/jj"
  no% = no% + 1 : alpha no% : parent no%,no2% : caption no%,"Objet:"
   top no%,50 : left no%,10 : font_color no%,0,0,0
  no% = no% + 1 : edit no% : parent no%,no2% : width no%,width(no2%)-70
   top no%,50 : left no%,60 : font_color no%,0,0,0 : no_DetailObjet% = no%
  no% = no% + 1 : button no% : parent no%,no2% : caption no%,"Modifier"
   top no%,80 : left no%,60 : font_color no%,0,0,0 : on_click no%,modifier_detail
  no% = no% + 1 : button no% : parent no%,no2% : caption no%,"Créer"
   top no%,80 : left no%,160 : font_color no%,0,0,0 : on_click no%,creer_detail
  no% = no% + 1 : button no% : parent no%,no2% : caption no%,"Supprimer"
   top no%,80 : left no%,260 : font_color no%,0,0,0 : on_click no%,supprimer_detail
end_sub

sub GUI_debug()
  no% = no% + 1 : list no% : no_debug% = no% : hide no%
  top no_debug%,top(no_IndexLIst%)
  left no_debug%,left(no_IndexLIst%)
  width no_debug%,width(no_IndexLIst%)
  height no_debug%,height(no_IndexList%)
end_sub

sub debug()
  dim_local ident$
  show no_debug%
  clear no_debug%
  start% = 0
  repeat
   ident$ = string$(200," ")
   start% = dll_call3("GetXmlElementByAddress",XML%,start%+1,adr(ident$))
   item_add no_debug%,trim$(ident$)
  until start%=0
  exit_sub
end_sub

sub initialiser()
  caption 0,"Suivi des contacts"
  XML% = 0
  contacts$ = ""
  caption no_StatusText%,"En attente..."
  caption no_StatusCount%,"0/0"
end_sub

sub ChargerIndex()
  dim_local start%, ident$
  if XML%=0 then return

  nombre_contacts% = 0
  caption no_StatusCount%,"0/"+str$(nombre_contacts%)
  start% = 0 : ' exclure Root
  while 1<3 : ' boucle infinie
   start% = dll_call4("SelectXmlElementByPath",XML%,start%+1,adr(crit_patronyme$),adr(sep$))
   if start%<1 then exit_while
   s$ = string$(300," ")
   res% = dll_call2("GetXmlData",XML%,adr(s$))
   ident$ = trim$(s$)
   start% = dll_call4("SelectXmlElementByPath",XML%,start%,adr(crit_prenoms$),adr(sep$))
   s$ = string$(300," ")
   res% = dll_call2("GetXmlData",XML%,adr(s$))
   ident$ = ident$ + ", "+trim$(s$)
   nombre_contacts% = nombre_contacts% + 1
   item_add no_IndexList%,ident$
  end_while
  res% = dll_call1("GetXmlTop",XML%)
  caption no_StatusCount%,"0/"+str$(nombre_contacts%)
end_sub

sub chercher_patronyme(nom$)
  dim_local tmp$, tmp1$
   sub_res% = 0
   while res%>0 : ' chercher le patronyme
   start% = dll_call4("SelectXmlElementByPath",XML%,start%+1,adr(crit_patronyme$),adr(sep$))
   if start%<1
   caption no_StatusText%,"Erreur de recherche"
   message "oups 1: "+str$(start%)
   sub_res% = 1
   exit_sub
   end_if
   tmp$ = string$(100," ")
   res% = dll_call2("GetXmlData",XML%,adr(tmp$))
   tmp$ = trim$(tmp$)
' message "tmp1$="+tmp1$+" tmp$="+tmp$+" nom$="+nom$+" "+crit_patronyme$
   if tmp$=nom$ then res% = 0
   end_while
   if tmp$<>nom$
   caption no_StatusText%,"Erreur de recherche"
   message "oups 2"
   sub_res% = 1
   exit_sub
   end_if
end_sub

sub chercher_prenoms(nom$,prenom$,aff%)
  dim_local item$, pre$
   sub_res% = 0
   res% = 1
   while res%>0 : ' chercher le prénom pour le patronyme trouvé
   res% = dll_call1("GetNextXmlSister",XML%)
' message "b "+str$(res%)
   if res%>0
   item$ = string$(20," ")
   res% = dll_call2("GetXmlName",XML%,adr(item$))
   item$ = trim$(item$)
' message "c "+str$(res%)+" ["+item$+"]"
' if item$="prenoms" then exit_while
   end_if
   if item$="prenoms"
   pre$ = string$(100," ")
   res% = dll_call2("GetXmlData",XML%,adr(pre$))
   pre$ = trim$(pre$)
' message "d "+str$(res%)+" ["+pre$+"] ["+prenom$+"]"
   if pre$=prenom$
   if aff%=1
   text no_ContactPatronyme%,nom$
   text no_ContactPrenoms%,prenom$
   end_if
   caption no_StatusText%,"Contact sélectionné"
   exit_sub
   end_if
   end_if
   end_while
end_sub

sub charger_civilite()
  dim_local tmp$
  res% = dll_call1("GetXmlParent",XML%)
  res% = dll_call1("GetFirstXmlChild",XML%)
  tmp$ = string$(20," ")
  res% = dll_call2("GetXmlName",XML%,adr(tmp$))
  tmp$ = trim$(tmp$)
  if tmp$<>"civilite"
   while res%>0
   res% = dll_call1("GetNextXmlSister",XML%)
   if res%<1 then exit_sub
   tmp$ = string$(20," ")
   res% = dll_call2("GetXmlName",XML%,adr(tmp$))
   tmp$ = trim$(tmp$)
   if tmp$="civilite"
   tmp$ = string$(20," ")
   res% = dll_call2("GetXmlData",XML%,adr(tmp$))
   tmp$ = trim$(tmp$)
   exit_while
   end_if
   end_while
   exit_sub
  else
   tmp$ = string$(20," ")
   res% = dll_call2("GetXmlData",XML%,adr(tmp$))
   tmp$ = trim$(tmp$)
  end_if
  text no_ContactCivilite%,tmp$
end_sub

sub charger_naissance()
  dim_local tmp$
  while res%>0
   res% = dll_call1("GetNextXmlSister",XML%)
   if res%<1 then exit_sub
   tmp$ = string$(20," ")
   res% = dll_call2("GetXmlName",XML%,adr(tmp$))
   tmp$ = trim$(tmp$)
   if tmp$="naissance"
   tmp$ = string$(20," ")
   res% = dll_call2("GetXmlData",XML%,adr(tmp$))
   tmp$ = trim$(tmp$)
   exit_while
   end_if
  end_while
  text no_ContactNaissance%,tmp$
  res% = 1
end_sub

sub charger_DateNaissance()
  dim_local tmp$
  while res%>0
   res% = dll_call1("GetNextXmlSister",XML%)
   if res%<1 then exit_sub
   tmp$ = string$(20," ")
   res% = dll_call2("GetXmlName",XML%,adr(tmp$))
   tmp$ = trim$(tmp$)
   if tmp$="datenaissance"
   tmp$ = string$(20," ")
   res% = dll_call2("GetXmlData",XML%,adr(tmp$))
   tmp$ = trim$(tmp$)
   exit_while
   end_if
  end_while
  text no_ContactDateNaissance%,tmp$
end_sub

sub charger_VilleNaissance()
  dim_local tmp$
  while res%>0
   res% = dll_call1("GetNextXmlSister",XML%)
   if res%<1 then exit_sub
   tmp$ = string$(20," ")
   res% = dll_call2("GetXmlName",XML%,adr(tmp$))
   tmp$ = trim$(tmp$)
   if tmp$="lieunaissance"
   res% = dll_call1("GetFirstXmlChild",XML%)
   tmp$ = string$(20," ")
   res% = dll_call2("GetXmlName",XML%,adr(tmp$))
   tmp$ = trim$(tmp$)
   while tmp$<>"ville"
   res% = dll_call1("GetNextXmlSister",XML%)
   tmp$ = string$(20," ")
   res% = dll_call2("GetXmlData",XML%,adr(tmp$))
   tmp$ = trim$(tmp$)
   if tmp$="ville" then exit_while
   end_while
   tmp$ = string$(20," ")
   res% = dll_call2("GetXmlData",XML%,adr(tmp$))
   tmp$ = trim$(tmp$)
   text no_ContactVilleNaissance%,tmp$
   exit_sub
   end_if
  end_while
end_sub

sub charger_DepartementNaissance()
  dim_local tmp$
  while res%>0
   res% = dll_call1("GetNextXmlSister",XML%)
   if res%<1 then exit_sub
   tmp$ = string$(20," ")
   res% = dll_call2("GetXmlName",XML%,adr(tmp$))
   tmp$ = trim$(tmp$)
   if tmp$="departement"
   tmp$ = string$(20," ")
   res% = dll_call2("GetXmlData",XML%,adr(tmp$))
   tmp$ = trim$(tmp$)
   exit_while
   end_if
  end_while
  text no_ContactDepartementNaissance%,tmp$
end_sub

sub charger_EtatCivil()
  charger_civilite()
  charger_naissance()
  charger_DateNaissance()
  charger_VilleNaissance()
  charger_DepartementNaissance()
end_sub

sub localiser_Historique()
  dim_local tmp$
  sub_res% = 1
  repeat
   tmp$ = string$(20," ")
   res% = dll_call2("GetXmlName",XML%,adr(tmp$))
   res% = dll_call1("GetXmlParent",XML%)
   tmp$ = string$(20," ")
   res% = dll_call2("GetXmlName",XML%,adr(tmp$))
  until trim$(tmp$)="contact"
  res% = dll_call1("GetFirstXmlChild",XML%)
  tmp$ = string$(20," ")
  res% = dll_call2("GetXmlName",XML%,adr(tmp$))
  tmp$ = trim$(tmp$)
  if tmp$<>"historique"
   while res%>0
   res% = dll_call1("GetNextXmlSister",XML%)
   if res%<1 then exit_sub
   tmp$ = string$(20," ")
   res% = dll_call2("GetXmlName",XML%,adr(tmp$))
   tmp$ = trim$(tmp$)
   if tmp$="historique"
   sub_res% = 0
   exit_sub
   end_if
   end_while
  end_if
end_sub

sub charger_Historique()
  dim_local ligne$, a_adr%, a_tmp$, m_adr%, m_tmp$, n_adr%, n_tmp$
  dim_local d_adr%, d_tmp$, o_adr%, o_tmp$
  clear no_HistoriqueList%
  localiser_Historique()
  clear no_AdrAnnee%
  clear no_AdrMois%
  clear no_AdrNature%
  clear no_AdrDate%
  clear no_AdrObjet%
  if sub_res%=1 then exit_sub : ' pas de historique ?
  res% = dll_call1("GetFirstXmlChild",XML%) : ' chercher la première "année"
  if res%<1 then exit_sub : ' historique vide ?
  a_adr% = dll_call1("GetXmlElementAddress",XML%) : ' prendre l'indexe du premier élément "année"
  while a_adr%>0 : ' boucle sur les années
   ' ici, l'élément actif est une "année" de l'historique
   a_tmp$ = string$(4," ")
   res% = dll_call2("GetXmlName",XML%,adr(a_tmp$))
   res% = dll_call1("GetFirstXmlChild",XML%) : ' chercher le premier "mois"
   if res%>=1
   m_adr% = dll_call1("GetXmlElementAddress",XML%) : ' prendre l'indexe du premier élément "mois"
   while m_adr%>0 : ' boucle sur les mois d'une année
   m_tmp$ = string$(2," ")
   res% = dll_call2("GetXmlName",XML%,adr(m_tmp$))

   ' ici, prendre le détail d'un mois
   res% = dll_call1("GetFirstXmlChild",XML%) : ' chercher le premier "détail"
   if res%>=1
   n_adr% = dll_call1("GetXmlElementAddress",XML%) : ' prendre l'indexe du premier élément "détail"
   while n_adr%>0 : ' boucle sur le détail d'un mois
   n_tmp$ = string$(100," ")
   res% = dll_call2("GetXmlName",XML%,adr(n_tmp$)) : ' prendre la "nature" du "détail"
   n_tmp$ = Left$(n_tmp$,10)

   ' prendre ici les infos du "détail"
   res% = dll_call1("GetFirstXmlChild",XML%) : ' chercher la date du "détail"
   d_tmp$ = string$(10," ")
   res% = dll_call2("GetXmlData",XML%,adr(d_tmp$))
   d_adr% = dll_call1("GetXmlElementAddress",XML%) : ' prendre l'indexe de la 'date"
   res% = dll_call1("GetNextXmlSister",XML%) : ' chercher "l'objet" du "détail"
   o_tmp$ = string$(100," ")
   res% = dll_call2("GetXmlData",XML%,adr(o_tmp$))
   o_adr% = dll_call1("GetXmlElementAddress",XML%) : ' prendre l'indexe de "l'objet"
   o_tmp$ = trim$(o_tmp$)

   ligne$ = a_tmp$ + " "+ m_tmp$+" "+n_tmp$+" "+d_tmp$+" "+o_tmp$
   item_add no_HistoriqueList%,ligne$
   item_add no_AdrAnnee%, str$(a_adr%)
   item_add no_AdrMois%, str$(m_adr%)
   item_add no_AdrNature%, str$(n_adr%)
   item_add no_AdrDate%, str$(d_adr%)
   item_add no_AdrObjet%, str$(o_adr%)

   res% = dll_call3("GetXmlElementByAddress",XML%,n_adr%,adr(n_tmp$)) : ' relire le détail traité
   res% = dll_call1("GetNextXmlSister",XML%) : ' chercher le détail suivant
   n_adr% = 0 : ' supposer "pas de détail suivant"
   if res%=1 then n_adr% = dll_call1("GetXmlElementAddress",XML%) : ' si, alors on prend l'indice
   end_while : ' fin boucle sur le détail d'un mois
   end_if

   res% = dll_call3("GetXmlElementByAddress",XML%,m_adr%,adr(m_tmp$)) : ' relire le mois traité
   res% = dll_call1("GetNextXmlSister",XML%) : ' chercher le mois suivant
   m_adr% = 0 : ' supposer "pas de mois suivant dans l'annnée"
   if res%=1 then m_adr% = dll_call1("GetXmlElementAddress",XML%) : ' si, alors on prend l'indice
   end_while : ' fin boucle sur les mois d'une année
   res% = dll_call3("GetXmlElementByAddress",XML%,a_adr%,adr(m_tmp$)) : ' relire l'année traitée
   res% = dll_call1("GetNextXmlSister",XML%) : ' chercher l'année suivante
   a_adr% = 0 : ' supposer "pas d'année suivante dans l'historique"
   if res%=1 then a_adr% = dll_call1("GetXmlElementAddress",XML%) : ' si, alors on prend l'indice
   end_if
  end_while : ' fin boucle sur les années


end_sub

sub chercher_contact(aff%)
  dim_local s$, nom$, prenom$, i%

  text no_ContactCivilite%,""
  text no_ContactPatronyme%,""
  text no_ContactNaissance%,""
  text no_contactPrenoms%,""
  text no_ContactDateNaissance%,""
  text no_ContactVilleNaissance%,""
  text no_ContactDepartementNaissance%,""
  text no_DetailNature%,""
  text no_DetailDate%,"aaaa/mm/jj"
  text no_DetailObjet%,""
  detail_choisi% = 0

  s$ = item_index$(no_IndexList%)
  i% = instr(s$,",")
  nom$ = left$(s$,i%-1)
  prenom$ = trim$(mid$(s$,i%+1,len(s$)))
' message nom$ + " / " + prenom$
  start% = 0
  res% = 1

  chercher_patronyme(nom$)
  if sub_res%=1 then exit_sub
  chercher_prenoms(nom$,prenom$,1)
  if sub_res%=1 then exit_sub
  if aff%=0 then exit_sub

  charger_EtatCivil()
  charger_Historique()

end_sub

sub supprimer_contact()
  dim_local tmp$
  chercher_contact(0)
  if sub_res%=1 then exit_sub
  repeat
   res% = dll_call1("GetXmlParent",XML%)
   if res%<1 then exit_sub
   tmp$ = string$(100," ")
   res% = dll_call2("GetXmlName",XML%,adr(tmp$))
  until trim$(tmp$)="contact"
  res% = dll_call1("DeleteXmlElement",XML%)
  item_delete no_IndexList%,item_index(no_IndexList%)
  caption no_StatusText%,"Elément supprimé"
end_sub

sub creer_contact()
  dim_local tmp$, bad%, item$, old$
  bad% = 0
  if XML%=0 then exit_sub

  if trim$(text$(no_ContactPatronyme%))="" then bad% = 1
  if trim$(text$(no_ContactPrenoms%)) ="" then bad% = 1
  if bad%=1
   caption no_StatusText%,"Patronyme et prénoms sont obligatoires"
   exit_sub
  end_if

  res% = dll_call1("GetXmlTop",XML%)

  ' N1
  tmp$ = "contact"
  res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))

   ' N2
   tmp$ = "id"
   res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
   tmp$ = "x"
   old$ = string$(20," ")
   res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))

  res% = dll_call1("GetXmlParent",XML%)
   ' N2
   tmp$ = "etatcivil"
   res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))

   ' N3
   tmp$ = "civilite"
   res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
   tmp$ = trim$(text$(no_ContactCivilite%))
   if len(tmp$)>0
   old$ = string$(20," ")
   res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
   end_if

   res% = dll_call1("GetXmlParent",XML%)
   ' N3
   tmp$ = "patronyme"
   res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
   tmp$ = trim$(text$(no_ContactPatronyme%))
   item$ = tmp$
   if len(tmp$)>0
   old$ = string$(20," ")
   res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
   end_if

   res% = dll_call1("GetXmlParent",XML%)
   ' N3
   tmp$ = "naissance"
   res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
   tmp$ = trim$(text$(no_ContactNaissance%))
   if len(tmp$)>0
   old$ = string$(20," ")
   res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
   end_if

   res% = dll_call1("GetXmlParent",XML%)
   ' N3
   tmp$ = "prenoms"
   res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
   tmp$ = trim$(text$(no_ContactPrenoms%))
   if len(tmp$)>0
   old$ = string$(20," ")
   res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
   end_if

   item$ = item$ + ", " + tmp$
   item_add no_IndexList%,item$
   nombre_contacts% = nombre_contacts% + 1
   caption no_StatusCount%,"0/"+str$(nombre_contacts%)

   res% = dll_call1("GetXmlParent",XML%)
   ' N3
   tmp$ = "datenaissance"
   res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
   tmp$ = trim$(text$(no_ContactDateNaissance%))
   if len(tmp$)>0
   old$ = string$(20," ")
   res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
   end_if

   res% = dll_call1("GetXmlParent",XML%)
   ' N3
   tmp$ = "lieunaissance"
   res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))

   ' N4
   tmp$ = "ville"
   res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
   tmp$ = trim$(text$(no_ContactVilleNaissance%))
   if len(tmp$)>0
   old$ = string$(20," ")
   res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
   end_if

   res% = dll_call1("GetXmlParent",XML%)
   ' N4
   tmp$ = "departement"
   res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
   tmp$ = trim$(text$(no_ContactDepartementNaissance%))
   if len(tmp$)>0
   old$ = string$(20," ")
   res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
   end_if

   res% = dll_call1("GetXmlParent",XML%)
   ' N3

   res% = dll_call1("GetXmlParent",XML%)
   ' N2

  res% = dll_call1("GetXmlParent",XML%)
   ' N2
   tmp$ = "contacter"
   res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))

   ' N3
   tmp$ = "telephone"
   res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
   tmp$ = "1234567890"
   if len(tmp$)>0
   old$ = string$(20," ")
   res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
   end_if

   res% = dll_call1("GetXmlParent",XML%)
   ' N3
   tmp$ = "mail"
   res% = dll_call3("AddXmlElement",XML%,3,adr(tmp$))
   tmp$ = "monmail"
   if len(tmp$)>0
   old$ = string$(20," ")
   res% = dll_call3("SetXmlData",XML%,adr(old$),adr(tmp$))
   end_if
end_sub

sub afficher_detail()
  dim_local s$, d_nature$, d_date$, d_objet$
  s$ = item_index$(no_HistoriqueList%)
' no_DetailNature%, no_DetailDate%, no_DetailObjet%
' 2015 09 commande 2015/09/23 recharges
  d_nature$ = mid$(s$,9,10)
  d_date$ = Mid$(s$,20,10)
  d_objet$= mid$(s$,31,len(s$))
  text no_DetailNature%,d_nature$
  text no_DetailDate%,d_date$
  text no_DetailObjet%,d_objet$
  detail_choisi% = 1
end_sub

sub modifier_detail()
  if detail_choisi%=0 then exit_sub
  ' reste à implémenter...
  message "Pas encore implémenté"
  exit_sub
  supprimer_detail()
  creer_detail()
end_sub

sub creer_detail()
  dim_local s$, annee$, mois$, jour$, ind%, a%, a$, s1$, i%
  if detail_choisi%=0 then exit_sub
  s$ = text$(no_DetailDate%)
  annee$ = left$(s$,4)
  mois$ = mid$(s$,6,2)
  jour$ = right$(s$,2)
  ind% = item_index(no_HistoriqueList%)
  ' reste à implémenter...
  message "Pas encore implémenté"
end_sub

sub supprimer_detail()
  dim_local ind%, adr%, s$
  if detail_choisi%=0 then exit_sub
  if detail_choisi%=0 then exit_sub
  ind% = item_index(no_HistoriqueList%)
  adr% = val(item_read$(no_AdrDate%,ind%))
  s$ = string$(20," ")
  res% = dll_call3("GetXmlElementByAddress",XML%,adr%,adr(s$))
  res% = dll_call1("GetXmlParent",XML%)
  s$ = string$(30," ")
  res% = dll_call2("GetXmlName",XML%,adr(s$))
  res% = dll_call1("DeleteXmlElement",XML%)
  item_delete no_HistoriqueList%,ind%
  item_delete no_AdrAnnee%,ind%
  item_delete no_AdrMois%,ind%
  item_delete no_AdrNature%,ind%
  item_delete no_AdrDate%,ind%
  item_delete no_AdrObjet%,ind%
if modif%=0
caption 0,caption(0) + " *"
modif% = 1
end_if
end_sub

nouveau:
  if XML%<>0
   if message_confirmation_yes_no("La base est modifiée. Voulez-vous la sauvegarder ?")=1
   if contacts$=""
   filter no_save%,"Fichier XML|*.xml"
   s$ = file_name$(no_save%)
   if s$="_" then return
   if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
   contacts$ = s$
   end_if
   res% = dll_call1("SaveXmlToFile",adr(contacts$))
   end_if
  end_if
  s$ = "<?xml version="+chr$(34)+"1.0"+chr$(34)+" encoding="+chr$(34)+"UTF-8"+chr$(34)+"?>"
  res% = dll_call1("LoadXmlFromString",adr(s$))
  XML% = res%
  contacts$ = ""
  caption 0,"Suivi des contacts - <nouveau> *"
  modif% = 1
  caption no_StatusText%,"Nouvelle base vide"
  ChargerIndex()
  return

ouvrir:
  if XML%<>0
   if message_confirmation_yes_no("La base est modifiée. Voulez-vous la sauvegarder ?")=1
   if contacts$=""
   filter no_save%,"Fichier XML|*.xml"
   s$ = file_name$(no_save%)
   if s$="_" then return
   if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
   contacts$ = s$
   end_if
   res% = dll_call1("SaveXmlToFile",adr(contacts$))
   end_if
  end_if
  res% = dll_call1("FreeXml",XML%)
  modif% = 0
  filter no_open%,"fichier XML|*.xml"
  s$ = file_name$(no_open%)
  if s$="_" then return
  if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
  if file_exists(s$)=0 then return
  contacts$ = s$
  res% = dll_call1("LoadXmlFromFile",adr(contacts$))
  if res%<>0 then XML% = res%
  s$ = file_extract_name$(contacts$)
  caption 0,"Suivi des contacts - "+s$
  caption no_StatusText%,"Base ouverte"
  ChargerIndex()
  return

sortir:
  if modif%=1
   if message_confirmation_yes_no("La base est modifiée. Voulez-vous la sauvegarder ?")=1
   if contacts$=""
   filter no_save%,"Fichier XML|*.xml"
   s$ = file_name$(no_save%)
   if s$="_" then return
   if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
   contacts$ = s$
   end_if
   res% = dll_call1("SaveXmlToFile",adr(contacts$))
   end_if
  end_if
  terminate
  return

enregistrer:
  modif% = 0
  if contacts$=""
   filter no_save%,"Fichier XML|*.xml"
   s$ = file_name$(no_save%)
   if s$="_" then return
   if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
   contacts$ = s$
  end_if
  res% = dll_call2("SaveXmlToFile",XML%,adr(contacts$))
  s$ = file_extract_name$(contacts$)
  caption 0,"Suivi des contacts - "+s$
  caption no_StatusText%,"Base enregistrée"
  return

enregistrersous:
  modif% = 0
  filter no_save%,"Fichier XML|*.xml"
  s$ = file_name$(no_save%)
  if s$="_" then return
  if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
  contacts$ = s$
  res% = dll_call2("SaveXmlToFile",XML%,adr(contacts$))
  s$ = file_extract_name$(contacts$)
  caption 0,"Suivi des contacts - "+s$
  caption no_StatusText%,"Base enregistrée"
  return

fermer:
  if modif%=1
   if message_confirmation_yes_no("La base est modifiée. Voulez-vous la sauvegarder ?")=1
   if contacts$=""
   filter no_save%,"Fichier XML|*.xml"
   s$ = file_name$(no_save%)
   if s$="_" then return
   if lower$(right$(s$,4))<>".xml" then s$ = s$ + ".xml"
   contacts$ = s$
   end_if
   res% = dll_call1("SaveXmlToFile",adr(contacts$))
   end_if
  end_if
  if XML%<>0 then res% = dll_call1("FreeXml",XML%)
  XML% = 0
  caption 0,"Suivi des contacts"
  modif% = 0
  caption no_StatusText%,"En attente..."
  return

select_contact:
  chercher_contact(1)
  return

nouveau_contact:
  creer_contact()
  return

supprimer_contact:
  supprimer_contact()
  return

select_detail:
  afficher_detail()
  return

modifier_detail:
  valider_detail()
  return

creer_detail:
  creer_detail()
  return

supprimer_detail:
  supprimer_detail()
  return

On commence à voir la gestion des arborescences en XML ?

Sujet: re Dim 15 Mar 2015 - 16:11

Klaus,
On_change ne fonctionne pas sur un "scrollBar" attaché à un onglet.

Sujet: Re: KGF_dll - nouvelles versions Dim 15 Mar 2015 - 16:34

Oui. Même sans le ON_CHANGE, le SCROLL_BAR ne marche pas dans un de mes onglets.

Je pense que je vais attendre la réalisation de Jack - ça rend mon TabObject obsolete.

Sujet: RE Dim 15 Mar 2015 - 17:15

Je serai toi, j' attendrai un peu car Jack ne nous permet pas les pictogrammes dans ses objets
et cela les rend fades...

Je commence à bien apprécier cet objet Tab, moi... Sad

Regardes mon PPE vs4, il est pas plus joli avec des pictogrammes dans les onglets
imagines le sans, cela ferait année logiciel des années 1980, ce serait dommage, non ?

A moins que tu aies une solution pour injecter des pictogrammes dans les objets de Jack... tongue

Sujet: Re: KGF_dll - nouvelles versions Dim 15 Mar 2015 - 19:14

Bien sûr que c'est beau ! Je suis en train de chercher une solution...

Sujet: Re: KGF_dll - nouvelles versions Lun 16 Mar 2015 - 1:08

Nouvelle version:
KGF.dll V4.47 du 16/03/2015

Nouveautés:
nouvelle fonction: GetSelectedGridText
nouvelle fonction: GetSelectedGridIndexes

Modules modifiés:
KGF.dll

Les sources et la doc seront mis à jour ultérieurement.

Cette fonction retourne le texte sélectionné dans un objet GRID de Panoramic. Le format d'appel est le suivant:

Code:: res% = dll_call4("GetSelectedGridText",object_internal(grid%),adr(sepcel$),adr(seplin$),adr(txt$))

res% = -1 en cas d'erreur ou 0 si réussite
grid% = numéro d'objet d'un GRID Panoramic
sepcel$ = chaîne de caractères servant de séparation entre cellules (exemple: sepcel$ = "\")
seplin$ = chaîne de caractères servant de séparation entre lignes(exemple: seplin$ = chr$(13)+chr$(10) )
txt$ = chaîne de caractères recevant le texte sélectionné dans un GRID

Code:: res% = dll_call3("GetSelectedGridIndexes",object_internal(grid%),adr(x1%),adr(y1%),adr(x2%),adr(y2%))

res% = -1 en cas d'erreur ou 0 si réussite
grid% = numéro d'objet d'un GRID Panoramic
x1%,y1% = coordonnées du coin en haut à gauche de la sélection
x2%,y2% = coordonnées du coin en bas à droite de la sélection

Le texte sélectionné représente un rectangle de cellules. Cette fonction retourne le texte de toutes les cellules sélectionnées, ligne par ligne, séparées par le séparateur.

Programme de démo:

Code:: ' demo_GetSelectedGridText.bas
label clic
dim s$, res%, sepcel$, seplin$, x1%, y1%, x2%, y2%
grid 1
grid_write 1,2,2,"aaa"
grid_write 1,2,3,"bbb"
grid_write 1,3,3,"ccc"
on_click 1,clic
dll_on "KGF.dll"

end

clic:
s$ = string$(255," ")
sepcel$ = "\"
seplin$ = chr$(13)+chr$(10)
res% = DLL_call4("GetSelectedGridText",object_internal(1),adr(sepcel$), adr(seplin$),adr(s$))
s$ = trim$(s$)
message s$
res% = DLL_call5("GetSelectedGridIndexes",object_internal(1),adr(x1%),adr(y1%),adr(x2%),adr(y2%))
message "Rectangle: ("+str$(x1%)+","+str$(y1%)+") --> ("+str$(x2%)+","+str$(y2%)+")"
return

Sujet: Re: KGF_dll - nouvelles versions Lun 16 Mar 2015 - 1:38

Testé et OK.

Sujet: Re: KGF_dll - nouvelles versions Lun 16 Mar 2015 - 2:29

Je viens de rajouter une nouvelle fonction à la même version, je l'ai documentée dans mon post ci-dessus et j'ai adapté le programme de démo. Cette fonction retourne 4 valeurs numériques représentant les coordonnées du rectangle sélectionné. Cela a son intérêt aussi...

Sujet: re Lun 16 Mar 2015 - 10:10

Je viens de lancer PPE_Vs2 pour mettre à jour la dll
et j' ai eu droit à ceci :

KGF_dll - nouvelles versions - Page 22 Captur10

Sujet: Re: KGF_dll - nouvelles versions Lun 16 Mar 2015 - 12:08

Désactive momentanément la mise à jour, et reprends dans mon WebDav, dossier Sources\KGF\, le fichier KGF.dll. C'est la version précédente, celle qui ne te posait pas de problème. Ainsi, tu ne perds rien.

Puis, en passant d'une dll à l'autre, essaie de savoir quel appel provoque ce crash. Sans ça, ça va être très dur de dépanner cela - chez moi, je n'ai pas de plantage.

Sujet: Re: KGF_dll - nouvelles versions Lun 16 Mar 2015 - 13:21

J'ai changé légèrement les paramètres de GetSelectedGridText. On peut maintenant définir un séparateur à placer entre les cellules d'une même ligne, et un séparateur éventuellement différent entre les lignes. Les séparateurs peuvent être des chaînes de caractères plus longues que 1.

Voici la doc actualisée:
Cette fonction retourne le texte sélectionné dans un objet GRID de Panoramic. Le format d'appel est le suivant:

Code:: res% = dll_call4("GetSelectedGridText",object_internal(grid%),adr(sepcel$),adr(seplin$),adr(txt$))

res% = -1 en cas d'erreur ou 0 si réussite
grid% = numéro d'objet d'un GRID Panoramic
sepcel$ = chaîne de caractères servant de séparation entre cellules (exemple: sepcel$ = "\")
seplin$ = chaîne de caractères servant de séparation entre lignes(exemple: seplin$ = chr$(13)+chr$(10) )
txt$ = chaîne de caractères recevant le texte sélectionné dans un GRID

Code:: res% = dll_call3("GetSelectedGridIndexes",object_internal(grid%),adr(x1%),adr(y1%),adr(x2%),adr(y2%))

res% = -1 en cas d'erreur ou 0 si réussite
grid% = numéro d'objet d'un GRID Panoramic
x1%,y1% = coordonnées du coin en haut à gauche de la sélection
x2%,y2% = coordonnées du coin en bas à droite de la sélection

Le texte sélectionné représente un rectangle de cellules. Cette fonction retourne le texte de toutes les cellules sélectionnées, ligne par ligne, séparées par le séparateur.

Programme de démo actualisé:

Code:: ' demo_GetSelectedGridText.bas
label clic
dim s$, res%, sepcel$, seplin$, x1%, y1%, x2%, y2%
grid 1
grid_write 1,2,2,"aaa"
grid_write 1,2,3,"bbb"
grid_write 1,3,3,"ccc"
on_click 1,clic
dll_on "KGF.dll"

end

clic:
s$ = string$(255," ")
sepcel$ = "\"
seplin$ = chr$(13)+chr$(10)
res% = DLL_call4("GetSelectedGridText",object_internal(1),adr(sepcel$), adr(seplin$),adr(s$))
s$ = trim$(s$)
message s$
res% = DLL_call5("GetSelectedGridIndexes",object_internal(1),adr(x1%),adr(y1%),adr(x2%),adr(y2%))
message "Rectangle: ("+str$(x1%)+","+str$(y1%)+") --> ("+str$(x2%)+","+str$(y2%)+")"
return

KGF.dll est à jour sur le WebDav et sur mon site.

Sujet: re Lun 16 Mar 2015 - 13:42

J' ai passé toutes les initialisations avec succes
donc, j' ai placé un trace_on qui s' est arrêté à la ligne 2760, ce qui correspond
à TabObjectFunction avec le message d' acces violation précédemment publié.

Code:: Tab_res% = dll_call6("TabObjectFunction",Tab%,1,0,3,c%,0)

c' est curieux, c' est une première...tout allait bien avec la version précédente (celle avant tes ajouts de la nuit )

Sujet: Re: KGF_dll - nouvelles versions Lun 16 Mar 2015 - 17:07

Je regarde ça. Comme ça, j'ai une indication précise ! Merci.

Sujet: Re: KGF_dll - nouvelles versions Lun 16 Mar 2015 - 17:26

Ok, Geronimi. Recharge stp et réessaie...

Sujet: re Lun 16 Mar 2015 - 19:16

A première vue, tout est rentré dans l' ordre.
Bravo Klaus !

Je n' ai plus l' acces violation à l' ouverture et tout s' affiche.

Sujet: Re: KGF_dll - nouvelles versions Lun 16 Mar 2015 - 20:50

Ouf...

Bon, on va attendre la réalisation de Jack sur les TAB. En moindre priorité, ce continue néanmoins de chercher uns solution à mon problème de suppression d'onglets.

Si Jack implémente les onglets tel que je le suppose, et s'il n'y a pas les icônes dans un premier temps, je pourrai les ajouter par une fonction DLL. Ce n'est pas très compliqué.

Sujet: Re: KGF_dll - nouvelles versions Mar 17 Mar 2015 - 1:45

Nouvelle version:
KGF.dll V4.48 du 17/03/2015

Nouveautés:
nouvelle fonction: WriteGridCells
nouvelle fonction: SetGridSeparators

Modules modifiés:
KGF.dll
KGF.chm

Les sources et la doc sont à jour.

J'ai modifié la syntaxe des fonctions déjà existantes, mais tout est documenté dans KGF.chm.
Ces fonctions sont documentés dans la section "Objets", dernier alinéa "Gestion des objets StringGrid".

Voici le programme de démo avec ces nouveautés. Ce programme remplace en particulier toutes les cellules sélectionnées dans le rectangle par des données différentes. On peut utiliser cette fonction WriteGridCells facilement pour effacer un rectangle de cellules dans un GRID.

Code:: ' demo_GetSelectedGridText.bas
label clic, exit
dim s$, res%, sepcel$, seplin$, x1%, y1%, x2%, y2%, x%, y%

grid 1
grid_write 1,2,2,"aaa"
grid_write 1,2,3,"bbb"
grid_write 1,3,3,"ccc"
on_click 1,clic
dll_on "KGF.dll"
on_close 0,exit
end

exit:
  res% = dll_call1("KillProcessByHandle",handle(0))
  return

clic:

  ' paramétrer les séparateurs (ce sont d'ailleurs les valeurs par défaut)
  sepcel$ = ""
  seplin$ = chr$(13)+chr$(10)
  res% = dll_call2("SetGridSeparators",adr(sepcel$),adr(seplin$))

  ' récupérer le texte des cellules sélectionnées
  s$ = string$(255," ")
  res% = DLL_call2("GetSelectedGridText",object_internal(1),adr(s$))
  s$ = trim$(s$)
  message s$

  ' récupérer les coordonnées du rectangle sélectionné
  res% = DLL_call5("GetSelectedGridIndexes",object_internal(1),adr(x1%),adr(y1%),adr(x2%),adr(y2%))
  message "Rectangle: ("+str$(x1%)+","+str$(y1%)+") --> ("+str$(x2%)+","+str$(y2%)+")"

  ' remplacer le texte des cellules sélectionnées par autre chose
  s$ = ""
  for y%=y1% to y2%

   for x%=x1% to x2%
   if x%>1 then s$ = s$ + sepcel$
   s$ = s$ + "L"+str$(y%) + " C"+str$(x%)
   next x%
   s$ = s$ + seplin$
  next y%
  message "nouvelles valeurs:"+seplin$+s$
  res% = dll_call6("WriteGridCells",object_internal(1),x1%,y1%,x2%,y2%,adr(s$))
  return

ATTENTION !
Ce n'est pas la peine d'essayer ces fonctions pour le moment - il y a encore un problème !

Sujet: re Mer 18 Mar 2015 - 15:53

Klaus,

Pourrais tu jeter un oeil à la fonction : "AddTabObjectTab"
J' ai le nom de l' onglet qui, en plus d' être à sa place dans l' onglet,
se retrouve en plein milieu du panel associé... Suspect

Sujet: Re: KGF_dll - nouvelles versions Mer 18 Mar 2015 - 16:18

Ok, je vais corriger cela ce soir. Je sais d'où ça vient...

» KGF_dll - nouvelles versions
» Nouvelles versions
» Synedit_Editor - nouvelles versions
» KGF_dll - nouvelles versions
» KGF_dll - nouvelles versions