après qq jours sur PureBASIC, je vous livre mon 1er programme, qui casse pas 3 pattes à un canard, mais bref.
Je l'ai fait car j'ai arrété de fumer et je me suis dit qu'il serait bien d'afficher (à chaque démarrage de mon micro) le montant économisé.
Code : Tout sélectionner
; ************************************************************
; * Project Name: StopTabac
; * Author(s) : Nicolas 'Flaith' Djurovic
; * Date Started: 04/16/2005
; * Last Updated: 04/18/2005
; * Website : http://flaith.free.fr
; * Email : flaith@wanadoo.fr
; * Version : 2.0
; * Copyright : CopyLeft 2005 Flaith
; * Licence : GPL
; * PB Version : 3.93
; ************************************************************
;
; Procédures utilisées
; --------------------
; Procédures calcul de date
; Auteur : Paneric
; Date : 22/09/2004
;
; Librairie extérieure utilisée
; -----------------------------
; PureCOLOR Librairies v8
; Auteur : Philippe 'gnozal' Guntz
; Date : 02/04/2005
;- Globals
;
Global d.l,m.l,y.l
Global D1.l,M1.l,Y1.l
Global l1$,l2$,l3$,l4$,l5$,l6$
Global Appli_Name$,Version_Appli$
Global NBPaquet.f,PrixPaquet.f,Euro.f
Global NBPaquet_txt$,PrixPaquet_txt$,Euro_txt$
;- Window Constants
;
Enumeration
#Window
EndEnumeration
;- Gadget Constants
;
Enumeration
#ALTF4
#Frame3D
#Text_0
#Text_1
#Text_2
#Text_3
#Text_4
#Text_5
#Button
#Text_Date
#Text_Today
#Text_Diff
#Text_gagne
#Text_gagen_fr
#Text_euro
#Text_fr
EndEnumeration
;- Fonts
;
Global FontID1
FontID1 = LoadFont(1, "Verdana Ref", 10)
Global FontID2
FontID2 = LoadFont(2, "Courier New", 10)
Global FontID3
FontID3 = LoadFont(3, "Courier New", 12)
;- Procédures
;
Procedure.l NombredeJoursduMois(mois.l, annee.l)
longueurdumois.l = 0
If mois = 4 Or mois = 8 Or mois = 9 Or mois = 11
longueurdumois = 30
Else
If mois = 2
If annee % 4 = 0
If annee%100 = 0 And annee%400 <> 0
longueurdumois = 28
Else
longueurdumois = 29
EndIf
Else
longueurdumois = 28
EndIf
Else
longueurdumois = 31
EndIf
EndIf
ProcedureReturn longueurdumois
EndProcedure
Procedure.l NombredeJoursentreDate(jour1.l, mois1.l, annee1.l, jour2.l, mois2.l, annee2.l)
Intervalle.l = 0
m.l = 0
If annee1 + 1 <= annee2 - 1
For j.l = annee1.l To annee2.l
longueurdumois.l = NombredeJoursduMois(2, j)
If longueurdumois = 28
Intervalle + 365
Else
Intervalle + 366
EndIf
Next j
EndIf
If annee1 < annee2
send.l = 12
Else
send = mois2 - 1
EndIf
If mois1 < send
For m = mois1 + 1 To send
Intervalle + NombredeJoursduMois(m, annne1)
Next m
EndIf
If mois2 > 1 And send = 12
For m = 1 To mois2 - 1
Intervalle + NombredeJoursduMois(m, annne2)
Next m
EndIf
If (mois1 = mois2) And (annee1 = annee2)
Intervalle = jour2 - jour1
Else
Intervalle + (NombredeJoursduMois(mois1, annee1) - jour1)
Intervalle + jour2
EndIf
ProcedureReturn Intervalle
EndProcedure
Procedure Load_Prefs()
ValReturn=0
If OpenPreferences("StopTabac.prefs")
PreferenceGroup("InfoAppli")
Appli_Name$ = ReadPreferenceString("ApplicationName", "")
Version_Appli$ = ReadPreferenceString("Version", "")
PreferenceGroup("Global")
D1.l = ReadPreferenceLong ("JourDeb", 0)
M1.l = ReadPreferenceLong ("MoisDeb", 0)
Y1.l = ReadPreferenceLong ("AnneeDeb", 0)
NBPaquet.f = ReadPreferenceFloat ("NBPaquet", 0.0)
PrixPaquet.f = ReadPreferenceFloat ("PrixPaquet", 0.0)
Euro.f = ReadPreferenceFloat ("Euro", 0.0)
NBPaquet_txt$ = ReadPreferenceString("NBPaquet", "")
PrixPaquet_txt$ = ReadPreferenceString("PrixPaquet", "")
Euro_txt$ = ReadPreferenceString("Euro", "")
ClosePreferences()
Else
MessageRequester("Erreur","Fichier "+Chr(34)+"StopTabac.prefs"+Chr(34)+" inexistant !", #PB_MessageRequester_Ok)
ValReturn = 1
ProcedureReturn ValReturn
EndIf
EndProcedure
;
Procedure CheckDate()
; Si pb avec fichier prefs, on quitte
If Load_Prefs() = 1
End
EndIf
; Date du jour
y.l = Year(Date())
m.l = Month(Date())
d.l = Day(Date())
; Nbre de jours depuis l'arrêt
diff.f = NombredeJoursentreDate(D1, M1, Y1,d, m, y)
diff - 1 ;j'enlève une journée car il faut qu'elle soit finie
; Calcul des montants économisés (en Euro et Franc)
prix_paquet_clope.f = PrixPaquet.f * NBPaquet.f
money.f = diff.f * prix_paquet_clope.f
moneyfranc.f = money.f * Euro.f ;6.55957
; Prépare l'affichage des valeurs
l1$ = Str(D1)+"/"+Str(M1)+"/"+Str(Y1)
l2$ = Str(d)+"/"+Str(m)+"/"+Str(y)+l0$
l3$ = Str(diff)+" Jours"
l4$ = StrF(money.f,2)
l5$ = StrF(moneyfranc.f,2)
l6$ = "Montant pour "+NBPaquet_txt$+" paquet(s) par jour à "+PrixPaquet_txt$+"€ le paquet !"
EndProcedure
; CallBack pour PureCOLOR
Procedure.l WindowCallBack(WindowID.l, message.l, wParam.l, lParam.l)
ReturnValue.l = #PB_ProcessPureBasicEvents
;
ReturnValue = PureCOLOR_CallBack(WindowID, message, wParam, lParam, ReturnValue)
;
ProcedureReturn ReturnValue
EndProcedure
Procedure Open_Window()
If OpenWindow(#Window, 216, 0, 371, 271, #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_WindowCentered , "Stop Tabac")
If CreateGadgetList(WindowID())
AddKeyboardShortcut(0, #PB_Shortcut_F4 | #PB_Shortcut_Alt, #ALTF4)
Frame3DGadget(#Frame3D, 10, 10, 350, 210, "")
SetGadgetFont(#Frame3D, FontID1)
TextGadget(#Text_0, 20, 30, 160, 20, "Date arrêt :")
SetGadgetFont(#Text_0, FontID3)
TextGadget(#Text_1, 20, 50, 160, 20, "Date du jour :")
SetGadgetFont(#Text_1, FontID3)
TextGadget(#Text_2, 20, 70, 160, 20, "Différence :")
SetGadgetFont(#Text_2, FontID3)
TextGadget(#Text_3, 20, 110, 160, 20, "J'ai économisé :")
SetGadgetFont(#Text_3, FontID3)
TextGadget(#Text_4, 20, 130, 160, 20, "Soit :")
SetGadgetFont(#Text_4, FontID3)
TextGadget(#Text_5, 20, 170, 330, 40, l6$, #PB_Text_Center | #PB_Text_Border)
SetGadgetFont(#Text_5, FontID2)
ButtonGadget(#Button, 140, 230, 90, 30, "Ok")
SetGadgetFont(#Button, FontID3)
TextGadget(#Text_Date, 190, 30, 120, 20, l1$, #PB_Text_Center | #PB_Text_Border)
SetGadgetFont(#Text_Date, FontID3)
TextGadget(#Text_Today, 190, 50, 120, 20, l2$, #PB_Text_Center | #PB_Text_Border)
SetGadgetFont(#Text_Today, FontID3)
TextGadget(#Text_Diff, 190, 70, 120, 20, l3$, #PB_Text_Center | #PB_Text_Border)
SetGadgetFont(#Text_Diff, FontID3)
TextGadget(#Text_gagne, 190, 110, 100, 20, l4$, #PB_Text_Right | #PB_Text_Border)
SetGadgetFont(#Text_gagne, FontID3)
TextGadget(#Text_gagen_fr, 190, 130, 100, 20, l5$, #PB_Text_Right | #PB_Text_Border)
SetGadgetFont(#Text_gagen_fr, FontID3)
TextGadget(#Text_euro, 290, 112, 20, 20, "€")
SetGadgetFont(#Text_euro, FontID3)
TextGadget(#Text_fr, 290, 132, 20, 20, "Fr")
SetGadgetFont(#Text_fr, FontID3)
EndIf
EndIf
; Crée un raccourci clavier CTRL+O sur la fenêtre #Window
; qui generera un evenement de valeur #CTRL_O.
AddKeyboardShortcut(#Window, #PB_Shortcut_Control | #PB_Shortcut_O, #Button)
EndProcedure
Procedure Make_Color()
PureCOLOR_SetGadgetColor(#Text_Date, #White, BackColor.l)
PureCOLOR_SetGadgetColor(#Text_Today, #White, BackColor.l)
PureCOLOR_SetGadgetColor(#Text_Diff, #White, BackColor.l)
PureCOLOR_SetGadgetColor(#Text_gagne, #White, BackColor.l)
PureCOLOR_SetGadgetColor(#Text_gagen_fr, #White, BackColor.l)
PureCOLOR_SetGadgetColor(#Text_5, #Black, #White)
EndProcedure
;- Programme Principal
;
Quit = 0
CheckDate()
Open_Window()
SetWindowCallback(@WindowCallBack())
Make_Color()
Repeat
Event = WaitWindowEvent() ; on récupère les évènements
If Event = #PB_Event_CloseWindow
Quit = 1
EndIf
If Event = #PB_EventGadget ; si on appuie sur un gadget
Select EventGadgetID()
Case #Button ; on appuie sur le bouton OK
Quit = 1
EndSelect
EndIf
If Event = #PB_EventMenu
Select EventMenuID()
Case #ALTF4 ; Alt-F4
Quit = 1
Case #Button ; ou Ctrl-O pour quitter
Quit = 1
EndSelect
EndIf
Until Quit = 1
Code : Tout sélectionner
[InfoAppli]
ApplicationName = StopTabac
Version = 2.0
;
; Les variables globales
;
[Global]
; Date début arrêt du tabac
JourDeb = 28
MoisDeb = 1
AnneeDeb = 2005
; Nombre de paquet fumé par jour
NBPaquet = 1.5
PrixPaquet = 5.60
Euro = 6.559570
Excellent fouteur de boules ton programme, pour ceux qui fument encore ! 
et quand je vais chez le buraliste, je sais combien ça me coûte 
c'est le but, ca me fait plaisir de voir combien ca m'aurait couté si j'avais continué à fumer !
