@ 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
Répertoire Private Drive GPB
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
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
Il n'y a pas de raison de changer de machine car une lib ne fonctionne pas à prioriJacobus 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
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.
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
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)
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
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
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 :
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.
@+
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.
@+