HOLIDAYS SCHOOL

---

Commentaire sur cette source (5)
Ajouter un commentaire et/ou une note

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.

'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

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

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip

• RATING-NOTE
• APPELER FICHIER AIDE EN 1 LIGNE LE PLUS SIMPLEMENT POSSIBLE.
• DRAW LINERELATION BETWEEN OBJECTS
• CREATEOBJECT EN EXE AVEC OPEN_SAVE DATA
• TIMESCALEGRID

• FUSEAUX MATIC
• AVERTISSEUR
• CREATION DU VERSION SHAREWARE
• ERYGENDA ÉTERNEL OU PRESQUE. VERSION DE BASE, SANS ATTACHEMENTS À DES DOCUMENTS
• HORLOGE 2