Trouve les date de début et fin de semaine pour un semaine et une année données

0/5 (7 avis)

Snippet vu 9 476 fois - Téléchargée 38 fois

Contenu du snippet

Bon étant donne le nombre croissant de personnes qui veulent les dates en fonction d'une semaine et de l'anné, j'ai décidé de chercher un peu et de faire une fonction.

Source / Exemple :


Private Sub Command1_Click()
 Call AfficherDate(30, 2003, LL, DD) 'appelle de la fonction pour la smaine 30 de l'anne 2003
End Sub

' ********** /!\ Attention /!\ **********
'1) Cette fonction est valable pour les années comprises entre 2001 et 2399 !
'2) La semaine 0 existe ! elle peut etre entiere(1er janvier =lundi) , ou bien fractionnée (1 janvier <> Lundi ).
'     Exemple : la semaine 0 de l'anne 2005 retourne : 27/12/2004 et 2/01/2005 .
Sub AfficherDate(S As Byte, Anne As Integer, L As Label, D As Label)
 
 Dim A As Integer
 A = (Anne - 12) Mod 28 ' (12 = 2000 mod 28 )
 If A = 0 Then A = 28

 Dim PeriodeJour(28) As Byte, j As Byte, t As Byte
 j = 6

 For t = 1 To A
     j = (j + 1 - ((t - 1) Mod 4 = 0 And t > 1)) Mod 7
     PeriodeJour(t) = j
 Next t
 
 Dim Lundi As Integer
 Lundi = S * 7 - PeriodeJour(A) - 6
 If Lundi < 0 Then
    L.Caption = 31 + Lundi & "/" & 12 & "/" & Anne - 1
    D.Caption = 7 - PeriodeJour(A) & "/" & 11 & "/" & Anne
 Else
    Dim JourParMois(12)
      JourParMois(1) = 31
      JourParMois(2) = 28 - ((A Mod 4) = 0)
      JourParMois(3) = 31
      JourParMois(4) = 30
      JourParMois(5) = 31
      JourParMois(6) = 30
      JourParMois(7) = 31
      JourParMois(8) = 31
      JourParMois(9) = 30
      JourParMois(10) = 31
      JourParMois(11) = 30
      JourParMois(12) = 31
 
    Dim Mois As Byte
    j = 1
    Mois = 1
    While Lundi > JourParMois(j)
       Lundi = Lundi - JourParMois(j)
       j = j + 1
       Mois = Mois + 1
    Wend
    L.Caption = Lundi & "/" & Mois & "/" & Anne
    
    Lundi = Lundi + 6
    If Lundi > JourParMois(j) Then
       D.Caption = Lundi - JourParMois(j) & "/" & IIf(Mois = 12, 1, Mois + 1) & "/" & Anne - (Mois = 12)
    Else
       D.Caption = Lundi & "/" & Mois & "/" & Anne
    End If
 End If
End Sub

Conclusion :


Un peu long peut-être ... mais rapide .

A voir également

Ajouter un commentaire Commentaires
cs_Zeroc00l
Messages postés
367
Date d'inscription
lundi 1 avril 2002
Statut
Membre
Dernière intervention
11 février 2010

17 juil. 2007 à 21:58
Dur dur de se remettre au delphi apres si longtemps ...
(notement pour se rendre compte qu'il n'y a pas d'operateur ternaire x-D)
Enfin ! Voila la traduction brute de fonderie !
(donc à retester):

procedure AfficherDate(S : byte; Anne : Integer; L : TLabel; D : TLabel);
var A : Integer;
PeriodeJour : array[1..28] of Byte;
j : Byte;
t : Byte;
Lundi : Integer;
JourParMois : array[1..12] of Integer;
Mois : Byte;
begin

A :(Anne - 12) Mod 28; // (12 2000 mod 28 )
if (A = 0) Then A := 28;

j := 6;

for t := 1 To A do
begin
j :(j + 1 - Integer(((t - 1) Mod 4 0) And (t > 1))) Mod 7;
PeriodeJour[t] := j;
end;


Lundi := S * 7 - PeriodeJour[A] - 6;
If (Lundi < 0) Then begin
L.Caption := IntToStr(31) + IntToStr(Lundi) + '/' + IntToStr(12) + '/' + IntToStr(Anne - 1);
D.Caption := IntToStr(7 - PeriodeJour[A]) + '/' + IntToStr(11) + '/' + IntToStr(Anne);
end Else begin

JourParMois[1] := 31;
JourParMois[2] := 28;
if ((A Mod 4) = 0) then
Dec(JourParMois[2]);
JourParMois[3] := 31;
JourParMois[4] := 30;
JourParMois[5] := 31;
JourParMois[6] := 30;
JourParMois[7] := 31;
JourParMois[8] := 31;
JourParMois[9] := 30;
JourParMois[10] := 31;
JourParMois[11] := 30;
JourParMois[12] := 31;

j := 1;
Mois := 1;
While (Lundi > JourParMois[j]) do
begin
Lundi := Lundi - JourParMois[j];
j := j + 1;
Mois := Mois + 1;
end;
L.Caption := IntToStr(Lundi) + '/' + IntToStr(Mois) + '/' + IntToStr(Anne);

Lundi := Lundi + 6;
If (Lundi > JourParMois[j]) Then begin
D.Caption := IntToStr(Lundi - JourParMois[j]) + '/';
if (Mois = 12) then
D.Caption := D.Caption + '1'
else
D.Caption := D.Caption + IntToStr(Mois + 1);
if (Mois = 12) then
Dec(Anne);
D.Caption := D.Caption + '/' + IntToStr(Anne);
end Else
D.Caption := IntToStr(Lundi) + '/' + IntToStr(Mois) + '/' + IntToStr(Anne);
end;
end;
ericmaudouit
Messages postés
8
Date d'inscription
jeudi 12 juillet 2007
Statut
Membre
Dernière intervention
16 février 2009

16 juil. 2007 à 18:16
Salut je cherche a faire tourner cette routine sous pascal DELPHI y aurais t' il quelqun qui l'a deja fait.
cs_Zeroc00l
Messages postés
367
Date d'inscription
lundi 1 avril 2002
Statut
Membre
Dernière intervention
11 février 2010

20 janv. 2004 à 23:27
Ah oui !
Effectivement c'est une petite coquille ... Désolé pour ceux qui auraient utilisé ce code ...
Vala c'est corrigé ! Merci !
cs_jr62
Messages postés
1
Date d'inscription
mardi 20 janvier 2004
Statut
Membre
Dernière intervention
20 janvier 2004

20 janv. 2004 à 10:38
J'ai essayé le code mais il ne fonctionne pas toujours. Au lieu de mettre:

While Lundi > JourParMois(j)
j = j + 1
Lundi = Lundi - JourParMois(j)
Mois = Mois + 1
Wend

Il faudrait plutot mettre:

While Lundi > JourParMois(j)
Lundi = Lundi - JourParMois(j)
j = j + 1
Mois = Mois + 1
Wend

A plus
cs_Zeroc00l
Messages postés
367
Date d'inscription
lundi 1 avril 2002
Statut
Membre
Dernière intervention
11 février 2010

31 juil. 2003 à 22:07
Bon effectivement ca marche tres bien ... aussi bien voire mieux qu moi donc je vais mettre une autre source a la place de celle ci ! (quand je l'aurai fait !)
Afficher les 7 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.