*
*     xbcomboget suitable for xbpget and xbpgetc usage
*
*     markcarew@magicwanddept.com.au
*

*================================================================

*
*   change history
*

/*
   version 1.611
   14/11/03 10:21
 minor adjustment to do with below

*/


/*
   version 1.61
   14/11/03 07:49
   eliminated very incorrect :clearitems
   was happening in preblock processing
   this clearing data from datalink target
   just prior to validation (postblock)
   when construct such as

   IF eval(::preblock,oget)
    lValid := eval(::postblock,oget)
   ENDIF

   thus causing validation failure because
   of incorrect blank value initialization

   this was happening in :setitems
*/

/*
  Version 1.6       >>--- 4 hours
  14/11/03 05:49
  added var lValid and
  methods postvalidate and setinput focus
  to handle validation
  either at the xbpsel level or in the case
  when there is a getfunc, in the getfunc
  itself
*/

/*
   Added dummy :home method for compatability
   with xbpget
*/


/*
    Version 1.51      >>--- 10 mins
    ::disable, ::enable, setappfcous
    when control passes to xbpget

*/

/*
    Version 1.50
    add ::getfucn to allow a single field to be split
    08/11/03 14:33    >>--- 1.5 hours
    into several for inline validation
    e.g.
    11:45PM
    requires 11 validated and 45 validated and PM validated
    separately

*/


/*
    Version 1.21
    07/11/03 20:20     >>---  20 mins
    fixed left and right cursor key
    causing spurious characters in edit
    buffer
/*


/*
    Version 1.20
                       >>--- 30 mins
    added postblock :getpostblock
    and
    added preblock :getpreblock
    processing for get field
*/


/*
    Version 1.01
    07/11/03 08:42     >>--- 4.5 hours
    added cursor ability to xbplistbox
    new keyboard method for this class
    changed get dialog handling
    added - and . to numeric
    markcarew@magicwanddept.com.au
*/


/*
    Version 1.00
    06/11/03 18:23     >>--- 35 hours
    xbpcomboget using
    xbpsle only
    markcarew@magicwanddept.com.au
*/

/*
    started as a request for
    combo box class for allowing selection of time
    markcarew@magicwanddept.com.au 04/11/03 13:42
*/
*
*    entry to list boxes is by ctrl+enter or alt+down
*    navigation is by cursor key
*    or up or down
*

#include "font.ch"
#include "appevent.ch"
#include "common.ch"
#include "xbp.ch"

#DEFINE GC_SAY_ROW    1
#DEFINE GC_SAY_COL    2
#DEFINE GC_SAY_TEXT   3
#DEFINE GC_SAY_PICT   4
#DEFINE GC_SAY_COLOR  5
#DEFINE GC_FLD_GSB    6
#DEFINE GC_FLD_VALUE  7
#DEFINE GC_FLD_TYP    8
#DEFINE GC_FLD_NO     9
#DEFINE GC_ADMISSION  10
#DEFINE GC_FILE       11
#DEFINE GC_FIELD      12
#DEFINE GC_VFUNC      13
#DEFINE GC_NUM_ITEMS  13
*
/*
*    you will need to UNCOMMENT this define
*    if you do not have
*    the magic wand system .dll's
*/
*       ............
* #DEFINE OBLK_IS_HERE
*
#DEFINE aPP { { XBP_PP_COMPOUNDNAME, FONT_DEFFIXED_SMALL } }
*

CLASS xbpcomboget FROM XbpComboBox
  *
  EXPORTED:
  *
  VAR controller
  VAR datalink
  VAR picture
  VAR bufferlength
  VAR datatype
  VAR getPreBlock
  VAR getPostBlock
  VAR PreBlock
  VAR PostBlock
  VAR getFunc
  VAR lValid
  *
  ACCESS ASSIGN METHOD datalink
  ACCESS ASSIGN METHOD bufferlength
  *
  METHOD clear
  METHOD editbuffer
  METHOD getdata
  METHOD keyboard
  METHOD setData
  METHOD setitems
  METHOD setWhere
  METHOD undo
  METHOD toSleData
  METHOD loneXbpComboGet
  METHOD doGetFunc
  METHOD postvalidate
  METHOD setinputfocus
  *
  INLINE METHOD home; return self
  *
ENDCLASS
*
*
*
METHOD xbpcomboget:setitems(aEles)
  *
  local nItems
  *
  *  static vars should be loaded before create()
  *  like preblock etc
  *  like postblock etc
  *
  DEFAULT ::preblock  TO {||.T.}
  DEFAULT ::postblock TO {||.T.}
  *
  *  allows separate processing;
    *  is required for enabled getfunc
  *
  IF valtype(::getfunc) == "B"
    *
    ::getpreblock     := ::preblock
    ::getpostblock    := ::postblock
    *
  else
    *
    ::getpreblock     := {||.T.}
    ::getpostblock    := {||.T.}
    *
  ENDIF
  *
  ::datatype          := valtype(aEles[1])
  *
  nItems              := ::numitems()
  *
  if nItems         == 1
    *
    ::delitem(1)
    *
  endif
  *
  nItems              := ::numitems()
  *
  IF nItems           == 0
    *
    aeval(aEles, {|ele| ::additem(::toSleData(ele)) })
    *
  end case
  *
RETURN self
*
*
*
METHOD XbpComboGet:setInputFocus()
  *
  ::lValid            := FALSE
  ::xbpSLE:setInputFocus()
  *
RETURN self
*
* Perform a postvalidation.
*
METHOD XbpComboGet:postValidate()
  *
  IF Valtype( ::postBlock ) == "B"
    *
    ::lValid    := Eval( ::postBlock, self )
    *
  ENDIF
  *
  IF ::lValid       == FALSE
    *
    setappfocus(self)
    *
  ENDIF
  *
RETURN ::lValid
*
*
*
METHOD xbpcomboget:setData(xValue)
  *
  IF xValue == nil
  else
    *
    *  a single value placed in the sle editbuffer
    *
    ::xbpsle:setdata(::toSleData(xValue))
    *
  ENDIF
  *
RETURN xValue
*
*
*
METHOD xbpcomboget:getdata()
  *
  local cValue
  *
  cValue                := ::xbpsle:getdata()
  *
return cValue
*
*
*
METHOD xbpcomboget:toSleData(ele)
  *
  local xRetVal
  *
  do case
  case ::datatype         == "C"
    *
    xRetval               := padr(ele,::bufferlength)
    *
  case ::datatype         == "N"
    *
    xRetval               := transform(ele,::picture)
    *
  case ::datatype         == "D"
    *
    xRetVal               := dtoc(ele)
    *
  end case
  *
return xRetVal
*
*
METHOD xbpcomboget:datalink(bData)
  *
  IF pcount()             == 1
    *
    ::XBPSLE:datalink     := bData
    *
  ENDIF
  *
return ::XBPSLE:datalink
*
*
*
METHOD xbpcomboget:bufferlength(nLen)
  *
  IF pcount()             == 1
    *
    ::XBPSLE:bufferlength := nLen
    *
  ENDIF
  *
RETURN ::XBPSLE:bufferlength
*
*
*
METHOD xbpcomboget:clear
RETURN ::XBPSLE:clear()
*
*
*
METHOD xbpcomboget:undo()
RETURN ::XBPSLE:undo()
*
*
*
METHOD xbpcomboget:editbuffer()
RETURN ::XBPSLE:editbuffer()
*
*
*
*
*
*
*
*
*
*
*
METHOD xbpcomboget:setwhere(aPos,aSize,nListHeight)
  *
  local lSetPos
  local lSetSize
  *
  if aPos     == nil
    *
    lSetPos   := TRUE
    *
    aPos      := ::currentPos()
    *
  else
    *
    lSetPos   :=  FALSE
    *
  endif
  *
  IF aSize    == nil
    *
    lSetSize  := TRUE
    *
    aSize     := ::currentSize()
    *
  ELSE
    *
    lSetSize  := FALSE
    *
  ENDIF
  *
  IF nListHeight == nil
    *
    nListHeight := 140
    *
  ENDIF
  *
  ::xbpComboBox:xbplistbox:setPosAndSize(aPos,{aSize[1],nListHeight})
  *
  IF lSetSize == TRUE .OR. lSetPos == TRUE
    *
    ::xbpComboBox:xbpSle:setPosAndSize(aPos,aSize)
    *
  ENDIF
  *
return self
*
*
*
method xbpcomboget:Keyboard(nKey)
  *
  local lDoEdit
  local lListBoxFocus
  local lHandled
  *
  IF ::listboxfocus()
    *
    lListBoxFocus         := TRUE
    lDoEdit               := FALSE
    *
  else
    *
    lListBoxFocus         := FALSE
    lDoEdit               := TRUE
    *
  ENDIF
  *
  lHandled                := FALSE
  *
  do case
  CASE nKey == xbeK_ALT_DOWN .OR. nKey == xbeK_CTRL_RETURN
    /*
     * Drop down the listbox.
    */
    *
    ::listboxFocus( .T. )
    *
    lDoEdit               := FALSE
    lListBoxFocus         := TRUE
    *
  case ::type             == XBPCOMBO_DROPDOWNLIST
    *
    * no keyboard data allowed
    *
    lDoEdit               := FALSE
    *
  case ::type             == XBPCOMBO_DROPDOWN
    *
    * keyboard data allowed
    *
  case ::type             == XBPCOMBO_SIMPLE
    *
    * no keyboard data allowed
    *
    lDoEdit               := FALSE
    *
    *
  END CASE
  *
  if lListBoxFocus        == FALSE
    *
    IF nKey               == xbeK_DOWN   .OR. ;
        nKey              == xbeK_UP     .OR. ;
        nKey              == xbeK_TAB    .OR. ;
        nKey              == xbeK_SH_TAB .OR. ;
        nKey              == xbeK_ENTER  .OR. ;
        nKey              == xbeK_ESC
      *
      *  if there is a getfunc validataion
      *  is handled by it ;
        *  otherwise
      *  validation is handled in here
      *
      IF VALTYPE(::getfunc) == "B"
        ::lValid := TRUE
      else
        *
        ::postValidate()
        *
      ENDIF
      *
      * can only move away from the field when
      * is returns a valid postblock
      *
      if ::lValid
        *
        ::controller:keyboard(nKey)
        *
      ENDIF
      *
      *  done
      *
      lHandled            := TRUE
      *
    ELSE
      *
      IF lDoEdit          == TRUE
        *
        do case
        case ::getFunc    == nil
          *
          ::disable()
          ::loneXbpComboGet(nKey)
          ::enable()
          setappfocus(self)
          *
        otherwise
          *
          ::disable()
          ::doGetFunc(nKey)
          ::enable()
          setappfocus(self)
          *
        end case
        *
        *  done
        *
        lHandled            := TRUE
        *
      ENDIF
      *
    ENDIF
    *
  endif
  *
  IF lHandled               == FALSE
    *
    DO CASE
    CASE nKey               == xbeK_UP        .OR. ;
        nKey                == xbeK_DOWN      .OR. ;
        nKey                == xbeK_PGUP      .OR. ;
        nKey                == xbeK_PGDN      .OR. ;
        nKey                == xbeK_CTRL_UP   .OR. ;
        nKey                == xbeK_CTRL_DOWN .OR. ;
        nKey                == xbeK_ENTER     .OR. ;
        nKey                == xbeK_ESC
      *
      ::xbpComboBox:keyboard(nKey)
      *
    OTHERWISE
      *
      * navigate by UPPERcase key
      *
    ENDCASE
    *
  ENDIF
  *
return SELF
*
*
*
*
method xbpComboGet:loneXbpComboGet(nKey)
  *
  local aPos
  local aSize
  local cEditVal
  local cNewChar
  local cPicture
  local cValType
  local drawingarea
  local mp1
  local mp2
  local nBufferLength
  local nEvent
  local oCtrl
  local oDialog
  local oGet
  local oParent
  local oXbp
  local xRetVal
  *
  aPos                      := ::xbpComboBox:currentPos()
  aSize                     := ::xbpComboBox:currentsize()
  * allow seeing of drop down arrow
  aSize[1]                  := aSize[1]-18
  oParent                   := ::setparent()
  *
  oDialog                   := ;
    XbpDialog():new(;
    oParent,;
    ,;
    {aPos[1]-1,aPos[2]-1},{aSize[1],aSize[2]},,;
    .F. )
  *
  oDialog:border            := XBPDLG_NO_BORDER
  oDialog:hidebutton        := FALSE
  oDialog:maxbutton         := FALSE
  oDialog:minbutton         := FALSE
  oDialog:TitleBar          := .F.
  oDialog:SysMenu           := .F.
  oDialog:TaskList          := .F.
  oDialog:close             := {|mp1,mp2,obj| obj:destroy() }
  *
  oDialog:create()
  *
  drawingArea               := oDialog:drawingArea
  *
  oDialog:show()
  *
  cPicture                  := ::picture
  cValType                  := ::datatype
  cEditVal                  := ::editbuffer()
  *
  do case
  case cValType             == "C"
    *
    IF nKey == xbeK_LEFT .OR. nKey == xbeK_RIGHT
    else
      *
      nBufferLength         := ::bufferLength
      cNewChar              := chr(nKey)
      cEditVal              := cNewChar + substr(cEditVal,2)
      cEditVal              := padr(cEditVal,nBufferLength)
      ::setData(cEditVal)
      *
    endif
    *
  case cValType             == "D"
    *
    cEditVal                := ctod(cEditVal)
    *
  case cValType             == "N"
    *
    cEditVal                := chr(nKey)
    *
    do case
    case cEditVal           == "-"
      cEditVal              := -0
    case cEditVal           == "."
      cEditVal              := .0
    otherwise
      cEditVal              := 0
    end case
    *
  end case
  *
  oGet := ;
    XbpGet():new( ;
    drawingArea, , ;
    {0,0},  ;
    aSize,aPP)
  *
  oGet:clipSiblings         := .T.
  *
  oGet:cargo                := array(13)
  *
  oGet:cargo[GC_SAY_ROW]    := 0
  oGet:cargo[GC_SAY_COL]    := 0
  oGet:cargo[GC_FLD_TYP]    := cValType
  oGet:cargo[GC_FLD_VALUE]  := cEditVal
  oGet:cargo[GC_FLD_NO]     := 1
  *
  oGet:datalink             := oBlk(oGet)
  *
  oGet:picture              := cPicture
  oGet:create()
  *
  *  passed in from outside as {||.t.}
  *
  oGet:preblock             := ::getPreBlock
  oGet:postblock            := ::getPostBlock
  *
  oCtrl                     := ;
    XbpGetController():new(oDialog):create()
  *
  setappfocus(oCtrl:window())
  *
  setappfocus(oGet)
  *
  oCtrl:read( , .F. )
  *
  *  load up the first character and position
  *  the get at the second position
  *
  IF nKey == xbeK_LEFT .OR. nKey == xbeK_RIGHT
    *
  else
    *  only vaid visible characters
    *
    postappevent(xbeP_Keyboard,nKey,NIL,oGet)
    *
  ENDIF
  *
  DO WHILE nEvent <> xbeP_Close
    *
    nEvent                    := AppEvent( @mp1, @mp2, @oXbp )
    *
    IF nEvent                 == xbeP_Keyboard
      *
      do case
      case   mp1                 == xbeK_ESC
        *
        postAppevent(xbeP_Close,,,oDialog)
        *
      case mp1                == xbeK_ENTER
        *
        xRetVal               := oGet:getdata()
        *
        postAppevent(xbeP_Close,,,oDialog)
        *
      end case
      *
    ENDIF
    *
    oXbp:handleEvent( nEvent, mp1, mp2 )
    *
  enddo
  *
  IF xRetVal                == nil
  else
    *
    *  set the displayed value
    *
    ::setData(xRetVal)
    *
    *  set the data in the datalink recipient
    *
    eval(::datalink,xRetval)
    *
  ENDIF
  *
return self
*
*
*
METHOD xbpComboGet:doGetFunc(nKey)
  *
  *  pass the function, the object and the key pressed
  *
  eval(::getFunc,self,nKey)
  *
return self

