Répertoire Private Drive GPB

Jacobus · Message par **Jacobus** » dim. 20/juin/2004 20:46

@ Denis :

Pas grave... exaspérant mais pas grave.
Tout est revenu dans l'ordre en supprimant
ta Librairie de Userlib et en nettoyant le registre.

Donc cela vient bien du fait que Mon PB 3.90 ne
supporte pas cette librairie. Pourquoi ?
that is the question...
Merci quand même

@ Hardy :
Ben oui... mais je savais pas.

Du coup je vais donc faire comme l'a suggéré DominiqueB
je vais seulement créer la direction du répertoire et laisser
celle du support, que ce soit un Flask disk ou un disk mou,
au libre choix de l'utilisateur.

Salut à tous et merci encore

jacobus

Anonyme2 · Message par **Anonyme2** » lun. 21/juin/2004 6:30

Jacobus a écrit :@ Denis :
Pas grave... exaspérant mais pas grave.
Tout est revenu dans l'ordre en supprimant
ta Librairie de Userlib et en nettoyant le registre.

Le registre ?

Pour PB surement car je n'écris rien dans le registre avec cette lib

Jacobus · Message par **Jacobus** » lun. 21/juin/2004 9:02

Salut Denis,

Oui, ta lib pas de problème pour la sortir,
mais j'ai constaté que des clefs du registre
étaient créées à chaque tentative de son utilisation.
Notamment qui envoyaient sur mspaint et PaintBrush.exe
de fait, lors de la suppression, les chemins ne menaient
plus nulle part. D'où le nettoyage du registre.

la première fois que j'ai utilisé ta librairie et que compiler a planté, malgré la suppresion de la librairie du dossier userlibrary, le compiler restait HS,
et impossible de revenir à la normale et PB était inutilisable. Pas songé au registre à ce moment là. J'ai alors dû le désinstaller et le réinstaller.

Par contre hier, en voyant que cela recommencait, j'ai préféré faire une vérification du registre avant de tout réinstaller. Et miracle cela a suffit.
Je suppose donc que ta librairie utilise MsPaint et PaintBrush pour colorier les gadgets et visiblement le compiler doit avoir un problème avec sur ma bécane, il se peut donc qu'il n'y ai pas de solution pour mon cas.
Si ce n'est de changer de machine

Dommage j'aimai bien l'idée et la syntaxe simple de ta librairie pour le coloriage. J'ai essayé avec une CallBack (une ça marche... une fois sur deux) mais je me suis planté royal en utilisant une deuxième Callback,
donc je crois que tant que je ne saurai pas faire mieux, mes gadgets resteront gris, tanpis.

@ + Jacobus

Anonyme2 · Message par **Anonyme2** » lun. 21/juin/2004 11:39

Jacobus a écrit : Salut Denis,
Par contre hier, en voyant que cela recommencait, j'ai préféré faire une vérification du registre avant de tout réinstaller. Et miracle cela a suffit.
Je suppose donc que ta librairie utilise MsPaint et PaintBrush pour colorier les gadgets et visiblement le compiler doit avoir un problème avec sur ma bécane, il se peut donc qu'il n'y ai pas de solution pour mon cas.
Si ce n'est de changer de machine
@ + Jacobus

Il n'y a pas de raison de changer de machine car une lib ne fonctionne pas à priori

Je n'utilise que du code simple avec des API window classiques du genre DeleteObject, CreateSolidBrush, GetParent, SetWindowLong, Getsyscolor, RedrawWindow, GetWindowLong, SetBkMode, SetTextColor, SetBkColor, CallWindowProc, GetClassName, lstrcmpiA et quelques fonctions purebasic; mais à aucun moment je n'utilise MSpaint ou PaintBrush .

Chaque fois qu'un gadget est mis en couleur, je mémorise ses paramètres dans une liste chainée qui est parcourue dans la callback.

A la fin je libère la mémoire des brush en parcourant la liste chainée qui contient les handles des brush valides.

Je n'accède pas du tout au registre mais c'est peut-être normal que d'autre prog y accèdent. Si tu utilise Regedit, tu verra que les accès se font presque sans arrêts même pour des logiciels qui ne semblent pas ouverts.

