VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "Mscomct2.ocx"
Begin VB.UserControl A_calocx 
   Alignable       =   -1  'True
   AutoRedraw      =   -1  'True
   BackColor       =   &H80000004&
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   2760
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2250
   ClipBehavior    =   0  'None
   ScaleHeight     =   2760
   ScaleWidth      =   2250
   Begin VB.TextBox date_choisie 
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   1500
   End
   Begin MSComCtl2.UpDown annee_UpDown 
      Height          =   255
      Left            =   1350
      TabIndex        =   7
      Top             =   300
      Visible         =   0   'False
      Width           =   240
      _ExtentX        =   423
      _ExtentY        =   450
      _Version        =   393216
      Enabled         =   -1  'True
   End
   Begin MSComCtl2.UpDown annee_UpDown10 
      Height          =   260
      Left            =   1560
      TabIndex        =   8
      Top             =   300
      Visible         =   0   'False
      Width           =   240
      _ExtentX        =   423
      _ExtentY        =   450
      _Version        =   393216
      Enabled         =   -1  'True
   End
   Begin VB.Image cde_select 
      Height          =   285
      Left            =   1480
      Picture         =   "A_calocx.ctx":0000
      Stretch         =   -1  'True
      Top             =   0
      Width           =   300
   End
   Begin VB.Label aujourdhui1 
      BackColor       =   &H00FFFFFF&
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   6.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000C000&
      Height          =   255
      Left            =   0
      TabIndex        =   9
      Top             =   1860
      Width           =   1560
   End
   Begin VB.Label cal 
      Height          =   180
      Index           =   0
      Left            =   1200
      TabIndex        =   6
      Top             =   1920
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Label aujourdhui 
      BackColor       =   &H00FFFFFF&
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   6.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000C000&
      Height          =   255
      Left            =   -60
      TabIndex        =   5
      Top             =   780
      Visible         =   0   'False
      Width           =   1500
   End
   Begin VB.Label date_courte_interne 
      Height          =   195
      Left            =   780
      TabIndex        =   4
      Top             =   1935
      Visible         =   0   'False
      Width           =   195
   End
   Begin VB.Line Line1 
      X1              =   30
      X2              =   1800
      Y1              =   765
      Y2              =   765
   End
   Begin VB.Label jour_semaine 
      Alignment       =   2  'Center
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   6.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   180
      Index           =   0
      Left            =   840
      TabIndex        =   3
      Top             =   1920
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Image raz_selection 
      Height          =   210
      Left            =   1560
      Stretch         =   -1  'True
      Top             =   1905
      Width           =   255
   End
   Begin VB.Line Line2 
      X1              =   0
      X2              =   1800
      Y1              =   1875
      Y2              =   1875
   End
   Begin VB.Image mois_suivant 
      Height          =   210
      Left            =   1620
      Stretch         =   -1  'True
      Top             =   340
      Visible         =   0   'False
      Width           =   180
   End
   Begin VB.Label annee 
      BackColor       =   &H80000004&
      Caption         =   "2000"
      BeginProperty Font 
         Name            =   "Arial Narrow"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   1020
      TabIndex        =   2
      Top             =   300
      Visible         =   0   'False
      Width           =   330
   End
   Begin VB.Label mois 
      Alignment       =   1  'Right Justify
      BackColor       =   &H80000004&
      Caption         =   "Novembre"
      BeginProperty Font 
         Name            =   "Arial Narrow"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   180
      TabIndex        =   1
      Top             =   300
      Visible         =   0   'False
      Width           =   765
   End
   Begin VB.Image mois_precedent 
      Height          =   210
      Left            =   0
      Stretch         =   -1  'True
      Top             =   315
      Visible         =   0   'False
      Width           =   180
   End
End
Attribute VB_Name = "A_calocx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Dim date_choisi As String
Dim date_recue_courte As String
Dim date_recue_longue As String
Dim indice_langue As String
Dim tab_jour(7, 7) As String * 20
Dim tab_mois(12, 7) As String * 20
Dim msg_err(2, 7)
Public Event datechangee()
Public Event inoutcontainer(in_out As Byte)
Public Event changeposition(y As Integer)
Dim open_tw_top As Byte
Dim Is_embedded As Byte
Dim PC_date_format As String
Dim mb_datechangee As Boolean

Public Property Let opening_toward_top(ByVal opening_tw_top As Byte)
open_tw_top = opening_tw_top
End Property

Public Property Let Limited_as_embedded(ByVal embed As Byte)
Is_embedded = embed
End Property



Public Sub Pos_top()
        mois_precedent.top = 250
        mois_suivant.top = 250
        aujourdhui1.top = 0
        raz_selection.top = 0
        annee.top = 240
        Mois.top = 240
        cde_select.top = 1815
        date_choisie.top = 1785
        Line1.Y1 = 680
        Line1.Y2 = 680
        Line2.Y1 = 1810
        Line2.Y2 = 1810
        RaiseEvent changeposition(-1770)
End Sub
Public Sub Pos_down()

  mois_precedent.top = 315
        mois_suivant.top = 315
        aujourdhui1.top = 1860
        raz_selection.top = 1880
        annee.top = 300
        Mois.top = 300
        cde_select.top = 0
        date_choisie.top = 0
        Line1.Y1 = 700
        Line1.Y2 = 700
        Line2.Y1 = 1815
        Line2.Y2 = 1815
        'RaiseEvent changeposition(1770)
End Sub
Public Function date_dt() As Double
On Error GoTo CleanUp
If Trim(date_courte_interne) = "" Then
  date_dt = 0
Else
date_dt = CDate(date_courte_interne)
End If
  Exit Function
CleanUp:
 date_dt = Date
