From: m.mejia@server1.codetel.net.do (Melvin Perez Cedano)
Subject: Populating a Calendar and Getting a date in 4GL
Date: 11 Dec 1995 22:18:04 -0500

Hi informixers!

This is freeware to Informix-4gl Programmers!!

Sorry for the comments :( they're in spanish! -> If you don't speak spanish,
take this as a practice! :)

I think that everyone has a similar way to do this. I have seem this in
informix/pub... (calx); I implemented in a different way: the user can
point-and-shoot thru the days using the cursor keys; specify a date (using
TAB key); move to the today's date (using CONTROL-T). This is very useful
when entering date values!

You could use a stub program calling the function, for example:

MAIN
   DEFINE l_date DATE

   LET l_date = look_date(TODAY, 3, 2)

END MAIN
-------------------------------- CUT HERE -----------------------------------
--***************************************************************************
--* look_date.4gl
--*
--* Este fuente contiene un conjunto de funciones que permiten escoger una
--* fecha del calendario, partiendo de una fecha inicial pasada como
--* parametro a la funcion principal look_date()
--*
--* SINTAXIS            : CALL look_date(p_date, ypos, xpos)
--*                           RETURNING <a_date>
--*                                  O
--*                       LET a_date = look_date(p_date, ypos, xpos)
--*
--* EJEMPLO             : LET m_date = look_date(TODAY, 5, 5)
--*        Muestra un calendario del mes actual en la coordenada (5,5),
--*        indicando como fecha de inicio la fecha de hoy.
--*
--* AUTOR               : Ing. Melvin Perez Cedano
--* ULT. ACTUALIZACION  : Mon Dec 11 21:28:47 SDQ 1995
--***************************************************************************

{----------------------------------------------------------------------------}
GLOBALS
    --> Definicion de variables globales al modulo. Pueden reducirse aun mas!
    DEFINE
        m_prevdate,                            --> Fecha previa
        m_currdate     DATE,                   --> Fecha actual
        ma_days        ARRAY[31] OF CHAR(2),   --> Arreglo de los dias del mes
        m_initpos,                             --> Posicion inicial.
        m_prevpos,                             --> Posicion anterior.
        m_currpos,                             --> Posicion actual.
        m_numdays      SMALLINT                --> Numero de Dias en el mes.
END GLOBALS

--***************************************************************************
--* look_date()       Funcion principal.
--*
--* Argumentos:
--*     p_date        Fecha Inicial
--*     p_ypos,
--*     p_xpos        Coordenadas de despliegue
--* Retorno:
--*     p_date        Si se cancelo la captura
--*     m_currdate    La fecha escogida por el usuario
--***************************************************************************
{----------------------------------------------------------------------------}
FUNCTION look_date(p_date, p_ypos, p_xpos)
    DEFINE p_date DATE,
        p_ypos,
        p_xpos SMALLINT

    LET m_currdate = p_date
    LET m_prevdate = m_currdate

    OPEN WINDOW w_calendar AT p_ypos, p_xpos WITH 10 ROWS, 22 COLUMNS
        ATTRIBUTE(BORDER, MENU LINE LAST, PROMPT LINE LAST)

    CALL load_month()
    CALL choose_day()

    CLOSE WINDOW w_calendar

    IF INT_FLAG THEN
        RETURN p_date
    ELSE
        RETURN m_currdate
    END IF
END FUNCTION

--***************************************************************************
--* load_month()      Carga el mes de la fecha actual.
--*
--* Argumentos:
--*     <ninguno>
--* Retorno:
--*     <ninguno>
--***************************************************************************
{----------------------------------------------------------------------------}
FUNCTION load_month()
    DEFINE ypos,
           xpos,
           i      SMALLINT,
           l_days CHAR(22)

    LET l_days = " SU MO TU WE TH FR SA "
    LET m_initpos = WEEKDAY(MDY(MONTH(m_currdate), 1, YEAR(m_currdate)))
    LET m_currpos = DAY(m_currdate)
    LET m_prevpos = m_currpos
    LET i = 1

    --> Inteligentemente determina la cantidad exacta de dias en cada mes.
    WHILE i <= 31
        IF MONTH(m_currdate - m_currpos + i) != MONTH(m_currdate) THEN
            EXIT WHILE
        END IF
        LET ma_days[i] = i USING "##"
        LET i = i + 1
    END WHILE

    LET m_numdays = i - 1

    CLEAR WINDOW w_calendar

    --> Despliega el encabezado el calendario
    DISPLAY m_currdate USING "MMM/YYYY" AT 1, 1
    DISPLAY l_days AT 2, 1 ATTRIBUTE(REVERSE)

    --> Despliega los dias del mes
    FOR i = 1 TO m_numdays
        CALL pos_day(i) RETURNING ypos, xpos
        DISPLAY " ", ma_days[i] AT ypos, xpos ATTRIBUTE(NORMAL)
    END FOR
END FUNCTION

