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

Soyez le premier à donner votre avis sur cette source.

Snippet vu 8 889 fois - Téléchargée 36 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

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

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;
Messages postés
8
Date d'inscription
jeudi 12 juillet 2007
Statut
Membre
Dernière intervention
16 février 2009

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

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

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
Messages postés
370
Date d'inscription
lundi 1 avril 2002
Statut
Membre
Dernière intervention
11 février 2010

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.