// **********************************************************************
// Use Dates.utl    // Date manipulation for VDF and DF3.2
//
// by Sture Andersen (sa1@vd.dk)
//
// The file contains a number of global functions for manipulating
// dates. The package may be used with DataFlex 3.1 and Visual DataFlex.
// This package is public domain.
//
// The package file is accompanied by a Word document (dfutil.doc)
// listing the functions and their use.
//
//
// Create: Fri  06-06-1997 - Merger of s_utl020, 021, 022, 023, 024, 025.
// Update: Thu  26-06-1997 - Fixes for strange behavior when date4_state is set.
//                         - Addition of popup_calendar to VDF.
//         Sun  29-06-1997 - Character mode popup calender.
//         Fri  04-07-1997 - Function WeekToDate added.
//         Thu  10-07-1997 - Fixes.
//         Mon  11-08-1997 - WeekToDate fixed.
//         Sun  24-08-1997 - Character mode popup calender finished.
//         Mon  15-12-1997 - Procedure Request_Popup_Calendar added.
//         Mon  29-12-1997 - Procedures ItemYear2to4, ItemDate2to4 and
//                           ItemSysdate added.
//         Mon  29-12-1997 - Procedures FieldYear2to4, FieldDate2to4 and
//                           FieldSysdate added.
//         Sun  01-02-1998 - Functions Module_Compile_Date and
//                           Module_Compile_Time added.
//         Wed  25-02-1998 - Request_Popup in calendar object now only
//                           responds if entry_state of the calling object
//                           is true (VDF version). (No apparent effect)
//         Sat  28-03-1998 - Added the following functions:
//                             TS_SysTime      TS_ExtractDate
//                             TS_ExtractTime  TS_ConvertToString
//         Tue  26-05-1998 - Procedure TS_UI_Update added
//         Sat  01-08-1998 - mask_date_window taken into account
//         Mon  10-08-1998 - Functions Module_Start_Date and
//                           Module_Start_Time added.
//         Wed  02-09-1998 - Parameter for Module_Start_Date removed
//         Mon  12-10-1998 - Portuguese added
//         Wed  04-11-1998 - TS_TimeEstimator class added
//         Tue  29-12-1998 - Function DateAsString added
//         Wed  13-01-1999 - Function DateWeekNumber changed according to
//                           Kjetil Johanson
//         Mon  18-01-1999 - Function DateWeekNumber changed according to
//                           Kjetil Johanson (again)
//         Tue  19-01-1999 - Changed procedure names in TS_TimeEstimator
//                           class (Continue->TS_Continue and Pause->
//                           TS_Pause)
//         Thu  21-01-1999 - Procedures DateFormatAsString and DateFormatName
//                           added.
//                         - Procedures DateCurrentSeparator and
//                           DateCurrentFormat added.
//         Tue  13-04-1999 - Julian constants added: Jan1st1900, Jan1st2000
//                           Jan1st1000 and Jan1st100
//         Mon  26-04-1999 - Changed procedure FieldYear2to4 and ItemYear2to4
//                           to trap 3 digit years.
//         Wed  27-04-1999 - Changed Dutch abbriviated day names (to 2 characters)
//         Sun  02-05-1999 - Added function TS_Compose2
//                         - Fixed error in TS_ConvertToString
//         Tue  01-06-1999 - Added procedure popup_no_export to calendar.
//         Thu  15-06-1999 - Fixed Date4to2 function and exporting dates
//                           from the calendar to forms with no form_margin.
//         Tue  07-09-1999 - Added function DateAsText
//         Wed  27-10-1999 - Temporary fix for Module_Compile_Date function
//                           in combination with y2k.
//         Wed  19-12-1999 - Function StrToDate added.
//                         - Existing function DateAsString renamed to
//                           DateToStr.
//         Mon  03-01-2000 - Fix for VDF4. Popup calendar on empty date field
//                           would result in seeding the calendar on year 100.
//                           This error was caused by the fact that VDF 4
//                           ignores SYSDATE4_STATE such that the sysdate
//                           command returns 03-01-100
//         Wed  01-02-2000 - Define instead of #REPLACE
//         Wed  23-08-2000 - Function TS_Module_Compile_Time added
//         Sat  04-08-2001 - Function StrToDate in Dates.nui fixed by Paul
//                           Cooling
//         Sat  30-08-2003 - Odd date thing fixed by Wil van Antwherpen. (Search: **WvA:)
//         Fri  27-04-2007 - Added oTextBoxMonth to display vdfq_MonthName in oCont3d to right of DayHeader (Garret Mott, search "GM ")
//
// NOTE:  There is language dependent string constants in this file.
//        Currently there are sections for dutch, english, danish, swedish,
//        norwegian, spanish, german and portuguese
//
//        These sections may be identified by searching the symbol LNG_DEFAULT
//
// ***********************************************************************
Use Dates.nui    // Date routines (No User Interface)
Use ErrorHnd.nui // cErrorHandlerRedirector class and oErrorHandlerQuiet object (No User Interface)