End Function
Public Function special_date_format(ByVal SEP As String) As String
special_date_format = left(date_courte_interne, 2) & SEP & Mid(date_courte_interne, 4, 2) & SEP & right(date_courte_interne, 4)
If special_date_format = SEP & SEP Then special_date_format = ""

End Function

Public Function code_mois(ByVal Mois As String) As String
code_mois = ""
For i = 1 To 12
If UCase(Mois) = UCase(Trim(tab_mois(i, indice_langue))) Then code_mois = Format(i, "0#")
Next i
End Function
Public Function nom_jour(ByVal date_jour As String) As String
nom_jour = ""
''pt
nom_jour = Trim(tab_jour(Weekday(Format(date_jour, "dd/mm/yyyy"), vbMonday), indice_langue))
End Function
Public Sub calcul_calendrier(ByVal date_selected As String, ByVal origine As Byte)
Dim offset_mois_precedent As Byte, offset_mois_suivant As Byte, index_debut_mois As Byte
Dim mm As Byte, jj_mois_precedent As Byte, date_depart As Date, jour_selected As Byte
''pt
If PC_date_format = "MDY" Then
date_selected = Format(date_selected, "mm/dd/yyyy")
Else
date_selected = Format(date_selected, "dd/mm/yyyy")
End If

If date_selected = "" Then

If PC_date_format = "MDY" Then
date_selected = Format(Now, "mm/dd/yyyy")
Else
date_selected = Format(Now, "dd/mm/yyyy")
End If
End If


date_depart = "01/" & Format(Month(Format(date_selected, "dd/mm/yyyy")), "0#") & "/" & Format(Year(date_selected), "####")
jour_selected = Day(Format(date_selected, "dd/mm/yyyy"))

Select Case Month(Format(date_depart, "dd/mm/yyyy"))
Case 1, 3, 5, 7, 8, 10, 12: jj_mois = 31
Case 4, 6, 9, 11: jj_mois = 30
Case 2
If Year(Format(date_depart, "dd/mm/yyyy")) Mod 4 = 0 Then jj_mois = 29 Else jj_mois = 28
End Select
mm = Month(Format(date_depart, "dd/mm/yyyy"))
UserControl.annee = Format(Year(Format(date_depart, "dd/mm/yyyy")), "####")
UserControl.Mois = nom_mois(mm)

If mm = 1 Then mm = 12 Else mm = mm - 1
Select Case mm
Case 1, 3, 5, 7, 8, 10, 12: jj_mois_precedent = 31
Case 4, 6, 9, 11: jj_mois_precedent = 30
Case 2
If Format(Year(Format(date_depart, "dd/mm/yyyy")), "####") Mod 4 = 0 Then jj_mois_precedent = 29 Else jj_mois_precedent = 28
End Select
For cpt1b = 1 To 42
cal(cpt1b) = ""
cal(cpt1b).BackColor = &HFFFFFF
Next cpt1b
index_debut_mois = Weekday((Format(date_depart, "dd/mm/yyyy")), 2)
If index_debut_mois = 1 Then index_debut_mois = 8
offset_mois_precedent = index_debut_mois - 1
For cpt1b = 1 To jj_mois
cal(index_debut_mois + cpt1b - 1) = Format(cpt1b, "0#")
If cpt1b = jour_selected And origine = 1 Then cal(index_debut_mois + cpt1b - 1).BackColor = &HFFFF00
cal(index_debut_mois + cpt1b - 1).ForeColor = &HC00000
Next cpt1b
For cpt1b = 1 To index_debut_mois - 1
cal(cpt1b) = Format(jj_mois_precedent - index_debut_mois + 1 + cpt1b, "0#")
cal(cpt1b).ForeColor = &H808080
Next cpt1b
For cpt1b = index_debut_mois + jj_mois To 42
cal(cpt1b) = Format(cpt1b - index_debut_mois - jj_mois + 1, "0#")
cal(cpt1b).ForeColor = &H808080
Next cpt1b
End Sub


Public Function nom_mois(ByVal code_mois As Byte) As String
nom_mois = ""
nom_mois = Trim(tab_mois(code_mois, indice_langue))
End Function
Public Function nom_precedent(ByVal mois1 As String, ByVal annee1 As String) As String
Dim i As Integer, code_mois As String * 2
For i = 1 To 12
If mois1 = Trim(tab_mois(i, indice_langue)) Then
code_mois = Format(i, "0#")
i = 12
End If
Next i
If code_mois = "01" Then
nom_precedent = Trim(tab_mois(12, indice_langue)) & "/" & Format((Val(annee1) - 1), "####")
Else
nom_precedent = Trim(tab_mois(Val(code_mois) - 1, indice_langue))
End If
End Function
Public Function nom_suivant(ByVal mois1 As String, ByVal annee1 As String) As String
Dim i As Integer, code_mois As String * 2
For i = 1 To 12
If mois1 = Trim(tab_mois(i, indice_langue)) Then
code_mois = Format(i, "0#")
i = 12
End If
Next i
If code_mois = "12" Then
nom_suivant = Trim(tab_mois(1, indice_langue)) & "/" & Format((Val(annee1) + 1), "####")
Else
nom_suivant = Trim(tab_mois(Val(code_mois) + 1, indice_langue))
End If
End Function



Private Sub annee_Click()
'If annee_UpDown.Visible = -1 Then
'annee_UpDown.Visible = KO
'Else
annee_UpDown.Visible = -1
annee_UpDown10.Visible = -1
mois_suivant.Visible = 0
mois_precedent.Visible = 0
'End If

End Sub

Private Sub annee_UpDown_DownClick()
annee = Val(annee) - 1
calcul_calendrier "01/" & code_mois(Mois) & "/" & annee, 0
End Sub

