//************************************************************************
//*** Date functions for classes.
//************************************************************************
//*** cWsDateMixin.pkg
//*** Version: 1.1
//*** Copyright (c) 2002-2004 NordTeam Gruppen
//***
//*** Author......: Allan Kim Eriksen
//*** Created.....: 15/04 2002
//*** Last updated: 10/02 2004
//***
//*** REQUIRES VDFQUERY from Sture Andersen.
//************************************************************************
// This mixin class is used to control date fields. It makes it possible
// for the user to insert date and month and current year will automatic
// added to the field. 2-digits year will be converted to 4 digit year.
// If no date is inserted the current date will automatic be inserted.
// This can be avoided by setting AllowBlankDate to True.
// <PGUP> og <PGDOWN> increase/decrease the date by 1.
// <CTRL>+<D> correct the date to current date.
// Version 1.1
// It is now possible to hit <CTRL>+<F4> to popup a calender. The calender
// here used are from Sture Andersens VDFQuery. It requires Dates.utl from Vdfquery.
// <SHIFT>+<PGUP> Increase the date by a week
// <SHIFT>+<PGDOWN> Decrease the date by a week
// <CTRL>+<PGUP> Increase the date by a month
// <CTRL>+<PGDOWN> Decrease the date by a month
//
Use DFAllEnt.pkg
Use Dates.utl