define DATES_INCLUDE_POPUP for 1   // If set to 0 the popup calendar will not be included

procedure ItemSysdate for desktop integer liItm
  date ldDate
  get value item liItm to ldDate
  if ldDate eq 0 begin
    sysdate4 ldDate
    set changed_value item liItm to ldDate
  end
end_procedure

procedure ItemDate2to4 for desktop integer liItm
  integer liYear
  date ldDate ldNewDate
  send ErrorHnd_Quiet_Activate
  get value item liItm to ldDate
  send ErrorHnd_Quiet_Deactivate

  move (vdfq_DateSegment(ldDate,DS_YEAR)) to liYear
  if (liYear=0 and ldDate<>0) move (DateIncr(ldDate,3,iSysYear())) to ldNewDate
  else move ldDate to ldNewDate

  move (Date2to4(ldNewDate)) to ldNewDate
  move (vdfq_DateSegment(ldNewDate,3)) to liYear
  if (liYear>99 and liYear<1000) begin
    error 15 // Illegal entry in this window
    procedure_return 1
  end
  if ldNewDate ne ldDate set value item liItm to ldNewDate
end_procedure

procedure ItemYear2to4 for desktop integer liItm
  integer liYear liNewYear
  get value item liItm to liYear
  if (liYear>99 and liYear<1000) begin
    error 15 // Illegal entry in this window
    procedure_return 1
  end
  move (Year2to4(liYear)) to liNewYear
  if liNewYear ne liYear set value item liItm to liNewYear
end_procedure