Private Sub annee_UpDown_UpClick()
annee = Val(annee) + 1
calcul_calendrier ("01/" & code_mois(Mois) & "/" & annee), 0
End Sub








Private Sub annee_UpDown10_DownClick()
annee = Val(annee) - 10
calcul_calendrier "01/" & code_mois(Mois) & "/" & annee, 0
End Sub


Private Sub annee_UpDown10_UpClick()
annee = Val(annee) + 10
calcul_calendrier "01/" & code_mois(Mois) & "/" & annee, 0
End Sub








Private Sub Cal_Click(Index As Integer)
Dim a As String, mois_glissant As String, annee_glissant As String, mois_suivant As String, mois_precedent As String
If indice_langue = "" Then configure_language ("E")
If cal(Index).ForeColor = &H808080 And Index > 20 Then
    mois_suivant = nom_suivant(Mois, annee)
    If InStr(mois_suivant, "/") <> 0 Then
    mois_glissant = left(mois_suivant, InStr(mois_suivant, "/") - 1)
    annee_glissant = right(mois_suivant, 4)
    Else
    mois_glissant = mois_suivant
    annee_glissant = annee
    End If
Else
If cal(Index).ForeColor = &H808080 And Index < 8 Then
    mois_precedent = nom_precedent(Mois, annee)
    If InStr(mois_precedent, "/") <> 0 Then
    mois_glissant = left(mois_precedent, InStr(mois_precedent, "/") - 1)
    annee_glissant = right(mois_precedent, 4)
    Else
    mois_glissant = mois_precedent
    annee_glissant = annee
    End If
Else
mois_glissant = Mois
annee_glissant = annee
End If
End If
date_recue_courte = ""
date_recue_longue = ""
    cal(Index).BackColor = &HFFFF00
    For cpt = 1 To 42
    If cpt <> Index Then cal(cpt).BackColor = &HFFFFFF
    Next cpt
    'pt
         If PC_date_format = "DMY" Then
         date_choisie = cal(Index) & " " & mois_glissant & " " & annee_glissant
         End If
        If PC_date_format = "MDY" Then
         date_choisie = mois_glissant & " " & cal(Index) & " " & annee_glissant
         End If
     UserControl.date_courte_interne = calcul_short_date(UserControl.date_choisie.Text)
     
     ' 15.5.2006
     Dim ld_auxDate As Date
     If IsDate(UserControl.date_courte_interne) Then
        ld_auxDate = Format(UserControl.date_courte_interne, "dd/mm/yyyy")
        
        If Year(ld_auxDate) < 1900 Or (Year(ld_auxDate) > 2078 And Month(ld_auxDate) > 5 And Day(ld_auxDate) > 6) Then
            UserControl.date_choisie.SetFocus
        End If
     End If
     
     RaiseEvent datechangee
     remove_cal_display
     If open_tw_top = 1 Then
     RaiseEvent changeposition(1770)
     Pos_down
     End If
     If Is_embedded = 1 Then RaiseEvent inoutcontainer(0)
     UserControl.Height = 350
    UserControl.Width = 1830
    
End Sub








Private Sub cde_select_Click()

If indice_langue = "" Then configure_language ("E")

    If UserControl.Height < 1500 Then
    If Is_embedded = 1 Then RaiseEvent inoutcontainer(1)
            If open_tw_top = 1 Then
            Pos_top
            Else
            Pos_down
            End If
            create_cal_display
            If date_recue_courte = "" Then
            If PC_date_format = "DMY" Then calcul_calendrier Format(date_courte, "dd/mm/yyyy"), 1
            If PC_date_format = "MDY" Then calcul_calendrier Format(date_courte, "mm/dd/yyyy"), 1
            Else
            calcul_calendrier date_recue_courte, 1
            UserControl.annee = Format(Year(Format(date_recue_courte, "dd/mm/yyyy")), "####")
            UserControl.Mois = nom_mois(Month(Format(date_recue_courte, "dd/mm/yyyy")))
            End If
            
            
    UserControl.Height = 2100
    UserControl.Width = 1830
    Else
        If open_tw_top = 1 Then
        remove_cal_display
        Pos_down
        UserControl.Height = 350
        UserControl.Width = 1830
        RaiseEvent changeposition(1770)
        Else
        remove_cal_display
        UserControl.Height = 350
        UserControl.Width = 1830
        RaiseEvent datechangee
        End If
            If Is_embedded = 1 Then RaiseEvent inoutcontainer(0)
End If
End Sub




Private Sub date_choisie_Change()
    mb_datechangee = True
End Sub

Private Sub date_choisie_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then
  If Len(date_choisie) > 8 Or Len(date_choisie) = 0 Then
    If Len(date_choisie) > 8 Then
    tester_date_clavier_long
    End If
    If Len(date_choisie) = 0 Then reinit_cal

Else
  If isNumeric(date_choisie) Then
  tester_date_clavier
  Else
  tester_date_clavier_long
  End If
    End If
    RaiseEvent datechangee
End If

End Sub


Private Sub date_choisie_LostFocus()
If Len(date_choisie) > 8 Or Len(date_choisie) = 0 Then
    If Len(date_choisie) > 8 Then
    tester_date_clavier_long
    End If
If Len(date_choisie) = 0 Then reinit_cal
Else
  If isNumeric(date_choisie) Then
  tester_date_clavier
Else
  tester_date_clavier_long
  End If
End If
End Sub


Private Sub mois_Click()
annee_UpDown.Visible = 0
annee_UpDown10.Visible = 0
mois_suivant.Visible = -1
mois_precedent.Visible = -1
End Sub

