VERSION 5.00
Begin VB.UserControl CDate 
   ClientHeight    =   510
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3000
   ScaleHeight     =   510
   ScaleWidth      =   3000
   Begin VB.PictureBox Pic_Date 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      FillColor       =   &H00FFFFFF&
      ForeColor       =   &H80000008&
      Height          =   285
      Left            =   2445
      Picture         =   "CDate.ctx":0000
      ScaleHeight     =   285
      ScaleWidth      =   240
      TabIndex        =   0
      Top             =   0
      Width           =   235
   End
   Begin VB.TextBox Txt_Date 
      Height          =   315
      Left            =   0
      MaxLength       =   10
      TabIndex        =   1
      Top             =   0
      Width           =   2595
   End
End
Attribute VB_Name = "CDate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private mb_ManualEdited As Boolean
Private mb_ProceduralChange As Boolean

Public Event Resize()

Private Sub Pic_Date_Click()
    gs_Date = GetFrDate
    Dates.Show 1
    If Txt_Date.Text <> gs_Date Then
        mb_ProceduralChange = OK
        Txt_Date.Text = gs_Date
    End If
    mb_ManualEdited = KO
End Sub

Private Sub Txt_Date_Change()
Dim i As Integer
Dim ls_text As String
Dim li_position As Integer

    If Not (mb_ProceduralChange) And mb_ManualEdited = KO Then
        
       
        ls_text = txt_Date.Text
        If ls_text <> "" Then
            li_position = txt_Date.SelStart
            i = 1
            While i <> Len(ls_text) + 1
                If Mid(ls_text, i, 1) = "/" Then
                    ls_text = Mid(ls_text, 1, i - 1) & Mid(ls_text, i + 1, Len(ls_text) - i)
                Else
                    i = i + 1
                End If
            Wend
            
            txt_Date.Text = ls_text
            
            Select Case li_position
                Case 1, 2
                    txt_Date.SelStart = li_position
                Case 3, 4, 5
                    txt_Date.SelStart = li_position - 1
                Case 6, 7, 8, 9
                    txt_Date.SelStart = li_position - 2
            End Select
            
        End If
        
        mb_ManualEdited = OK
    End If
    mb_ProceduralChange = KO
End Sub

Private Sub txt_Date_KeyPress(KeyAscii As Integer)
    If Len(txt_Date.Text) = 8 And mb_ManualEdited = OK And KeyAscii <> 8 And txt_Date.SelLength = 0 Then
        KeyAscii = 0
    End If
End Sub

Private Sub UserControl_EnterFocus()
    If Enabled = OK Then Txt_Date.SetFocus
End Sub

Private Sub UserControl_GotFocus()
    If Enabled = OK Then Txt_Date.SetFocus
End Sub

Private Sub UserControl_Initialize()
    mb_ManualEdited = KO
    mb_ProceduralChange = KO
End Sub

Private Sub UserControl_InitProperties()
    Txt_Date.Enabled = OK
    Pic_Date.Enabled = OK
    Pic_Date.Picture = LoadResPicture(RES_COMBOCOPY, 1)
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    Txt_Date.Enabled = PropBag.ReadProperty("Enabled", True)
    If Txt_Date.Enabled = OK Then
        Pic_Date.Enabled = OK
        Pic_Date.Picture = LoadResPicture(RES_COMBOCOPY, 1)
    Else
        Pic_Date.Enabled = KO
        Pic_Date.Picture = LoadResPicture(RES_COMBOCOPYGRAY, 1)
    End If
End Sub

Private Sub UserControl_Resize()
'------------------------------------------------------------------
' Name :UserControl_Resize
'
' Purpose : Resize the text field to CDate extend
'
' review : 16/Mar/2000 by JJB
'------------------------------------------------------------------

    Txt_Date.Height = 315
    Height = 315
    If Width < 500 Then Width = 500
    Txt_Date.Width = Width '- 220
    Txt_Date.Top = 0
    Txt_Date.Left = 0
    Pic_Date.Left = Width - 270
    Pic_Date.Top = 0
    Pic_Date.Width = 260
    Pic_Date.Height = 345
    RaiseEvent Resize
End Sub

Property Let Enabled(ByVal lb_State As Boolean)
    If lb_State Then
        Txt_Date.Enabled = OK
        Pic_Date.Enabled = OK
        Pic_Date.Picture = LoadResPicture(RES_COMBOCOPY, 1)
    Else
        Txt_Date.Enabled = KO
        Pic_Date.Enabled = KO
        Pic_Date.Picture = LoadResPicture(RES_COMBOCOPYGRAY, 1)
    End If
End Property

Property Get Enabled() As Boolean
    Enabled = Txt_Date.Enabled
End Property


