/*
 * Xailer source code:
 *
 * Listbox.prg
 * Clase TListBox()
 *
 * Copyright 2003, 2007 Ignacio Ortiz de Zuņiga
 * Copyright 2003, 2007 Xailer.com
 * All rights reserved
 *
 */

#include "Xailer.ch"


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

CLASS XListBox FROM TStdControl

PUBLISHED:
   PROPERTY nWidth         INIT 75
   PROPERTY nHeight        INIT 100
   PROPERTY lBorder        INIT .T.
   PROPERTY nClrPane       INIT clWindow EDITOR PE_Color
   PROPERTY nColsWidth     INIT 100 WRITE METHOD SetColumnsWidth  EDITOR PE_Scale

   PROPERTY aItems         INIT {}  READ GetItems  WRITE METHOD SetItems   EDITOR PE_StringList
   PROPERTY cText          READ METHOD GetText  WRITE INLINE ::SelectString( Value )

   PROPERTY nIndex         INIT 1   READ METHOD GetIndex WRITE METHOD SetIndex

   PROPERTY lAutoSort         INIT .F.
   PROPERTY lMultipleSel      INIT .F.
   PROPERTY lExtendedSel      INIT .T.
   PROPERTY lIntegralHeight   INIT .T. WRITE METHOD SetIntegralHeight
   PROPERTY lScrollbarAlways  INIT .F.
   PROPERTY lHScroll          INIT .F. WRITE METHOD SetHScroll
   PROPERTY lMultiColumn      INIT .F. WRITE METHOD SetMultiColumn
   PROPERTY lUseTabStops      INIT .F. WRITE METHOD SetUseTabStops

   EVENT OnChange( oSender, nIndex ) // --> Nil
   EVENT OnDblClick( oSender ) // --> Nil

PUBLIC:
   PROPERTY nTopIndex INIT 1  READ GetTopIndex  WRITE SetTopIndex
   PROPERTY lRedraw   INIT .T. WRITE METHOD SetRedraw

PROTECTED:
   DATA cWinClassName INIT "ListBox"
   DATA nCtlStyle INIT nOr( WS_CHILD, WS_CLIPCHILDREN, WS_CLIPSIBLINGS, LBS_NOTIFY, LBS_HASSTRINGS, WS_BORDER, WS_VSCROLL )

PUBLIC:
   METHOD Create( oParent ) CONSTRUCTOR
   METHOD Scale( nScale )

   METHOD AddItem( cItem ) INLINE ::InsertItem( Nil, cItem ) // --> lSuccess
   METHOD InsertItem( nPos, cItem ) // --> lSuccess
   METHOD DeleteItem( nItem ) // --> lSuccess
   METHOD ModifyItem( nItem, cItem ) // --> lSuccess
   METHOD DeleteItems()    INLINE ::Reset() // --> lSuccess

   METHOD SetCurSel( n )   INLINE ::SendMsg( LB_SETCURSEL, n - 1 ) + 1 // --> nIndex
   METHOD GetCurSel()      INLINE ::SendMsg( LB_GETCURSEL ) + 1 // --> nIndex
   METHOD SetSel( nItem, lMode ) INLINE ( IIf( nItem == Nil, nItem := ::nIndex, ), ; // --> nIndex
                                          IIf( lMode == Nil, lMode := .T., ), ;
                                             ::SendMsg( LB_SETSEL, IIf( lMode, 1, 0 ), nItem - 1 ) != LB_ERR )
   METHOD SelectString( cString, nFrom ) INLINE ( IIf( nFrom == Nil, nFrom := 0, ), ; // --> nIndex
                                                  ::SendMsg( LB_SELECTSTRING, nFrom - 1, cString ) != LB_ERR )

   METHOD GetSelItems() // --> aSelItems
   METHOD SetSelItems( aItems ) // --> lSuccess

   METHOD SetHorzExtent( nSize ) ; // --> nOldExtent
      INLINE ::SendMsg( LB_SETHORIZONTALEXTENT, nSize, 0 )
   METHOD GetHorzExtent() ; // --> nHorzExtent
      INLINE ::SendMsg( LB_GETHORIZONTALEXTENT, 0, 0 )