--***************************************************************************
--* pos_day()         Determina la posicion de despliegue de un dia
--*
--* Argumentos:
--*     p_daynum      Numero del Dia.
--* Retorno:
--*     xpos, ypos    Coordenadas de despliegue.
--***************************************************************************
{----------------------------------------------------------------------------}
FUNCTION pos_day(p_daynum)
    DEFINE p_daynum,
           xpos,
           ypos SMALLINT

    LET xpos = ((p_daynum + m_initpos - 1) MOD 7) + 1
    LET xpos = 3 * xpos - 2
    LET ypos = ((p_daynum + m_initpos - 1) / 7) + 3

    RETURN ypos, xpos
END FUNCTION

--***************************************************************************
--* choose_day()      Escoge el dia, permitiendo moverse con los cursores
--*
--* Argumentos:
--*     <ninguno>
--* Retorno:
--*     <ninguno>
--***************************************************************************
{----------------------------------------------------------------------------}
FUNCTION choose_day()
    MENU ""
        BEFORE MENU
            CALL show_day()
        --> Asigna activa la fecha del dia
        COMMAND KEY(CONTROL-T)
            LET m_currdate = TODAY
            CALL move_day()
        --> Permite indicar una fecha
        COMMAND KEY(TAB)
            CALL prompt_for_date() RETURNING m_currdate
            CALL move_day()
        COMMAND KEY(DOWN)
            LET m_currdate = m_currdate + 7
            CALL move_day()
        COMMAND KEY(UP)
            LET m_currdate = m_currdate - 7
            CALL move_day()
        COMMAND KEY(LEFT)
            LET m_currdate = m_currdate - 1
            CALL move_day()
        COMMAND KEY(RIGHT)
            LET m_currdate = m_currdate + 1
            CALL move_day()
        COMMAND KEY(NEXTPAGE)
            LET m_currdate = m_currdate + m_numdays
            CALL move_day()
        COMMAND KEY(PREVPAGE)
            LET m_currdate = m_currdate - m_numdays
            CALL move_day()
        COMMAND KEY (RETURN, INTERRUPT)
            EXIT MENU
    END MENU
END FUNCTION

--***************************************************************************
--* move_day()        Se mueve al dia escogido por la funcion choose_day()
--*
--* Argumentos:
--*     <ninguno>
--* Retorno:
--*     <ninguno>
--***************************************************************************
{----------------------------------------------------------------------------}
FUNCTION move_day()
    --> La fecha nueva se encuentra en otro mes/anio, carga el mes de esta.
    IF (MONTH(m_currdate) != MONTH(m_prevdate) OR
        YEAR(m_currdate) != YEAR(m_prevdate)) THEN
        CALL load_month()
    END IF

    LET m_prevpos = m_currpos
    LET m_currpos = DAY(m_currdate)
    LET m_prevdate = m_currdate

    --> Despliega el dia
    CALL show_day()
END FUNCTION

--***************************************************************************
--* show_day()        Muestra el dia escogido en modo REVERSE.
--*
--* Argumentos:
--*     <ninguno>
--* Retorno:
--*     <ninguno>
--***************************************************************************
{----------------------------------------------------------------------------}
FUNCTION show_day()
    DEFINE xpos,
           ypos,
           pos SMALLINT

    --> Despliega en modo normal el dia actual.
    CALL pos_day(m_prevpos) RETURNING ypos, xpos

    DISPLAY " ", ma_days[m_prevpos] AT ypos, xpos ATTRIBUTE(NORMAL)

    --> Despliega en modo REVERSE el nuevo dia.
    CALL pos_day(m_currpos) RETURNING ypos, xpos
    DISPLAY " ", ma_days[m_currpos] AT ypos, xpos ATTRIBUTE(REVERSE)

    --> Despliega la fecha
    DISPLAY m_currdate AT 1, 12 ATTRIBUTE(BOLD)
END FUNCTION

--***************************************************************************
--* prompt_for_date() Permite indicar/capturar una fecha.
--*
--* Argumentos:
--*     <ninguno>
--* Retorno:
--*     l_input_date  La fecha introducida
--***************************************************************************
{----------------------------------------------------------------------------}
FUNCTION prompt_for_date()
    DEFINE l_input_date DATE

    WHENEVER ERROR CONTINUE

    --> Inicializa variables para control del PROMPT
    LET STATUS = -1
    LET l_input_date = ""

    WHILE STATUS != 0 OR l_input_date IS NULL
        PROMPT "Fecha  : "  FOR l_input_date ATTRIBUTE(REVERSE)
            ON KEY(TAB)
                LET l_input_date = m_currdate
                CONTINUE WHILE
        END PROMPT

        IF STATUS != 0 THEN
            CALL ERR_PRINT(-1304)
        END IF
    END WHILE

    WHENEVER ERROR STOP

    RETURN l_input_date
END FUNCTION
----------------------------- END OF THE CODE ----------------------------------

IF <this is useful for you> THEN
    use it! :)
ELSE
    throw away :(
END IF
                                  //////
+------------------------------ooo-O-O-ooo--------------------------------+
|                                   U                                     |
| Melvin Perez Cedano                             Santo Domingo, Dom. Rep.|
| Vice-President                                  m.mejia@codetel.net.do  |
| Systems Development                             Phone (809) 686-5574    |
| CAM Informatica, S. A.                          Fax   (809) 686-5467    |
+-------------------------------------------------------------------------+