Private Function isNumeric(ByVal ls_Num As String)
Dim ls_TempNum As String
Dim ls_char As String
Dim li_Count As Integer
    isNumeric = KO
    ls_TempNum = Trim(ls_Num)
    For li_Count = 1 To Len(ls_TempNum)
        ls_char = Mid(ls_TempNum, li_Count, 1)
        If ls_char < "0" Or ls_char > "9" Then Exit Function
    Next
    isNumeric = OK
End Function

Private Function isValidDate(ByVal ls_Date As String)
'------------------------------------------------------------------
' Name :isValidDate
'
' Purpose : check if a "jjmmyyyy" date is valid
'
' review : 16/May/2000 by JJB
'------------------------------------------------------------------
On Error GoTo Err_isValidDate
Dim ls_TempDate As String
Dim ld_Date As Date
Dim ls_Year As String
Dim ls_Month As String
Dim ls_day As String

    isValidDate = KO
    ls_TempDate = Trim(ls_Date)
    If Len(ls_TempDate) <> 8 Then Exit Function
    If Not (isNumeric(ls_TempDate)) Then Exit Function
    ls_Year = Right(ls_TempDate, 4)
    ls_Month = Mid(ls_TempDate, 3, 2)
    ls_day = Left(ls_TempDate, 2)
    ld_Date = DateSerial(ls_Year, ls_Month, ls_day)
    If (Year(ld_Date) = CInt(ls_Year)) And (Month(ld_Date) = CInt(ls_Month)) And (Day(ld_Date) = CInt(ls_day)) Then
        isValidDate = OK
    End If
    Exit Function
    
Err_isValidDate:

End Function

Public Sub Reinit()
    If Txt_Date.Text <> "" Then
        mb_ProceduralChange = OK
        Txt_Date.Text = ""
    End If
    mb_ManualEdited = KO
End Sub

Property Let SetDate(ByVal ls_Date As String)
    If Txt_Date.Text <> ls_Date Then
        mb_ProceduralChange = OK
        Txt_Date.Text = ls_Date
    End If
End Property

Public Sub SetToday()
    mb_ProceduralChange = OK
    txt_Date.Text = Format(Day(Now), "00") & "/" & Format(Month(Now), "00") & "/" & Year(Now)
    mb_ManualEdited = KO
End Sub

Public Sub AddDay(ll_Day As Long)
Dim ld_Date As Date
Dim ls_Year As String
Dim ls_Month As String
Dim ls_Day As String
Dim ls_tempdate As String
    
    mb_ProceduralChange = OK
    
    ls_tempdate = Txt_Date.Text

    If mb_ManualEdited = OK Then
        If isValidDate(Txt_Date.Text) = KO Then Exit Sub
        ls_Year = Right(ls_tempdate, 4)
        ls_Month = Mid(ls_tempdate, 3, 2)
        ls_Day = Left(ls_tempdate, 2)
    Else
        ls_Year = Right(ls_tempdate, 4)
        ls_Month = Mid(ls_tempdate, 4, 2)
        ls_Day = Left(ls_tempdate, 2)
    End If
    
    ld_Date = DateSerial(ls_Year, ls_Month, ls_Day)
    
    ld_Date = DateAdd("d", ll_Day, ld_Date)

    ls_Day = Day(ld_Date)
    ls_Month = Month(ld_Date)
    ls_Year = Year(ld_Date)

    Txt_Date.Text = Format(ls_Day, "00") & "/" & Format(ls_Month, "00") & "/" & ls_Year

    mb_ManualEdited = KO
End Sub

Property Get GetUSDate() As String
'get Date in US format
    If mb_ManualEdited Then
        If isValidDate(Txt_Date.Text) Then
            GetUSDate = Mid(Trim(Txt_Date.Text), 3, 2) & "/" & Left(Trim(Txt_Date.Text), 2) & "/" & Right(Trim(Txt_Date.Text), 4)
        Else
            GetUSDate = ""
        End If
    Else
        GetUSDate = FormatD(Txt_Date.Text, "mm/dd/yyyy")
    End If
End Property

Property Get GetFrDate() As String
'get Date in US format
    If mb_ManualEdited Then
        If isValidDate(Txt_Date.Text) Then
            GetFrDate = Left(Trim(Txt_Date.Text), 2) & "/" & Mid(Trim(Txt_Date.Text), 3, 2) & "/" & Right(Trim(Txt_Date.Text), 4)
        Else
            GetFrDate = ""
        End If
    Else
        GetFrDate = Txt_Date.Text 'FormatD(Txt_Date.Text, "dd/mm/yyyy")
    End If
End Property

Property Get isDateEntered() As Boolean
    If (Txt_Date.Text <> "") Then
        isDateEntered = OK
    Else
        isDateEntered = KO
    End If
End Property


Property Get isDateValid() As Boolean
    If mb_ManualEdited Then
        isDateValid = isValidDate(Txt_Date.Text)
    Else
        isDateValid = OK
    End If
End Property

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    PropBag.WriteProperty "Enabled", Txt_Date.Enabled, True
End Sub
