// TESTDATE.DF3
//
// This program source may be used for testing the functions of utility
// pack DATES.UTL.
//
// Sture Andersen
//
// Create: Fri  27-06-1997
// Update: Thu  09-08-2001
//

Use LangSymb.pkg // Language symbols
define lng_default for LNG_ENGLISH

Use App.utl    // Character Mode classes
Use Dates.utl  // Date functions for DF3.2 and VDF

set_date_attribute date4_state to DFTRUE

/TestDate.Hdr
ÚÄTest date routinesÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
/TestDate.Input1
³
³  Test date: __/__/____
³      (F4=Calendar)
/TestDate.Input2
                                        ³
   ___ US  ___ European  ___ Military   ³
                                        ³
/TestDate.Result
³  Week number: _.                      Julian value: ___________  ³
³                                                                  ³
³  Day..:   _.                          Weekday: _. _____________  ³
³  Month:   _. _____________                                       ³
³  Year.: ___.                                                     ³
³                                                                  ³
³  First date in month...: __/__/____                              ³
³  Last date in month....: __/__/____                              ³
³                                                                  ³
³  Three weeks before: __/__/____  Four months before: __/__/____  ³
³  Three weeks after.: __/__/____  Two months after..: __/__/____  ³
³  Ridiculous British company date: _________ (#D2-#MN3-#Y2)       ³
/TestDate.Btn
³                                                      ___________ ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
/*

register_procedure DoCalculateDate
object oTestDate_Client is a app.ModalClient TestDate.Hdr
  set location to 3 6 ABSOLUTE
  on_key kcancel send cancel

  object oFrm1 is a form TestDate.Input1
    set location to 1 0 RELATIVE
    on_key key_F8 send incr_date
    on_key key_F7 send decr_date
    on_key key_ctrl+key_d send popup to (popup_calendar(self))
    on_key kprompt        send popup to (popup_calendar(self))

    procedure decr_date
      set value item 0 to (date(integer(value(self,0))-1))
      send DoCalculateDate
    end_procedure

    procedure incr_date
      local integer ldDate
      get value item 0 to ldDate
      set value item 0 to (date(ldDate+1))
      send DoCalculateDate
    end_procedure

    item_list
      on_item "" send DoCalculateDate
    end_item_list

    procedure NotifyPopupCalendarChange date ldDate
      set delegation_mode to DELEGATE_TO_PARENT
      set value item 0 to (string(ldDate))
      send DoCalculateDate
    end_procedure
  end_object

  object oRad is a radio TestDate.Input2
    set location to 1 27 RELATIVE
    set select_mode to AUTO_SELECT
    item_list
      on_item
      on_item
      on_item
    end_item_list

    procedure item_change integer liFrom integer liTo returns integer
      local date ldDate
      forward get msg_item_change liFrom liTo to liTo
      get value of (oFrm1(self)) item 0 to ldDate
      if liTo eq 0 set_attribute df_date_format to DF_DATE_USA
      if liTo eq 1 set_attribute df_date_format to DF_DATE_EUROPEAN
      if liTo eq 2 set_attribute df_date_format to DF_DATE_MILITARY
      set value of (oFrm1(self)) item 0 to ldDate
      if (active_state(self)) send DoCalculateDate
      procedure_return liTo
    end_procedure

    procedure DoInitialize
      local integer liFormat
      get_attribute df_date_format to liFormat
      if liFormat eq DF_DATE_USA      set current_item to 0
      if liFormat eq DF_DATE_EUROPEAN set current_item to 1
      if liFormat eq DF_DATE_MILITARY set current_item to 2
    end_procedure
    send DoInitialize
  end_object

  object oFrm2 is a form TestDate.Result
    set location to 4 0 RELATIVE
    set focus_mode to NONFOCUSABLE

    item_list
      on_item "" send none
      on_item "" send none
      on_item "" send none
      on_item "" send none
      on_item "" send none
      on_item "" send none
      on_item "" send none
      on_item "" send none
      on_item "" send none
      on_item "" send none
      on_item "" send none
      on_item "" send none
      on_item "" send none
      on_item "" send none
      on_item "" send none
    end_item_list

    procedure DoDisplayResult date ldDate
      set value item  0 to (DateWeekNumber(ldDate))
      set value item  1 to (integer(ldDate))
      set value item  2 to (DateSegment(ldDate,DS_DAY))
      set value item  3 to (DateDayNumber(ldDate))
      set value item  4 to (DateDayName(ldDate))
      set value item  5 to (DateSegment(ldDate,DS_MONTH))
      set value item  6 to (DateMonthName(ldDate))
      set value item  7 to (DateSegment(ldDate,DS_YEAR))
      set value item  8 to (FirstDayInMonth(ldDate))
      set value item  9 to (LastDayInMonth(ldDate))
      set value item 10 to (DateIncrement(ldDate,DS_WEEK,-3))
      set value item 11 to (DateIncrement(ldDate,DS_MONTH,-4))
      set value item 12 to (DateIncrement(ldDate,DS_WEEK,3))
      set value item 13 to (DateIncrement(ldDate,DS_MONTH,2))
      set value item 14 to (DateAsText(ldDate,"#D2-#MN3-#Y2"))
    end_procedure
  end_object

  object oBtn is a app.Button TestDate.Btn
    set location to 16 0 RELATIVE
    item_list
      on_item "Close" send cancel
    end_item_list
  end_object

  procedure DoCalculateDate
    local date ldDate
    get value of (oFrm1(self)) item 0 to ldDate
    send DoDisplayResult to (oFrm2(self)) ldDate
  end_procedure
end_object

start_ui (oTestDate_Client(self))