Page 1 sur 2

Répertoire Private Drive GPB

Publié : jeu. 17/juin/2004 22:10
par Jacobus
:) Salut,

J'ai pensé à ceux qui partent en vacance et qui souhaitent garder le contact, notamment avec leurs potes du forum PB

Donc voilà un code qui permet de créer un carnet d'adresses spécial forum Pure Basic pour enregistrer quelques infos sur chacun.
L'intérêt de la chose c'est qu'il est conçu pour tenir sur une disquette et donc dans la main ou un sac de voyage.

Avec ça vous pouvez vous connecter sur n'importe quel ordinateur et envoyez des messages ou vous connecter au site souhaité sans chercher longtemps. Les adresses e-mail et le site web devenant accessibles d'un clic une fois la fiche individuelle créée.

Voici le code, il fonctionne sans bug chez moi (Win Me)
mais si vous souhaitez l'optimiser à vous de voir.

Code : Tout sélectionner

;REPERTOIRE PRIVE "PRIVATE DRIVE" par Jacobus - Juin 2004
;A USAGE DU GANG DU FORUM PURE BASIC
;Sa petite taille permet de garder l'application et le répertoire 
;contenant les fiches individuelles sur une disquette standard 1.44 Mo 
;et de l'emmener partout. De ce fait, permet également d'en préserver 
;la confidentialité

;*********VERSION DISQUETTE/FLOPPY UNIQUEMENT*******************

;- Enumeration
Enumeration
 #repertoire = 0
 ;- text
 #text_0
 #text_1
 #text_2
 #text_3
 #text_4
 #text_5
 #text_6
 #text_7
 #text_8
 #text_9
 #text_10
 #text_11
 #text_12
 #text_13
 #text_14
 #text_15
 #text_16
 #text_17
 #text_18
 #text_19
 #text_20
 #text_21
 #text_22
 #text_23
 #text_24
 #text_25
 #text_26
 #text_27
 #text_28
 #text_29
 #text_30
 #text_31
 #text_32
 #text_33
 #text_34
 #text_35
 #text_36
 #text_37
 #text_38
 #text_39
 #text_40
 #text_41
 #text_42
 #text_43
 #text_44
 #text_45
 #text_46
 #text_47
 #text_48
 #text_49
 #text_50
 #text_51
 #text_52
 #text_53
 #text_54
 #text_55
 #text_56
 #text_57
 ;- string
 #String_0
 #String_1
 #String_2
 #String_3
 #String_4
 #String_5
 #String_6
 #String_7
 #String_8
 #String_9
 #String_10
 #String_11
 #String_12
 #String_13
 #String_14
 #String_15
 #String_16
 #String_17
 #String_18
 #String_19
 #String_20
 #String_21
 #String_22
 ;- boutons
 #bouton_creer
 #bouton_consulter
 #bouton_sauvegarder
 #Bouton_licence
 #bouton_creer_contact
 #bouton_annuler 
 #bouton_enregistrer
 #bouton_modifier
 #bouton_menu_repertoire
 
 #Nb_contacts
 #text_compte_contacts
 #text_version
 #fiche_contact
;- frames3D 
 #frame01
 #frame02
 #frame03
 #frame04
 #frame05
 #frame06
 
 #frame07
 #frame08
 #frame09
 #frame10
 #frame11
 ;- images
 #image1
 #image2
 #image3
 #image4
 #image5
 #image6
 #image7
 #image8 
 #image9
 #image10
 ;- rajouts 
 #messagerie
 #choix_email
 #em_1
 #em_2
 #em_3
 #em_4
 #bouton_em_1
 #bouton_em_2
 #bouton_em_3
 #bouton_em_4
 #bouton_messagerie
 #voir_une_fiche
 #autre_fiche
 #nouvelle_fiche
 #acces_siteweb
EndEnumeration 

;- Variables Global
Global pseudo.s, nom.s, prenom.s 
Global adressedom.s, adressetr.s, siteweb.s, genre.s
Global teld1.s, teld2.s, telt1.s, telt2.s, telm1.s, telm2.s, faxd.s, faxt.s
Global emailperso1.s, emailperso2.s, emailtrav1.s, emailtrav2.s
Global commentairesprive.s  
Global commentp1.s, commentp2.s, commentp3.s

;- Declare procedures
Declare ouverture_repertoire()
Declare creation_repertoire(Modification.l)
Declare Presentation()
Declare creation_fichier()
Declare consultation_repertoire()
Declare messagerie()

       
;pour savoir combien il y a de personnes enregistrées dans votre répertoire
;si votre dossier est sur disquette, changer le chemin
Procedure compter_contacts(Dossier.s)

 Dossier="A:\Répertoire\"
  If ExamineDirectory(n, Dossier, "*.txt")  : nb=0
    Repeat 
      Filetype = NextDirectoryEntry()  
      If FileType = 1 
        Nb + 1 
      EndIf 
    Until FileType = 0 
  EndIf 
  ProcedureReturn Nb 
EndProcedure


