Gambas France BETA


Pas de compte ? Incription

Exemple 14 :

Gérer les dates et les formats locaux :


À l'aide d'un petit programme de Jacques, modifié pour tenir compte du format FR.
Téléchargeable ici : les Dates

Problème soulevé :



Le code :

Les déclarations et autres :


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
' Gambas class file

PUBLIC iPeriode AS INTEGER
PUBLIC sMonTexte AS STRING
PUBLIC sAlerte AS STRING
PUBLIC sDateJour AS STRING
' 'différences entre deux dates
PUBLIC sTrans1 AS STRING '<------------------------------------------------- les variables de transposition
PUBLIC sTrans2 AS STRING
' 'jour de la semaine de la date de naissance
PUBLIC sTrans3 AS STRING
' 'ajout période à une date
PUBLIC sTrans4 AS STRING
PUBLIC sTrans5 AS STRING

PUBLIC SUB Form_Open() '<----------------------------------------------------- on commence

DIM sQuand AS STRING

Application.MainWindow = ME
ME.Center
sDateJour = Format(Date(Now), "dd/mm/yyyy")
sQuand = sDatejour
lblD1.Text = sQuand
sQuand = Format(Now, "dddd dd mmmm yyyy")
lbl.Text = "Aujourd'hui, nous sommes le " & sQuand
sAlerte = "Erreur OverFlow "'"Calcul Impossible "

RadioBut_Click() '<-----------------'valueBox ou InputBox--------------- différences entre deux dates
RBDateNais_Click() '<-----------------'valueBox ou InputBox--------------- jour de la semaine de la date de naissance
RBAJPer_Click() '<---------------------'valueBox ou InputBox--------------- ajout période à une date

END

PUBLIC SUB Form_KeyPress() '<------------------------------------------------- touches du clavier

IF Key.code = Key.Enter OR Key.code = Key.Return THEN
CmdCalDe_Click() '<------------------------------------------------- différences entre deux dates
CmdJour_Click() '<----------------------------------------------------- jour de la semaine de la date de naissance
CmdCalDe2_Click() '<--------------------------------------------------- ajout période à une date
ENDIF
IF Key.code = Key.Esc THEN ME.Close '<------------------------------------- pour fermer par escape

END

PUBLIC SUB CmdFin_Click() '<------------------------------------------------- pour sortir de là

ME.Close()

END

PUBLIC SUB TimeDe1_Timer() '<------------------------------------------------- mais que fait le timer

lblDmn.Text = Format(Time(Now), "hh:nn:ss") '<----------------------------- il affiche l'heure toutes les secondes

END

Calcul de la différence entre deux dates :


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
PUBLIC SUB CmdCalDe_Click() '<------------------------------------------------ 'différences entre deux dates

DIM dateDepart, dateArrive AS DATE
DIM iJour, iAn, iTrim, iWeek, iHeure, iMinute, iMois, iSeconde AS INTEGER
DIM sDonc1, sDonc2, sTruc1, sTruc2 AS STRING

'-------------------------------------------------------------------------------------------
sDonc1 = sTrans1 '<--------------------------------------------------------- variable de transposition
IF sDonc1 = "" THEN sDonc1 = "01/01/0000"
sTruc1 = Mid(sDonc1, 4, 2) & "/" & Mid(sDonc1, 1, 2) & "/" & Mid(sDonc1, 7, 4) '<-- retourne le format US

IF IsDate(sDonc1) = FALSE THEN RETURN '<----------------------------------- il faut une date
dateDepart = Date(CDate(sTruc1)) '<----------------------------------- au format US
lblDepart.Text = sDonc1 '<----------------------------------------------- au format FR
' vbxDebut.Text = sDonc1
' lblDepart.Text = Format(DateDepart, "dd/mm/yyyy")
'-------------------------------------------------------------------------------------------
sDonc2 = sTrans2 '<--------------------------------------------------------- variable de transposition
IF sDonc2 = "" THEN sDonc2 = Format(Date(Now), "dd/mm/yyyy")
sTruc2 = Mid(sDonc2, 4, 2) & "/" & Mid(sDonc2, 1, 2) & "/" & Mid(sDonc2, 7, 4) '<-- retourne le format US

