PureBasic

Forums PureBasic - Français
https://www.purebasic.fr/french/

Stop Tabac

https://www.purebasic.fr/french/viewtopic.php?t=2747

Page 1 sur 1

Stop Tabac

Publié : jeu. 21/avr./2005 18:58
par flaith
Bonjour à Tous,
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
Fichier des preferences : StopTabac.prefs

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

Publié : jeu. 21/avr./2005 19:47
par Jacobus
:) Excellent fouteur de boules ton programme, pour ceux qui fument encore !

Moi, je fume la pipe :lol: et quand je vais chez le buraliste, je sais combien ça me coûte :mad:

Publié : ven. 22/avr./2005 8:48
par flaith
Arf, je sais :D c'est le but, ca me fait plaisir de voir combien ca m'aurait couté si j'avais continué à fumer !
J'ai envoyé le prog à qq potes gros fumeur, ca les calme 8O

Publié : ven. 22/avr./2005 9:30
par Oliv
Je ferais bien voir ça à mon père mais je vais me prendre des baffes :cry:

Publié : ven. 22/avr./2005 9:48
par cederavic
Oliv a écrit :Je ferais bien voir ça à mon père mais je vais me prendre des baffes :cry:
Moi je le regarderais bien, mais je me metrais des baffes aussi :roll:

Publié : ven. 22/avr./2005 9:55
par Le Soldat Inconnu
oh :lol: des baffes

pourtant qu'est-ce que les fumeurs claquent en pognon :
Pour flaith, en un an ça donne :
1.5*5.6*365 = 3066€ (soit plus de 20000F) :!:

Publié : ven. 22/avr./2005 14:25
par Oliv
Pendant un moment mon père (mais heuresement pour sa santé ET son compte en banque) c'était 2 paquets de gitanes par jour (il y a 4-5 ans, c'était un peu moins chère mais bon...) : calculez le prix :cry:

Publié : dim. 24/avr./2005 7:35
par bernard13
ton programme marche pas
quand je lance il trouve pas le fichier StopTabac.prefs...

Publié : dim. 24/avr./2005 8:29
par flaith
bernard13 a écrit :ton programme marche pas
quand je lance il trouve pas le fichier StopTabac.prefs...
La dernière partie du code citée plus haut doit être enregistrée sous ce nom :wink:
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru