/*
 * ListboxMod.prg
 * Control TListbox moderno
 *
 * Copyright 2020 Ignacio Ortiz de Zúñiga
 * Copyright 2020 https://Xailer.com
 * All rights reserved
 *
 */

#include "Xailer.ch"
#xtranslate IsSpecialChar( <nKey> ) => Chr( <nKey> ) $ ( " .:,;-_¿¡'?=)(/&%$!ºª*Çç¨{}\|@#[]+<>" + Chr( 32 ) )

CLASS XListBoxMod FROM TScrollingWinControl

PUBLISHED:
   PROPERTY oImageList     WRITE METHOD SetImageList AS TImageList ;
                           EDITOR PE_ImageList
   PROPERTY aItems         INIT {} WRITE METHOD SetItems ;
                           EDITOR PE_StringList
   PROPERTY cText          READ GetText ;
                           WRITE METHOD SetText

   PROPERTY nIndex         INIT 0 ;
                           WRITE METHOD SetIndex

   PROPERTY nWidth         INIT 150
   PROPERTY nHeight        INIT 200
   PROPERTY nMargin        INIT 10
   PROPERTY nItemHeight    INIT 25 ;
                           WRITE INLINE ::FnItemHeight := Value, ::Refresh()
   PROPERTY nBorderStyle   INIT bvFLAT
   PROPERTY nBorderSides
   PROPERTY nOrientation   INIT orLEFT VALUES orLEFT, orRIGHT
   PROPERTY nClrPane       INIT clWindow     EDITOR PE_Color
   PROPERTY nClrText       INIT clWindowText EDITOR PE_Color
   PROPERTY nClrHotPane    INIT clActiveCaption EDITOR PE_Color ;
                           WRITE INLINE ( ::FnClrHotPane := Value, ::Refresh(), Value )
   PROPERTY nClrHotText    INIT clWindowText EDITOR PE_Color ;
                           WRITE INLINE ( ::FnClrHotText := Value, ::Refresh(), Value )
   PROPERTY nClrSelPane    INIT clLightYellow EDITOR PE_Color ;
                           WRITE INLINE ( ::FnClrSelPane := Value, ::Refresh(), Value )
   PROPERTY nClrSelText    INIT clWindowText EDITOR PE_Color ;
                           WRITE INLINE ( ::FnClrSelText := Value, ::Refresh(), Value )
   PROPERTY nVAlignment    INIT vaCENTER ;
                           WRITE INLINE ( ::FnVAlignment := Value, ::Refresh(), Value );
                           VALUES vaTOP, vaCENTER

   PROPERTY lMultipleSel   INIT .F. ;
                           WRITE METHOD SetMultipleSel
   PROPERTY lCheckboxes    INIT .F. ;
                           WRITE INLINE ::FlCheckBoxes := Value, ::Refresh()
   PROPERTY lHtmlText      INIT .F. ;
                           WRITE INLINE ::FlHtmlText := Value, ::Refresh()
   PROPERTY lMultiLine     INIT .F.

   PROPERTY lParentFont
   PROPERTY lTabStop          INIT .T.
   PROPERTY lTransparent      INIT .F.
   PROPERTY lHotTrack         INIT .T.
   PROPERTY lHideScrollBars   INIT .T. // Must be set before Create()
   PROPERTY lShowActive       INIT .T.
   PROPERTY lShortCuts        INIT .F. WRITE INLINE ( ::FlShortCuts := Value, ::SetShortCuts() )

   EVENT OnChange( oSender, nOld, nNew ) // --> Nil
   EVENT OnChanged( oSender ) // --> Nil
   EVENT OnChangeSelected( oSender, aSelected ) // --> NIL
   EVENT OnSelect( oSender, nIndex ) // --> Nil
   EVENT OnDrawItem( oSender, nItem, cText, nImage, nClrText, nClrPane, hDC, aRect ) //--> Nil | lOk
   EVENT OnCheckStateChanged( oSender, nItem, lNew ) // --> Nil | lOk
   EVENT OnCalcVirtualSize( oSender, BYREF nVirtualW, BYREF nVirtualH ) // --> NIL
   EVENT OnClick( oSender, nKeyFlags, nRow )
   EVENT OnDblClick( oSender, nKeyFlags, nRow )

PUBLIC:
   PROPERTY aChecked    INIT {} ;
                        WRITE METHOD SetChecked
   PROPERTY aSelected   INIT {} ;
                        WRITE METHOD SetSelected ;
                        READ METHOD  GetSelected

   METHOD New( oParent )      CONSTRUCTOR
   METHOD Create( oParent )   CONSTRUCTOR

   METHOD FirstVisible() // --> nItem
   METHOD LastVisible() // --> nItem
   METHOD IsItemVisible( nIndex ) // --> lVisible
   METHOD SetFirstVisible( nItem ) // --> lOk
   METHOD ForceItemVisible( nItem ) // --> NIL
   METHOD ItemSelected( nItem )      INLINE ( AScan( ::FaSelected, nItem ) > 0 ) // --> lValue
   METHOD ItemChecked( nItem )       INLINE ( AScan( ::FaChecked, nItem ) > 0 ) // --> lValue
   METHOD ItemText( nItem, lHtml )  // --> cText
   METHOD ItemHot( nItem )           INLINE ( nItem == ::nHotPos ) // --> lValue
   METHOD ItemPushed( nItem )        INLINE ( nItem == ::nHotPos .AND. ::lPushed ) // --> lValue
   METHOD RecCount()                 INLINE Len( ::FaWork ) // --> nLen
   METHOD AddItem( cItem )           INLINE Aadd( ::FaItems, cItem ), ::Refresh() // --> NIL
   METHOD InsertItem( nPos, cItem )  INLINE HB_AIns( ::FaItems, nPos, cItem, .t. ), ::Refresh() // --> NIL
   METHOD DeleteItem( nItem )        INLINE HB_ADel( ::FaItems, nItem, .T. ) // --> NIL
   METHOD ModifyItem( nItem, cItem ) INLINE ::FaItems[ nItem ] := cItem, ::Refresh() // --> NIL
   METHOD DeleteItems()              INLINE ::FaItems := {}, ::Refresh() // --> NIL
   METHOD AddImage( cImage, lMasked ) // --> nPos
   METHOD MinimumRowHeight()
   METHOD CheckAll()
   METHOD UnCheckAll()  INLINE ::FaChecked := {}, ::Refresh()

PROTECTED:
   PROPERTY oBrush
   PROPERTY lBorder     INIT .F.
   PROPERTY l3D
   DATA nCtlStyle       INIT nOr( WS_CHILD, WS_CLIPCHILDREN, WS_CLIPSIBLINGS )
   DATA aHotPos
   DATA cSeek           INIT ""
   DATA lFound          INIT .F.
   DATA nHotPos         INIT 0
   DATA lPushed         INIT .F.
   DATA nCheckBoxSize   INIT 18

RESERVED:
   ACCESS aWork  IS aItems
   ACCESS FaWork IS FaItems

   PROPERTY nScrollIncrement
   PROPERTY nClientLeft
   PROPERTY nClientTop
   PROPERTY nVirtualWidth
   PROPERTY nVirtualHeight
   PROPERTY nClientWidth   INIT 0
   PROPERTY nClientHeight  INIT 0

   METHOD SelectString( cString, nFrom ) INLINE ::SetText( cString, .T., nFrom )
   METHOD SearchText( nKey )
   METHOD HitTest( aPos, BYREF nItemTop )
   METHOD Adjust( lRedraw )          INLINE ::CalcVirtualRect(), ::Super:Adjust( lRedraw )

   METHOD SetImageList( oValue )
   METHOD SetItems( aItems, lRefresh )
   METHOD GetText()              INLINE ::FcText
   METHOD SetText( cValue, lSoft, nFrom )
   METHOD SetIndex( nValue, lDel )
   METHOD SetMultipleSel( lValue )
   METHOD SetChecked( aValues )
   METHOD SetSelected( aValues )
   METHOD GetSelected()
   METHOD CalcVirtualRect()
   METHOD AddSelected( nItem )
   METHOD SwapSelected( nItem )
   METHOD SwapCheckState( nItem )
   METHOD GetCheckboxRect( nX, nY )

   METHOD Free()

   METHOD Paint( hDC )
   METHOD PaintItem( hDC, nItem, aRect )
   METHOD ItemByPosLeftBound( aPos )    INLINE ::nMargin

   METHOD WMPaint()
   METHOD WMEraseBkgnd() INLINE 1
   METHOD WMMouseMove( nWParam, nLParam, hWnd )
   METHOD WMMouseLeave()
   METHOD WMLButtonDown( nWParam, nLParam )
   METHOD WMLButtonUp( nWParam, nLParam )
   METHOD WMKeyDown( nKey, nFlags, hWnd )
   METHOD WMChar( nKey, nFlags, hWnd )
   METHOD WMMouseWheel( nWParam, nLParam )
   METHOD WMKillFocus( hCtl ) INLINE ( ::Super:WMKillFocus( hCtl ),;
                                       ::Refresh( .F. ) )
   METHOD WMSetFocus( hCtl )  INLINE ( ::Super:WMSetFocus( hCtl ),;
                                       ::Refresh( .F. ) )
   METHOD WMPrintClient() EXTERN XListBoxMod_WMPaint()

   METHOD Click( nWParam, nLParam )
   METHOD DblClick( nKey, nX, nY )

   METHOD SetShortCuts()
   METHOD ShortCut( cKey )
   METHOD GetShortCut( cKey )

   METHOD XAClick() VIRTUAL

ENDCLASS

//------------------------------------------------------------------------------

METHOD New( oParent ) CLASS XListBoxMod

   ::Super:New( oParent )

   IF Empty( ::FoImageList )
      ::FoImageList := TImageList():Create( Self )
   ENDIF

RETURN Self

//------------------------------------------------------------------------------

METHOD Create( oParent ) CLASS XListBoxMod

   UPDATE ::oParent TO oParent

   ::Super:Create()

   IF Empty( ::FoImageList )
      ::FoImageList := TImageList():Create( Self )
   ENDIF

   ::nScrollIncrement := ::nItemHeight

   ::SetShortCuts()
   ::SetIndex()

RETURN Self

//------------------------------------------------------------------------------

METHOD Free() CLASS XListBoxMod

   IF ::oImageList != NIL .AND. ::oImageList:oParent == Self
      ::oImageList:Destroy()
   ENDIF

RETURN ::Super:Free()

//------------------------------------------------------------------------------

METHOD SetImageList( oValue ) CLASS XListBoxMod

   IF ::FoImageList != Nil .AND. ::FoImageList:oParent == Self
      ::FoImageList:Destroy()
   ENDIF

   ::FoImageList := oValue

RETURN oValue

//------------------------------------------------------------------------------

METHOD SetItems( aItems, lRefresh ) CLASS XListBoxMod

   DEFAULT aItems TO {}
   DEFAULT lRefresh TO .T.

   ::FaItems    := aItems
   ::FaSelected := {}
   ::FaChecked  := {}
   ::FnIndex := 0

   IF lRefresh
      ::OnChangeSelected( ::FaSelected )
      ::Adjust()
      ::Refresh()
      ::SetShortCuts()
   ENDIF

RETURN NIL

//------------------------------------------------------------------------------

METHOD ItemText( nItem, lHtml ) CLASS XListBoxMod

   LOCAL cText

   IF nItem > 0 .AND. nItem <= Len( ::FaWork )
      cText := ::FaWork[ nItem ]
   ELSE
      cText := ""
   ENDIF

   IF Empty( lHtml ) .AND. ::lHtmlText
      cText := XA_RemoveTags( cText )
   ENDIF

RETURN cText

//------------------------------------------------------------------------------

METHOD SetText( cValue, lSoft, nFrom ) CLASS XListBoxMod

   LOCAL nAt
   LOCAL lExact

   DEFAULT lSoft TO .F., nFrom TO 1

   IF !lSoft
      nAt := AScan( ::FaWork, {|v,e| Upper( ::ItemText( e ) ) == Upper( cValue )}, nFrom )
   ELSE
      lExact := Set( _SET_EXACT, .F. )
      nAt := AScan( ::FaWork, {|v,e| Upper( ::ItemText( e ) ) = Upper( cValue )}, nFrom )
      Set( _SET_EXACT, lExact )
   ENDIF

   IF nAt > 0
      ::FcText := ::ItemText( nAt )
      ::nIndex := nAt
   ELSE
      ::FcText := ""
   ENDIF

RETURN ::FcText

//------------------------------------------------------------------------------

METHOD SearchText( nKey ) CLASS XListBoxMod

   LOCAL cSeek
   LOCAL nAt
   LOCAL lExact, lKey

   cSeek := ::cSeek

   IF ( lKey := !Empty( nKey ) )
      cSeek += Upper( Chr( nKey ) )
   ENDIF

   lExact := Set( _SET_EXACT, .F. )
   nAt := AScan( ::FaWork, {|v,e| Upper( ::ItemText( e ) ) = cSeek } )
   Set( _SET_EXACT, lExact )

   IF nAt > 0
      ::nIndex := nAt
      ::cSeek   := cSeek
      ::lFound  := .T.
   ELSE
      ::lFound := .F.
      IF lKey
         Beep( 150,100 )
      ENDIF
   ENDIF

RETURN ::lFound

//------------------------------------------------------------------------------
// Simple y rápido. Es más que probable que NO surga la HScroll cuando se usen
// negritas o distintos tipos de Font con lHtmlText a .T.
// Se ha introducido el evento para poder corregirlo a mano

METHOD CalcVirtualRect() CLASS XListBoxMod

   LOCAL nMax, nMargin, nImg, nVirtualW, nVirtualH

   nMax    := 0
   nMargin := ::nMargin

   AEval( ::FaWork, {|v,e| nMax := Max( nMax, Len( ::ItemText( e ) ) ) } )

   nMax := MulDiv( ::oFont:GetTextWidth( Replicate( "B", nMax ), Self ), 108, 100 )
   nMax += ( nMargin * 2 )

   IF ( nImg := ::oImageList:nWidth ) > 1
      nMax += ( nImg + nMargin )
   ENDIF

   IF ::lCheckboxes
      nMax += ( ::nCheckBoxSize + nMargin )
   ENDIF

   nVirtualW := Max( nMax, ::nClientWidth )
   nVirtualH := Max( ::RecCount() * ::nItemHeight, ::nClientHeight )

   ::OnCalcVirtualSize( @nVirtualW, @nVirtualH )

   ::FnVirtualWidth  := nVirtualW
   ::FnVirtualHeight := nVirtualH

RETURN nil

//------------------------------------------------------------------------------

METHOD FirstVisible() CLASS XListBoxMod

RETURN Int( -::nClientTop / ::nItemHeight ) + 1

//----------------------------------------------------------------------------------

METHOD LastVisible() CLASS XListBoxMod

RETURN Min( ::RecCount(), ::FirstVisible() + Int( ::nClientHeight / ::nItemHeight ) )

//------------------------------------------------------------------------------

METHOD IsItemVisible( nIndex ) CLASS XListBoxMod

   LOCAL nFirst, nLast
   LOCAL lValue

   nFirst := ::FirstVisible()
   nLast  := ::LastVisible()

   lValue := nIndex > nFirst .AND. nIndex < nLast

   IF nIndex == nFirst
      lValue := ( ::nClientTop >= 0 )
   ELSEIF nIndex == nLast
      lValue := ( -::nClientTop >= ( ::nVirtualHeight - ::nClientHeight ) )
   ENDIF

RETURN lValue

//------------------------------------------------------------------------------

METHOD GetCheckboxRect( nX, nY ) CLASS XListBoxMod

   LOCAL aRect := Array( 4 )
   LOCAL nSize := ::nCheckBoxSize

   aRect[ rtLEFT ]   := nX
   aRect[ rtRIGHT ]  := aRect[ rtLEFT ] + nSize
   aRect[ rtTOP ]    := nY + Int( ( ::nItemHeight- nSize ) / 2 )
   aRect[ rtBOTTOM ] := aRect[ rtTOP ] + nSize

RETURN aRect

//------------------------------------------------------------------------------

METHOD AddSelected( nItem ) CLASS XListBoxMod

   IF !::lMultipleSel
      ::FaSelected := { nItem }
   ELSEIF AScan( ::FaSelected, nItem ) == 0
      AAdd( ::FaSelected, nItem )
   ENDIF

   ::OnChangeSelected( ::FaSelected )

RETURN NIL

//------------------------------------------------------------------------------

METHOD SwapSelected( nItem ) CLASS XListBoxMod

   LOCAL nAt

   IF !::lMultipleSel
      ::FaSelected := { nItem }
   ELSEIF ( nAt := AScan( ::FaSelected, nItem ) ) == 0
      AAdd( ::FaSelected, nItem )
   ELSEIF Len( ::FaSelected ) > 1
      HB_ADel( ::FaSelected, nAt, .T. )
   ENDIF

   ::OnChangeSelected( ::FaSelected )

RETURN .T.

//------------------------------------------------------------------------------

METHOD SwapCheckState( nItem ) CLASS XListBoxMod

   LOCAL nFor
   LOCAL lRet

   nFor := AScan( ::FaChecked, nItem )
   lRet := ::OnCheckStateChanged( nItem, Empty( nFor ) )
   lRet := ( lRet == NIL .OR. lRet )

   IF lRet
      IF Empty( nFor )
         AAdd( ::FaChecked, nItem )
      ELSE
         HB_ADel( ::FaChecked, nFor, .t. )
      ENDIF
      ::Refresh()
   ENDIF

RETURN lRet

//------------------------------------------------------------------------------

METHOD SetIndex( nValue, lDel ) CLASS XListBoxMod

   LOCAL nPos, nLen
   LOCAL lRet, lChangeSel := .f.

   DEFAULT lDel TO .T., nValue TO ::FnIndex

   nLen := ::RecCount()

   IF lDel
      ::FaSelected := {}
      lChangeSel := .t.
   ENDIF

   IF nValue > 0 .AND. nValue <= nLen
      IF nValue != ::FnIndex
         lRet := ::OnChange( ::FnIndex, @nValue )
      ENDIF
      IF lRet == NIL .OR. lRet
         ::FnIndex := nValue
         ::FcText  := ::ItemText( nValue )
         ::cSeek   := ""
         ::lFound  := .F.
         ::AddSelected( nValue )
         lChangeSel := .f. // Event triggered at AddSelected()
         nPos := ::nItemHeight * ( nValue - 1 )
         IF nPos < -::nClientTop
            ::nClientTop := -nPos
         ELSEIF ( nPos + ::nItemHeight ) > ( ::nClientHeight - ::nClientTop )
            ::nClientTop := ::nClientHeight - nPos - ::nItemHeight
         ENDIF
         ::OnChanged()
         ::Refresh()
      ENDIF
   ELSEIF nLen == 0
      ::FnIndex := 0
      lChangeSel := .f.
      ::Refresh()
   ENDIF

   IF lChangeSel
      ::OnChangeSelected( ::FaSelected )
   ENDIF

RETURN ::FnIndex

//------------------------------------------------------------------------------

METHOD SetMultipleSel( lValue ) CLASS XListBoxMod

   ::FlMultipleSel := lValue
   ::FaSelected := { ::nIndex }
   ::OnChangeSelected( ::FaSelected )

RETURN lValue

//------------------------------------------------------------------------------

METHOD SetChecked( aValues ) CLASS XListBoxMod

   IF !::lCheckboxes .AND. !Empty( aValues )
      ::FlCheckboxes := .T.
   ENDIF

   ::FaChecked := aValues
   ::Refresh()

RETURN NIL

//------------------------------------------------------------------------------

METHOD SetSelected( aValues ) CLASS XListBoxMod

   IF !::lMultipleSel .AND. !Empty( aValues )
      ::lMultipleSel := .T.
   ENDIF

   ::faSelected := aValues

   ::OnChangeSelected( ::FaSelected )

   ::Refresh()

RETURN NIL

//------------------------------------------------------------------------------

METHOD GetSelected() CLASS XListBoxMod

   IF Len( ::FaSelected ) == 0 .AND. ::nIndex > 0
      RETURN { ::nIndex }
   ENDIF

RETURN ::faSelected

//------------------------------------------------------------------------------

METHOD AddImage( cImage, lMasked ) CLASS XListBoxMod

   LOCAL nImage

   WITH OBJECT ::oImageList
      IF Ascan( :aBitmaps, {|v| Upper( v ) == Upper( cImage ) } ) == 0
         nImage := :Add( cImage, lMasked )
      ENDIF
   END WITH

RETURN nImage

//------------------------------------------------------------------------------

METHOD SetFirstVisible( nItem ) CLASS XListBoxMod

   DEFAULT nItem TO ::FnIndex

   IF ( ::RecCount() * ::nItemHeight ) > ::nClientHeight
      ::nClientTop := - ( ( nItem - 1 ) * ::nItemHeight )
      ::Refresh()
      RETURN .T.
   ENDIF

RETURN .F.

//------------------------------------------------------------------------------

METHOD ForceItemVisible( nItem )  CLASS XListBoxMod

   LOCAL nBeg, nEnd, nPos, nHei

   nBeg := ( nItem - 1 ) * ::nItemHeight
   nEnd := nBeg + ::nItemHeight
   nPos := - ::nClientTop
   nHei := ::nClientHeight

   IF nEnd < nPos
      ::nClientTop := - nBeg
      ::Refresh()
   ELSEIF ( nPos + nHei ) < nEnd
      ::nClientTop -= ( nEnd - nPos - nHei )
      ::Refresh()
   ENDIF

RETURN NIL

//------------------------------------------------------------------------------

METHOD WMMouseMove( nWParam, nLParam, hWnd ) CLASS XListBoxMod

   LOCAL aPos
   LOCAL nHot

   aPos := { LoWord( nLParam ), HiWord( nLParam ) }

   IF Empty( ::aHotPos )
      TrackMouseEvent( ::Handle, TME_LEAVE )
   ENDIF

   ::aHotPos := aPos

   IF ::IsInScrollZone( aPos, 3 ) .OR. lGetKeyState( VK_LBUTTON )
      ::nHotPos := 0
   ELSE
      nHot := ::HitTest ( ::aHotPos )
      IF nHot != ::nHotPos .AND. PtInRect( GetClientRect( ::Handle ), aPos )
         ::nHotPos := nHot
         IF ::lHotTrack
            ::Refresh()
         ENDIF
      ENDIF
   ENDIF

RETURN ::Super:WMMouseMove( nWParam, nLParam, hWnd )

//------------------------------------------------------------------------------

METHOD WMMouseLeave() CLASS XListBoxMod

   ::aHotPos := NIL
   ::nHotPos := 0
   ::lPushed := .F.
   ::Refresh()

RETURN ::Super:WMMouseLeave()

//------------------------------------------------------------------------------

METHOD WMLButtonDown( nWParam, nLParam ) CLASS XListBoxMod

   LOCAL aPos := { LoWord( nLParam ), HiWord( nLParam ) }

   IF ::lTabStop .AND. GetFocus() != ::Handle
      SetFocus( ::Handle )
   ENDIF

   IF !::IsInScrollZone( aPos, 3 )
      ::lPushed := .T.
   ENDIF

RETURN ::Super:WMLButtonDown( nWParam, nLParam )

//------------------------------------------------------------------------------

METHOD WMLButtonUp( nWParam, nLParam ) CLASS XListBoxMod

   LOCAL aPos
   LOCAL nItem, nLast, nFor, nTop
   LOCAL lDel

   ReleaseCapture()

   aPos := { LoWord( nLParam ), HiWord( nLParam ) }

   IF !Empty( ::aHotPos ) .and. ::lPushed .and. ( nItem := ::HitTest( aPos, @nTop ) ) > 0
      IF ::lCheckboxes .and. PtInRect( ::GetCheckboxRect( ::ItemByPosLeftBound( aPos ), nTop ), aPos )
         ::SwapCheckState( nItem )
         ::lPushed := .F.
      ENDIF

      lDel := !lGetKeyState( VK_SHIFT ) .AND. !lGetKeyState( VK_CONTROL )
      nLast := ::nIndex
      ::SetIndex( nItem, lDel )
      IF !lDel
         IF ::lMultipleSel .AND. lGetKeyState( VK_SHIFT )
            IF nLast < nItem
               FOR nFor := ( nLast + 1 ) TO nItem -1
                  ::SwapSelected( nFor )
               NEXT
               ::AddSelected( nItem )
            ELSE
               FOR nFor := nItem + 1 TO ( nLast - 1 )
                  ::SwapSelected( nFor )
               NEXT
               ::AddSelected( nItem )
            ENDIF
         ENDIF
      ELSE
         ::FcText := ::ItemText( nItem )
         ::OnSelect( nItem )
      ENDIF

      ::Click( nWParam, nLParam )

   ENDIF

   ::lPushed := .F.

RETURN ::Super:WMLButtonUp( nWParam, nLParam )

//------------------------------------------------------------------------------

METHOD WMKeyDown( nKey, nFlags, hWnd ) CLASS XListBoxMod

   LOCAL nPage, nIndex, nFor, nLen
   LOCAL lDel, lRet

   IF hWnd != ::Handle
      RETURN ::Super:WMKeyDown( nKey, nFlags, hWnd )
   ENDIF

   nPage  := Int( ::nClientHeight / ::nItemHeight )
   nIndex := ::FnIndex
   nLen   := ::RecCount()
   lDel   := !lGetKeyState( VK_SHIFT ) .OR. !::lMultipleSel

   SWITCH nKey
   CASE VK_DOWN
      IF ::nIndex < nLen
         IF !lDel
            ::AddSelected( ::FnIndex )
         ENDIF
         ::SetIndex( ::FnIndex + 1, lDel )
      ENDIF
      RETURN 0
      EXIT
   CASE VK_UP
      IF ::nIndex > 1
         IF !lDel
            ::AddSelected( ::FnIndex )
         ENDIF
         ::SetIndex( ::FnIndex - 1, lDel )
      ENDIF
      RETURN 0
      EXIT
   CASE VK_HOME
      IF ::nIndex != 1
         IF !lDel
            FOR nFor := nIndex TO 1 STEP -1
               ::AddSelected( nFor )
            NEXT
         ENDIF
         ::SetIndex( 1, lDel )
      ENDIF
      RETURN 0
      EXIT
   CASE VK_END
      IF ::nIndex != nLen
         IF !lDel
            FOR nFor := nIndex TO nLen
               ::AddSelected( nFor )
            NEXT
         ENDIF
         ::SetIndex( nLen, lDel )
      ENDIF
      RETURN 0
      EXIT
   CASE VK_NEXT
      IF ::nIndex != nLen
         nLen :=  Min( nLen, ::FnIndex + nPage )
         IF !lDel
            FOR nFor := nIndex TO nLen
               ::AddSelected( nFor )
            NEXT
         ENDIF
         ::SetIndex( nLen, lDel )
      ENDIF
      RETURN 0
      EXIT
   CASE VK_PRIOR
      IF ::nIndex != 1
         nLen := Max( 1, ::FnIndex - nPage )
         IF !lDel
            FOR nFor := nIndex TO nLen STEP -1
               ::AddSelected( nFor )
            NEXT
         ENDIF
         ::SetIndex( nLen, lDel )
      ENDIF
      RETURN 0
      EXIT
   CASE VK_LEFT
      IF ( ::nVirtualWidth > ::nClientWidth ) .AND. ::nClientLeft < 0
         ::nClientLeft := Min( ::nClientLeft + ::nScrollIncrement, 0 )
         ::Refresh()
      ENDIF
      RETURN 0
      EXIT
   CASE VK_RIGHT
      IF ( ::nVirtualWidth > ::nClientWidth ) .AND. ;
         ( ::nVirtualWidth - ::nClientWidth + ::nClientLeft ) > 0
         ::nClientLeft -= ::nScrollIncrement
         ::Refresh()
      ENDIF
      RETURN 0
      EXIT
   CASE VK_SPACE
   CASE VK_RETURN
      IF ::lCheckboxes
         nFor := AScan( ::FaChecked, nIndex )
         lRet := ::OnCheckStateChanged( nIndex, Empty( nFor ) )
         IF Empty( nFor )
            AAdd( ::FaChecked, nIndex )
         ELSE
            HB_ADel( ::FaChecked, nFor, .t. )
         ENDIF
         ::Refresh()
         RETURN 0
         EXIT
      ELSE
         ::FcText := ::ItemText( nIndex )
         ::OnSelect( nIndex )
      ENDIF
   END SWITCH

RETURN ::Super:WMKeyDown( nKey, nFlags, hWnd )

//------------------------------------------------------------------------------

METHOD WMChar( nKey, nFlags, hWnd ) CLASS XListBoxMod

   LOCAL nLen

   IF hWnd != ::Handle
      RETURN ::Super:WMChar( nKey, nFlags, hWnd )
   ENDIF

   IF ( IsCharAlphaNumeric( nKey ) .OR. IsSpecialChar( nKey ) ) .AND. ;
      ::GetShortCut( nKey ) == 0
      IF ::SearchText( nKey )
         RETURN 0
      ENDIF
   ELSEIF nKey == VK_BACK .AND. ::lFound
      nLen := Len( ::cSeek )
      IF nLen > 0
         ::cSeek := Left( ::cSeek, --nLen )
         RETURN 0
      ENDIF
   ENDIF

RETURN ::Super:WMChar( nKey, nFlags, hWnd )

//------------------------------------------------------------------------------

METHOD WMMouseWheel( nWParam, nLParam ) CLASS XListBoxMod

   IF !lGetKeyState( VK_SHIFT ) .AND. !lGetKeyState( VK_CONTROL )
      ::nClientTop := Min( 0, ::nClientTop + ::nScrollIncrement * IIF( HiInt( nWParam ) > 0, 1, -1 ) )
      ::Refresh()
      RETURN 0
   ENDIF

RETURN ::Super:WMMouseWheel( nWParam, nLParam )

//------------------------------------------------------------------------------

METHOD Click( nWParam, nLParam ) CLASS XListBoxMod

   LOCAL nRow

   nRow := ::HitTest( { LoInt( nLParam ), HiInt( nLParam ) } )

   IF nRow > 0
      RETURN ::OnClick( nWParam, nRow )
   ENDIF

RETURN NIL

//------------------------------------------------------------------------------

METHOD DblClick( nKey, nX, nY ) CLASS XListBoxMod

   LOCAL nRow

   nRow := ::HitTest( { nX, nY } )

   IF nRow > 0 .AND. ::EventAssigned( "OnDblClick" )
      ::OnDblClick( nKey, nRow )
      RETURN 0
   ENDIF

RETURN NIL

//------------------------------------------------------------------------------

METHOD MinimumRowHeight() CLASS XListBoxMod

RETURN Max( ::oImageList:nHeight, ::oFont:GetTextHeight( "B" ) ) + 2

//------------------------------------------------------------------------------

METHOD SetShortCuts() CLASS XListBoxMod

   LOCAL aKeys := {}, nAt

   IF ::oForm != Nil
      ::oForm:DelShortCut( Self )
      IF ::FlShortCuts
         AEval( ::aItems, {| cText | IIf( ( nAt := At( "&", cText ) ) > 0, ;
                AAdd( aKeys, Substr( cText, nAt + 1, 1 ) ), ) } )
         IF ! Empty( aKeys )
            ::oForm:AddShortCut( Self, aKeys )
         ENDIF
      ENDIF
   ENDIF

RETURN Nil

//------------------------------------------------------------------------------

METHOD GetShortCut( cKey ) CLASS XListBoxMod

   LOCAL n, nAt

   IF ::FlShortCuts .AND. !Empty( cKey )
      IF ValType( cKey ) == "N"
         cKey := Chr( cKey )
      ENDIF

      cKey := Upper( cKey )

      FOR n := 1 TO Len( ::aItems )
         IF ( nAt := At( "&", ::aItems[ n ] ) ) > 0 .AND. ;
                     Upper( Substr( ::aItems[ n ], nAt + 1, 1 ) ) == cKey
            RETURN n
         ENDIF
      NEXT
   ENDIF

RETURN 0

//------------------------------------------------------------------------------

METHOD ShortCut( cKey ) CLASS XListBoxMod

   LOCAL nPos := ::GetShortCut( cKey )

   IF ! Empty( nPos )
      ::FcText := ::ItemText( nPos )
      ::nIndex := nPos
      ::OnSelect( nPos )
   ENDIF

RETURN 0

//------------------------------------------------------------------------------

METHOD CheckAll() CLASS XListBoxMod

   ::FaChecked := Array( Len( ::FaItems ) )
   AEval( ::FaChecked, {|v,e| ::FaChecked[ e ] := e } )
   ::Refresh()

RETURN nil

//------------------------------------------------------------------------------