RESERVED:
   METHOD SetTopIndex( nIndex ) ;
      INLINE ::SendMsg( LB_SETTOPINDEX, nIndex - 1, 0 )
   METHOD GetTopIndex() ;
      INLINE ::SendMsg( LB_GETTOPINDEX, 0, 0 ) + 1

   METHOD Command( nNotifyCode )

   METHOD SetIntegralHeight( lOnOff )
   METHOD SetMultiColumn( lOnOff )
   METHOD SetUseTabStops( lOnOff )
   METHOD GetIndex()
   METHOD SetIndex( nIndex )
   METHOD Change( nIndex ) INLINE ::FnIndex := nIndex, ::OnChange( nIndex )

   METHOD SetItems( aItems )
   METHOD GetItems()       INLINE Aclone( ::FaItems )
   METHOD Reset()          INLINE IIf( ::SendMsg( LB_RESETCONTENT ) != LB_ERR, ( ::FaItems := {}, .T. ), .F. )
   METHOD GetCount()       INLINE ::SendMsg( LB_GETCOUNT )

   METHOD GetSel( nItem ) INLINE ( IIf( nItem == Nil, nItem := ::nIndex, ), ;
                                    ( ::SendMsg( LB_GETSEL, nItem - 1 ) != 0 ) )

   METHOD GetSelCount()   INLINE IIf( ::lMultipleSel, ::SendMsg( LB_GETSELCOUNT ), 0 )

   METHOD GetText( nItem )

   METHOD FindString( cString, nFrom ) ;
      INLINE ( IIf( nFrom == Nil, nFrom := 0, ), ;
               ::SendMsg( LB_FINDSTRING, nFrom - 1, cString ) + 1 )
   METHOD FindStringEx( cString, nFrom ) ;
      INLINE ( IIf( nFrom == Nil, nFrom := 0, ), ;
               ::SendMsg( LB_FINDSTRINGEXACT, nFrom - 1, cString ) + 1 )

   // nAttributes -> DDL_
   METHOD SetDir( nAttributes, cPath ) ;
      INLINE ::SendMsg( LB_DIR, nAttributes, cPath )

   METHOD GetItemData( nItem ) ;
      INLINE ::SendMsg( LB_GETITEMDATA, nItem, 0 )
   METHOD SetItemData( nItem, nData ) ;
      INLINE ::SendMsg( LB_SETITEMDATA, nItem, nData )

   METHOD InitStorage( nItems, nBytes ) ;
      INLINE ::SendMsg( LB_INITSTORAGE, nItems, nBytes )

   METHOD ItemFromPoint( x, y ) ;
      INLINE ::SendMsg( LB_ITEMFROMPOINT, 0, MakeLong( x, y ) )

   METHOD GetItemHeight( nItem )
   METHOD SetItemHeight( nItem, nHeight )
   METHOD SelRange( lSelect, nFrom, nTo )
   METHOD SetColumnsWidth( nWidth )
   METHOD GetAnchor()
   METHOD SetAnchor( nItem )
   METHOD GetCaretIndex()
   METHOD SetCaretIndex( nItem, lScroll )

   METHOD GetItemRect( nItem )
   METHOD SetCount( nCount ) ;
      INLINE IIf( ::HasStyle( LBS_NODATA ) .AND. ! ::HasStyle( LBS_HASSTRINGS ), ;
                   ::SendMsg( LB_SETCOUNT, nCount, 0 ), )

   METHOD ClearTabStops()           INLINE ::SendMsg( LB_SETTABSTOPS, 0, 0 )
   METHOD SetTabStops( aTabStops )
   METHOD SetHScroll( lHScroll )

   METHOD WMEraseBkgnd() INLINE 1
   METHOD WMPaint() EXTERN XControl_EraseSolidAndPaint()
   METHOD WMPrintClient()
   METHOD LoadFromControl()
   METHOD SetRedraw( Value )

ENDCLASS

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

METHOD Create( oParent ) CLASS XListBox

   LOCAL nHeight := ::nHeight

   IF ::lAutoSort
      ::nCtlStyle := nOr( ::nCtlStyle, LBS_SORT )
   ENDIF

   IF ::lMultipleSel
      ::nCtlStyle := nOr( ::nCtlStyle, LBS_MULTIPLESEL )
      IF ::lExtendedSel
         ::nCtlStyle := nOr( ::nCtlStyle, LBS_EXTENDEDSEL )
      ENDIF
   ENDIF

   IF ::lScrollbarAlways
      ::nCtlStyle := nOr( ::nCtlStyle, LBS_DISABLENOSCROLL )
   ENDIF

   ::SetIntegralHeight()
   ::SetMultiColumn()
   ::SetUseTabStops()

   ::Super:Create( oParent )

   ::nHeight := MulDiv( nHeight, Application:nScale, 100 )

   IF ::Handle != 0 .AND. Len( ::FaItems ) > 0 .AND. ::GetCount() == 0
      AEval( ::FaItems, {|v| ::SendMsg( LB_ADDSTRING, 0, v ) } )
      ::FnIndex := ::SetCurSel( ::FnIndex )
   ENDIF

   ::SetColumnsWidth()

   IF ::lAutoSort .AND. ::lRedraw
      ::LoadFromControl()
   ENDIF