/*

  oComboGet:getFucn := {|o,n| gettime(o,n) }

*/
function gettime(oXbpCmbg,nKey)
  *
  local aPos
  local aSize
  local cAmPm
  local cEditVal
  local cHour
  local cMinute
  local cNewChar
  local drawingarea
  local getlist
  local mp1
  local mp2
  local nBufferLength
  local nAcross
  local nEvent
  local nPtr
  local oAmPm
  local oCtrl
  local oDialog
  local oGetValid
  local oHour
  local oMinute
  local oParent
  local oStatic
  local oXbp
  local xRetVal
  *
  aPos                      := oXbpCmbG:xbpComboBox:currentPos()
  aSize                     := oXbpCmbG:xbpComboBox:currentsize()
  oParent                   := oXbpCmbG:setparent()
  *
  * at blake's suggestion
  * 08/11/03 09:44
  *
  aSize[1]:= aSize[1]-18
  oDialog                   := ;
    XbpDialog():new(;
    oParent,;
    ,;
    {aPos[1]-1,aPos[2]-2},{aSize[1],aSize[2]-1},,;
    .F. )
  *
  oDialog:border            := XBPDLG_NO_BORDER
  oDialog:hidebutton        := FALSE
  oDialog:maxbutton         := FALSE
  oDialog:minbutton         := FALSE
  oDialog:TitleBar          := .F.
  oDialog:SysMenu           := .F.
  oDialog:TaskList          := .F.
  oDialog:close             := {|mp1,mp2,obj| obj:destroy() }
  *
  oDialog:create()
  *
  drawingArea               := oDialog:drawingArea
  *
  oDialog:show()
  *
  cEditVal                  := oXbpCmbG:editbuffer()
  *
  *  split it into three variables
  *
  cHour                     := substr(cEditVal,1,2)
  *
  cMinute                   := substr(cEditVal,4,2)
  *
  cAmPm                     := right(cEditVal,2)
  *
  *
  IF nKey == xbeK_LEFT .OR. nKey == xbeK_RIGHT
  else
    *
    cNewChar                := chr(nKey)
    *
    IF isDigit(cNewChar)
      *
      nBufferLength         := oXbpCmbG:bufferLength
      cEditVal              := cNewChar + substr(cEditVal,2)
      cEditVal              := padr(cEditVal,nBufferLength)
      oXbpCmbG:setData(cEditVal)
      *
      cHour                 := cNewChar + right(cHour,1)
      *
    ENDIF
    *
  endif
  *
  nAcross                   := 3
  *
  oHour := ;
    XbpGet():new( ;
    drawingArea, , ;
    {nAcross,0},  ;
    {18,20},aPP)
  *
  oHour:clipSiblings         := .T.
  *
  oHour:cargo                := array(13)
  *
  oHour:cargo[GC_SAY_ROW]    := 0
  oHour:cargo[GC_SAY_COL]    := 0
  oHour:cargo[GC_FLD_TYP]    := "C"
  oHour:cargo[GC_FLD_VALUE]  := cHour
  oHour:cargo[GC_FLD_NO]     := 1
  *
  oHour:datalink             := oBlk(oHour)
  *
  oHour:picture              := "@!"
  oHour:xbpsle:border        := .F.
  oHour:create()
  *
  oHour:preblock             := {|| .T.}
  oHour:postblock            := {|g|g:value>="00".AND.g:value<"13"}
  *
  nAcross                    += 20
  *
  oStatic                    := ;
    xbpStatic():new( drawingArea, , {nAcross,0}, {3,20} )
  oStatic:caption            := ":"
  oStatic:clipSiblings       := .T.
  oStatic:options            := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_BOTTOM
  oStatic:create()
  *
  nAcross                    += 4
  *
  oMinute := ;
    XbpGet():new( ;
    drawingArea, , ;
    {nAcross,0},  ;
    {18,20},aPP)
  *
  oMinute:clipSiblings         := .T.
  *
  oMinute:cargo                := array(13)
  *
  oMinute:cargo[GC_SAY_ROW]    := 0
  oMinute:cargo[GC_SAY_COL]    := 3
  oMinute:cargo[GC_FLD_TYP]    := "C"
  oMinute:cargo[GC_FLD_VALUE]  := cMinute
  oMinute:cargo[GC_FLD_NO]     := 2
  *
  oMinute:datalink             := oBlk(oMinute)
  *
  oMinute:picture              := "@!"
  oMinute:xbpsle:border        := .F.
  oMinute:create()
  *
  oMinute:preblock             := {|| .T.}
  oMinute:postblock            := {|g|g:value>="00".AND.g:value<"60"}
  *
  *
  nAcross                      += 18
  *
  oAmPm := ;
    XbpGet():new( ;
    drawingArea, , ;
    {nAcross,0},  ;
    {22,20},aPP)
  *
  oAmPm:clipSiblings         := .T.
  *
  oAmPm:cargo                := array(13)
  *
  oAmPm:cargo[GC_SAY_ROW]    := 0
  oAmPm:cargo[GC_SAY_COL]    := 5
  oAmPm:cargo[GC_FLD_TYP]    := "C"
  oAmPm:cargo[GC_FLD_VALUE]  := cAmPm
  oAmPm:cargo[GC_FLD_NO]     := 2
  *
  oAmPm:datalink             := oBlk(oAmPm)
  *
  oAmPm:picture              := "!M"
  oAmPm:xbpsle:border        := .F.
  oAmPm:create()
  *
  oAmPm:preblock             := {|| .T.}
  oAmPm:postblock            := {|g|g:value=="AM".OR.g:value=="PM"}
  *
  oCtrl                     := ;
    XbpGetController():new(oDialog):create()
  *
  setappfocus(oCtrl:window())
  *
  setappfocus(oHour)
  *
  oCtrl:read( , .F. )
  *
  *  load up the first character and position
  *  the get at the second position
  *
  IF (nKey == xbeK_LEFT .OR. nKey == xbeK_RIGHT) .AND. ;
      isDigit(cNewChar)
    *
  else
    *  only vaid visible characters
    *
    postappevent(xbeP_Keyboard,nKey,NIL,oHour)
    *
  ENDIF
  *
  DO WHILE nEvent <> xbeP_Close
    *
    nEvent                      := AppEvent( @mp1, @mp2, @oXbp )
    *
    IF nEvent                   == xbeP_Keyboard
      *
      cNewChar                  := upper(chr(mp1))
      *
      do case
      case mp1                  == xbeK_ESC
        *
        xRetVal                 := nil
        *
        postAppevent(xbeP_Close,,,oDialog)
        *
      case mp1                  == xbeK_ENTER
        *
        *  validate the lot
        *
        xRetVal                 := nil
        *
        getlist                 := oCtrl:aGetlist
        *
        xRetval                 := "goodone matey, bonza, beaudy, ripper"
        *
        FOR nPtr                := 1 TO 3
          *
          oGetValid             := getlist[nPtr]
          *
          if eval(oGetValid:postblock,oGetValid)
          else
            *
            xRetVal             := nil
            *
          endif
          *
        NEXT
        *
        IF xRetVal              == nil
        else
          postAppevent(xbeP_Close,,,oDialog)
        ENDIF
        *
      case isdigit(cNewChar) .OR. isalpha(cNewChar)
        *
        *  when in the second character
        *
        IF oXbp:get:pos         == 2
          *
          *  validate the entry
          *
          IF eval(oXbp:postblock,oXbp) == TRUE
            *
            *  ok next field
            *
            postAppevent(xbeP_Keyboard,xbeK_DOWN,,oXbp)
            *
          else
            *
            tone(800)
            *
            oXbp:home()
            *
          endif
          *
        end case
        *
      end case
      *
    endif
    *
    oXbp:handleEvent( nEvent, mp1, mp2 )
    *
  enddo
  *
  IF xRetVal              == nil
  else
    *
    cHour                 := oHour:getdata()
    *
    cMinute               := oMinute:getdata()
    *
    cAmPm                 := oAmPm:getdata()
    *
    oXbpCmbG:setData(cHour+":"+cMinute+cAmPm)
    *
  ENDIF
  *
return nil

*
#IFDEF OBLK_IS_HERE
  *
  *
  *
  function oBlk(oget)
    local bBlock
    bBlock := ;
      {|x|iif(x== nil,oget:cargo[GC_FLD_VALUE],oget:cargo[GC_FLD_VALUE]:=x)}
    return bBlock

  #ENDIF