Class cWsDate_Mixin Is A Mixin

    Procedure Define_cWsDate_Mixin
        Property Boolean pbAllowBlankDate False

        On_Key Key_CTRL+Key_D Send DoShowCurrentDate
        On_Key 290 Send DoIncreaseDate         // PGUP
        On_Key 291 Send DoDecreaseDate         // PGDOWN
        On_Key 5131 Send DoIncreaseWeek        // Shift + PGUP
        On_Key 5132 Send DoDecreaseWeek        // Shift + PGDOWN
        On_Key 292 Send DoIncreaseMonth        // Ctrl + PGUP
        On_Key 293 Send DoDecreaseMonth        // Ctrl + PGDOWN
        On_Key Key_CTRL+Key_F4 Send DoShowCalender

    End_Procedure

    Function nowDate Returns Date 
        local Date dato
        sysdate4 dato
        Function_Return dato
    End_Function

    Procedure Set AllowBlankDate Boolean bVal
        Set pbAllowBlankDate To bVal
    End_Procedure

    Function AllowBlankDate Returns Boolean
        Boolean bVal
        Get pbAllowBlankDate To bVal
        Function_Return bVal
    End_Function

    Procedure exiting Integer obj Returns Integer
        Date dValue
        String sValue
        Integer ret_val iEpoch iDatatype iValueHasChanged
        Integer iDate iMonth iYear
        Boolean bBlankOk bOldState
        Move 0 To iValueHasChanged
        Get_Date_Attribute epoch_value To iEpoch
        Get form_datatype Item (current_item(Self)) To iDatatype
        If ((iDataType = mask_date_window) Or (iDataType = date_Window)) Begin
            Send ignore_error To error_info_object 16
            Get_Date_Attribute date4_state To bOldState
            Set_Date_Attribute date4_state To (False)
            Get value To sValue
            Move (Trim(sValue)) To sValue
            Move sValue To dValue
            If ((sValue <> String(dValue)) And (Trim(String(dvalue)) = 0)) Begin
                Move (datecompose(1,1,datesegment(nowDate(Self), DS_YEAR))) To dValue
                Set value To dValue
                Increment iValueHasChanged
            End
            Get AllowBlankDate To bBlankOk
            If ((Not(bBlankOk)) Or (sValue <> "")) Begin
                Move (DateSegment(dValue, DS_YEAR)) To iYear
                Move (DateSegment(dValue, DS_MONTH)) To iMonth
                Move (DateSegment(dValue, DS_DAY)) To iDate
                If (iYear < 100) Begin
                    Move (nowDate(Self)) To dValue
                    If ((iYear > 0) And (iYear < 100)) Move (If(iYear<iEpoch, iYear+2000, iyear+1900)) To iYear
                    If (iYear = 0) Move (DateSegment(dValue, DS_YEAR)) To iYear
                    If ((iDate > 0) And (iMonth > 0)) Move (DateCompose(iDate, iMonth, iYear)) To dValue
                    Set value To dValue
                    Increment iValueHasChanged
                End
            End
            Set_Date_Attribute date4_state To bOldState
            Send trap_error To error_info_object 16
        End
        Forward Get msg_exiting obj To ret_val
        If ret_val Procedure_Return ret_val
        If iValueHasChanged Send DoChangeDEOValue
        Procedure_Return 0
    End_Procedure

    Procedure DoChangeDEOValue
        Boolean bUnderstood
        Handle hoFocus
        Integer Item# srvr# File# rec# Field#
        String val
        Get Focus To hoFocus
        Send ignore_error To error_info_object 98   // Forms on dialogs causes this error.
        Get Is_Function Get_Deo_Control_Object hoFocus False To bUnderstood
        Send trap_error To error_info_object 98
        If bUnderstood Begin
           Get current_Item To Item#
           Get Server To srvr#
           If srvr# Begin
              Get data_file To File#
              Get entry_value Item Item# To val
              Get Data_field To Field#
              // Send info_box ("Setting File_field_changedValue srvr# ="*string(srvr#)*"File# ="*string(File#)*"Field# ="*string(Field#)*"Val ="*val)
              Set File_Field_changed_Value Of srvr# File# Field# To val
           End
        End
    End_Procedure

    Procedure DoShowCurrentDate
        Integer iDataType
        Get form_datatype Item (current_item(Self)) To iDatatype
        If ((iDataType = mask_date_window) Or (iDataType = date_Window)) Begin
            Set value To (nowDate(Self))
            Send DoChangeDEOValue
        End
    End_Procedure

    Procedure DoIncreaseDate
        Date dDato
        Integer iDataType
        Get form_datatype Item (current_item(Self)) To iDatatype
        If ((iDataType = mask_date_window) Or (iDataType = date_Window)) Begin
            Get value To dDato
            If (Integer(dDato) > 0) Begin
                Move (Integer(dDato)+1) To dDato
                Set value To dDato
                Send DoChangeDEOValue
            End
        End
    End_Procedure

    Procedure DoDecreaseDate
        Date dDato
        Integer iDataType
        Get form_datatype Item (current_item(Self)) To iDatatype
        If ((iDataType = mask_date_window) Or (iDataType = date_Window)) Begin
            Get value To dDato
            If (Integer(dDato) > 0) Begin
                Move (Integer(dDato)-1) To dDato
                Set value To dDato
                Send DoChangeDEOValue
            End
        End
    End_Procedure

    Procedure DoIncreaseWeek
        Date dDato
        Integer iDataType
        Get form_datatype Item (current_item(Self)) To iDatatype
        If ((iDataType = mask_date_window) Or (iDataType = date_Window)) Begin
            Get value To dDato
            If (Integer(dDato) > 0) Begin
                Move (Integer(dDato)+7) To dDato
                Set value To dDato
                Send DoChangeDEOValue
            End
        End
    End_Procedure

    Procedure DoDecreaseWeek
        Date dDato
        Integer iDataType
        Get form_datatype Item (current_item(Self)) To iDatatype
        If ((iDataType = mask_date_window) Or (iDataType = date_Window)) Begin
            Get value To dDato
            If (Integer(dDato) > 0) Begin
                Move (Integer(dDato)-7) To dDato
                Set value To dDato
                Send DoChangeDEOValue
            End
        End
    End_Procedure

    Procedure DoIncreaseMonth
        Date dDato
        Integer iDataType
        Get form_datatype Item (current_item(Self)) To iDatatype
        If ((iDataType = mask_date_window) Or (iDataType = date_Window)) Begin
            Get value To dDato
            If (Integer(dDato) > 0) Begin
                Get DateIncrement dDato DS_MONTH 1 To dDato
                Set value To dDato
                Send DoChangeDEOValue
            End
        End
    End_Procedure

    Procedure DoDecreaseMonth
        Date dDato
        Integer iDataType
        Get form_datatype Item (current_item(Self)) To iDatatype
        If ((iDataType = mask_date_window) Or (iDataType = date_Window)) Begin
            Get value To dDato
            If (Integer(dDato) > 0) Begin
                Get DateIncrement dDato DS_MONTH -1 To dDato
                Set value To dDato
                Send DoChangeDEOValue
            End
        End
    End_Procedure

    Procedure DoShowCalender
        Integer iDataType
        Date dDato
        Get form_datatype Item (current_item(Self)) To iDatatype
        If ((iDataType = mask_date_window) Or (iDataType = date_Window)) Begin
            Send Request_Popup_Calendar
            Get value To dDato
            Set value To dDato  // Fremprovokerer OnChange
            //Send DoChangeDEOValue
        End
    End_Procedure // Prompt


End_Class