C'est vraiment bizarre car c'est du code vraiment classique et pas très long.

Je vais vérifier le fichier sur mon site.

Anonyme2 · Message par **Anonyme2** » lun. 21/juin/2004 14:41

Pour me faire pardonner (Mais de quoi ?) je t'ai mis une petite procedure Callback qui intercepte les Messages pour la couleur.

Je n'ai mis que de la couleur aux gadgets de la première fenêtre.

J'ai déclaré la variable CouleurFenetre comme globale

J'ai ajouté la procédure MyCallback qui gère la couleur

J'ai ajouté la ligne SetWindowCallback(@MyCallback()) dans la procédure ouverture_repertoire() qui indique à Pure qu'il y a une procédure d'interception d'événements en plus de la boucle principale.

Comme la Brush CouleurFenetre est utilisé sans arrêts par le prog, il ne faut pas la détruire dès que le fond de la fenêtre est peint, c'est pour ça que le deleteObject est à la fin du prog

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 
Global CouleurFenetre   ; brush utilisée dans la callback etc

;- 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() 


Procedure MyCallback(Window.l, Message.l, wParam.l, lParam.l)
  ; ici on répond à certains messages dont on n'a pas accès dans la boucle d'événements Purebasic
  ; en particulier pour mettre en couleur certains gadgets
   ReturnValue = #PB_ProcessPureBasicEvents

  Select Message
     Case #WM_CTLCOLORSTATIC   
         ; pour les Frame3D
          If lparam = GadgetID(#frame01) Or lparam = GadgetID(#frame02) 
            SetBkMode_(wParam, #TRANSPARENT)
            SetTextColor_(wParam, #white) ; Couleur du text blanc ; #white = $FFFFFF 
            ReturnValue = CouleurFenetre ; on doit retourner la Brush de la couleur du fond
            
          ElseIf lparam = GadgetID(#text_compte_contacts) Or lparam = GadgetID(#text_version) Or lparam = GadgetID(#Nb_contacts)
           ; pour les Textgadget
            SetBkMode_(wParam, #TRANSPARENT)  ; définit le mode pour le fond du text
            SetTextColor_(wParam, 0)   ; Couleur du text 0 = noir 
            ReturnValue = CouleurFenetre  ; on doit retourner la Brush de la couleur du fond
          EndIf
  EndSelect

 ProcedureReturn ReturnValue
  
EndProcedure
        
;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) 
    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 
 SetWindowCallback(@MyCallback())
 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

DeleteObject_(CouleurFenetre)

Jacobus · Message par **Jacobus** » lun. 21/juin/2004 14:59

Merci Denis,
Je te rassure tu n'as rien à te faire pardonner
Chuis pas du genre à me prendre la tête pour des bricoles.
Si ça marche tant mieux sinon tanpis, je cherche un autre moyen.

Ton arrangement va me permettre d'étudier ça en détails
je t'en remercie encore, très sympa de ta part.

@ + Jacobus

Jacobus · Message par **Jacobus** » lun. 21/juin/2004 15:18

Y a des fois ... on se demande...

Lancement du code en compilation avec mode debugger
Le programme fonctionne, affichage de la fenêtre principale
soit ouverture_repertoire sans problème.
Si on clic sur le bouton "Enregistrer un nouveau contact"
BLAM ! Pure Basic a provoqué une erreur et va maintenant être arrêté.
Mais le debugger a le temps d'afficher qu'à la ligne n°.. il y a un object non initialisé. Très exactement ici :

Code : Tout sélectionner

Case #WM_CTLCOLORSTATIC    
         ; pour les Frame3D 
    [b]==>Là =>[/b]If lparam = GadgetID(#frame01) Or lparam = GadgetID(#frame02) 
            SetBkMode_(wParam, #TRANSPARENT) 
            SetTextColor_(wParam, #white) ; Couleur du text blanc ; #white = $FFFFFF 
            ReturnValue = CouleurFenetre ; on doit retourner la Brush de la couleur du fond

Se pourrait-il que du fait de la colorisation des autres fenêtres et donc du DeleteObject qui s'y trouve cela soit à l'origine du blème.
je vais tester ça, auquel cas on ne pourrait avoir qu'une fenêtre colorée.
@+