RETURN Self

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

METHOD Scale( nScale ) CLASS XListBox

   DEFAULT nScale TO Application:nScale

   IF nScale != 100
      ::FnColsWidth  := MulDiv( ::FnColsWidth, nScale, 100 )
      ::Super:Scale( nScale )
   ENDIF

RETURN Nil

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

METHOD SetIntegralHeight( lOnOff ) CLASS XListBox

   UPDATE ::FlIntegralHeight TO lOnOff

   ::ChangeCtlStyle( LBS_NOINTEGRALHEIGHT, ! ::FlIntegralHeight )

RETURN Nil

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

METHOD SetMultiColumn( lOnOff ) CLASS XListBox

   UPDATE ::FlMultiColumn TO lOnOff

   ::ChangeCtlStyle( LBS_MULTICOLUMN, ::FlMultiColumn )

RETURN Nil

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

METHOD SetUseTabStops( lOnOff ) CLASS XListBox

   UPDATE ::FlUseTabStops TO lOnOff

   ::ChangeCtlStyle( LBS_USETABSTOPS, ::FlUseTabStops )

RETURN Nil

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

METHOD GetIndex() CLASS XListBox

   IF ! Empty( ::Handle )
      ::FnIndex := ::GetCurSel()
   ENDIF

RETURN ::FnIndex

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

METHOD SetIndex( nValue ) CLASS XListBox

   IF ! Empty( ::Handle )
      IF ::lMultipleSel
         ::FnIndex := ::SetSel( nValue )
      ELSE
         ::FnIndex := ::SetCurSel( nValue )
      ENDIF
   ELSE
      ::FnIndex := nValue
   ENDIF

RETURN ::FnIndex

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

METHOD Command( nNotifyCode ) CLASS XListBox

   IF nNotifyCode == LBN_SELCHANGE
      ::Change( ::GetCurSel() )
   ENDIF

RETURN ::Super:Command( nNotifyCode )

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

METHOD InsertItem( nPos, cItem ) CLASS XListBox

   LOCAL lRet := .T.

   DEFAULT cItem    TO "Listbox item"

   IF nPos == Nil .OR. nPos > ::GetCount()
      AAdd( ::FaItems, cItem )
      IF ::Handle != 0
         IF ! ::SendMsg( LB_ADDSTRING, 0, cItem ) != LB_ERR
            lRet := .F.
         ENDIF
      ENDIF
   ELSE
      AAdd( ::FaItems, Nil )
      AIns( ::FaItems, nPos )
      ::FaItems[ nPos ] := cItem
      IF ::Handle != 0
         IF ! ::SendMsg( LB_INSERTSTRING, nPos - 1 , cItem ) != LB_ERR
            lRet := .F.
         ENDIF
      ENDIF
   ENDIF

   IF ::lAutoSort .AND. ::lRedraw
      ::LoadFromControl()
   ENDIF

RETURN lRet

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

METHOD DeleteItem( nPos ) CLASS XListBox

   LOCAL lRet := .T.

   DEFAULT nPos   TO ::nIndex

   IF nPos <= 0 .OR. nPos > Len( ::FaItems )
      RETURN .F.
   ENDIF

   ADel( ::FaItems, nPos )
   ASize( ::FaItems, Len( ::FaItems ) - 1 )

   IF ::Handle != 0
      IF ! ::SendMsg( LB_DELETESTRING, nPos - 1 ) != LB_ERR
         lRet := .F.
      ENDIF
   ENDIF

RETURN lRet

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

METHOD ModifyItem( nPos, cItem ) CLASS XListBox

   LOCAL lRet := .T.

   DEFAULT nPos  TO ::nIndex, ;
           cItem TO "Listbox item"

   IF nPos < 1 .OR. nPos > Len( ::FaItems )
      RETURN .F.
   ENDIF

   ::FaItems[ nPos ] := cItem

   IF ::DeleteItem( nPos )
      ::InsertItem( nPos, cItem )
      IF nPos == ::FnIndex
         ::SendMsg( LB_SETCURSEL, nPos - 1 )
      ENDIF
   ELSE
      lRet := .F.
   ENDIF

   IF ::lAutoSort .AND. ::lRedraw
      ::LoadFromControl()
   ENDIF

RETURN lRet

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

METHOD SetItems( aItems ) CLASS XListBox

   IF ::Reset()
      ::FaItems := aItems
   ELSE
      RETURN .F.
   ENDIF

   ::SendMsg( WM_SETREDRAW, .F. )
   IF ! Empty( ::Handle ) .AND. ! Empty( ::FaItems )
      AEval( ::FaItems, {|v| ::SendMsg( LB_ADDSTRING, 0, v ) } )
      ::nIndex := 1
   ENDIF
   IF ::FlRedraw
      ::SendMsg( WM_SETREDRAW, .T. )
      IF ::lAutoSort
         ::LoadFromControl()
      ENDIF
   ENDIF

   ::Refresh()

RETURN .T.

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

METHOD SetSelItems( aItems ) CLASS XListBox

   LOCAL nFor

   IF ! ::lMultipleSel
      RETURN .F.
   ENDIF

   FOR nFor := 1 TO Len( ::FaItems )
      IF ! ::SetSel( nFor, AScan( aItems, nFor ) != 0 )
         RETURN .F.
      ENDIF
   NEXT

RETURN .T.

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

METHOD GetItemHeight( nItem ) CLASS XListBox

   LOCAL nHeight := 0

   DEFAULT nItem TO 0

   nHeight := ::SendMsg( LB_GETITEMHEIGHT, nItem, 0 )

RETURN nHeight

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

METHOD SetItemHeight( nItem, nHeight ) CLASS XListBox

   DEFAULT nItem TO 0

   ::SendMsg( LB_SETITEMHEIGHT, nItem, nHeight )

RETURN Nil

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

METHOD SelRange( lSelect, nFrom, nTo ) CLASS XListBox

   DEFAULT lSelect TO .T.

   ::SendMsg( LB_SELITEMRANGE, lSelect, MakeLong( nFrom, nTo ) )

RETURN Nil

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

METHOD SetColumnsWidth( nWidth ) CLASS XListBox

   DEFAULT nWidth TO ::FnColsWidth

   ::FnColsWidth := nWidth

   IF ::lMultiColumn
      ::SendMsg( LB_SETCOLUMNWIDTH, nWidth, 0 )
   ENDIF

RETURN Nil

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

METHOD GetAnchor() CLASS XListBox

   LOCAL nAnchor := 0

   IF ::lMultipleSel
      nAnchor := ::SendMsg( LB_GETANCHORINDEX, 0, 0 )
   ENDIF

RETURN nAnchor

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

METHOD SetAnchor( nItem ) CLASS XListBox

   IF ::lMultipleSel
      ::SendMsg( LB_SETANCHORINDEX, nItem, 0 )
   ENDIF

RETURN Nil

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

METHOD GetCaretIndex() CLASS XListBox

   LOCAL nCaret := 0

   IF ::lMultipleSel
      nCaret := ::SendMsg( LB_GETCARETINDEX, 0, 0 )
   ENDIF

RETURN nCaret

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

METHOD SetCaretIndex( nItem, lScroll ) CLASS XListBox

   DEFAULT lScroll TO .F.

   IF ::lMultipleSel
      ::SendMsg( LB_SETCARETINDEX, nItem, lScroll )
   ENDIF

RETURN Nil

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

METHOD SetHScroll( lHScroll ) CLASS XListBox

   DEFAULT lHScroll TO .T.

   ::FlHScroll := lHScroll
   ::ChangeCtlStyle( WS_HSCROLL, lHScroll )

RETURN ::FlHScroll

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

METHOD SetRedraw( lRedraw ) CLASS XListBox

   IF lRedraw .AND. ::lAutoSort
      ::LoadFromControl()
   ENDIF

RETURN ::Super:SetRedraw( lRedraw )

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

#pragma BEGINDUMP

#undef _WIN32_WINNT
#define _WIN32_WINNT   0x0400

#include <windows.h>
#include <commctrl.h>
#include <xailer.h>

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

HB_FUNC_STATIC( XLISTBOX_GETTEXT )
{
   PHB_ITEM Self = hb_stackSelfItem();
   HWND hwnd = GetHandleOf( Self );
   int nItem = hb_parnl( 1 );

   if( hwnd )
      {
      char *cItem;
      int nLen;

      if( HB_ISNIL( 1 ) )  // NOTA: No leer nIndex porque se asigna a 0 al crear el control - [JFG]
         nItem = SendMessage( hwnd, LB_GETCURSEL, 0, 0 ) + 1;
      nLen = SendMessage( hwnd, LB_GETTEXTLEN, nItem - 1, 0 );

      if( nLen > 0 )
         {
         cItem = hb_xgrab( nLen + 1 );
         SendMessage( hwnd, LB_GETTEXT, nItem - 1, (LPARAM) cItem );
         hb_retc_buffer( cItem );
         }
      else
         hb_retc( "" );
      }
   else
      {
      PHB_ITEM aItems = XA_ObjGetItemCopy( Self, "FaItems" );
      int nLen = hb_arrayLen( aItems );

      if( HB_ISNIL( 1 ) )
         nItem = XA_ObjGetNL( Self, "FnIndex" );
      if( ( nItem > 0 ) && ( nItem <= nLen ) )
         hb_retc( hb_arrayGetCPtr( aItems, nItem ) );
      else
         hb_retc( "" );

      hb_itemRelease( aItems );
      }
}

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