Private Sub mois_precedent_Click()
Dim a As Byte
a = code_mois(Mois)
If a = 1 Then
a = 12
annee = annee - 1
Else
a = a - 1
End If
Mois = nom_mois(a)
''pt
'If PC_date_format = "DMY" Then
calcul_calendrier "01/" & Format(a, "0#") & "/" & Format(annee, "####"), 0
'Else
'calcul_calendrier Format(a, "0#") & "/" & "01/" & Format(annee, "####"), 0
'End If



End Sub

Private Sub mois_suivant_Click()
Dim a As Byte
a = code_mois(Mois)
If a = 12 Then
a = 1
annee = annee + 1
Else
a = a + 1
End If
Mois = nom_mois(a)

''pt
'If PC_date_format = "DMY" Then
calcul_calendrier "01/" & Format(a, "0#") & "/" & Format(annee, "####"), 0
'Else
'calcul_calendrier Format(a, "0#") & "/" & "01/" & Format(annee, "####"), 0
'End If
End Sub


Private Sub quit_Click()
Unload Me
End Sub

Public Property Let date_courte(ByVal date_courte As String)
If Len(date_courte) = 10 Then
If indice_langue = "" Then configure_language ("E")
date_recue_courte = date_courte
UserControl.date_courte_interne = date_courte
date_recue_longue = left(date_courte, 2) & " " & nom_mois(Val(Mid(date_courte, 4, 2))) & " " & right(date_courte, 4)
If PC_date_format = "DMY" Then UserControl.date_choisie = date_recue_longue
If PC_date_format = "MDY" Then UserControl.date_choisie = date_us_long
Else
date_recue_courte = ""
End If
End Property

Public Property Let date_locked(ByVal date_locked As Byte)
If date_locked <> 0 Then
date_choisie.Locked = -1
cde_select.Enabled = 0
Else
date_choisie.Locked = 0
cde_select.Enabled = -1
End If
End Property





Private Sub raz_selection_Click()
reinit_cal
remove_cal_display
 UserControl.Height = 350
    UserControl.Width = 1830
RaiseEvent datechangee
If open_tw_top = 1 Then
RaiseEvent changeposition(1770)
Pos_down
End If

If Is_embedded = 1 Then RaiseEvent inoutcontainer(0)
End Sub

Private Sub UserControl_ExitFocus()
 If UserControl.Height > 1500 Then
 remove_cal_display
 If open_tw_top = 1 Then
 RaiseEvent changeposition(1770)
 Pos_down
 End If
 If Is_embedded = 1 Then RaiseEvent inoutcontainer(0)
    Else
        If mb_datechangee = True Then
            mb_datechangee = False
            RaiseEvent datechangee
        End If
 End If
    UserControl.Height = 350
    UserControl.Width = 1830
End Sub

Public Property Get date_longue() As String
date_longue = UserControl.date_choisie
End Property
Public Property Get jour_date() As String
If Len(UserControl.date_courte_interne) > 5 Then
jour_date = nom_jour(UserControl.date_courte_interne)
Else
jour_date = ""
End If
End Property
Public Property Get date_courte() As String
date_courte = UserControl.date_courte_interne
End Property
Public Property Get date_us() As String
date_us = Mid(UserControl.date_courte_interne, 4, 2) & "/" & left(UserControl.date_courte_interne, 2) & "/" & right(UserControl.date_courte_interne, 4)
If date_us = "//" Then date_us = ""
End Property


Public Property Let date_us(as_Date As String)
Dim lv_Date As Variant

On Error GoTo ErrorHandler
  lv_Date = Split(as_Date, "/")
  If IsArray(lv_Date) And UBound(lv_Date) = 2 Then
    If PC_date_format = "DMY" Then
      date_courte = Format(DateSerial(lv_Date(2), lv_Date(0), lv_Date(1)), "DD/MM/YYYY")
    ElseIf PC_date_format = "MDY" Then
      date_courte = Format(DateSerial(lv_Date(2), lv_Date(0), lv_Date(1)), "MM/DD/YYYY")
    Else
      Call reinit_cal
    End If
  Else
    Call reinit_cal
  End If
  Exit Property
ErrorHandler:
  Call reinit_cal
End Property

Public Property Get date_us_long() As String
If indice_langue = "" Then configure_language ("E")
date_us_long = nom_mois(Val(Mid(UserControl.date_courte_interne, 4, 2))) & " " & left(UserControl.date_courte_interne, 2) & " " & right(UserControl.date_courte_interne, 4)


End Property

Public Property Get date_yyyymmdd() As String
date_yyyymmdd = Format(UserControl.date_courte_interne, "dd/mm/yyyy")
date_yyyymmdd = Mid(UserControl.date_courte_interne, 7, 4) & Mid(UserControl.date_courte_interne, 4, 2) & left(UserControl.date_courte_interne, 2)
End Property

Public Property Get date_sql() As String
    date_sql = Format(UserControl.date_courte_interne, "yyyy-mm-dd")
End Property

Function calcul_short_date(ByVal d1 As String)
Dim wrk As String
''pt
d1 = Format(d1, "dd mmmm yyyy")
wrk = left(d1, Len(d1) - 5)
wrk = right(wrk, Len(wrk) - 3)
calcul_short_date = left(d1, 2) & "/" & code_mois(wrk) & "/" & right(d1, 4)
End Function







Public Sub reinit_cal()
UserControl.date_choisie = ""
UserControl.date_courte_interne = ""
date_courte = ""
annee_UpDown.Visible = 0
annee_UpDown10.Visible = 0
mois_suivant.Visible = -1
mois_precedent.Visible = -1
RaiseEvent datechangee
End Sub




Public Property Get Enabled() As Integer
Enabled = UserControl.cde_select.Enabled
End Property

Public Property Let Enabled(ByVal enabled_value As Integer)
UserControl.cde_select.Enabled = enabled_value
date_choisie.Enabled = enabled_value
End Property
Public Property Let Language(ByVal Language As String)
 configure_language (Language)
 ''pt
 date_format_of_the_machine
