home *** CD-ROM | disk | FTP | other *** search
/ Power CD-ROM!! 7 / POWERCD7.ISO / prgmming / clipper / dateplus.prg < prev    next >
Text File  |  1993-10-14  |  11KB  |  497 lines
  1. /*
  2.  * File......: Dateplus.prg
  3.  * Author....: Niall Scott
  4.  * BBS.......: The Dark Knight Returns
  5.  * Net/Node..: 050/069
  6.  * User Name.: Niall Scott
  7.  * Date......: 23/06/93
  8.  * Revision..: 2.0
  9.  * Log file..: $Logfile$
  10.  *
  11.  * This is an original work by Niall R Scott and is placed in the
  12.  * public domain.
  13.  *
  14.  * Modification history:
  15.  * ---------------------
  16.  *
  17.  * Rev 1.0  8/3/93
  18.  * Initial Revision
  19.  * Rev 2.0  23/06/93
  20.  * Rewritten to avoid use of Clipper Date functions in key
  21.  * handler which caused problems when an invalid date was
  22.  * typed in.
  23.  * Added knock-on parameter and toggles
  24.  */
  25.  
  26.  
  27. /*  $DOC$
  28.  *  $FUNCNAME$
  29.  *      DATEPLUS
  30.  *  $CATEGORY$
  31.  *      Get Reader
  32.  *  $ONELINER$
  33.  *      Allow + & - on date input
  34.  *  $SYNTAX$
  35.  *      @ <row>, <col> GET <var> [...] DATEPLUS ;
  36.  *                            [ADDDATE] [KEY <nkey] [....]
  37.  *  $ARGUMENTS$
  38.  *
  39.  *  $RETURNS$
  40.  *
  41.  *  $DESCRIPTION$
  42.  *      Get reader to allow incementation and decrementation on a
  43.  *      date field.
  44.  *
  45.  *      Use as per example. ADDDATE & KEY are optional features.
  46.  *
  47.  *        When the user is in the date field the use of the +
  48.  *        and - keys will scroll the section of the date in
  49.  *        which the cursor is located. If ADDDATE is NOT used
  50.  *        each section will be independant of the other apart from
  51.  *        the number of days in a month. If ADDDATE is used then
  52.  *        ALL fields will be affected, eg start date 31/12/93
  53.  *        press + key result 01/01/94. If KEY <nkey> is defined,
  54.  *        nkey will be mapped to allow the user to toggle the
  55.  *        knock-on effect.
  56.  *      TAB & SHIFT_TAB will move between elements of the date
  57.  *
  58.  *    NOTE
  59.  *        Allows use of all normal Get functions eg VALID,WHEN but
  60.  *        DATEPLUS ADDKEY KEY must be in that order and not separated
  61.  *        by any other clause.
  62.  *        Zero in any field is invalid.
  63.  *  $EXAMPLES$
  64.  *      CLS
  65.  *      @ 10,20 say "Enter date :"
  66.  *        // Fully incremental date function
  67.  *      @ 10,35 GET nDate DATEPLUS ADDDATE COLOR 'W+/R'
  68.  *        // Non incremental date function + - only affect the
  69.  *        // current section
  70.  *      @ 10,35 GET nDate DATEPLUS COLOR 'W+/R'
  71.  *        // Non incremental date function + - only affect the
  72.  *        // current section but allow the user to toggle using
  73.  *        // F10 key
  74.  *      @ 10,35 GET nDate DATEPLUS KEY K_F10 COLOR 'W+/R'
  75.  *      READ
  76.  *
  77.  *  $SEEALSO$
  78.  *
  79.  *  $INCLUDE$
  80.  *    GT_Datep.ch
  81.  *  $END$
  82.  */
  83.  
  84. #include "gt_lib.ch"
  85.  
  86. #define K_PLUS   43
  87. #define K_MINUS  45
  88.  
  89. #define DATE_UK        1
  90. #define DATE_USA    2
  91. #define DATE_JAPAN    3
  92. #define DATESET     SET(_SET_DATEFORMAT)
  93.  
  94. STATIC nDateFormat   := DATE_UK
  95. STATIC lKnockOn
  96.  
  97. PROCEDURE DateRead( oGet, lInc, nSwitch)
  98.  
  99.     DEFAULT nSwitch to 999
  100.     lKnockOn := lInc
  101.     // Return if not a Date Memvar
  102.     IF oGet:Type != "D"
  103.         //    RETURN
  104.     ENDIF
  105.  
  106.     // Check    which Date Format
  107.     IF UPPER(SUBSTR(DATESET,1,2)) =="DD"
  108.         nDateFormat :=    DATE_UK
  109.  
  110.     ELSEIF UPPER(SUBSTR(DATESET,1,2)) =="MM"
  111.         nDateFormat :=    DATE_USA
  112.  
  113.     ELSE
  114.         nDateFormat :=    DATE_JAPAN
  115.     ENDIF
  116.  
  117.     // Read the GET if the WHEN condition is satisfied
  118.     IF ( GetPreValidate(oGet) )
  119.  
  120.         // activate the GET for reading
  121.         oGet:SetFocus()
  122.  
  123.         DO WHILE ( oGet:ExitState == GE_NOEXIT )
  124.             // Check for initial typeout
  125.             // (no editable positions)
  126.             IF ( oGet:TypeOut )
  127.                 oGet:exitstate := GE_ENTER
  128.             END
  129.  
  130.             // Apply keystrokes until exit
  131.             DO WHILE ( oGet:ExitState == GE_NOEXIT )
  132.                 GetDateKey( oGet, INKEY(0), nSwitch)
  133.             ENDDO
  134.  
  135.             // Disallow exit if the VALID condition
  136.             // is not satisfied
  137.             IF ( !GetPostValidate(oGet) )
  138.                 oGet:ExitState := GE_NOEXIT
  139.             ENDIF
  140.  
  141.         ENDDO
  142.  
  143.         // de-activate the GET
  144.         oGet:KillFocus()
  145.  
  146.     ENDIF
  147.  
  148. RETURN
  149.  
  150. STATIC PROCEDURE GetDateKey( oGet, nKey, nSwitchKey )
  151.     LOCAL cKey            := ""
  152.     LOCAL bKeyBlock
  153.     LOCAL cDatePos        := "D"
  154.     LOCAL nLoop         := 0
  155.     LOCAL aDate            := {}
  156.     LOCAL aDaysOfMonth  := {31,28,31,30,31,30,31,31,30,31,30,31}
  157.  
  158.     //Split date in buffer
  159.     aDate := Str2Date(oGet:Buffer)
  160.  
  161.     // check for SET nKey first
  162.     IF ( (bKeyBlock := SETKEY(nKey)) <> NIL )
  163.         GetDoSetKey(bKeyBlock, oGet)
  164.     ENDIF
  165.  
  166.     // This allows it to used with all date formats
  167.     // I HOPE!
  168.     DO CASE
  169.     // EUROPEAN DATE
  170.     CASE nDateFormat ==    DATE_UK
  171.         // Check which part of date field you are in
  172.         // and set cDatePos accordingly
  173.         IF oGet:Pos < 3
  174.             cDatePos := "D"
  175.         ELSEIF  (oGet:pos   > 3 .AND. oGet:pos < 6)
  176.             cDatePos := "M"
  177.         ELSE
  178.             cDatePos := "Y"
  179.         ENDIF
  180.  
  181.         // AMERICAN DATE
  182.     CASE nDateFormat ==    DATE_USA
  183.         IF oGet:Pos < 3
  184.             cDatePos := "M"
  185.         ELSEIF  (oGet:pos   > 3 .AND. oGet:pos < 6)
  186.             cDatePos := "D"
  187.         ELSE
  188.             cDatePos := "Y"
  189.         ENDIF
  190.  
  191.         // JAPAN or ANSI
  192.     OTHERWISE
  193.         IF LEN(DATESET) == 8
  194.             IF oGet:Pos < 3
  195.                 cDatePos := "Y"
  196.             ELSEIF  (oGet:pos   > 3 .AND. oGet:pos < 6)
  197.                 cDatePos := "M"
  198.             ELSE
  199.                 cDatePos := "D"
  200.             ENDIF
  201.         ELSE
  202.             IF oGet:Pos < 5
  203.                 cDatePos := "Y"
  204.             ELSEIF  (oGet:pos   > 5 .AND. oGet:pos < 8)
  205.                 cDatePos := "M"
  206.             ELSE
  207.                 cDatePos := "D"
  208.             ENDIF
  209.         ENDIF
  210.  
  211.     ENDCASE
  212.  
  213.     //Ensure that February has the correct number of days
  214.     aDaysOfMonth[2] := IIF(( aDate[3] %4 == 0) .AND. ;
  215.     (aDate[3] % 1000 > 0),29,28)
  216.  
  217.     IF ( nKey == K_PLUS ) .OR. (nKey == K_MINUS)
  218.         DO CASE
  219.  
  220.         CASE cDatePos == 'D'
  221.  
  222.             // Make sure that month is within range
  223.             IF aDate[2] == 0
  224.                 aDate[2] := 1
  225.             ELSEIF aDate[2] > 12
  226.                 aDate[2] := 12
  227.             ENDIF
  228.  
  229.             //Day must not be greater than the number of
  230.             // days of the month
  231.             IF aDate[1] > aDaysOfMonth[ aDate[2]]
  232.                 aDate[1] := aDaysOfMonth[ aDate[2]]
  233.             ENDIF
  234.  
  235.             // Add or subtract day
  236.             aDate[1] := IIF(nKey == K_PLUS, aDate[1]+1 , aDate[1]-1 )
  237.  
  238.             // if less than 1 set days to end of month
  239.             IF aDate[1] < 1
  240.                 // If incrementation of month & year required
  241.                 If lKnockOn
  242.                     aDate[2]--
  243.                     IF aDate[2] < 1
  244.                         aDate[3]--
  245.                         aDate[2] := 12
  246.                     ENDIF
  247.                 ENDIF
  248.  
  249.                 aDate[1] := aDaysOfMonth[ aDate[2] ]
  250.  
  251.                 //If end of month reset to beginning
  252.             ELSEIF aDate[1] > aDaysOfMonth[ aDate[2] ]
  253.                 // If incrementation of month & year required
  254.                 IF lKnockOn
  255.                     aDate[2]++
  256.                     IF aDate[2] > 12
  257.                         aDate[3]++
  258.                         aDate[2] := 1
  259.                     ENDIF
  260.                 ENDIF
  261.                 aDate[1] := 1
  262.  
  263.             ENDIF
  264.  
  265.         CASE cDatePos == 'M'
  266.  
  267.             // Make sure of valid month
  268.             IF aDate[2] > 12
  269.                 aDate[2] := 12
  270.             ELSEIF aDate[2] < 1
  271.                 aDate[2] := 1
  272.             ENDIF
  273.  
  274.             //Add or substract 1 month
  275.             aDate[2] := IIF(nKey == K_PLUS, aDate[2]+1 , aDate[2]-1 )
  276.  
  277.             IF aDate[2] > 12
  278.                 // If incrementation of month & year required
  279.                 IF lKnockOn
  280.                     aDate[3]++
  281.                 ENDIF
  282.  
  283.                 aDate[2] := 1
  284.             ELSEIF aDate[2] < 1
  285.                 // If incrementation of month & year required
  286.                 IF lKnockOn
  287.                     aDate[3]--
  288.                 ENDIF
  289.                 aDate[2] := 12
  290.             ENDIF
  291.             IF aDate[1] > aDaysOfMonth[ aDate[2] ]
  292.                 aDate[1] := aDaysOfMonth[ aDate[2] ]
  293.             ENDIF
  294.  
  295.         CASE cDatePos == 'Y'
  296.             aDate[3] := IIF(nKey == K_PLUS, aDate[3]+1 , aDate[3]-1 )
  297.  
  298.             //Recalculate February
  299.             aDaysOfMonth[2] := IIF(( aDate[3] %4 == 0) .AND. ;
  300.             (aDate[3] % 1000 > 0),29,28)
  301.  
  302.             IF aDate[2] == 2
  303.                 IF aDate[1] > aDaysOfMonth[ 2 ]
  304.                     aDate[1] := aDaysOfMonth[ 2]
  305.                 ENDIF
  306.             ENDIF
  307.         ENDCASE
  308.  
  309.         // Stuff day, month and year back into Get buffer
  310.         StuffDate( aDate, oGet)
  311.     ENDIF
  312.  
  313.     DO CASE
  314.     //If the key pressed is the defined key
  315.     // toggle incremental ON/OFF
  316.     CASE (nKey == nSwitchKey )
  317.         lKnockOn := IIF(lKnockOn, .F., .T. )
  318.  
  319.     CASE ( nKey == K_UP )
  320.         oGet:ExitState := GE_UP
  321.  
  322.     CASE ( nKey == K_SH_TAB )
  323.         IF __SetCentury()    .AND. ;
  324.             nDateFormat ==    DATE_JAPAN
  325.  
  326.             IF oGet:Pos < 5
  327.                 oGet:End()
  328.             ELSE
  329.                 oGet:Left()
  330.                 oGet:Left()
  331.             ENDIF
  332.         ELSE
  333.             IF oGet:pos < 3
  334.                 oGet:End()
  335.             ELSEIF oGet:Pos < 6
  336.                 oGet:Left()
  337.                 oGet:Left()
  338.             ELSE
  339.                 oGet:Left()
  340.                 oGet:Left()
  341.                 oGet:Left()
  342.                 oGet:Left()
  343.  
  344.             ENDIF
  345.         ENDIF
  346.  
  347.     CASE ( nKey == K_DOWN )
  348.         oGet:ExitState := GE_DOWN
  349.  
  350.     CASE ( nKey == K_TAB )
  351.         IF __SetCentury()    .AND. ;
  352.             nDateFormat ==    DATE_JAPAN
  353.  
  354.             IF oGet:Pos >7
  355.                 oGet:Home()
  356.             ELSEIF oGet:Pos >4
  357.                 FOR nLoop := oGet:Pos TO 8
  358.                     oGet:Right()
  359.                 NEXT
  360.             ELSE
  361.                 FOR nLoop := oGet:Pos TO 5
  362.                     oGet:Right()
  363.                 NEXT
  364.             ENDIF
  365.         ELSE
  366.             IF oGet:pos > 6
  367.                 oGet:home()
  368.             ELSE
  369.                 oGet:RIGHT()
  370.                 oGet:RIGHT()
  371.             ENDIF
  372.         ENDIF
  373.  
  374.     CASE ( nKey == K_ENTER )        ;        oGet:ExitState := GE_ENTER
  375.  
  376.     CASE ( nKey == K_ESC )
  377.         IF ( SET(_SET_ESCAPE ) )
  378.             oGet:undo()
  379.             oGet:ExitState := GE_ESCAPE
  380.         ENDIF
  381.  
  382.     CASE ( nKey == K_PGUP )         ;        oGet:ExitState := GE_WRITE
  383.  
  384.     CASE ( nKey == K_PGDN )         ;        oGet:ExitState := GE_WRITE
  385.  
  386.     CASE ( nKey == K_CTRL_HOME )    ;        oGet:ExitState := GE_TOP
  387.  
  388.    CASE (nKey == K_CTRL_W )         ;        oGet:ExitState := GE_WRITE
  389.  
  390.     CASE (nKey == K_INS )
  391.         SET( _SET_INSERT , !SET(_SET_INSERT ) )
  392.  
  393.     CASE (nKey == K_UNDO)            ;        oGet:undo()
  394.  
  395.     CASE (nKey == K_HOME )          ;        oGet:home( )
  396.  
  397.     CASE (nKey == K_END )           ;        oGet:END( )
  398.  
  399.     CASE (nKey == K_RIGHT )         ;        oGet:Right( )
  400.  
  401.     CASE (nKey == K_LEFT )          ;        oGet:Left( )
  402.  
  403.     CASE (nKey == K_CTRL_RIGHT )    ;        oGet:WordRight( )
  404.  
  405.     CASE (nKey == K_CTRL_LEFT )     ;        oGet:WordLeft( )
  406.  
  407.     CASE (nKey == K_BS )            ;        oGet:BackSpace( )
  408.  
  409.     CASE (nKey == K_DEL )           ;        oGet:Delete( )
  410.  
  411.     CASE (nKey == K_CTRL_T )        ;        oGet:DelWordRight( )
  412.  
  413.     CASE (nKey == K_CTRL_Y )        ;        oGet:DelEnd( )
  414.  
  415.     CASE (nKey == K_CTRL_BS )       ;        oGet:DelWordLeft( )
  416.  
  417.     OTHERWISE
  418.  
  419.         IF (nKey >= 48 .AND. nKey <= 57 )
  420.  
  421.             cKey := CHR(nKey )
  422.  
  423.             IF ( SET(_SET_INSERT )  )
  424.                 oGet:Insert(cKey )
  425.             ELSE
  426.                 oGet:OverStrike(cKey )
  427.             END
  428.  
  429.             IF ( oGet:TypeOut  )
  430.                 IF ( SET(_SET_BELL )  )
  431.                     ?? CHR(7 )
  432.                 END
  433.  
  434.                 IF ( !SET(_SET_CONFIRM )  )
  435.                     oGet:ExitState := GE_ENTER
  436.                 END
  437.             END
  438.         END
  439.     ENDCASE
  440.  
  441. RETURN
  442.  
  443. STATIC FUNCTION StuffDate( aTmpDate, oGet)
  444.  
  445.     // Do not allow a zero value
  446.     aTmpDate[1] := IIF(aTmpDate[1] == 0,1 ,aTmpDate[1] )
  447.     aTmpDate[2] := IIF(aTmpDate[2] == 0,1 ,aTmpDate[2] )
  448.     aTmpDate[3] := IIF(aTmpDate[3] == 0,1 ,aTmpDate[3] )
  449.  
  450.     // Put Back date according to format
  451.     DO CASE
  452.     CASE nDateFormat ==    DATE_UK
  453.         oGet:VarPut( CTOD(ALLTRIM( STR(aTmpDate[1]) ) ;
  454.         +"/"+ ALLTRIM( STR( aTmpDate[2])) +"/"+;
  455.         ALLTRIM(STR(aTmpDate[3])) ) )
  456.  
  457.     CASE nDateFormat ==    DATE_USA
  458.         oGet:VarPut( CTOD(ALLTRIM( STR(aTmpDate[2]) ) ;
  459.         +"/"+ ALLTRIM( STR( aTmpDate[1])) +"/"+;
  460.         ALLTRIM(STR(aTmpDate[3])) ) )
  461.  
  462.     OTHERWISE
  463.         oGet:VarPut( CTOD(ALLTRIM( STR(aTmpDate[3]) ) ;
  464.         +"/"+ ALLTRIM( STR( aTmpDate[2])) +"/"+;
  465.         ALLTRIM(STR(aTmpDate[1])) ) )
  466.     ENDCASE
  467.  
  468.     oGet:UpdateBuffer()
  469.  
  470. Return(NIL)
  471.  
  472. // Convert a date string into an array of form {dd,mm,yy[yy]}
  473. STATIC FUNCTION Str2Date( cStr )
  474.     Local aDate1[3]
  475.     Local aDate2[3]
  476.  
  477.     aDate1 := Str2Arr( cStr, '/')
  478.     /// make aDate2 according to Date Format
  479.     DO CASE
  480.     CASE nDateFormat == DATE_USA
  481.         aDate2[1] := VAL(aDate1[2])
  482.         aDate2[2] := VAL(aDate1[1])
  483.         aDate2[3] := VAL(aDate1[3])
  484.  
  485.     CASE nDateFormat == DATE_JAPAN
  486.         aDate2[1] := VAL(aDate1[3])
  487.         aDate2[2] := VAL(aDate1[2])
  488.         aDate2[3] := VAL(aDate1[1])
  489.  
  490.     OTHERWISE
  491.         aDate2[1] := VAL(aDate1[1])
  492.         aDate2[2] := VAL(aDate1[2])
  493.         aDate2[3] := VAL(aDate1[3])
  494.     ENDCASE
  495.  
  496. RETURN (aDate2)
  497.