#IF DATES_INCLUDE_POPUP
 register_procedure NotifyPopupCalendarChange date ldDate
 register_procedure NotifyPopupCalendarSelect date ldDate

  use DFAllent
  Class calendar.textbox is a textbox
    Procedure Construct_Object
      Forward Send Construct_Object
      Set Auto_Size_State To DFFALSE
      Set Justification_Mode to (JMODE_VCENTER+JMODE_CENTER)
      Property Integer _piDayNumber
    End_Procedure
    Procedure UpdateDayName
        Integer iDay
        Get _piDayNumber to iDay
        #IF LNG_DEFAULT=LNG_DUTCH // The dutch only wants the first 2 letters of the weekday
         Set Value to (Left(vdfq_DayName(iDay),2))
        #ELSE
         Set Value to (Left(vdfq_DayName(iDay),3))
        #ENDIF
    End_Procedure
  End_Class

  register_object oBtn1
  register_object oBtn6

  class calendar.button is a button

    procedure construct_object
      forward send construct_object
      set size to 15 18
      on_key kleftarrow   send prev_day
      on_key krightarrow  send next_day
      on_key kuparrow     send prev_week
      on_key kdownarrow   send next_week
      property date pdAssignedDate public 0
    end_procedure

    procedure switch // This makes all 42 buttons act as if they are one focus
      send activate to (oBtn1(self))
    end_procedure
    procedure switch_back
      send activate to (oBtn6(self))
    end_procedure

    procedure mouse_down
      integer lhSelf
      forward send mouse_down
      move self to lhSelf
      delegate set pdCurrentDate to (pdAssignedDate(lhSelf))
    end_procedure
  end_class

  desktop_section
    object popup_calendar is a ModalPanel
      set size to 165 250
      property date    pdCurrentDate  public 0
      property integer p_current_year  public -1
      property integer p_current_month public -1
      property integer pExportState    public 1

      on_key key_ctrl+key_pgup send prev_year
      on_key key_ctrl+key_pgdn send next_year
      on_key          key_pgup send prev_month
      on_key          key_pgdn send next_month
      on_key key_ctrl+key_d    send go_today
      On_Key kcancel           Send cancel
      
      Procedure Deactivate_Group
        Forward Send Deactivate_Group
      End_Procedure

      Object oCont3d is a Container3d
        set location to 5 5
        set size to 120 237
        object oTextboxYear is a calendar.textbox
          set location to 5 5
          set size to 15 30
          set border_style to BORDER_STATICEDGE
          procedure display
            set value to (p_current_year(self))
          end_procedure
        end_object
        object oDaynameHeader is a container3d
          set location to 5 39
          set size to 15 126
          set border_style to BORDER_STATICEDGE
          procedure initialize
            integer liItm
            for liItm from 0 to 6
              object oTxt is a calendar.textbox
                set size to 12 17
                Set location to 0 (liItm*17.6+1)
                Set _piDayNumber to (liItm+1)
                #IF LNG_DEFAULT=LNG_DUTCH // The dutch only wants the first 2 letters of the weekday
                 Set value to (left(vdfq_DayName(liItm+1),2))
                #ELSE
                 Set value to (left(vdfq_DayName(liItm+1),3))
                #ENDIF
              end_object
            loop
          end_procedure
          Send initialize
          Procedure UpdateDayNames
            Broadcast Send UpdateDayName 
          End_Procedure
        end_object

        //GM 04/27/07 to display Month in container
        object oTextboxMonth is a calendar.textbox
          set location to 5 170
          set size to 15 50
          set border_style to BORDER_STATICEDGE
          procedure display
            set value to (vdfq_MonthName(p_current_month(self)))
          end_procedure
        end_object

        object oWeekNumberHeader is a container3d
          set location to 24 5
          set size     to 89 30
          set border_style to BORDER_STATICEDGE
          object oObjIdArray is an array
          end_object
          procedure initialize
            integer liItm lhObj
            move (oObjIdArray(self)) to lhObj
            for liItm from 0 to 5
              #PUSH !Zb    // Compiler trick. Non static number
              #SET ZB$ -1  // of child objects.
              object oTxt is a textbox
                set size to 15 30
                set location to (liItm*15+1) 1
                set value of lhObj item (item_count(lhObj)) to self
              end_object
              #POP ZB$     // End trick
            loop
          end_procedure
          procedure display
            integer liItm lhObj
            date ldDate ldLastDate
            move (oObjIdArray(self)) to lhObj
            get pdCurrentDate to ldDate
            move (FirstDayInMonth(ldDate)) to ldDate
            move (LastDayInMonth(ldDate)) to ldLastDate
            move (ldDate-DateDayNumber(ldDate)+1) to ldDate
            for liItm from 0 to 5
              if (liItm*7+ldDate) le ldLastDate ;
                set value of (integer(value(lhObj,liItm))) to (t.calendar.week*string(DateWeekNumber(liItm*7+ldDate)))
              else set value of (integer(value(lhObj,liItm))) to ""
            loop
          end_procedure
          send initialize
        end_object
        object oDaysGrid is a container3d
          set location to 23 39
          set size     to 100 127
          set border_style to BORDER_NONE
          object oBtnArray is an array
          end_object
          procedure initialize
            integer liRow liCol lhBtnArray
            move (oBtnArray(self)) to lhBtnArray
            for liRow from 0 to 5
              for liCol from 0 to 6
                #PUSH !Zb
                #SET ZB$ -1
                object oBtn is a calendar.button
                  set location to (liRow*15) (liCol*18)
                  set value of lhBtnArray item (item_count(lhBtnArray)) to self
                  on_item "" send move_value_out_ok
                end_object
                #POP ZB$
              loop
            loop
          end_procedure
          send initialize

          Procedure display.iii Integer liItm Integer liDay Integer lbActivate
            Integer lhObj liCurrentDay
            Move (Integer(value(oBtnArray(Self),liItm))) to lhObj
            Move (vdfq_DateSegment(pdCurrentDate(Self),DS_DAY)) to liCurrentDay
            If lbActivate Begin
              If liDay eq liCurrentDay Send activate to lhObj
            End
            Else Begin
              If liDay Begin
                Set value of lhObj to liDay
                Set visible_state of lhObj to DFTRUE
                Set pdAssignedDate of lhObj to (DateCompose(liDay,p_current_month(Self),p_current_year(Self)))
              End
              Else begin
                Set visible_state of lhObj to DFFALSE
              End
            End
          End_Procedure

          Procedure display Integer lbActivate
            Integer liFirstItem liLastItem liItm liDay liDate
            Get pdCurrentDate to liDate
            Move (FirstDayInMonth(liDate)) to liDate
            
            Move (DateDayNumber(liDate)-1) to liFirstItem
            