End Property
Public Property Let saisie_directe(ByVal saisie_directe As String)
End Property


Public Sub tester_date_clavier()
Dim date_clavier As String
If indice_langue = "" Then configure_language ("E")
If Len(date_choisie) <> 2 And Len(date_choisie) <> 4 And Len(date_choisie) <> 6 And Len(date_choisie) <> 8 Then
MsgBox msg_err(0, indice_langue) & UserControl.date_choisie & msg_err(1, indice_langue)
GoTo erreur_clavier
End If
If Not isNumeric(date_choisie) Then
MsgBox msg_err(0, indice_langue) & UserControl.date_choisie & msg_err(1, indice_langue)
GoTo erreur_clavier
End If
If Len(UserControl.date_choisie) = 4 And (Val(right(UserControl.date_choisie, 2)) > 12 Or Val(right(UserControl.date_choisie, 2)) < 1) Then
MsgBox msg_err(0, indice_langue) & UserControl.date_choisie & msg_err(1, indice_langue)
GoTo erreur_clavier
End If
If Len(UserControl.date_choisie) = 6 And (Val(Mid(UserControl.date_choisie, 3, 2)) > 12 Or Val(Mid(UserControl.date_choisie, 3, 2)) < 1) Then
MsgBox msg_err(0, indice_langue) & UserControl.date_choisie & msg_err(1, indice_langue)
GoTo erreur_clavier
End If
If Len(UserControl.date_choisie) = 8 And (Val(Mid(UserControl.date_choisie, 3, 2)) > 12 Or Val(Mid(UserControl.date_choisie, 3, 2)) < 1) Then
MsgBox msg_err(0, indice_langue) & UserControl.date_choisie & " " & msg_err(1, indice_langue)
GoTo erreur_clavier
End If

If Val(left(UserControl.date_choisie, 2)) > 31 Or Val(left(UserControl.date_choisie, 2)) < 1 Then
MsgBox msg_err(0, indice_langue) & UserControl.date_choisie & msg_err(1, indice_langue)
GoTo erreur_clavier
End If



date_clavier = ""
''pt
If PC_date_format = "DMY" Then
Select Case Len(UserControl.date_choisie)
Case 2: 'mois et annee courante
date_clavier = UserControl.date_choisie & "/" & Format(Month(Date), "0#") & "/" & Year(Date)
Case 4: 'annee courante
date_clavier = left(UserControl.date_choisie, 2) & "/" & right(UserControl.date_choisie, 2) & "/" & Year(Date)
Case 6: 'YY. on suppose annee 2000 et plus
date_clavier = left(UserControl.date_choisie, 2) & "/" & Mid(UserControl.date_choisie, 3, 2) & "/20" & right(UserControl.date_choisie, 2)
Case 8: 'YY. on suppose annee 2000 et plus
date_clavier = left(UserControl.date_choisie, 2) & "/" & Mid(UserControl.date_choisie, 3, 2) & "/" & right(UserControl.date_choisie, 4)
End Select
If Not IsDate(date_clavier) Then
MsgBox msg_err(0, indice_langue) & date_clavier & msg_err(1, indice_langue)
GoTo erreur_clavier
End If
End If


If PC_date_format = "MDY" Then
Select Case Len(UserControl.date_choisie)
Case 2: 'mois et annee courante
date_clavier = UserControl.date_choisie & "/" & Format(Month(Date), "0#") & "/" & Year(Date)
Case 4: 'annee courante
date_clavier = right(UserControl.date_choisie, 2) & "/" & left(UserControl.date_choisie, 2) & "/" & Year(Date)
Case 6: 'YY. on suppose annee 2000 et plus
date_clavier = Mid(UserControl.date_choisie, 3, 2) & "/" & left(UserControl.date_choisie, 2) & "/20" & right(UserControl.date_choisie, 2)
Case 8: 'YY. on suppose annee 2000 et plus
date_clavier = Mid(UserControl.date_choisie, 3, 2) & "/" & left(UserControl.date_choisie, 2) & "/" & right(UserControl.date_choisie, 4)
End Select
If Not IsDate(date_clavier) Then
MsgBox msg_err(0, indice_langue) & date_clavier & msg_err(1, indice_langue)
GoTo erreur_clavier
End If
End If




date_courte = date_clavier
RaiseEvent datechangee
Exit Sub
erreur_clavier:
UserControl.date_choisie = ""
UserControl.date_choisie.SetFocus
End Sub

Public Sub tester_date_clavier_long()
'pt
Dim date_clavier As String, mois1 As String, jour1 As String, annee1 As String, date_trouvee As String, code_mois1 As String
If indice_langue = "" Then configure_language ("E")
date_entree = UserControl.date_choisie
''transformer date longue en courte
Dim i As Integer, v As Integer
UserControl.date_choisie = Trim(UserControl.date_choisie)
date_entree = UserControl.date_choisie
v = 0

Select Case PC_date_format
Case "DMY":