IF IsDate(sDonc2) = FALSE THEN RETURN '<----------------------------------- il faut une date
dateArrive = Date(CDate(sTruc2)) '<---------------------------------- au format US
lblDarrive.Text = sDonc2 '<----------------------------------------------- au format FR
' vbxFin.Text = sDonc2
' lblDarrive.Text = Format(DateArrive, "dd/mm/yyyy")

lblDepVal.Text = Format(CFloat(dateDepart), "#,###.###") '<--------------------- affichage valeur entière de la date (dateDepart)
lblDaVal.Text = Format(CFloat(dateArrive), "#,###.###")
lblDifff.Text = Format(CFloat(dateArrive) - CFloat(dateDepart), "#,###.###")

iJour = DateDiff(dateDepart, dateArrive, gb.Day)
iAn = DateDiff(dateDepart, dateArrive, gb.Year)
iTrim = DateDiff(dateDepart, dateArrive, gb.Quarter)
iWeek = DateDiff(dateDepart, dateArrive, gb.Week)
iHeure = DateDiff(dateDepart, dateArrive, gb.Hour)
iMois = DateDiff(dateDepart, dateArrive, gb.Month)

IF Abs(iJour) < 2 THEN
lblDif.Text = Format(Abs(iJour), "#,###") & " jour"
ELSE
lblDif.Text = Format(Abs(iJour), "#,###") & " jours"
ENDIF

IF Abs(iAn) < 2 THEN
lblDif2.Text = Format(Abs(iAn), "#,###") & " an"
ELSE
lblDif2.Text = Format(Abs(iAn), "#,###") & " ans"
ENDIF

IF Abs(iTrim) < 2 THEN
lblDif3.Text = Format(Abs(iTrim), "#,###") & " trimestre"
ELSE
lblDif3.Text = Format(Abs(iTrim), "#,###") & " trimestres"
ENDIF

IF Abs(iWeek) < 2 THEN
lblDif5.Text = Format(Abs(iWeek), "#,###") & " semaine"
ELSE
lblDif5.Text = Format(Abs(iWeek), "#,###") & " semaines"
ENDIF

IF Abs(iHeure) < 2 THEN
lblDif6.Text = Format(Abs(iHeure), "#,###") & " heure"
ELSE
lblDif6.Text = Format(Abs(iHeure), "#,###") & " heures"
ENDIF

lblDif7.Text = Format(Abs(iMois), "#,###") & " mois"

TRY iMinute = DateDiff(dateDepart, dateArrive, gb.Minute) '<------------- error OverFlow
IF ERROR THEN
lblDif8.Foreground = Color.Red
lblDif8.Text = sAlerte & "en minutes"
ELSE
IF Abs(iMinute) < 2 THEN
lblDif8.Text = Format(Abs(iMinute), "#,###") & " minute"
ELSE
lblDif8.Text = Format(Abs(iMinute), "#,###") & " minutes"
ENDIF
ENDIF

TRY iSeconde = DateDiff(dateDepart, dateArrive, gb.Second) '<------------ error OverFlow
IF ERROR THEN
lblDif9.Foreground = Color.Red
lblDif9.Text = sAlerte & "en secondes"
RETURN
ELSE
IF Abs(iSeconde) < 2 THEN
lblDif9.Text = Format(Abs(iSeconde), "#,###") & " seconde"
ELSE
lblDif9.Text = Format(Abs(iSeconde), "#,###") & " secondes"
ENDIF
ENDIF

CATCH
Message.Info("Une ERREUR de saisie ! ")

END