HB_FUNC_STATIC( XLISTBOX_GETSELITEMS )
{
   PHB_ITEM Self = hb_stackSelfItem();
   HWND hwnd = GetHandleOf( Self );
   DWORD wLen = SendMessage( hwnd, LB_GETSELCOUNT, 0, 0 );

   if( wLen )
   {
      DWORD wFor;
      int * pBuffer = ( int * ) hb_xgrab( sizeof( int ) * wLen );
      SendMessage( hwnd, LB_GETSELITEMS, ( WPARAM ) wLen, ( LPARAM ) pBuffer );

      hb_reta( wLen );

      for( wFor = 0; wFor < wLen; wFor++ )
         hb_storvnl( pBuffer[ wFor ] + 1, -1, wFor + 1 );

      hb_xfree( ( void * ) pBuffer );
   }
   else
      hb_reta( 0 );
}

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

HB_FUNC_STATIC( XLISTBOX_GETITEMRECT )
{
   PHB_ITEM Self = hb_stackSelfItem();
   HWND hwnd = GetHandleOf( Self );
   RECT lprc;

   if( SendMessage( hwnd, LB_GETITEMRECT, hb_parnl( 1 ) - 1, (LPARAM) &lprc ) != LB_ERR )
   {
      hb_reta( 4 );
      hb_storvnl( lprc.top, -1, 1 );
      hb_storvnl( lprc.left, -1, 2 );
      hb_storvnl( lprc.bottom, -1, 3 );
      hb_storvnl( lprc.right, -1, 4 );
   }
   else
   {
      hb_reta( 4 );
      hb_storvnl( 0, -1, 1 );
      hb_storvnl( 0, -1, 2 );
      hb_storvnl( 0, -1, 3 );
      hb_storvnl( 0, -1, 4 );
   }
}

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

HB_FUNC_STATIC( XLISTBOX_SETTABSTOPS )
{
   PHB_ITEM Self = hb_stackSelfItem();
   HWND hwnd = GetHandleOf( Self );

   if( XA_ObjGetL( Self, "lUseTabStops" ) )
   {
      if( HB_ISARRAY( 1 ) )
      {
         PHB_ITEM pTabs = hb_param( 1, HB_IT_ARRAY );
         LPINT lpTabs;
         UINT uiTabs = hb_arrayLen( pTabs );
         UINT i;

         lpTabs = (LPINT) hb_xgrab( sizeof( int ) * uiTabs );

         for( i = 1; i < uiTabs; i++ )
            lpTabs[ i - 1 ] = ( hb_arrayGetNL( pTabs, i + 1 ) * 4 );

         hb_retl( SendMessage( hwnd, LB_SETTABSTOPS, (WPARAM) uiTabs, (LPARAM) lpTabs ) );
         hb_xfree( (LPINT) lpTabs );
      }
   }
   else
      hb_retl( FALSE );
}

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

HB_FUNC_STATIC( XLISTBOX_LOADFROMCONTROL )
{
   PHB_ITEM Self = hb_stackSelfItem();
   HWND hwnd = GetHandleOf( Self );

   if( hwnd )
   {
      int iLen = SendMessage( hwnd, LB_GETCOUNT, 0, 0 );
      int iFor;
      PHB_ITEM aItems = hb_itemArrayNew( iLen );

      for( iFor = 0; iFor < iLen; iFor++ )
      {
         PHB_ITEM pItem = hb_itemNew( NULL );
         char *cItem;
         int nLen = SendMessage( hwnd, LB_GETTEXTLEN, iFor, 0 );
         cItem = hb_xgrab( nLen + 1 );
         SendMessage( hwnd, LB_GETTEXT, iFor, (LPARAM) cItem );
         hb_itemPutCLPtr( pItem, cItem, nLen );
         hb_arraySetForward( aItems, iFor + 1, pItem );
         hb_itemRelease( pItem );
      }
      XA_ObjSendItem( Self, "_FaItems", aItems );
      hb_itemRelease( aItems );
   }
}

#pragma ENDDUMP

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