For i = 1 To Len(date_entree)
If Mid(date_entree, i, 1) = " " Then v = v + 1
If v = 0 Then jour1 = Trim(jour1 & Mid(date_entree, i, 1))
If v = 1 Then mois1 = Trim(mois1 & Mid(date_entree, i, 1))
If v = 2 Then annee1 = Trim(annee1 & Mid(date_entree, i, 1))
If Len(mois1) = 1 Then mois1 = UCase(mois1)
Next i
jour1 = Format(jour1, "0#")
'' valider date courte comme si entrez ds composant
If v <> 2 Then
MsgBox msg_err(0, indice_langue) & UserControl.date_choisie & " " & msg_err(1, indice_langue)
GoTo erreur_clavier1
End If
If Mid(date_entree, 2, 1) <> " " And Mid(date_entree, 3, 1) <> " " Then
MsgBox msg_err(0, indice_langue) & UserControl.date_choisie & " " & msg_err(1, indice_langue)
GoTo erreur_clavier1
End If
If Mid(date_entree, 2, 1) = "" Then
UserControl.date_choisie = "0" & date_entree
date_entree = UserControl.date_choisie
End If
If Mid(date_entree, Len(date_entree) - 2, 1) <> " " And Mid(date_entree, Len(date_entree) - 4, 1) <> " " Then
MsgBox msg_err(0, indice_langue) & UserControl.date_choisie & " " & msg_err(1, indice_langue)
GoTo erreur_clavier1
End If
code_mois1 = code_mois(mois1)
If code_mois1 = "" Then
MsgBox msg_err(0, indice_langue) & UserControl.date_choisie & " " & msg_err(1, indice_langue)
GoTo erreur_clavier1
End If
date_trouvee = jour1 & "/" & code_mois1 & "/" & annee1
If Not IsDate(date_trouvee) Then
MsgBox msg_err(0, indice_langue) & UserControl.date_choisie & " " & msg_err(1, indice_langue)
GoTo erreur_clavier1
End If
date_trouvee = Format(date_trouvee, "dd/mm/yyyy")

Case "MDY":

For i = 1 To Len(date_entree)
If Mid(date_entree, i, 1) = " " Then v = v + 1
If v = 0 Then mois1 = Trim(mois1 & Mid(date_entree, i, 1))
If v = 1 Then jour1 = Trim(jour1 & Mid(date_entree, i, 1))
If v = 2 Then annee1 = Trim(annee1 & Mid(date_entree, i, 1))
If Len(mois1) = 1 Then mois1 = UCase(mois1)
Next i
jour1 = Format(jour1, "0#")
'' valider date courte comme si entrez ds composant
If v <> 2 Then
MsgBox msg_err(0, indice_langue) & UserControl.date_choisie & msg_err(1, indice_langue)
GoTo erreur_clavier1
End If
If Trim(Mid(date_entree, 1, 4)) = "" Then
MsgBox msg_err(0, indice_langue) & UserControl.date_choisie & msg_err(1, indice_langue)
GoTo erreur_clavier1
End If
'If Mid(date_entree, 2, 1) = "" Then
'UserControl.date_choisie = "0" & date_entree
'date_entree = UserControl.date_choisie
'End If
If Mid(date_entree, Len(date_entree) - 2, 1) <> " " And Mid(date_entree, Len(date_entree) - 4, 1) <> " " Then
MsgBox msg_err(0, indice_langue) & UserControl.date_choisie & msg_err(1, indice_langue)
GoTo erreur_clavier1
End If
code_mois1 = code_mois(mois1)
If code_mois1 = "" Then
MsgBox msg_err(0, indice_langue) & UserControl.date_choisie & msg_err(1, indice_langue)
GoTo erreur_clavier1
End If
'pt
If Len(annee1) = 2 Then date_trouvee = jour1 & "/" & code_mois1 & "/20" & annee1
If Len(annee1) = 4 Then date_trouvee = jour1 & "/" & code_mois1 & "/" & annee1
If Not IsDate(date_trouvee) Then
MsgBox msg_err(0, indice_langue) & UserControl.date_choisie & msg_err(1, indice_langue)
GoTo erreur_clavier1
End If
'date_trouvee = Format(date_trouvee, "mm/dd/yyyy")

End Select

' 15.5.2006
Debug.Assert (IsDate(date_trouvee))

If Year(date_trouvee) < 1900 Or (Year(date_trouvee) > 2078 And Month(date_trouvee) > 5 And Day(date_trouvee) > 6) Then
    MsgBox msg_err(0, indice_langue) & UserControl.date_choisie & msg_err(1, indice_langue)
    GoTo erreur_clavier1
End If


date_recue_courte = date_trouvee
UserControl.date_courte_interne = date_trouvee
date_recue_longue = left(date_trouvee, 2) & " " & nom_mois(Val(Mid(date_trouvee, 4, 2))) & " " & right(date_trouvee, 4)

If PC_date_format = "DMY" Then UserControl.date_choisie = date_recue_longue
If PC_date_format = "MDY" Then UserControl.date_choisie = date_us_long
'RaiseEvent datechangee
Exit Sub
erreur_clavier1:
UserControl.date_choisie = ""
UserControl.date_choisie.SetFocus
End Sub


Public Sub create_cal_display()
Dim i0 As Integer, i1 As Integer, i2 As Integer, dist1 As Integer, dist2 As Integer
If open_tw_top = 1 Then
dist1 = 700
dist2 = 500
Else
dist1 = 730
dist2 = 540
End If
Mois.Visible = -1
annee.Visible = -1
mois_precedent.Visible = -1
mois_suivant.Visible = -1
'pt
If PC_date_format = "DMY" Then
aujourdhui = Format(Now, "dd/mm/yyyy")
aujourdhui1 = Mid(nom_jour(aujourdhui), 1, 3) & " " & left(aujourdhui, 2) & " " & nom_mois(Val(Mid(aujourdhui, 4, 2))) & " " & right(aujourdhui, 4)
End If
If PC_date_format = "MDY" Then
aujourdhui = Format(Now, "mm/dd/yyyy")
aujourdhui1 = Mid(nom_jour(aujourdhui), 1, 3) & " " & nom_mois(Val(Mid(aujourdhui, 4, 2))) & " " & left(aujourdhui, 2) & " " & right(aujourdhui, 4)
End If

annee = Format(Year(Now), "####")
Mois = nom_mois(Format(Month(Now), "#0"))