Calcul du jour de la semaine de la date de naissance :


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
PUBLIC SUB CmdJour_Click() '<------------------------------------------------- 'jour de la semaine de la date de naissance

DIM sQuoi, sTruc AS STRING
DIM dQuand AS DATE

sQuoi = sTrans3 '<--------------------------------------------------------- variable de transposition
sTruc = Mid(sQuoi, 4, 2) & "/" & Mid(sQuoi, 1, 2) & "/" & Mid(sQuoi, 7, 4) '<-- retourne le format US

IF sQuoi = "" OR IsDate(sQuoi) = FALSE THEN '<----------------------------- il faut une date
lblNe.Foreground = Color.Red
lblJour.Foreground = Color.Red
lblNe.Text = sAlerte
lblJour.Text = " par manque d'information !"
RETURN
ENDIF

dQuand = Date(CDate(sTruc)) '<--------------------------------------------- au format US
lblNe.Text = "Si vous êtes bien né(e) le : " sQuoi '<-------------------- jour de naissance au format FR
sQuoi = Format((dQuand), "dddd dd mmmm yyyy") '<------------------------ le jour de la semaine au format FR
lblJour.Text = " alors c'était le : " sQuo " et vous avez DateDiff(dQuand Date(Now) gb.Year " ans."

CATCH
Message.Info("Une ERREUR de saisie!")

END

Calcul de l'ajout de période(s) à une date :


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
PUBLIC SUB CmdCalDe2_Click() '<----------------------------------------------- 'ajout période à une date

DIM dateDepart, date2 AS DATE
DIM sDonc, sTruc, sPeriode, sDate3 AS STRING
DIM iCompte AS INTEGER

sDonc = sTrans4 '<--------------------------------------------------------- variable de transposition
IF sDonc = "" THEN sDonc = Format(Now, "dd/mm/yyyy")
sTruc = Mid(sDonc, 4, 2) & "/" & Mid(sDonc, 1, 2) & "/" & Mid(sDonc, 7, 4) '<-- retourne le format US
IF IsDate(sDonc) = FALSE THEN RETURN
dateDepart = Date(CDate(sTruc)) '<-------------------------------------- au format US
' lblDepart2.Text = sDonc '<----------------------------------------------- au format FR
lblDepart2.Text = Format(dateDepart, "dd/mm/yyyy")

periode_Click ' <---------------------------------------------------------- sélection de la période
sPeriode = sTrans5 '<--------------------------------------------------------- variable de transposition

IF sPeriode = "" THEN sPeriode = "1"
IF IsInteger(sPeriode) = FALSE THEN RETURN

IF Abs(Val(sPeriode)) < 2 OR lblperiode.Text = "mois" THEN '<------------ singulier ou pluriel
lblperiode.Text = sPeriode & " " & lblperiode.Text
ELSE
lblperiode.Text = sPeriode & " " & lblperiode.Text & "s"
ENDIF

iCompte = CInt(sPeriode) '<------------------------------------------------ initialisation de iCompte
date2 = DateAdd(dateDepart, iPeriode, iCompte) '<----------------------- calcul de l'ajout de type de période en termes de compte
sDate3 = Mid(CStr(date2), 4, 2) & "/" & Mid(CStr(date2), 1, 2) & "/" & Mid(CStr(date2), 7, 4) '<-- ici inutilisé, retourne le format FR
lblDif4.Text = Format(date2, "dddd dd mmmm yyyy")
' lblDif4.Text = sDate3
IF iCompte > 0 THEN
lblD11.Text = "La date, sera le : " '<----------------------------- pour un ajout
ELSE
lblD11.Text = "La date, était le : " '<----------------------------- pour un retrait (valeur négative)
ENDIF

CATCH
Message.Info("Une ERREUR de saisie!")

END


Les éléments dans l'IDE :






====================

Liens vers les commandes utilisées :




====================

Navigation :



<-- Liens du Wiki : <--
<-- Accueil du WIKI : <--

====================

La Documentation :



====================