//            If (gbSundayIsFirstDayOfWeek) Begin
//                Increment liFirstItem
//                If (liFirstItem>7) Begin
//                    Move (liFirstItem-7) to liFirstItem
//                End
//            End
            // **WvA: 27-08-2003 VDF9.1 Needs the integer datevalue to be casted to
            // a date before the expression can be evaluated.
            Move (LastDayInMonth(liDate)-Date(liDate)+liFirstItem) to liLastItem
            // **
            ifnot lbActivate begin
              for liItm from 0 to (liFirstItem-1)
                send display.iii liItm 0 0
              loop
            end
            move 1 to liDay
            for liItm from liFirstItem to liLastItem
              send display.iii liItm liDay lbActivate
              increment liDay
            loop
            ifnot lbActivate begin
              for liItm from (liLastItem+1) to 41
                send display.iii liItm 0 0
              loop
            end
          end_procedure
        end_object
        object oTxtMonth is a calendar.textbox
          set size to 12 27
          set location to 25 185
          set value to t.calendar.month
        end_object
        object oBtn1 is a button
          set size to 12 12
          set location to 40 185
          on_item "" send prev_month
          set bitmap to "prev.bmp"
          procedure switch_back
            send display_main
          end_procedure
        end_object
        object oBtn2 is a button
          set size to 12 12
          set location to 40 200
          on_item "" send next_month
          set bitmap to "next.bmp"
        end_object
        object oTxtYear is a calendar.textbox
          set size to 12 27
          set location to 70 185
          set value to t.calendar.year
        end_object
        object oBtn3 is a button
          set size to 12 12
          set location to 85 185
          on_item "" send prev_year
          set bitmap to "prev.bmp"
        end_object
        object oBtn4 is a button
          set size to 12 12
          set location to 85 200
          on_item "" send next_year
          set bitmap to "next.bmp"
        end_object
      end_object
      object oBtn5 is a button
        set size to 14 60
        set location to 129 115
        on_item t.calendar.ok send move_value_out_ok
      end_object
      object oBtn6 is a button
        set size to 14 60
        set location to 129 182
        on_item t.calendar.cancel send cancel
        procedure switch
          send display_main
        end_procedure
      end_object
      procedure next_year
        set pdCurrentDate to (DateIncr(pdCurrentDate(self),DS_YEAR,1))
        send display_main
      end_procedure
      procedure prev_year
        set pdCurrentDate to (DateIncr(pdCurrentDate(self),DS_YEAR,-1))
        send display_main
      end_procedure
      procedure next_month
        set pdCurrentDate to (DateIncr(pdCurrentDate(self),DS_MONTH,1))
        send display_main
      end_procedure
      procedure prev_month
        set pdCurrentDate to (DateIncr(pdCurrentDate(self),DS_MONTH,-1))
        send display_main
      end_procedure
      procedure next_week
        set pdCurrentDate to (DateIncr(pdCurrentDate(self),DS_WEEK,1))
        send display_main
      end_procedure
      procedure prev_week
        set pdCurrentDate to (DateIncr(pdCurrentDate(self),DS_WEEK,-1))
        send display_main
      end_procedure
      procedure next_day
        set pdCurrentDate to (DateIncr(pdCurrentDate(self),DS_DAY,1))
        send display_main
      end_procedure
      procedure prev_day
        set pdCurrentDate to (DateIncr(pdCurrentDate(self),DS_DAY,-1))
        send display_main
      end_procedure
      procedure go_today
        date ldDate
        sysdate4 ldDate
        set pdCurrentDate to ldDate
        send display_main
      end_procedure
      property integer invoking_object_id public 0
      procedure OnChange date ldDate
        integer lhFocus lbDelegationMode
        get invoking_object_id to lhFocus
        if lhFocus gt desktop begin
          get delegation_mode of lhFocus to lbDelegationMode
          set delegation_mode of lhFocus to no_delegate_or_error
          send NotifyPopupCalendarChange to lhFocus ldDate
          set delegation_mode of lhFocus to lbDelegationMode
        end
      end_procedure
      procedure display
        integer liDate liMonth liYear
        get pdCurrentDate to liDate
        send OnChange liDate
        move (vdfq_DateSegment(liDate,DS_YEAR)) to liYear
        move (vdfq_DateSegment(liDate,DS_MONTH)) to liMonth
        if (p_current_year(self)<>liYear or p_current_month(self)<>liMonth) begin
          set p_current_year to liYear
          set p_current_month to liMonth
          set value to (t.calendar.calendar_popup+", "+vdfq_MonthName(liMonth))
          send display to (oTextboxMonth(oCont3d(self))) //GM 04/27/07
          send display to (oTextboxYear(oCont3d(self)))
          send display to (oWeekNumberHeader(oCont3d(self)))
          send display to (oDaysGrid(oCont3d(self))) 0
        end
      end_procedure
      procedure display_main
        send display
        send display to (oDaysGrid(oCont3d(self))) 1
      end_procedure
      procedure popup_no_export
        Set pExportState to DFFALSE
        Set p_current_year to -1
        Send UpdateDayNames of (oDaynameHeader(oCont3d(Self)))
        send popup
        Set pExportState to DFTRUE
      end_procedure

      property boolean pbDirectMode       False
      property boolean pbDirectModeAccept False

      Procedure popup_group
        integer lhFocus
        Date ldDate
        If (not(pbDirectMode(Self))) Begin
          Move (focus(desktop)) to lhFocus
          Set invoking_object_id to lhFocus
          Send ErrorHnd_Quiet_Activate
          Get value of lhFocus item current to ldDate
          Send DateDecompose ldDate
          If (not(DateIsLegalComponents(Dates$Day,Dates$Month,Dates$Year))) Begin
            Move 0 to ldDate
          End
          Send ErrorHnd_Quiet_Deactivate
        End
        Else Begin
          Get pdCurrentDate to ldDate
        End
        ifnot (Integer(ldDate)) Move (dSysdate()) to ldDate
        move (Date2to4(ldDate)) to ldDate
        set pdCurrentDate to ldDate
        Set p_current_year to -1
        Send UpdateDayNames of (oDaynameHeader(oCont3d(Self)))
        Send display