For i0 = 0 To 5
For i1 = 1 To 7
i2 = (i1 + (i0 * 7))
Load cal(i2)
cal(i2).left = (i1 - 1) * 260
cal(i2).top = dist1 + (i0 * 180)
cal(i2).Visible = -1
Next i1
Next i0
For i0 = 1 To 7
Load jour_semaine(i0)
jour_semaine(i0).left = (i0 - 1) * 260
jour_semaine(i0).top = dist2
jour_semaine(i0).Visible = -1
jour_semaine(i0).Caption = Mid(tab_jour(i0, indice_langue), 1, 3)
Next i0
raz_selection.Picture = LoadResPicture(102, vbResIcon)
mois_precedent.Picture = LoadResPicture(1001, vbResIcon)
mois_suivant.Picture = LoadResPicture(1002, vbResIcon)
mois_precedent.Visible = -1
mois_suivant.Visible = -1
End Sub
Public Sub remove_cal_display()
'Dim cal1(42) As Object
Dim i0 As Integer, i1 As Integer, i2 As Integer
'Set cal1(1) = Controls.Add("vb.label", "cal1")

For i0 = 0 To 5
For i1 = 1 To 7
i2 = (i1 + (i0 * 7))
If i2 <> 0 Then
Unload cal(i2)
End If
Next i1
Next i0
For i0 = 1 To 7
Unload jour_semaine(i0)
Next i0
Set raz_selection.Picture = Nothing
Set mois_precedent.Picture = Nothing
Set mois_suivant.Picture = Nothing
annee_UpDown.Visible = 0
annee_UpDown10.Visible = 0
End Sub


