Attribute VB_Name = "ModRaz"

'Dim Annee(365) As String
Dim m_Mois(1 To 12)
Dim ValCycle As Integer
Dim curday As Integer
Public mois As Integer
Public pYear As Integer
Dim Quadrant As Integer

Public OldIndexP As OLE_COLOR
Public NewIndexP As OLE_COLOR
Public OldIndexC As OLE_COLOR
Public NewIndexC As OLE_COLOR

Public Dy As Integer
Dim Jours As Long
Dim pDy As Integer
Dim Gregor As Long
Dim Court As Long
Dim AnneeNor As Long
Dim AnneeLong As Long
Dim a As String
Dim b As Integer
Dim X As Integer

Public Function RazMe()
On Error Resume Next
For i = 0 To 35
 With Fcalendar
    .Lp(i).Visible = False
    .Lp(i).Width = 0
 End With
Next
End Function
Public Sub YearRetour()
Dy = 0
pDy = 0
If pYear > 1 Then
    pYear = pYear - 1
End If
EffacAll

CalculDayMoisYear
GardeNumeroJour
End Sub
Public Sub YearAvant()
pDy = 0
Dy = 0
pYear = pYear + 1
EffacAll

CalculDayMoisYear
GardeNumeroJour

End Sub


Public Sub MonthRetour()
Dy = 0
pDy = 0
If pYear > 1 Then
    If mois > 1 Then
        mois = mois - 1
    Else
        pYear = pYear - 1
        mois = 12
    End If
End If
EffacAll
CalculDayMoisYear
GardeNumeroJour

End Sub
Public Sub MonthAvant()
Dy = 0
pDy = 0
If mois < 12 Then
    mois = mois + 1
Else
    pYear = pYear + 1
    mois = 1
End If
EffacAll
CalculDayMoisYear
GardeNumeroJour

End Sub
Public Sub EffacAll()
On Error Resume Next
Dim w As Integer
For w = 0 To 41
    OldIndexC = &HFFFFFF
    OldIndexP = &H0&
    Fcalendar.lblDate(w).BackColor = OldIndexC
    Fcalendar.lblDate(w).ForeColor = OldIndexP
Next w
Fcalendar.La = "": Fcalendar.plage = "": Fcalendar.aa = "": Fcalendar.aaa = ""
End Sub

Public Sub GardeNumeroJour()
'si changement de mois ou année alors garder et afficher le n°du jour actuel
On Error Resume Next
For X = 0 To 41
 If Val(Fcalendar.lblDate(X).Caption) = Fcalendar.NumberDay.Caption Then
    Fcalendar.lblDate(X).BackColor = RGB(250, 0, 0)
    Fcalendar.NumberDay.Caption = Fcalendar.lblDate(X).Caption
    Fcalendar.NumberDay.BackColor = RGB(250, 0, 0)
 End If
Next X
End Sub
Private Sub EcrisMois()
m_Mois(1) = 31
m_Mois(2) = 28
m_Mois(3) = 31
m_Mois(4) = 30
m_Mois(5) = 31
m_Mois(6) = 30
m_Mois(7) = 31
m_Mois(8) = 31
m_Mois(9) = 30
m_Mois(10) = 31
m_Mois(11) = 30
m_Mois(12) = 31
With Fcalendar
If mois = 1 Then .lblMois = "Janvier"
If mois = 2 Then .lblMois = "Fevrier"
If mois = 3 Then .lblMois = "Mars"
If mois = 4 Then .lblMois = "Avril"
If mois = 5 Then .lblMois = "Mai"
If mois = 6 Then .lblMois = "Juin"
If mois = 7 Then .lblMois = "Juillet"
If mois = 8 Then .lblMois = "Aoutt"
If mois = 9 Then .lblMois = "Septembre"
If mois = 10 Then .lblMois = "Octobre"
If mois = 11 Then .lblMois = "Novembre"
If mois = 12 Then .lblMois = "Decembre" '...
End With

End Sub
Public Sub CalculDayMoisYear()
Jours = 6
EcrisMois
Gregor = (584 * 3)
Court = 355
AnneeNor = 365
AnneeLong = 366
ValCycle = 19

With Fcalendar

For X = 0 To 41
    .lblDate(X) = ""
Next X
.lblYear = pYear

If pYear / 4 = Int(pYear / 4) Then m_Mois(2) = 29
If pYear >= Gregor Then
    If pYear / 100 = Int(pYear / 100) Then m_Mois(2) = 28
    If pYear / 400 = Int(pYear / 400) Then m_Mois(2) = 29
Else
    If pYear / 4 = Int(pYear / 4) Then m_Mois(2) = 29 Else m_Mois(2) = 28
End If


For X = 1 To pYear - 1
    Quadrant = AnneeNor
    If X >= Gregor Then
        If X / 4 = Int(X / 4) Then Quadrant = AnneeLong
        If X / 100 = Int(X / 100) Then Quadrant = AnneeNor
        If X / 400 = Int(X / 400) Then Quadrant = AnneeLong
    Else
        Quadrant = AnneeNor
        If X / 4 = Int(X / 4) Then Quadrant = AnneeLong
    End If
    If X = Gregor Then Quadrant = Court
    Jours = Jours + Quadrant
Next X

If pYear = Gregor Then m_Mois(9) = ValCycle
    For X = 1 To (mois - 1)
        Jours = Jours + m_Mois(X)
    Next X
Do While Jours > 7
    Jours = Jours - 7
Loop
a = 7
b = Jours

If m_Mois(mois) = ValCycle Then
    For X = 1 To 3
        .lblDate(X + 1) = X
    Next X
    
For X = 14 To 30
        .lblDate(X - 10) = X
    Next X
Else
    If b = 7 Then b = 0
    For X = 1 To m_Mois(mois)
        .lblDate(b) = X
        .lblDate(b).BorderStyle = 1
        b = b + 1
    Next X
End If


pDy = Day(Date)
If mois = Month(Date) Then
    If pYear = Year(Date) Then
        For X = 0 To 41
            If Val(.lblDate(X).Caption) = pDy Then
                .lblDate(X).BackColor = RGB(250, 0, 0)
                .NumberDay.Caption = .lblDate(X).Caption
                .NumberDay.BackColor = RGB(250, 0, 0)

            End If
        Next X
    End If
End If
End With
End Sub


Sub main()
    Dy = 0
    pYear = Year(Date)
    mois = Month(Date)
  Fcalendar.Show
  RazMe
End Sub