//        Set private.stop_ui_state to False
        forward send popup_group
        send display to (oDaysGrid(oCont3d(self))) 1
      end_procedure

      Procedure move_value_out
        Integer lhFocus lbDelegationMode liMargin liDataType
//      if (pExportState(self)) begin
          Get invoking_object_id to lhFocus
          If lhFocus gt desktop Begin
            Get Delegation_Mode of lhFocus to lbDelegationMode
            Set Delegation_Mode of lhFocus to No_Delegate_Or_Error
            Send NotifyPopupCalendarSelect to lhFocus (pdCurrentDate(Self))
            Get Form_Margin of lhFocus item current to liMargin
            Get Form_Datatype of lhFocus item current to liDataType
            Set Delegation_Mode of lhFocus to lbDelegationMode
            If (pExportState(Self)) Begin
              If (liMargin>=10 or liDataType=mask_date_window or liDataType=date_window) Set value of lhFocus item current to (pdCurrentDate(Self))
              Else             Set Value of lhFocus item Current to (Date4to2(pdCurrentDate(Self)))
              Set Item_Changed_State of lhFocus item Current to DFTRUE
            End
          End
//      end
      End_Procedure

      procedure move_value_out_ok
        if (pbDirectMode(self)) begin
          set pbDirectModeAccept to true
        end
        else begin
          send move_value_out
        end

        send deactivate
      end_procedure

      Procedure request_popup
        Integer lhFocus liType lbDelegationMode
        Move (Focus(desktop)) to lhFocus

        Send UpdateDayNames of (oDaynameHeader(oCont3d(Self)))
        Set p_current_year to -1

        If lhFocus gt desktop Begin
          Get Delegation_Mode of lhFocus to lbDelegationMode
          Set Delegation_Mode of lhFocus to No_Delegate_Or_Error
          Get Form_Datatype of lhFocus item Current to liType
          If (liType=Date_Window or liType=Mask_Date_Window) Begin
            Send Popup
          End
          Set Delegation_Mode of lhFocus to lbDelegationMode
        End
      End_Procedure

      function SelectDate date ldValue returns date
        date dRval
        set pbDirectMode to True
        Set pdCurrentDate to ldValue
        Set p_current_year to -1
        send display
        set pbDirectModeAccept to False
        send popup_no_export
        set pbDirectMode to False
        if (pbDirectModeAccept(self)) Begin
          get pdCurrentDate to dRval
        end
        else begin
          move 0 to dRval
        end
        function_return dRval
      end_function
    end_object
  end_desktop_section
  // If the procedure below was not defined "for cObject" its symbolic
  // substitute would become negative (because located on the desktop). This
  // would result in the toolbar object not being able to handle it. Therefore:
  procedure request_popup_calendar for cObject
    send request_popup to (popup_calendar(self))
  end_procedure
  procedure popup_calendar_no_export
    send popup_no_export to (popup_calendar(self))
  end_procedure
  register_procedure Add_Toolbar_Button_Bitmap string lsBmp string lsTip string lsStatusHelp integer liMsg integer lhObj
  procedure Add_Calendar_tbButton integer lhToolButton
    send Add_Toolbar_Button_Bitmap to lhToolButton "DfCalend.bmp" t.calendar.calendar_popup t.calendar.Activate msg_request_popup_calendar
  end_procedure
  function s.calendar returns integer // Backwards compatible!!
    function_return (popup_calendar(self))
  end_function
  Function PopupCalendarFunction Date dValue Returns Date
    Function_Return (SelectDate(popup_calendar,dValue))
  end_function
#ENDIF // DATES_INCLUDE_POPUP