Public Sub configure_language(ByVal Language As String)
Select Case Language
 Case "E": indice_langue = 1
 tab_jour(1, indice_langue) = "Monday"
 tab_jour(2, indice_langue) = "Tuesday"
 tab_jour(3, indice_langue) = "Wednesday"
 tab_jour(4, indice_langue) = "Thursday"
 tab_jour(5, indice_langue) = "Friday"
 tab_jour(6, indice_langue) = "Saturday"
 tab_jour(7, indice_langue) = "Sunday"
 tab_mois(1, indice_langue) = "January"
 tab_mois(2, indice_langue) = "February"
 tab_mois(3, indice_langue) = "March"
 tab_mois(4, indice_langue) = "April"
 tab_mois(5, indice_langue) = "May"
 tab_mois(6, indice_langue) = "June"
 tab_mois(7, indice_langue) = "July"
 tab_mois(8, indice_langue) = "August"
 tab_mois(9, indice_langue) = "September"
 tab_mois(10, indice_langue) = "October"
 tab_mois(11, indice_langue) = "November"
 tab_mois(12, indice_langue) = "December"
 msg_err(0, indice_langue) = "Date entered "
 msg_err(1, indice_langue) = "is invalid. Try again"
 Case "D": indice_langue = 2
 tab_jour(1, indice_langue) = "maandag"
 tab_jour(2, indice_langue) = "dinsdag"
 tab_jour(3, indice_langue) = "woensdag"
 tab_jour(4, indice_langue) = "donderdag"
 tab_jour(5, indice_langue) = "vrijdag"
 tab_jour(6, indice_langue) = "zaterdag"
 tab_jour(7, indice_langue) = "zondag"
 tab_mois(1, indice_langue) = "januari"
 tab_mois(2, indice_langue) = "februari"
 tab_mois(3, indice_langue) = "maart"
 tab_mois(4, indice_langue) = "april"
 tab_mois(5, indice_langue) = "mei"
 tab_mois(6, indice_langue) = "juni"
 tab_mois(7, indice_langue) = "juli"
 tab_mois(8, indice_langue) = "augustus"
 tab_mois(9, indice_langue) = "september"
 tab_mois(10, indice_langue) = "october"
 tab_mois(11, indice_langue) = "november"
 tab_mois(12, indice_langue) = "december"
 msg_err(0, indice_langue) = "Date entered "
 msg_err(1, indice_langue) = "is invalid. Try again"
 Case "F": indice_langue = 3
 tab_jour(1, indice_langue) = "Lundi"
 tab_jour(2, indice_langue) = "Mardi"
 tab_jour(3, indice_langue) = "Mercredi"
 tab_jour(4, indice_langue) = "Jeudi"
 tab_jour(5, indice_langue) = "Vendredi"
 tab_jour(6, indice_langue) = "Samedi"
 tab_jour(7, indice_langue) = "Dimanche"
 tab_mois(1, indice_langue) = "Janvier"
 tab_mois(2, indice_langue) = "Fevrier"
 tab_mois(3, indice_langue) = "Mars"
 tab_mois(4, indice_langue) = "Avril"
 tab_mois(5, indice_langue) = "Mai"
 tab_mois(6, indice_langue) = "Juin"
 tab_mois(7, indice_langue) = "Juillet"
 tab_mois(8, indice_langue) = "Août"
 tab_mois(9, indice_langue) = "Septembre"
 tab_mois(10, indice_langue) = "Octobre"
 tab_mois(11, indice_langue) = "Novembre"
 tab_mois(12, indice_langue) = "Decembre"
 msg_err(0, indice_langue) = "Date entered "
 msg_err(1, indice_langue) = "is invalid. Try again"
 Case "G": indice_langue = 4
 tab_jour(1, indice_langue) = "Montag"
 tab_jour(2, indice_langue) = "Dienstag"
 tab_jour(3, indice_langue) = "Mittwoch"
 tab_jour(4, indice_langue) = "Donerstag"
 tab_jour(5, indice_langue) = "Freitag"
 tab_jour(6, indice_langue) = "Samstag"
 tab_jour(7, indice_langue) = "Sontag"
 tab_mois(1, indice_langue) = "Januar"
 tab_mois(2, indice_langue) = "Februar"
 tab_mois(3, indice_langue) = "März"
 tab_mois(4, indice_langue) = "April"
 tab_mois(5, indice_langue) = "Mai"
 tab_mois(6, indice_langue) = "Juni"
 tab_mois(7, indice_langue) = "Juli"
 tab_mois(8, indice_langue) = "August"
 tab_mois(9, indice_langue) = "September"
 tab_mois(10, indice_langue) = "Oktober"
 tab_mois(11, indice_langue) = "November"
 tab_mois(12, indice_langue) = "Dezember"
 msg_err(0, indice_langue) = "Date entered "
 msg_err(1, indice_langue) = "is invalid. Try again"
 Case "I": indice_langue = 5
 tab_jour(1, indice_langue) = "Lunedi"
 tab_jour(2, indice_langue) = "Martedi"
 tab_jour(3, indice_langue) = "Mercoledi"
 tab_jour(4, indice_langue) = "Giovedi"
 tab_jour(5, indice_langue) = "Venerdi"
 tab_jour(6, indice_langue) = "Sabato"
 tab_jour(7, indice_langue) = "Domenica"
 tab_mois(1, indice_langue) = "Gennaio"
 tab_mois(2, indice_langue) = "Febbraio"
 tab_mois(3, indice_langue) = "Marzo"
 tab_mois(4, indice_langue) = "Aprile"
 tab_mois(5, indice_langue) = "Maggio"
 tab_mois(6, indice_langue) = "Giugno"
 tab_mois(7, indice_langue) = "Luglio"
 tab_mois(8, indice_langue) = "Agosto"
 tab_mois(9, indice_langue) = "Septembre"
 tab_mois(10, indice_langue) = "Ottobre"
 tab_mois(11, indice_langue) = "Novembre"
 tab_mois(12, indice_langue) = "Dicembre"
 msg_err(0, indice_langue) = "Date entered "
 msg_err(1, indice_langue) = "is invalid. Try again"
 Case "R": indice_langue = 6
  tab_jour(1, indice_langue) = "Monday"
 tab_jour(2, indice_langue) = "Tuesday"
 tab_jour(3, indice_langue) = "Wednesday"
 tab_jour(4, indice_langue) = "Thursday"
 tab_jour(5, indice_langue) = "Friday"
 tab_jour(6, indice_langue) = "Saturday"
 tab_jour(7, indice_langue) = "Sunday"
 tab_mois(1, indice_langue) = "January"
 tab_mois(2, indice_langue) = "February"
 tab_mois(3, indice_langue) = "March"
 tab_mois(4, indice_langue) = "April"
 tab_mois(5, indice_langue) = "May"
 tab_mois(6, indice_langue) = "June"
 tab_mois(7, indice_langue) = "July"
 tab_mois(8, indice_langue) = "August"
 tab_mois(9, indice_langue) = "September"
 tab_mois(10, indice_langue) = "October"
 tab_mois(11, indice_langue) = "November"
 tab_mois(12, indice_langue) = "December"
 msg_err(0, indice_langue) = "Date entered "
 msg_err(1, indice_langue) = "is invalid. Try again"
 Case "S": indice_langue = 7
  tab_jour(1, indice_langue) = "Lunes"
 tab_jour(2, indice_langue) = "Martes"
 tab_jour(3, indice_langue) = "Miércoles"
 tab_jour(4, indice_langue) = "Jueves"
 tab_jour(5, indice_langue) = "Viernes"
 tab_jour(6, indice_langue) = "Sábado"
 tab_jour(7, indice_langue) = "Domingo"
 tab_mois(1, indice_langue) = "Enero"
 tab_mois(2, indice_langue) = "Febrero"
 tab_mois(3, indice_langue) = "Marzo"
 tab_mois(4, indice_langue) = "Abril"
 tab_mois(5, indice_langue) = "Mayo"
 tab_mois(6, indice_langue) = "Junio"
 tab_mois(7, indice_langue) = "Julio"
 tab_mois(8, indice_langue) = "Agosto"
 tab_mois(9, indice_langue) = "Septiembre"
 tab_mois(10, indice_langue) = "Octubre"
 tab_mois(11, indice_langue) = "Noviembre"
 tab_mois(12, indice_langue) = "Diciembre"
 msg_err(0, indice_langue) = "Date entered "
 msg_err(1, indice_langue) = "is invalid. Try again"
  Case Else: indice_langue = 1
 tab_jour(1, indice_langue) = "Monday"
 tab_jour(2, indice_langue) = "Tuesday"
 tab_jour(3, indice_langue) = "Wednesday"
 tab_jour(4, indice_langue) = "Thursday"
 tab_jour(5, indice_langue) = "Friday"
 tab_jour(6, indice_langue) = "Saturday"
 tab_jour(7, indice_langue) = "Sunday"
 tab_mois(1, indice_langue) = "January"
 tab_mois(2, indice_langue) = "February"
 tab_mois(3, indice_langue) = "March"
 tab_mois(4, indice_langue) = "April"
 tab_mois(5, indice_langue) = "May"
 tab_mois(6, indice_langue) = "June"
 tab_mois(7, indice_langue) = "July"
 tab_mois(8, indice_langue) = "August"
 tab_mois(9, indice_langue) = "September"
 tab_mois(10, indice_langue) = "October"
 tab_mois(11, indice_langue) = "November"
 tab_mois(12, indice_langue) = "December"
 msg_err(0, indice_langue) = "Date entered "
 msg_err(1, indice_langue) = "is invalid. Try again"
 End Select

End Sub

Public Function date_format_of_the_machine()
'pt
Dim d As String
d = "11/12/2002"
If Month(d) = 12 Then PC_date_format = "DMY"
If Month(d) = 11 Then PC_date_format = "MDY"
End Function