Procedure ouverture_repertoire() 

  If OpenWindow(#repertoire, 0, 0, 450, 230, #PB_Window_SystemMenu | #PB_Window_ScreenCentered| #PB_Window_Invisible, "PRIVATE DRIVE - GANG PURE BASIC ") 
;j'aime bien cette couleur  
 CouleurFenetre = CreateSolidBrush_(RGB(110, 130, 205)) 
  SetClassLong_(WindowID(0), #GCL_HBRBACKGROUND, CouleurFenetre) 
   DeleteObject_(CouleurFenetre) 
    HideWindow(0, 0)

  If CreateGadgetList (WindowID())
     
     ButtonGadget(#bouton_creer, 10, 140, 200, 30, "Enregistrer un nouveau contact") 
      
     ButtonGadget(#bouton_consulter, 220, 140, 200, 30, "Consulter la fiche d'un contact")
      
     ButtonGadget(#Bouton_licence,220,180,200,30,"Licence d'utilisation")
      
  If LoadFont(0, "Times New Roman", 12, #PB_Font_Bold)
     TextGadget(#Nb_contacts, 10, 90, 300, 20, "Nombre de contacts enregistrés  :     " + Str(compter_contacts("A:\Répertoire\"))) 
      SetGadgetFont(#Nb_contacts, FontID())
      
     TextGadget(#text_compte_contacts,10,20,430,30,"Vous pouvez enregistrer un nouveau contact ou consulter une fiche déjà enregistrée. Vous pouvez également créer ou mettre à jour une disquette de sauvegarde de vos contacts.")
      
     Frame3DGadget(#frame01,5,70,440,50,"Inventaire")
      
     Frame3DGadget(#frame02,5,5,440,50,"A partir d'ici...") 
         
     TextGadget(#text_version,10,180,200,30,"Répertoire Private Drive - Version 1 Floppy - 06/2004")
    EndIf 
  EndIf
 EndIf 
     
 Repeat  :EventID = WaitWindowEvent() 
    
  Until EventID = #PB_EventCloseWindow Or EventID = #PB_EventGadget             
    CloseWindow(#repertoire) 
   
  If EventID = #PB_EventGadget : Select EventGadgetID() 
    
    Case #bouton_creer
;initialisation des variables    
    pseudo = ReadPreferenceString("Pseudo", "")
    prenom = ""
    nom = ""
    adressedom = ""
    adressetr = ""
    siteweb = ""
    genre = ""
    teld1 = ""
    teld2 = ""
    telt1 = ""
    telt2 = ""
    telm1 = ""
    telm2 = ""
    faxd = ""
    faxt = ""
    emailperso1 = ""
    emailperso2 = ""
    emailtrav1 = ""
    emailtrav2 = ""
    commentairesprive = ""
    commentp1 ="" : commentp2 ="" : commentp3 ="" 
   
          creation_repertoire(0)
  
    Case #bouton_consulter : consultation_repertoire() 
         
    Case #Bouton_licence ; un petit message pour faire pro
       MessageRequester("LICENCE D'UTILISATION du REPERTOIRE PRIVATE DRIVE","TOUS DROITS RESERVES A L'AUTEUR"+Chr(13)+""+Chr(13)+"CE LOGICIEL NE PEUT ETRE COPIE, VENDU, NI CEDE A UNE AUTRE PERSONNE PHYSIQUE OU MORALE SANS LE CONSENTEMENT DE L'AUTEUR"+Chr(13)+""+Chr(13)+"Utilisation accordée au GANG DU FORUM PURE BASIC",#MB_ICONINFORMATION | #PB_MessageRequester_Ok)
       ouverture_repertoire()
       
       EndSelect 
      EndIf
EndProcedure

 
Procedure creation_repertoire(Modification.l) 
  If OpenWindow(#fiche_contact, 216, 0, 650, 500, #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_WindowCentered| #PB_Window_Invisible, "ENREGISTREMENT D'UN NOUVEAU GANGSTER PB") 
    
CouleurFenetre = CreateSolidBrush_(RGB(110, 130, 205)) 
 SetClassLong_(WindowID(#fiche_contact), #GCL_HBRBACKGROUND, CouleurFenetre) 
  DeleteObject_(CouleurFenetre) 
   HideWindow(#fiche_contact, 0)
  
    If CreateGadgetList(WindowID())
;Liste des textgadget et stringgadget associés...  
   TextGadget(#Text_0, 200, 10, 40, 20, "Pseudo:")
   StringGadget(#String_0, 250, 10, 200, 20, pseudo) 
   
   TextGadget(#Text_1, 10, 40, 30, 20, "Nom:")
    StringGadget(#String_1, 45, 40, 150, 20, nom,#PB_String_Uppercase)
      
   TextGadget(#Text_2, 210,40,40,20, "Prénom:")
    StringGadget(#String_2,255,40,150,20, prenom)
        
   TextGadget(#Text_3, 10, 60, 85, 20, "Adresse domicile:")
    StringGadget(#String_3, 100, 60, 200, 20, adressedom)
   
   TextGadget(#Text_4, 330, 60, 50, 20, "Pays :")
    StringGadget(#String_4, 385, 60, 230, 20, adressetr,#PB_String_Uppercase)
       
   TextGadget(#Text_5, 10, 90, 100, 20, "Site Web:   http:// ") 
    StringGadget(#String_5, 115, 90, 500, 20, siteweb)
      
   TextGadget(#Text_6, 10, 110, 100, 20, "Genre du contenu:")
    StringGadget(#String_6, 115, 110, 500, 20, genre)
    
   TextGadget(#Text_7, 70, 150, 110, 20, "Téléphone domicile 1:")
    StringGadget(#String_7, 185, 150, 100, 20, teld1,#PB_String_Numeric)
    
   TextGadget(#Text_8, 300, 150, 110, 20, "Téléphone domicile 2:")
    StringGadget(#String_8, 415, 150, 100, 20, teld2,#PB_String_Numeric)
    
   TextGadget(#Text_9, 70, 180, 110, 20, "Tél lieu de travail 1 :")
    StringGadget(#String_9, 185, 180, 100, 20, telt1,#PB_String_Numeric)
      
   TextGadget(#Text_10, 300, 180, 110, 20, "Tél lieu de travail 2:")
    StringGadget(#String_10, 415, 180, 100, 20, telt2,#PB_String_Numeric)
    
   TextGadget(#Text_11, 70, 210, 110, 20, "Téléphone mobile 1:")
    StringGadget(#String_11, 185, 210, 100, 20, telm1,#PB_String_Numeric)
    
   TextGadget(#Text_12, 300, 210, 110, 20, "Téléphone mobile 2:")
    StringGadget(#String_12, 415, 210, 100, 20, telm2,#PB_String_Numeric)
        
   TextGadget(#Text_13, 70, 240, 110, 20, "FAX Domicile:")
    StringGadget(#String_13, 185, 240, 100, 20, faxd,#PB_String_Numeric)
    
   TextGadget(#Text_14, 300, 240, 110, 20, "FAX Travail :")
    StringGadget(#String_14, 415, 240, 100, 20, faxt,#PB_String_Numeric)
    
   TextGadget(#Text_15, 10, 270, 80, 20, "E-mail perso 1 :")
    StringGadget(#String_15, 95, 270, 400, 20, emailperso1)
    
   TextGadget(#Text_16, 10, 290, 80, 20, "E-mail perso 2 :")
    StringGadget(#String_16, 95, 290, 400, 20, emailperso2)
    
   TextGadget(#Text_17, 100, 315, 80, 20, "E-mail travail 1 :")
    StringGadget(#String_17, 195, 315, 400, 20, emailtrav1 )
    
   TextGadget(#Text_18, 100, 335, 80, 20, "E-mail travail 2 :")
    StringGadget(#String_18, 195, 335, 400, 20, emailtrav2) 
;pour faire des commentaires gratinés et perso sur le gangster
;ou encore un rappel rapide de ce qu'il a codé ou ce que vous voulez   
   TextGadget(#Text_19, 10, 370, 150, 20, "Commentaires personnels :")
    StringGadget(#String_19, 165, 370, 465, 20, commentairesprive)
    StringGadget(#String_20, 10, 390, 620, 20, commentp1)
    StringGadget(#String_21, 10, 410, 620, 20, commentp2)
    StringGadget(#String_22, 10, 430, 620, 20, commentp3)
    
 ButtonGadget(#Bouton_creer_contact, 100, 460, 100, 20,"Créer contact") 
 ButtonGadget(#Bouton_annuler, 220, 460, 100, 20,"Annuler")
 ButtonGadget(#voir_une_fiche,340,460,100,20,"Consulter")
    
 Frame3DGadget(#frame04,5,0,640,136,"")     
 Frame3DGadget(#frame05,5,357,630,128,""); délimiteur sympa
 
      
 EndIf : Presentation=0 
    
 Repeat  : EventID = WaitWindowEvent() 
    If EventID = #PB_EventGadget : Select EventGadgetID()  
    
    Case #voir_une_fiche
      CloseWindow(#fiche_contact)
       consultation_repertoire()
        
    Case #bouton_creer_contact
;variable = texte contenu dans string n° 0  ... etc          
    pseudo = GetGadgetText(#String_0)
    nom = GetGadgetText(#String_1)
    prenom = GetGadgetText(#String_2)
    adressedom = GetGadgetText(#String_3)
    adressetr = GetGadgetText(#String_4)
    siteweb = GetGadgetText(#String_5)
    genre = GetGadgetText(#String_6)
    teld1 = GetGadgetText(#String_7)
    teld2 = GetGadgetText(#String_8)
    telt1 = GetGadgetText(#String_9)
    telt2 = GetGadgetText(#String_10)
    telm1 = GetGadgetText(#String_11)
    telm2 = GetGadgetText(#String_12)
    faxd = GetGadgetText(#String_13)
    faxt = GetGadgetText(#String_14)
    emailperso1 = GetGadgetText(#String_15)
    emailperso2 = GetGadgetText(#String_16)
    emailtrav1 = GetGadgetText(#String_17)
    emailtrav2 = GetGadgetText(#String_18)
    commentairesprive = GetGadgetText(#String_19)
    commentp1 = GetGadgetText(#String_20)
    commentp2 = GetGadgetText(#String_21)
    commentp3 = GetGadgetText(#String_22)
   
    CloseWindow(#fiche_contact)
    Presentation = 1 
            
    Case #bouton_annuler
       If Modification  
            Presentation = 1
              EndIf 
            EventID = #PB_EventCloseWindow     
        EndSelect 
      EndIf 
    Until EventID = #PB_EventCloseWindow Or Presentation
    
    CloseWindow(#fiche_contact) 
    
     If Presentation : Presentation()
    Else : ouverture_repertoire()  
    EndIf  
  EndIf 
EndProcedure 

Procedure Presentation()
    
  If OpenWindow(#fiche_contact, 216, 0, 650, 490, #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_WindowCentered| #PB_Window_Invisible, "Présentation de  : "+ pseudo +" - "+ prenom +" "+ nom)
   
CouleurFenetre = CreateSolidBrush_(RGB(110, 130, 205)) 
 SetClassLong_(WindowID(#fiche_contact), #GCL_HBRBACKGROUND, CouleurFenetre) 
  DeleteObject_(CouleurFenetre) 
   HideWindow(#fiche_contact, 0)
  
    If CreateGadgetList(WindowID())
   
     ButtonGadget(#bouton_enregistrer, 530, 150, 100, 20, "Enregistrer") 
      GadgetToolTip(#bouton_enregistrer,"Enregistrer ce nouveau contact ou les modifications sur une fiche existante")
      
     ButtonGadget(#bouton_modifier, 530, 175, 100, 20, "Modifier") 
      GadgetToolTip(#bouton_modifier,"Apporter des modifications à la fiche en cours")
      
     ButtonGadget(#bouton_menu_repertoire, 530, 200, 100, 20, "Retour au menu")
      GadgetToolTip(#bouton_menu_repertoire,"Fenêtre d'accueil") 
      
     ButtonGadget(#bouton_messagerie,530,225,100,20,"Messagerie")
      GadgetToolTip(#bouton_messagerie,"Envoyez un e-mail à "+ pseudo)
      
     ButtonGadget(#autre_fiche,530,250,100,20,"Autre contact")
      GadgetToolTip(#autre_fiche,"Consulter une fiche existante")
      
     ButtonGadget(#nouvelle_fiche,530,275,100,20,"Nouveau contact")
      GadgetToolTip(#nouvelle_fiche,"Enregistrer un nouveau contact dans le répertoire")
      
     ButtonGadget(#acces_siteweb,530,300,100,20,"Sur le Web")
      GadgetToolTip(#acces_siteweb,"Se connecter au site de "+ pseudo)
;chargement d'une police bien grasse pour certains textes      
    If LoadFont(0, "Times New Roman", 10, #PB_Font_Bold)
    
    TextGadget(#text_20, 20, 5, 600, 20,"Mon contact : " + pseudo +" - "+ prenom +" "+ nom, #pb_text_center) 
    SetGadgetFont(#text_20, FontID()) 
        
    TextGadget(#text_21, 10, 35, 80, 20, "Domicile :") 
    TextGadget(#text_22, 100, 35, 400, 20, adressedom)
    SetGadgetFont(#text_22, FontID()); police grasse
    TextGadget(#text_23, 10, 60, 100, 20, "Région du monde : ") 
    TextGadget(#text_24, 120, 60, 400, 20, adressetr)
        
    TextGadget(#text_25, 10, 90, 70, 20, "Site Web : ") 
    TextGadget(#text_26, 90, 90, 500, 20, siteweb)
    SetGadgetFont(#text_26, FontID()) 
    TextGadget(#text_27, 10, 120, 70, 20, "Genre :") 
    TextGadget(#text_28, 80, 120, 510, 20, genre)
    SetGadgetFont(#text_28, FontID())  
    TextGadget(#text_29, 10, 150, 100, 20, "Tel domicile 1 : ") 
    TextGadget(#text_30, 120, 150, 120, 20, teld1)
    SetGadgetFont(#text_30, FontID()) 
    TextGadget(#text_31, 250, 150, 100, 20, "Tel domicile 2: ") 
    TextGadget(#text_32, 360, 150, 120, 20, teld2)
    SetGadgetFont(#text_32, FontID())
    TextGadget(#text_33, 10, 180, 100, 20, "Tel travail 1 : ") 
    TextGadget(#text_34, 120, 180, 120, 20, telt1)
    SetGadgetFont(#text_34, FontID())
    TextGadget(#text_35, 250, 180, 100, 20, "Tel travail 2 : ") 
    TextGadget(#text_36, 360, 180, 120, 20, telt2)
    SetGadgetFont(#text_36, FontID())
    TextGadget(#text_37, 10, 210, 100, 20, "Tel mobile 1 : ") 
    TextGadget(#text_38, 120, 210, 120, 20, telm1)
    SetGadgetFont(#text_38, FontID()) 
    TextGadget(#text_39, 250, 210, 100, 20, "Tel mobile 2 : ") 
    TextGadget(#text_40, 360, 210, 120, 20,  telm2)
    SetGadgetFont(#text_40, FontID())
    
    TextGadget(#text_41, 10, 240, 100, 20, "Fax domicile : ") 
    TextGadget(#text_42, 120, 240, 120, 20, faxd)
    SetGadgetFont(#text_42, FontID())
    TextGadget(#text_43, 250, 240, 100, 20, "Fax travail : ") 
    TextGadget(#text_44, 360, 240, 120, 20, faxt)
    SetGadgetFont(#text_44, FontID())
   
    TextGadget(#Text_45, 10, 270, 80, 20, "E-mail perso 1 : ")    
    TextGadget(#text_46, 95, 270, 400,20, emailperso1)
    SetGadgetFont(#text_46, FontID())
    TextGadget(#Text_47, 10, 290, 80, 20, "E-mail perso 2 : ")    
    TextGadget(#text_48, 95, 290, 400,20, emailperso2)
    SetGadgetFont(#text_48, FontID())
    TextGadget(#Text_49, 10, 310, 80, 20, "E-mail travail 1 : ")    
    TextGadget(#text_50, 95, 310, 400,20, emailtrav1)
    SetGadgetFont(#text_50, FontID())
    TextGadget(#Text_51, 10, 330, 80, 20, "E-mail travail 2 : ")    
    TextGadget(#text_52, 95, 330, 400,20, emailtrav2)
    SetGadgetFont(#text_52, FontID())
    
    TextGadget(#Text_53, 10, 360, 150, 20, "Commentaires personnels : ")    
    TextGadget(#text_54, 165, 360, 480,20, commentairesprive)
    TextGadget(#text_55, 10, 390, 630,20, commentp1)
    TextGadget(#text_56, 10, 420, 630,20, commentp2)
    TextGadget(#text_57, 10, 450, 630,20, commentp3)
       
 EndIf 
      
   Repeat : EventID = WaitWindowEvent() 
        
   Until EventID = #PB_EventCloseWindow Or EventID = #PB_EventGadget 
  CloseWindow(#fiche_contact) 
    If EventID = #PB_EventGadget :Select EventGadgetID() 
            
    Case #bouton_modifier : creation_repertoire(1)
            
    Case #bouton_enregistrer : creation_fichier()
                       
    Case #bouton_menu_repertoire : ouverture_repertoire()
    
    Case #bouton_messagerie : messagerie()
    
    Case #autre_fiche : consultation_repertoire()
    
    Case #nouvelle_fiche 
    pseudo = ReadPreferenceString("Pseudo", "")
    prenom = ""
    nom = ""
    adressedom = ""
    adressetr = ""
    siteweb = ""
    genre = ""
    teld1 = ""
    teld2 = ""
    telt1 = ""
    telt2 = ""
    telm1 = ""
    telm2 = ""
    faxd = ""
    faxt = ""
    emailperso1 = ""
    emailperso2 = ""
    emailtrav1 = ""
    emailtrav2 = ""
    commentairesprive = ""
    commentp1 ="" : commentp2 ="" : commentp3 ="" 
   
    creation_repertoire(0) 
    
    Case #acces_siteweb : RunProgram("http://"+ siteweb)
    
       EndSelect 
      EndIf   
    EndIf 
  EndIf   
EndProcedure

Procedure messagerie()
;Pour ne saisir les adresses e-mail qu'une fois, lors de la 
;création de la fiche. Puis renvoi automatique des e-mails dans une 
;fenêtre qui les rend actifs.
 If OpenWindow(#messagerie, 216, 0, 530, 330, #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_WindowCentered| #PB_Window_Invisible, "Envoi d'un message à : "+ pseudo +" - "+ prenom +" "+ nom) 
   
CouleurFenetre = CreateSolidBrush_(RGB(110, 130, 205)) 
 SetClassLong_(WindowID(#messagerie), #GCL_HBRBACKGROUND, CouleurFenetre) 
  DeleteObject_(CouleurFenetre) 
   HideWindow(#messagerie, 0)
  
    If CreateGadgetList(WindowID())
       TextGadget(#choix_email, 10, 20, 500, 20, "Choisir à quelle adresse puis cliquer sur le bouton correspondant pour envoyer le message")
        Frame3DGadget(#frame07,5,5,515,40,"")
     
     If LoadFont(2, "Times New Roman", 10, #PB_Font_Bold)
     
    TextGadget(#em_1, 10,60,500,20, "E-mail perso 1 :     "+ emailperso1)    
     SetGadgetFont(#em_1, FontID())
   
       ButtonGadget(#bouton_em_1,100,85,200,20,"Créer le message et l'envoyer") 
        Frame3DGadget(#frame08,5,50,515,60,"")
       
    TextGadget(#em_2, 10,130,500,20,"E-mail perso 2 :     "+ emailperso2)
     SetGadgetFont(#em_2, FontID())
 
       ButtonGadget(#bouton_em_2,100,155,200,20,"Créer le message et l'envoyer")
        Frame3DGadget(#frame09,5,120,515,60,"")
    
    TextGadget(#em_3, 10,200,500,20,"E-mail travail 1 :     "+ emailtrav1)
     SetGadgetFont(#em_3, FontID())
  
        ButtonGadget(#bouton_em_3,100,225,200,20,"Créer le message et l'envoyer")
        Frame3DGadget(#frame10,5,190,515,60,"")
    
    TextGadget(#em_4, 10,270,500,20,"E-mail travail 2 :     "+ emailtrav2)
     SetGadgetFont(#em_4, FontID())
   
       ButtonGadget(#bouton_em_4,100,295,200,20,"Créer le message et l'envoyer")
        Frame3DGadget(#frame11,5,260,515,60,"")
        
      EndIf 
     EndIf 
    EndIf   
    
 Repeat : EventID = WaitWindowEvent() 
        
   Until EventID = #PB_EventCloseWindow Or EventID = #PB_EventGadget 
      
    CloseWindow(#messagerie) 
    
    If EventID = #PB_EventGadget 
        Select EventGadgetID() 
   ;Ouverture de votre log de messagerie par défaut prêt à l'envoi     
         Case #bouton_em_1 : RunProgram("mailto:" + emailperso1)

         Case #bouton_em_2 : RunProgram("mailto:" + emailperso2)
         
         Case #bouton_em_3 : RunProgram("mailto:" + emailtrav1)
         
         Case #bouton_em_4 : RunProgram("mailto:" + emailtrav2)
         
     EndSelect 
    EndIf 
   Presentation()  
EndProcedure 

Procedure creation_fichier() 
;Enregistrement de la fiche créée directement dans le répertoire sur la 
;disquette. Le nom du fichier créé est celui du contact
 Fichier.s = SaveFileRequester("Enregistrer le Gangster PB", "A:\Répertoire\" + pseudo +" - "+ prenom +" "+ nom + ".txt", "Gangster|*.txt", 0) 
  If Fichier = ""     
    Else   
      If GetExtensionPart(Fichier) = ""  
        Fichier = Fichier + ".txt"  
      EndIf
    fiche.s = GetFilePart(Fichier.s) : EnregistreFichier = #True 
   If FileSize(Fichier.s)>0 ;si le nom du fichier, donc du contact existe déjà (cas d'une modification)...
    Reponse = MessageRequester("CE CONTACT EXISTE DEJA !","Voulez-vous remplacer le contact  :  " + fiche.s + "  ?  Il a déjà été enregistré !",#MB_ICONEXCLAMATION | #PB_MessageRequester_YesNo ) 
     If Reponse = 6 : a$ + "Yes"
       ElseIf Reponse = 7 : a$ + "No"
        Else  : a$ + "Cancel" 
     EndIf  
      If Reponse <> 6  : EnregistreFichier = #False 
  EndIf 
 EndIf 
   If EnregistreFichier  
     If CreatePreferences(Fichier)  
     
      WritePreferenceString("Nom",nom)
      WritePreferenceString("Prénom",prenom)
      WritePreferenceString("Pseudo",pseudo) 
      WritePreferenceString("Domicile",adressedom)
      WritePreferenceString("Pays",adressetr)
      WritePreferenceString("Site Web", siteweb)
      WritePreferenceString("Genre",genre)  
      WritePreferenceString("Téléphone domicile 1",teld1) 
      WritePreferenceString("Téléphone domicile 2",teld2)
      WritePreferenceString("Téléphone lieu de travail 1",telt1)
      WritePreferenceString("Téléphone lieu de travail 2",telt2)
      WritePreferenceString("Téléphone mobile 1",telm1)
      WritePreferenceString("Téléphone mobile 2",telm1) 
      WritePreferenceString("Fax domicile",faxd)
      WritePreferenceString("Fax travail",faxt)
      WritePreferenceString("E-mail perso 1",emailperso1)
      WritePreferenceString("E-mail perso 2",emailperso2)
      WritePreferenceString("E-mail travail 1",emailtrav1)
      WritePreferenceString("E-mail travail 2",emailtrav2)
      WritePreferenceString("Commentaires perso",commentairesprive)
      WritePreferenceString("-",commentp1)
      WritePreferenceString("-",commentp2)
      WritePreferenceString("-",commentp3)
      ClosePreferences() 
      
      MessageRequester("VALIDATION", "Le Gangster PB suivant  :" + pseudo +" - "+ prenom +" " + nom + "   a été bien enregistré",#MB_ICONINFORMATION | #PB_MessageRequester_Ok)       
    Else 
      MessageRequester("PROBLEME !", "Impossible de créer le fichier"+Chr(13)+""+Chr(13)+"Vous avez sûrement été Gangstérisé !",#MB_ICONWARNING | #PB_MessageRequester_Ok) 
    EndIf 
   EndIf 
  EndIf 
    Presentation() 
EndProcedure

Procedure consultation_repertoire()
Fichier.s = OpenFileRequester("Voir la fiche d'un Gangster", "A:\Répertoire\","Gangster|*.txt", 0)
  If Fichier = "" 
    ouverture_repertoire() ; ou au choix : creation_repertoire(0)  
  Else 
    If  OpenPreferences(Fichier)
;Veillez ici à conserver les mêmes valeurs que pour l'écriture, 
;et vis versa. ex: WritePreferenceString("Nom",nom) 
;donc > ReadPreferenceString("Nom","") et pas ReadPreferenceString("nom","")
;sinon plantage, le programme ne lira pas ou ecrira n'importe où (j'ai essayé)  
    nom = ReadPreferenceString("Nom","")
    prenom = ReadPreferenceString("Prénom","")
    pseudo = ReadPreferenceString("Pseudo","")
    adressedom = ReadPreferenceString("Domicile","")
    adressetr = ReadPreferenceString("Pays","")
    siteweb = ReadPreferenceString("Site Web","")
    genre = ReadPreferenceString("Genre","")
    teld1 = ReadPreferenceString("Téléphone domicile 1","")
    teld2 = ReadPreferenceString("Téléphone domicile 2","")
    telt1 = ReadPreferenceString("Téléphone lieu de travail 1","")
    telt2 = ReadPreferenceString("Téléphone lieu de travail 2","")
    telm1 = ReadPreferenceString("Téléphone mobile 1","")
    telm2 = ReadPreferenceString("Téléphone mobile 2","")
    faxd = ReadPreferenceString("Fax domicile","")
    faxt = ReadPreferenceString("Fax travail","")
    emailperso1 = ReadPreferenceString("E-mail perso 1","")
    emailperso2 = ReadPreferenceString("E-mail perso 2","")
    emailtrav1 = ReadPreferenceString("E-mail travail 1","")
    emailtrav2 = ReadPreferenceString("E-mail travail 2","")
    commentairesprive = ReadPreferenceString("Commentaires perso","")
    commentp1 = ReadPreferenceString("-","")
    commentp2 = ReadPreferenceString("-","")
    commentp3 = ReadPreferenceString("-","")
    
    ClosePreferences()  : Presentation()   
    EndIf 
  EndIf 
EndProcedure
ouverture_repertoire();retour au menu principal
Une fois l'executable créé, copiez le sur une disquette, créez un dossier nommé " Répertoire" sur la disquette et lancez l'application.
Il est facilement adaptable au goût de chacun pour un agenda perso.

Si cela intéresse quelqu'un j'ai aussi la version pour C:
avec images et mot de passe ( méthode de GUIMAUVE)

@ + Jacobus :P

Publié : jeu. 17/juin/2004 22:42
par Jacobus
RAAAH ! j'ai laissé des commentaires de l'autre version et les constantes images, mais ça gène pas, ça marche quand même.

Publié : ven. 18/juin/2004 6:10
par Anonyme2
J'ai modifié ta procédure ouverture_repertoire() pour mettre le fond des gadgets en couleur (Frame3D et Textgadget) qui utilise ma petite librairie MoreGadgetColor

Voir mon message ici pour la télécharger
http://purebasic.hmt-forum.com/viewtopic.php?t=647

Code : Tout sélectionner

  If LoadFont(0, "Times New Roman", 12, #PB_Font_Bold) 
     TextGadget(#Nb_contacts, 10, 90, 300, 20, "Nombre de contacts enregistrés  :     " + Str(compter_contacts("A:\Répertoire\"))) 
      SetGadgetFont(#Nb_contacts, FontID()) 
      SetGadgetColor(#Nb_contacts, #black, RGB(110, 130, 205))  ; <-- ici
      
#black = 0
     TextGadget(#text_compte_contacts,10,20,430,30,"Vous pouvez enregistrer un nouveau contact ou consulter une fiche déjà enregistrée. Vous pouvez également créer ou mettre à jour une disquette de sauvegarde de vos contacts.") 
     SetGadgetColor(#text_compte_contacts, #black, RGB(110, 130, 205))

     Frame3DGadget(#frame01,5,70,440,50,"Inventaire") 
     SetGadgetColor(#frame01, #black, RGB(110, 130, 205))  ; <-- ici
      
     Frame3DGadget(#frame02,5,5,440,50,"A partir d'ici...") 
     SetGadgetColor(#frame02, #black, RGB(110, 130, 205))  ; <-- ici
          
     TextGadget(#text_version,10,180,200,30,"Répertoire Private Drive - Version 1 Floppy - 06/2004") 
     SetGadgetColor(#text_version, #black, RGB(110, 130, 205))  ; <-- ici
Endif

Publié : sam. 19/juin/2004 11:12
par Jacobus
:( Je te remercie Denis, mais bien qu'ayant suivi tes instructions à la lettre, ta Lib ne fonctionne pas chez moi.

Pire... m'a planté le PBcompiler :roll:

J'ai dû tout réinstaller PB.

Je suppose que j'ai fait un truc qui fallait pas mais je sais pas où...

Tu dis que ta librairie est un fichier sans extension à mettre dans users lib,
mais lors des essais de compilation les fonctions ne sont pas reconnues.

ne faut-il pas lui ajouter l'extension .lib, puis l'appeler via OpenLibrary() ?

Bah...je sèche sur le coup.

Un coup de pouce pour débloquer mes neurones serait le bienvenu, merci.

Jacobus

Merci

Publié : sam. 19/juin/2004 12:26
par DominiqueB
Ton carnet d'adresse est sympa, merci.
Une suggestion, pourquoi imposer l'emplacement du répertoire sur disquette "a:\répertoire\" ?
Met simplement "répertoire\" comme ca le programme cherchera son répertoire sur place, ou que soit situé le programme !
Une autre idée: teste la présence du répertoire, si il n'existe pas tu le créé. Comme ca lors de la première utilisation l'utilisateur n'a pas à le créer manuellement.

Merci.
Dominique

Publié : dim. 20/juin/2004 12:11
par Jacobus
:) Merci,
Sur disquette pour qu'il soit transportable et comme j'ai une version sur lecteur C:\ (que je posterai dès qu'elle sera adaptée, plus gros code)
je trouve pratique de pouvoir garder à l'abri son carnet d'adresse. 8)

J'ai suivi tes conseils concernant la création automatique du dossier de destination lors du premier enregistrement et c'est vrai que c'est mieux pour l'utilisateur, il a pas à se casser la tête :sleeping:

Donc voilà le nouveau code modifié et prêt à l'emploi
mais sans la coloration made by Denis #aieaieaie

Code : Tout sélectionner

;REPERTOIRE PRIVE "PRIVATE DRIVE" par Jacobus - Juin 2004
;A USAGE DU GANG DU FORUM PURE BASIC
;Sa petite taille permet de garder l'application et le répertoire 
;contenant les fiches individuelles sur une disquette standard 1.44 Mo 
;et de l'emmener partout. De ce fait, permet également d'en préserver 
;la confidentialité

;*********VERSION DISQUETTE/FLOPPY UNIQUEMENT*******************

;- Enumeration
Enumeration
 #repertoire = 0
 ;- text
 #text_0
 #text_1
 #text_2
 #text_3
 #text_4
 #text_5
 #text_6
 #text_7
 #text_8
 #text_9
 #text_10
 #text_11
 #text_12
 #text_13
 #text_14
 #text_15
 #text_16
 #text_17
 #text_18
 #text_19
 #text_20
 #text_21
 #text_22
 #text_23
 #text_24
 #text_25
 #text_26
 #text_27
 #text_28
 #text_29
 #text_30
 #text_31
 #text_32
 #text_33
 #text_34
 #text_35
 #text_36
 #text_37
 #text_38
 #text_39
 #text_40
 #text_41
 #text_42
 #text_43
 #text_44
 #text_45
 #text_46
 #text_47
 #text_48
 #text_49
 #text_50
 #text_51
 #text_52
 #text_53
 #text_54
 #text_55
 #text_56
 #text_57
 ;- string
 #String_0
 #String_1
 #String_2
 #String_3
 #String_4
 #String_5
 #String_6
 #String_7
 #String_8
 #String_9
 #String_10
 #String_11
 #String_12
 #String_13
 #String_14
 #String_15
 #String_16
 #String_17
 #String_18
 #String_19
 #String_20
 #String_21
 #String_22
 ;- boutons
 #bouton_creer
 #bouton_consulter
 #bouton_sauvegarder
 #Bouton_licence
 #bouton_creer_contact
 #bouton_annuler 
 #bouton_enregistrer
 #bouton_modifier
 #bouton_menu_repertoire
 
 #Nb_contacts
 #text_compte_contacts
 #text_version
 #fiche_contact
;- frames3D 
 #frame01
 #frame02
 #frame03
 #frame04
 #frame05
 #frame06 
 #frame07
 #frame08
 #frame09
 #frame10
 #frame11
 
 ;- rajouts 
 #messagerie
 #choix_email
 #em_1
 #em_2
 #em_3
 #em_4
 #bouton_em_1
 #bouton_em_2
 #bouton_em_3
 #bouton_em_4
 #bouton_messagerie
 #voir_une_fiche
 #autre_fiche
 #nouvelle_fiche
 #acces_siteweb
EndEnumeration 

;- Variables Global
Global pseudo.s, nom.s, prenom.s 
Global adressedom.s, adressetr.s, siteweb.s, genre.s
Global teld1.s, teld2.s, telt1.s, telt2.s, telm1.s, telm2.s, faxd.s, faxt.s
Global emailperso1.s, emailperso2.s, emailtrav1.s, emailtrav2.s
Global commentairesprive.s  
Global commentp1.s, commentp2.s, commentp3.s

;- Declare procedures
Declare ouverture_repertoire()
Declare creation_repertoire(Modification.l)
Declare Presentation()
Declare creation_fichier()
Declare consultation_repertoire()
Declare messagerie()
Declare creation_dossier()
Declare verif_dossier()
       
;pour savoir combien il y a de personnes enregistrées dans votre répertoire
Procedure compter_contacts(Dossier.s)
 Dossier="A:\RépertoireGPB\"
  If ExamineDirectory(n, Dossier, "*.txt")  : nb=0
    Repeat 
      Filetype = NextDirectoryEntry()  
      If FileType = 1 
        Nb + 1 
      EndIf 
    Until FileType = 0 
  EndIf 
  ProcedureReturn Nb 
EndProcedure

Procedure ouverture_repertoire() 

  If OpenWindow(#repertoire, 0, 0, 450, 230, #PB_Window_SystemMenu | #PB_Window_ScreenCentered| #PB_Window_Invisible, "PRIVATE DRIVE - GANG PURE BASIC ") 
;j'aime bien cette couleur  
 CouleurFenetre = CreateSolidBrush_(RGB(110, 130, 205)) 
  SetClassLong_(WindowID(0), #GCL_HBRBACKGROUND, CouleurFenetre) 
   DeleteObject_(CouleurFenetre) 
    HideWindow(0, 0)

  If CreateGadgetList (WindowID())
     
     ButtonGadget(#bouton_creer, 10, 140, 200, 30, "Enregistrer un nouveau contact") 
      
     ButtonGadget(#bouton_consulter, 220, 140, 200, 30, "Consulter la fiche d'un contact")
      
     ButtonGadget(#Bouton_licence,220,180,200,30,"Licence d'utilisation")
      
  If LoadFont(0, "Times New Roman", 12, #PB_Font_Bold)
     TextGadget(#Nb_contacts, 10, 90, 300, 20, "Nombre de contacts enregistrés  :     " + Str(compter_contacts("A:\Répertoire\"))) 
      SetGadgetFont(#Nb_contacts, FontID())
            
     TextGadget(#text_compte_contacts,10,20,430,30,"Vous pouvez enregistrer un nouveau contact ou consulter une fiche déjà enregistrée. Vous pouvez également créer ou mettre à jour une disquette de sauvegarde de vos contacts.")
    
     Frame3DGadget(#frame01,5,70,440,50,"Inventaire")
      
     Frame3DGadget(#frame02,5,5,440,50,"A partir d'ici...") 
         
     TextGadget(#text_version,10,180,200,30,"Répertoire Private Drive - Version 1 Floppy - 06/2004")
   
    EndIf 
  EndIf
 EndIf 
     
 Repeat  :EventID = WaitWindowEvent() 
    
  Until EventID = #PB_EventCloseWindow Or EventID = #PB_EventGadget             
    CloseWindow(#repertoire) 
   
  If EventID = #PB_EventGadget : Select EventGadgetID() 
    
    Case #bouton_creer
;initialisation des variables    
    pseudo = ReadPreferenceString("Pseudo", "")
    prenom = ""
    nom = ""
    adressedom = ""
    adressetr = ""
    siteweb = ""
    genre = ""
    teld1 = ""
    teld2 = ""
    telt1 = ""
    telt2 = ""
    telm1 = ""
    telm2 = ""
    faxd = ""
    faxt = ""
    emailperso1 = ""
    emailperso2 = ""
    emailtrav1 = ""
    emailtrav2 = ""
    commentairesprive = ""
    commentp1 ="" : commentp2 ="" : commentp3 ="" 
   
          creation_repertoire(0)
  
    Case #bouton_consulter : verif_dossier() : consultation_repertoire() 
         
    Case #Bouton_licence ; un petit message pour faire pro
       MessageRequester("LICENCE D'UTILISATION du REPERTOIRE PRIVATE DRIVE","TOUS DROITS RESERVES A L'AUTEUR"+Chr(13)+""+Chr(13)+"CE LOGICIEL NE PEUT ETRE COPIE, VENDU, NI CEDE A UNE AUTRE PERSONNE PHYSIQUE OU MORALE SANS LE CONSENTEMENT DE L'AUTEUR"+Chr(13)+""+Chr(13)+"Utilisation accordée au GANG DU FORUM PURE BASIC",#MB_ICONINFORMATION | #PB_MessageRequester_Ok)
       ouverture_repertoire()
       
       EndSelect 
      EndIf
EndProcedure

 
Procedure creation_repertoire(Modification.l) 
  If OpenWindow(#fiche_contact, 216, 0, 650, 500, #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_WindowCentered| #PB_Window_Invisible, "ENREGISTREMENT D'UN NOUVEAU GANGSTER PB") 
    
CouleurFenetre = CreateSolidBrush_(RGB(110, 130, 205)) 
 SetClassLong_(WindowID(#fiche_contact), #GCL_HBRBACKGROUND, CouleurFenetre) 
  DeleteObject_(CouleurFenetre) 
   HideWindow(#fiche_contact, 0)
  
    If CreateGadgetList(WindowID())
;Liste des textgadget et stringgadget associés...  
   TextGadget(#Text_0, 200, 10, 40, 20, "Pseudo:")
   StringGadget(#String_0, 250, 10, 200, 20, pseudo) 
   
   TextGadget(#Text_1, 10, 40, 30, 20, "Nom:")
    StringGadget(#String_1, 45, 40, 150, 20, nom,#PB_String_Uppercase)
      
   TextGadget(#Text_2, 210,40,40,20, "Prénom:")
    StringGadget(#String_2,255,40,150,20, prenom)
        
   TextGadget(#Text_3, 10, 60, 85, 20, "Adresse domicile:")
    StringGadget(#String_3, 100, 60, 200, 20, adressedom)
   
   TextGadget(#Text_4, 330, 60, 50, 20, "Pays :")
    StringGadget(#String_4, 385, 60, 230, 20, adressetr,#PB_String_Uppercase)
       
   TextGadget(#Text_5, 10, 90, 100, 20, "Site Web:   http:// ") 
    StringGadget(#String_5, 115, 90, 500, 20, siteweb)
      
   TextGadget(#Text_6, 10, 110, 100, 20, "Genre du contenu:")
    StringGadget(#String_6, 115, 110, 500, 20, genre)
    
   TextGadget(#Text_7, 70, 150, 110, 20, "Téléphone domicile 1:")
    StringGadget(#String_7, 185, 150, 100, 20, teld1,#PB_String_Numeric)
    
   TextGadget(#Text_8, 300, 150, 110, 20, "Téléphone domicile 2:")
    StringGadget(#String_8, 415, 150, 100, 20, teld2,#PB_String_Numeric)
    
   TextGadget(#Text_9, 70, 180, 110, 20, "Tél lieu de travail 1 :")
    StringGadget(#String_9, 185, 180, 100, 20, telt1,#PB_String_Numeric)
      
   TextGadget(#Text_10, 300, 180, 110, 20, "Tél lieu de travail 2:")
    StringGadget(#String_10, 415, 180, 100, 20, telt2,#PB_String_Numeric)
    
   TextGadget(#Text_11, 70, 210, 110, 20, "Téléphone mobile 1:")
    StringGadget(#String_11, 185, 210, 100, 20, telm1,#PB_String_Numeric)
    
   TextGadget(#Text_12, 300, 210, 110, 20, "Téléphone mobile 2:")
    StringGadget(#String_12, 415, 210, 100, 20, telm2,#PB_String_Numeric)
        
   TextGadget(#Text_13, 70, 240, 110, 20, "FAX Domicile:")
    StringGadget(#String_13, 185, 240, 100, 20, faxd,#PB_String_Numeric)
    
   TextGadget(#Text_14, 300, 240, 110, 20, "FAX Travail :")
    StringGadget(#String_14, 415, 240, 100, 20, faxt,#PB_String_Numeric)
    
   TextGadget(#Text_15, 10, 270, 80, 20, "E-mail perso 1 :")
    StringGadget(#String_15, 95, 270, 400, 20, emailperso1)
    
   TextGadget(#Text_16, 10, 290, 80, 20, "E-mail perso 2 :")
    StringGadget(#String_16, 95, 290, 400, 20, emailperso2)
    
   TextGadget(#Text_17, 100, 315, 80, 20, "E-mail travail 1 :")
    StringGadget(#String_17, 195, 315, 400, 20, emailtrav1 )
    
   TextGadget(#Text_18, 100, 335, 80, 20, "E-mail travail 2 :")
    StringGadget(#String_18, 195, 335, 400, 20, emailtrav2) 
;pour faire des commentaires gratinés et perso sur le gangster
;ou encore un rappel rapide de ce qu'il a codé ou ce que vous voulez   
   TextGadget(#Text_19, 10, 370, 150, 20, "Commentaires personnels :")
    StringGadget(#String_19, 165, 370, 465, 20, commentairesprive)
    StringGadget(#String_20, 10, 390, 620, 20, commentp1)
    StringGadget(#String_21, 10, 410, 620, 20, commentp2)
    StringGadget(#String_22, 10, 430, 620, 20, commentp3)
    
 ButtonGadget(#Bouton_creer_contact, 100, 460, 100, 20,"Créer contact") 
 ButtonGadget(#Bouton_annuler, 220, 460, 100, 20,"Annuler")
 ButtonGadget(#voir_une_fiche,340,460,100,20,"Consulter")
    
 Frame3DGadget(#frame04,5,0,640,136,"")     
 Frame3DGadget(#frame05,5,357,630,128,""); délimiteur sympa
 
      
 EndIf : Presentation=0 
    
 Repeat  : EventID = WaitWindowEvent() 
    If EventID = #PB_EventGadget : Select EventGadgetID()  
    
    Case #voir_une_fiche
      CloseWindow(#fiche_contact)
       consultation_repertoire()
        
    Case #bouton_creer_contact
;variable = texte contenu dans string n° 0  ... etc          
    pseudo = GetGadgetText(#String_0)
    nom = GetGadgetText(#String_1)
    prenom = GetGadgetText(#String_2)
    adressedom = GetGadgetText(#String_3)
    adressetr = GetGadgetText(#String_4)
    siteweb = GetGadgetText(#String_5)
    genre = GetGadgetText(#String_6)
    teld1 = GetGadgetText(#String_7)
    teld2 = GetGadgetText(#String_8)
    telt1 = GetGadgetText(#String_9)
    telt2 = GetGadgetText(#String_10)
    telm1 = GetGadgetText(#String_11)
    telm2 = GetGadgetText(#String_12)
    faxd = GetGadgetText(#String_13)
    faxt = GetGadgetText(#String_14)
    emailperso1 = GetGadgetText(#String_15)
    emailperso2 = GetGadgetText(#String_16)
    emailtrav1 = GetGadgetText(#String_17)
    emailtrav2 = GetGadgetText(#String_18)
    commentairesprive = GetGadgetText(#String_19)
    commentp1 = GetGadgetText(#String_20)
    commentp2 = GetGadgetText(#String_21)
    commentp3 = GetGadgetText(#String_22)
   
    CloseWindow(#fiche_contact)
    Presentation = 1 
            
    Case #bouton_annuler
       If Modification  
            Presentation = 1
              EndIf 
            EventID = #PB_EventCloseWindow     
        EndSelect 
      EndIf 
    Until EventID = #PB_EventCloseWindow Or Presentation
    
    CloseWindow(#fiche_contact) 
    
     If Presentation : Presentation()
    Else : ouverture_repertoire()  
    EndIf  
  EndIf 
EndProcedure 

Procedure Presentation()
    
  If OpenWindow(#fiche_contact, 216, 0, 650, 490, #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_WindowCentered| #PB_Window_Invisible, "Présentation de  : "+ pseudo +" - "+ prenom +" "+ nom)
   
CouleurFenetre = CreateSolidBrush_(RGB(110, 130, 205)) 
 SetClassLong_(WindowID(#fiche_contact), #GCL_HBRBACKGROUND, CouleurFenetre) 
  DeleteObject_(CouleurFenetre) 
   HideWindow(#fiche_contact, 0)
  
    If CreateGadgetList(WindowID())
   
     ButtonGadget(#bouton_enregistrer, 530, 150, 100, 20, "Enregistrer") 
      GadgetToolTip(#bouton_enregistrer,"Enregistrer ce nouveau contact ou les modifications sur une fiche existante")
      
     ButtonGadget(#bouton_modifier, 530, 175, 100, 20, "Modifier") 
      GadgetToolTip(#bouton_modifier,"Apporter des modifications à la fiche en cours")
      
     ButtonGadget(#bouton_menu_repertoire, 530, 200, 100, 20, "Retour au menu")
      GadgetToolTip(#bouton_menu_repertoire,"Fenêtre d'accueil") 
      
     ButtonGadget(#bouton_messagerie,530,225,100,20,"Messagerie")
      GadgetToolTip(#bouton_messagerie,"Envoyez un e-mail à "+ pseudo)
      
     ButtonGadget(#autre_fiche,530,250,100,20,"Autre contact")
      GadgetToolTip(#autre_fiche,"Consulter une fiche existante")
      
     ButtonGadget(#nouvelle_fiche,530,275,100,20,"Nouveau contact")
      GadgetToolTip(#nouvelle_fiche,"Enregistrer un nouveau contact dans le répertoire")
      
     ButtonGadget(#acces_siteweb,530,300,100,20,"Sur le Web")
      GadgetToolTip(#acces_siteweb,"Se connecter au site de "+ pseudo)
;chargement d'une police bien grasse pour certains textes      
    If LoadFont(0, "Times New Roman", 10, #PB_Font_Bold)
    
    TextGadget(#text_20, 20, 5, 600, 20,"Mon contact : " + pseudo +" - "+ prenom +" "+ nom, #pb_text_center) 
    SetGadgetFont(#text_20, FontID()) 
        
    TextGadget(#text_21, 10, 35, 80, 20, "Domicile :") 
    TextGadget(#text_22, 100, 35, 400, 20, adressedom)
    SetGadgetFont(#text_22, FontID()); police grasse
    TextGadget(#text_23, 10, 60, 100, 20, "Région du monde : ") 
    TextGadget(#text_24, 120, 60, 400, 20, adressetr)
        
    TextGadget(#text_25, 10, 90, 70, 20, "Site Web : ") 
    TextGadget(#text_26, 90, 90, 500, 20, siteweb)
    SetGadgetFont(#text_26, FontID()) 
    TextGadget(#text_27, 10, 120, 70, 20, "Genre :") 
    TextGadget(#text_28, 80, 120, 510, 20, genre)
    SetGadgetFont(#text_28, FontID())  
    TextGadget(#text_29, 10, 150, 100, 20, "Tel domicile 1 : ") 
    TextGadget(#text_30, 120, 150, 120, 20, teld1)
    SetGadgetFont(#text_30, FontID()) 
    TextGadget(#text_31, 250, 150, 100, 20, "Tel domicile 2: ") 
    TextGadget(#text_32, 360, 150, 120, 20, teld2)
    SetGadgetFont(#text_32, FontID())
    TextGadget(#text_33, 10, 180, 100, 20, "Tel travail 1 : ") 
    TextGadget(#text_34, 120, 180, 120, 20, telt1)
    SetGadgetFont(#text_34, FontID())
    TextGadget(#text_35, 250, 180, 100, 20, "Tel travail 2 : ") 
    TextGadget(#text_36, 360, 180, 120, 20, telt2)
    SetGadgetFont(#text_36, FontID())
    TextGadget(#text_37, 10, 210, 100, 20, "Tel mobile 1 : ") 
    TextGadget(#text_38, 120, 210, 120, 20, telm1)
    SetGadgetFont(#text_38, FontID()) 
    TextGadget(#text_39, 250, 210, 100, 20, "Tel mobile 2 : ") 
    TextGadget(#text_40, 360, 210, 120, 20,  telm2)
    SetGadgetFont(#text_40, FontID())
    
    TextGadget(#text_41, 10, 240, 100, 20, "Fax domicile : ") 
    TextGadget(#text_42, 120, 240, 120, 20, faxd)
    SetGadgetFont(#text_42, FontID())
    TextGadget(#text_43, 250, 240, 100, 20, "Fax travail : ") 
    TextGadget(#text_44, 360, 240, 120, 20, faxt)
    SetGadgetFont(#text_44, FontID())
   
    TextGadget(#Text_45, 10, 270, 80, 20, "E-mail perso 1 : ")    
    TextGadget(#text_46, 95, 270, 400,20, emailperso1)
    SetGadgetFont(#text_46, FontID())
    TextGadget(#Text_47, 10, 290, 80, 20, "E-mail perso 2 : ")    
    TextGadget(#text_48, 95, 290, 400,20, emailperso2)
    SetGadgetFont(#text_48, FontID())
    TextGadget(#Text_49, 10, 310, 80, 20, "E-mail travail 1 : ")    
    TextGadget(#text_50, 95, 310, 400,20, emailtrav1)
    SetGadgetFont(#text_50, FontID())
    TextGadget(#Text_51, 10, 330, 80, 20, "E-mail travail 2 : ")    
    TextGadget(#text_52, 95, 330, 400,20, emailtrav2)
    SetGadgetFont(#text_52, FontID())
    
    TextGadget(#Text_53, 10, 360, 150, 20, "Commentaires personnels : ")    
    TextGadget(#text_54, 165, 360, 480,20, commentairesprive)
    TextGadget(#text_55, 10, 390, 630,20, commentp1)
    TextGadget(#text_56, 10, 420, 630,20, commentp2)
    TextGadget(#text_57, 10, 450, 630,20, commentp3)
       
 EndIf 
      
   Repeat : EventID = WaitWindowEvent() 
        
   Until EventID = #PB_EventCloseWindow Or EventID = #PB_EventGadget 
  CloseWindow(#fiche_contact) 
    If EventID = #PB_EventGadget :Select EventGadgetID() 
            
    Case #bouton_modifier : creation_repertoire(1)
            
    Case #bouton_enregistrer :  creation_dossier() : creation_fichier()
                       
    Case #bouton_menu_repertoire : ouverture_repertoire()
    
    Case #bouton_messagerie : messagerie()
    
    Case #autre_fiche : verif_dossier() : consultation_repertoire()
    
    Case #nouvelle_fiche 
    pseudo = ReadPreferenceString("Pseudo", "")
    prenom = ""
    nom = ""
    adressedom = ""
    adressetr = ""
    siteweb = ""
    genre = ""
    teld1 = ""
    teld2 = ""
    telt1 = ""
    telt2 = ""
    telm1 = ""
    telm2 = ""
    faxd = ""
    faxt = ""
    emailperso1 = ""
    emailperso2 = ""
    emailtrav1 = ""
    emailtrav2 = ""
    commentairesprive = ""
    commentp1 ="" : commentp2 ="" : commentp3 ="" 
   
    creation_repertoire(0) 
    
    Case #acces_siteweb : RunProgram("http://"+ siteweb)
    
       EndSelect 
      EndIf   
    EndIf 
  EndIf   
EndProcedure

Procedure messagerie()
;Pour ne saisir les adresses e-mail qu'une fois, lors de la 
;création de la fiche. Puis renvoi automatique des e-mails dans une 
;fenêtre qui les rend actifs.
 If OpenWindow(#messagerie, 216, 0, 530, 330, #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_WindowCentered| #PB_Window_Invisible, "Envoi d'un message à : "+ pseudo +" - "+ prenom +" "+ nom) 
   
CouleurFenetre = CreateSolidBrush_(RGB(110, 130, 205)) 
 SetClassLong_(WindowID(#messagerie), #GCL_HBRBACKGROUND, CouleurFenetre) 
  DeleteObject_(CouleurFenetre) 
   HideWindow(#messagerie, 0)
  
    If CreateGadgetList(WindowID())
       TextGadget(#choix_email, 10, 20, 500, 20, "Choisir à quelle adresse puis cliquer sur le bouton correspondant pour envoyer le message")
        Frame3DGadget(#frame07,5,5,515,40,"")
     
     If LoadFont(2, "Times New Roman", 10, #PB_Font_Bold)
     
    TextGadget(#em_1, 10,60,500,20, "E-mail perso 1 :     "+ emailperso1)    
     SetGadgetFont(#em_1, FontID())
   
       ButtonGadget(#bouton_em_1,100,85,200,20,"Créer le message et l'envoyer") 
        Frame3DGadget(#frame08,5,50,515,60,"")
       
    TextGadget(#em_2, 10,130,500,20,"E-mail perso 2 :     "+ emailperso2)
     SetGadgetFont(#em_2, FontID())
 
       ButtonGadget(#bouton_em_2,100,155,200,20,"Créer le message et l'envoyer")
        Frame3DGadget(#frame09,5,120,515,60,"")
    
    TextGadget(#em_3, 10,200,500,20,"E-mail travail 1 :     "+ emailtrav1)
     SetGadgetFont(#em_3, FontID())
  
        ButtonGadget(#bouton_em_3,100,225,200,20,"Créer le message et l'envoyer")
        Frame3DGadget(#frame10,5,190,515,60,"")
    
    TextGadget(#em_4, 10,270,500,20,"E-mail travail 2 :     "+ emailtrav2)
     SetGadgetFont(#em_4, FontID())
   
       ButtonGadget(#bouton_em_4,100,295,200,20,"Créer le message et l'envoyer")
        Frame3DGadget(#frame11,5,260,515,60,"")
        
      EndIf 
     EndIf 
    EndIf   
    
 Repeat : EventID = WaitWindowEvent() 
        
   Until EventID = #PB_EventCloseWindow Or EventID = #PB_EventGadget 
      
    CloseWindow(#messagerie) 
    
    If EventID = #PB_EventGadget 
        Select EventGadgetID() 
   ;Ouverture de votre log de messagerie par défaut prêt à l'envoi     
         Case #bouton_em_1 : RunProgram("mailto:" + emailperso1)

         Case #bouton_em_2 : RunProgram("mailto:" + emailperso2)
         
         Case #bouton_em_3 : RunProgram("mailto:" + emailtrav1)
         
         Case #bouton_em_4 : RunProgram("mailto:" + emailtrav2)
         
     EndSelect 
    EndIf 
   Presentation()  
EndProcedure 

Procedure verif_dossier()
;On vérifie si le dossier a été créé et s'il contient des fichiers
Fichier.s = "A:\RépertoireGPB\*.txt"
Contenu = FileSize(Fichier)
 If Contenu = -1 ;s'il n'y a rien...
   MessageRequester("FARCEUR !", "VOUS N'AVEZ ENCORE AUCUN CONTACT DANS VOTRE REPERTOIRE",#MB_ICONEXCLAMATION | #PB_MessageRequester_Ok)
 EndIf 
EndProcedure 

Procedure creation_dossier()
;Création automatique du dossier lors du premier enregistrement de fichier
  Dossier.s = "\RépertoireGPB"
   Resultat = CreateDirectory("A:\RépertoireGPB")
    If FileSize(Dossier.s)>0 ;si le dossier existe...
      creation_fichier();on créé le fichier
    If Resultat = 1;si le dossier n'existe pas, on le créé
      creation_fichier();et on enrgistre le fichier dedans
    If Resultat = 0; si on ne parvient à créer ni dossier, ni fichier ...
     MessageRequester("PROBLEME", "IMPOSSIBLE DE CREER LE DOSSIER",#MB_ICONWARNING | #PB_MessageRequester_Ok)   
   EndIf   
  EndIf 
 EndIf 
EndProcedure 

Procedure creation_fichier()
;Enregistrement de la fiche créée directement dans le répertoire sur la 
;disquette. Le nom du fichier créé est celui du contact
 Fichier.s = SaveFileRequester("Enregistrer le Gangster PB", "A:\RépertoireGPB\" + pseudo +" - "+ prenom +" "+ nom + ".txt", "Gangster|*.txt", 0)  
  
  If Fichier = ""     
    Else   
      If GetExtensionPart(Fichier) = ""  
        Fichier = Fichier + ".txt"  
      EndIf
    fiche.s = GetFilePart(Fichier.s) : EnregistreFichier = #True 
   If FileSize(Fichier.s)>0 ;si le nom du fichier, donc du contact existe déjà (cas d'une modification)...
    Reponse = MessageRequester("CE CONTACT EXISTE DEJA !","Voulez-vous remplacer le contact  :  " + fiche.s + "  ?  Il a déjà été enregistré !",#MB_ICONEXCLAMATION | #PB_MessageRequester_YesNo ) 
     If Reponse = 6 : a$ + "Yes"
       ElseIf Reponse = 7 : a$ + "No"
        Else  : a$ + "Cancel" 
     EndIf  
      If Reponse <> 6  : EnregistreFichier = #False 
  EndIf 
 EndIf 
EndIf 

   If EnregistreFichier  
     If CreatePreferences(Fichier)  
     
      WritePreferenceString("Nom",nom)
      WritePreferenceString("Prénom",prenom)
      WritePreferenceString("Pseudo",pseudo) 
      WritePreferenceString("Domicile",adressedom)
      WritePreferenceString("Pays",adressetr)
      WritePreferenceString("Site Web", siteweb)
      WritePreferenceString("Genre",genre)  
      WritePreferenceString("Téléphone domicile 1",teld1) 
      WritePreferenceString("Téléphone domicile 2",teld2)
      WritePreferenceString("Téléphone lieu de travail 1",telt1)
      WritePreferenceString("Téléphone lieu de travail 2",telt2)
      WritePreferenceString("Téléphone mobile 1",telm1)
      WritePreferenceString("Téléphone mobile 2",telm1) 
      WritePreferenceString("Fax domicile",faxd)
      WritePreferenceString("Fax travail",faxt)
      WritePreferenceString("E-mail perso 1",emailperso1)
      WritePreferenceString("E-mail perso 2",emailperso2)
      WritePreferenceString("E-mail travail 1",emailtrav1)
      WritePreferenceString("E-mail travail 2",emailtrav2)
      WritePreferenceString("Commentaires perso",commentairesprive)
      WritePreferenceString("-",commentp1)
      WritePreferenceString("-",commentp2)
      WritePreferenceString("-",commentp3)
      ClosePreferences() 
      
      MessageRequester("VALIDATION", "Le Gangster PB suivant  :" + pseudo +" - "+ prenom +" " + nom + "   a été bien enregistré",#MB_ICONINFORMATION | #PB_MessageRequester_Ok)       
    Else 
      MessageRequester("PROBLEME !", "Impossible de créer le fichier"+Chr(13)+""+Chr(13)+"Vous avez sûrement été Gangstérisé !",#MB_ICONWARNING | #PB_MessageRequester_Ok) 
    EndIf 
   EndIf 
  
    Presentation() 
EndProcedure

Procedure consultation_repertoire()

Fichier.s = OpenFileRequester("Voir la fiche d'un Gangster", "A:\RépertoireGPB\","Gangster|*.txt", 0)
  If Fichier = "" 
    ouverture_repertoire() ; ou au choix : creation_repertoire(0)  
  Else 
    If  OpenPreferences(Fichier)
;Veillez ici à conserver les mêmes valeurs que pour l'écriture, 
;et vis versa. ex: WritePreferenceString("Nom",nom) 
;donc > ReadPreferenceString("Nom","") et pas ReadPreferenceString("nom","")
;sinon plantage, le programme ne lira pas ou ecrira n'importe où (j'ai essayé)  
    nom = ReadPreferenceString("Nom","")
    prenom = ReadPreferenceString("Prénom","")
    pseudo = ReadPreferenceString("Pseudo","")
    adressedom = ReadPreferenceString("Domicile","")
    adressetr = ReadPreferenceString("Pays","")
    siteweb = ReadPreferenceString("Site Web","")
    genre = ReadPreferenceString("Genre","")
    teld1 = ReadPreferenceString("Téléphone domicile 1","")
    teld2 = ReadPreferenceString("Téléphone domicile 2","")
    telt1 = ReadPreferenceString("Téléphone lieu de travail 1","")
    telt2 = ReadPreferenceString("Téléphone lieu de travail 2","")
    telm1 = ReadPreferenceString("Téléphone mobile 1","")
    telm2 = ReadPreferenceString("Téléphone mobile 2","")
    faxd = ReadPreferenceString("Fax domicile","")
    faxt = ReadPreferenceString("Fax travail","")
    emailperso1 = ReadPreferenceString("E-mail perso 1","")
    emailperso2 = ReadPreferenceString("E-mail perso 2","")
    emailtrav1 = ReadPreferenceString("E-mail travail 1","")
    emailtrav2 = ReadPreferenceString("E-mail travail 2","")
    commentairesprive = ReadPreferenceString("Commentaires perso","")
    commentp1 = ReadPreferenceString("-","")
    commentp2 = ReadPreferenceString("-","")
    commentp3 = ReadPreferenceString("-","")
    
    ClosePreferences()  : Presentation()   
    EndIf 
  EndIf 
EndProcedure
ouverture_repertoire();retour au menu principal
@ + Jacobus

Publié : dim. 20/juin/2004 15:24
par hardy
Nan, mais plus personne n'utilise de disquette! Il y a les flash disks :mrgreen:

Publié : dim. 20/juin/2004 15:24
par Anonyme2
Jacobus a écrit ::( Je te remercie Denis, mais bien qu'ayant suivi tes instructions à la lettre, ta Lib ne fonctionne pas chez moi.

Pire... m'a planté le PBcompiler :roll:

J'ai dû tout réinstaller PB.

Je suppose que j'ai fait un truc qui fallait pas mais je sais pas où...

Tu dis que ta librairie est un fichier sans extension à mettre dans users lib,
mais lors des essais de compilation les fonctions ne sont pas reconnues.

ne faut-il pas lui ajouter l'extension .lib, puis l'appeler via OpenLibrary() ?

Bah...je sèche sur le coup.

Un coup de pouce pour débloquer mes neurones serait le bienvenu, merci.

Jacobus

:?: :?: :?:
Tu as quelle version de PB ? Quelle version de windows ?

Sinon le fichier est bien sans extension à mettre dans le répertoire PureBasic\PureLibraries\UserLibraries

Ensuite tu ferme puis tu ouvre à nouveau l'éditeur PureBasic ou tu utilise la commande de l'éditeur "redémarrer le compilateur".

Si la commande Setgadgetcolor() n'est pas reconnu c'est que la librairie n'est pas au bon endroit.

Ca marche avec Pure 3.91 beta mais surement avec les versions précédantes, il me semble pas avoir utiliser de commandes spécifique du type Isgadget ou autre.

Publié : dim. 20/juin/2004 16:26
par Jacobus
@ Hardy :
Ben moi si, j'utilise encore des disquettes
et c'est quoi Flash disk ? :??: Euh désolé...connais pas...
Dans ma cambrousse je suis ravitaillé par les corbeaux, et le Haut Débit reste un voeu pieu... alors c'est sûr je dois louper quelques trucs :roll:

@ Denis :
C'est pourtant bien la procédure que j'ai suivi.
Sauf que je n'ai pas redémarré le compiler. #spin
...Viens p't-être de là, je vais réessayer ça.

j'ai PB 3.90 et Windows Me

Merci à vous, Jacobus

Publié : dim. 20/juin/2004 17:17
par Backup
c'est pas une petite clef USB qui contient des puces de memoire
et qui permet de l'utiliser comme une disquette sauf que t'a au minimum
512 K demande au Soldat inconu il en a une y va te poster la photo :lol:

Publié : dim. 20/juin/2004 17:34
par Jacobus
@ Dobro... je crois bien que tu as raison :D
j'ai déjà lu un post du soldat où il parlait d'une clef
qu'il trimballe partout...
Faut que j'aille faire les boutiques spécialisées, japprendrai :lol:

@ Denis... Euh... je ne peux plus charger ta lib sur ton site,
Est-ce normal ? ( l'autre est partie au nettoyage :mrgreen: )

Publié : dim. 20/juin/2004 17:45
par Jacobus
:) Enfin, la Librairie est de retour. J'essaye.
@ +

Publié : dim. 20/juin/2004 18:12
par Jacobus
@ Denis :mad:
C'est génial ! Le PB Compiler est encore planté !
Chouette! #jaune faut je remette tout à neuf.

Honnêtement, si ça marche chez les autres je vois pas pourquoi mon PB ne veut pas de ta librairie :?: :?:

Non seulement ça plante le compiler... mais définitivement.
Bousillé... peux plus rien faire avec.

Bouarf... je vais un tour
Rrrrôôôgggnnnntuuûûûddjjjjûûûû de Rrrrôôôgggnnnntuuûûûddjjjjûûûû

@ + Jacobus

Publié : dim. 20/juin/2004 18:54
par hardy
Ben oui, un flash disk c'est tout petit, ça pèse 20 grammes, ça stocke de 128 à 512Mo, ça se branche sur la prise USB, et c'est rapide d'accès.
Moi je promène toujours le mien avec mes stylos pour les transferts de données.
Puis maintenant c'est plus bien cher. t'en as un pour 60 euros.

Publié : dim. 20/juin/2004 20:01
par Anonyme2
Jacobus a écrit :@ Denis :mad:
C'est génial ! Le PB Compiler est encore planté !
Chouette! #jaune faut je remette tout à neuf.

Honnêtement, si ça marche chez les autres je vois pas pourquoi mon PB ne veut pas de ta librairie :?: :?:

Non seulement ça plante le compiler... mais définitivement.
Bousillé... peux plus rien faire avec.

Bouarf... je vais un tour
Rrrrôôôgggnnnntuuûûûddjjjjûûûû de Rrrrôôôgggnnnntuuûûûddjjjjûûûû

@ + Jacobus
Désolé :oops:
ca marche pourtant sous XP et WIN 98
Je vais regarder mon code pour voir si je trouve quelque chse.