Holidays school

0/5 (5 avis)

Vue 5 528 fois - Téléchargée 753 fois

Description

Beaucoup de personnes, m'ont demandés par email, si il était possible de concevoir sur un calendrier les vacances scolaires sans controls supplémentaires.
C'est fait, et c'est un cadeau de fin d'année pour tous ceux qui souhaitent apportrer à leurs projets, un petit plus.
Attention, il n'est pas opptimisé mais fonctionnelle à 100%.

J'ai repris le code de maskedit de Yoman que je remercie au passage.

Il n'y a rien de compliqué au contraire.

Source / Exemple :


'La premiere phrase du mois debute à 27 pxls de pic()
'Une lettre mesure ici 7 pxls, normal Fontsize=7
'donc pour la 1ere ligne on a : Point Haut de lettre= 27; bas de lettre=27+7=34 pxls
'ecart entre chaque ligne suivant le type de police: ici= 5pxls
'donc chaque hauteur de ligne est décalée de 12 pxls
'     chaque bas de ligne est décalée de 12 pxls
'a partir de cela on traite cette info

'pour avoir chaque hauteur ou le Y sur chaque hauteur de ligne,
'on recupere la date en format 10/01/2004
'10   => servira à Y
'01   => l'index pour chaque Pic (pictureBox pour chaque mois)
'2004 => l'année pour save fichier

'//recupere et convertir le n° du jour en position Y Haut de lettre ici ex:= le 10è jour de Janvier 2004
'On retranche -1 à ce jour car on travail en base 0
'donc 10-1=9 puis, on le multiplie par 12 (car 12 est l'ecart entre chaque ligne) et enfin on rajoute la position
'initiale de 27 qui est le debut de la premiere ligne.
'donc 10-1=9  *12  +27

'c'est donc le role de PosDebDate

'Ca va pas trop compliqué pour l'instant?

'pour le bas de lettre idem mais il faut rajouter en plus la hauteur de lettre donc 7 pxls
'donc 10-1=9  *12  +27  et enfin +7
'c'est donc le role de PosEndDate

'si vous changer de police  modifier la hauteur de lettre ici=7
' et l'écart entre chaque ligne ici=12

Private Function PosDebDate(DebDate As Integer) As Integer
On Error Resume Next
Dim s%
If DebDate = 0 Then
   s% = DebDate * 12 + (27 - 12)
   PosDebDate = s%
Else
   DebDate = DebDate - 1
   s% = DebDate * 12 + 27
   PosDebDate = s%
End If
If Err Then Exit Function
End Function

'//recupere et convertir le n° du jour en position Y bas de lettre
Private Function PosEndDate(EndDate As Integer) As Integer
On Error Resume Next
Dim s%
If EndDate = 0 Then
   s% = EndDate * 12 + (34 - 12)
   PosEndDate = s%
Else
   EndDate = EndDate - 1
   s% = EndDate * 12 + 34
   PosEndDate = s%
End If
If Err Then Exit Function
End Function

'//Dessine les lines des zones sur les picturebox
Private Sub DrawHolidays(DebZoneA$, EndZoneA$, colors&, Zones&)
On Error Resume Next
Dim DebA$, EndA$
Dim DebMois$, EndMois$
Dim DebPosA%, EndPosA%
Dim moisA%, moisB%
Dim WidthLine&

'//on recupere les 2 premiers chiffres de la date pour la position haute de Y
DebA$ = Mid$(DebZoneA$, 1, 2) '//=> 10 day
'//on recupere les 2 premiers chiffres de la date pour la position basse de Y
EndA$ = Mid$(EndZoneA$, 1, 2) ' //=> 26 day

'//on recupere les 2 chiffres du milieu de la date pour les index
DebMois$ = Mid$(DebZoneA$, 4, 2) '//=> 01 mois
EndMois$ = Mid$(EndZoneA$, 4, 2) '//=> 03 mois
moisA% = CInt(DebMois$) '//les convertis en integer
moisB% = CInt(EndMois$) '//les convertis en integer

DebPosA% = PosDebDate(CInt(DebA$)) '//convertis le N° du jour en Position haute Y
EndPosA% = PosEndDate(CInt(EndA$)) '//convertis le N° du jour en Position basse Y

'//suivant la zone a,b ou c, on place chaque bande a un endroit
Select Case Zones
 Case 1: WidthLine& = 113 '//-->118
 Case 2: WidthLine& = 120 '//-->125
 Case 3: WidthLine& = 127 '//-->132
End Select

If DebMois$ = EndMois$ Then '//vacance sur le meme mois
'//donc sur 1 mois entier
   FCals.Pic(moisA%).Line (WidthLine&, DebPosA%)-(WidthLine& + 5, EndPosA%), colors&, BF
Else '//sur plusieurs mois
If DebMois$ <> EndMois$ Then '//vacance sur le meme mois
   '// on demarre à la position voulue jusqu'au bas de la derniere ligne(ici 394 pxls)
   FCals.Pic(moisA%).Line (WidthLine&, DebPosA%)-(WidthLine& + 5, 394), colors&, BF
   
   '// et on reprend en haut de la premiere ligne(ici 27 pxls) jusqu'à la position basse voulue
   FCals.Pic(moisB%).Line (WidthLine&, 27)-(WidthLine& + 5, EndPosA%), colors&, BF
End If
End If
End Sub

Conclusion :


Seul bug connu si on veut, est la ligne du 25 Mars qui est un peut trop long
Il suffit de changer les largeurs des contenaires suivant votre largeur de screen

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
261
Date d'inscription
jeudi 13 janvier 2005
Statut
Membre
Dernière intervention
18 mai 2009
3
C'est marrant, il fetaient la victoire de 1945 en 1641?

Si non, c'est joli
Messages postés
99
Date d'inscription
vendredi 11 juillet 2003
Statut
Membre
Dernière intervention
16 juin 2007

Bonjours,

Moi aussi je te dit merci, car je cherchais comment faire un calendrier.
Je vais regarder le code pour essayer de l'adapter à mon programme.
Merci,donc encore

FREEGAMER
Messages postés
178
Date d'inscription
vendredi 1 novembre 2002
Statut
Membre
Dernière intervention
9 janvier 2010

Ah enfin une personne qui sait dire merci et reconnaitre le travail des autres.
Merci
@+
Messages postés
224
Date d'inscription
jeudi 31 janvier 2002
Statut
Membre
Dernière intervention
22 décembre 2009

Moi jte dis merci, c pas mal , et jpense que c le premier prog qui est fait en la matiere pr les vacance lol
Messages postés
178
Date d'inscription
vendredi 1 novembre 2002
Statut
Membre
Dernière intervention
9 janvier 2010

un petit merçi n'a jamais fait de mal à personne non...

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.