home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 16 / CD_ASCQ_16_0994.iso / news / 4611 / fw16d.ins / SOURCE / CLASSES / LISTBOX.PRG < prev    next >
Text File  |  1994-06-10  |  10KB  |  356 lines
  1. #include "FiveWin.ch"
  2. #include "Constant.ch"
  3.  
  4. #define LB_ADDSTRING         ( WM_USER +  1 )
  5. #define LB_INSERTSTRING      ( WM_USER +  2 )
  6. #define LB_DELETESTRING      ( WM_USER +  3 )
  7. #define LB_RESETCONTENT      ( WM_USER +  5 )
  8. #define LB_SETCURSEL         ( WM_USER +  7 )
  9. #define LB_GETCURSEL         ( WM_USER +  9 )
  10. #define LB_GETCOUNT          ( WM_USER + 12 )
  11. #define LB_DIR               ( WM_USER + 14 )
  12. #define LB_ERR                           -1
  13.  
  14. #define COLOR_WINDOW       5
  15. #define COLOR_WINDOWTEXT   8
  16.  
  17. //----------------------------------------------------------------------------//
  18.  
  19. CLASS TListBox FROM TControl
  20.  
  21.    DATA   aItems
  22.    DATA   bChanged
  23.    DATA   lOwnerDraw, nBmpSize
  24.    DATA   cFileSpec
  25.  
  26.    METHOD New( nRow, nCol, bSetGet, aItems, nWidth, nHeight, bChanged,;
  27.                oWnd, bValid, nClrFore, nClrBack, lPixel, lDesign,;
  28.                bLDblClicked, oFont, cMsg, lUpdate ) CONSTRUCTOR
  29.  
  30.    METHOD ReDefine( nId, bSetGet, aItems, bChanged,  oWnd, nHelpId,;
  31.                     lOwnerDraw, nBmpSize, bValid, cFileSpec,;
  32.                     nClrFore, nClrBack, bLDblClicked, cMsg,;
  33.                     lUpdate ) CONSTRUCTOR
  34.  
  35.    METHOD cToChar() INLINE Super:cToChar( "LISTBOX" )
  36.  
  37.    METHOD cGenPrg()
  38.  
  39.    METHOD Init( hDlg ) INLINE  Super:Init( hDlg ),;
  40.                                ::Default()
  41.  
  42.    METHOD MouseMove( nRow, nCol, nKeyFlags )
  43.  
  44.    METHOD GoTop()    INLINE ::Select( 1 )
  45.    METHOD GoBottom() INLINE ::Select( Len( ::aItems ) )
  46.  
  47.    METHOD Select( nItem ) INLINE ::SendMsg( LB_SETCURSEL, nItem - 1, 0 )
  48.  
  49.    METHOD Set( cNewItem )
  50.  
  51.    METHOD Add( cItem, nAt )
  52.    METHOD Modify( cItem, nAt )
  53.    METHOD Insert( cItem, nAt )
  54.    METHOD Del( nAt )
  55.    METHOD GetItem( nItem ) INLINE  LbxGetItem( ::hWnd, nItem )
  56.  
  57.    METHOD Len() INLINE  SendMessage( ::hWnd, LB_GETCOUNT )
  58.  
  59.    METHOD LostFocus()
  60.  
  61.    METHOD Reset() INLINE Eval( ::bSetGet, "" ),;
  62.                          ASize( ::aItems, 0 ),;
  63.                          ::SendMsg( LB_RESETCONTENT )
  64.  
  65.    METHOD Change()
  66.  
  67.    METHOD FillMeasure( nPInfo ) INLINE  LbxMeasure( nPInfo, ::nBmpSize )
  68.  
  69.    METHOD DrawItem( nPStruct ) INLINE  LbxDrawItem( nPStruct, ::aItems )
  70.  
  71.    METHOD GetPos() BLOCK ;             // it has to be a BLOCK
  72.       { | Self, nPos | nPos := ::SendMsg( LB_GETCURSEL ),;
  73.                        If( nPos == -1, 0, nPos + 1 ) }
  74.  
  75.    METHOD Default()
  76.  
  77.    METHOD VScroll( nWParam, nLParam ) VIRTUAL  // We request default behaviors
  78.  
  79. ENDCLASS
  80.  
  81. //----------------------------------------------------------------------------//
  82.  
  83. METHOD New( nRow, nCol, bSetGet, aItems, nWidth, nHeight, bChanged, ;
  84.             oWnd, bValid, nClrFore, nClrBack, lPixel, lDesign,;
  85.             bLDblClicked, oFont, cMsg, lUpdate )  CLASS TListBox
  86.  
  87.    if nClrFore == nil
  88.       nClrBack := GetSysColor( COLOR_WINDOW )
  89.    endif
  90.  
  91.    DEFAULT aItems   := {}, nWidth := 40, nHeight := 40,;
  92.            nClrFore := GetSysColor( COLOR_WINDOWTEXT ),;
  93.            lPixel   := .f., lDesign := .f., lUpdate := .f.
  94.  
  95.    ::cCaption   = ""
  96.    ::nTop       = nRow * If( lPixel, 1, LST_CHARPIX_H )        //14
  97.    ::nLeft      = nCol * If( lPixel, 1, LST_CHARPIX_W )      // 8
  98.    ::nBottom    = ::nTop  + nHeight - 1
  99.    ::nRight     = ::nLeft + nWidth - 1
  100.    ::aItems     = aItems
  101.    ::bSetGet    = bSetGet
  102.    ::bChanged   = bChanged
  103.    ::bLDblClick = bLDblClicked
  104.    ::oWnd       = oWnd
  105.    ::oFont      = oFont
  106.    ::lOwnerDraw = .f.
  107.    ::nStyle     = nOR( LBS_NOTIFY, WS_TABSTOP, LBS_DISABLENOSCROLL,;
  108.                        LBS_USETABSTOPS, WS_CHILD, WS_VISIBLE, WS_BORDER,;
  109.                        WS_VSCROLL, If( lDesign, WS_THICKFRAME, 0 ) )
  110.    ::nId        = ::GetNewId()
  111.    ::bValid     = bValid
  112.    ::lDrag      = lDesign
  113.    ::lCaptured  = .f.
  114.    ::cMsg       = cMsg
  115.    ::lUpdate    = lUpdate
  116.  
  117.    ::SetColor( nClrFore, nClrBack )
  118.  
  119.    if oWnd:lVisible
  120.       ::Create( "LISTBOX" )
  121.       ::Default()
  122.       oWnd:AddControl( Self )
  123.    else
  124.       oWnd:DefControl( Self )
  125.    endif
  126.  
  127. return nil
  128.  
  129. //----------------------------------------------------------------------------//
  130.  
  131. METHOD ReDefine( nId, bSetGet, aItems, bChanged, oWnd, nHelpId,;
  132.                  lOwnerDraw, nBmpSize, bValid, cFileSpec, nClrFore,;
  133.                  nClrBack, bLDblClicked, cMsg, lUpdate ) CLASS TListBox
  134.  
  135.    if nClrFore == nil
  136.       nClrBack := GetSysColor( COLOR_WINDOW )
  137.    endif
  138.  
  139.    DEFAULT aItems   := {}, nBmpSize := 30,;
  140.            nClrFore := GetSysColor( COLOR_WINDOWTEXT ),;
  141.            lUpdate  := .f.
  142.  
  143.    ::nId        = nId
  144.    ::hWnd       = 0
  145.    ::aItems     = aItems
  146.    ::bSetGet    = bSetGet
  147.    ::bChanged   = bChanged
  148.    ::bLDblClick = bLDblClicked
  149.    ::oWnd       = oWnd
  150.    ::nHelpId    = nHelpId
  151.    ::lOwnerDraw = lOwnerDraw
  152.    ::nBmpSize   = nBmpSize
  153.    ::bValid     = bValid
  154.    ::cFileSpec  = cFileSpec
  155.    ::lDrag      = .f.
  156.    ::lCaptured  = .f.
  157.    ::cMsg       = cMsg
  158.    ::lUpdate    = lUpdate
  159.  
  160.    ::SetColor( nClrFore, nClrBack )
  161.  
  162.    if lOwnerDraw
  163.       AEval( ::aItems, ;
  164.              { | cBitmap, n | ::aItems[ n ] := ReadBitmap( 0, cBitmap ) } )
  165.    endif
  166.  
  167.    oWnd:DefControl( Self )
  168.  
  169. return nil
  170.  
  171. //----------------------------------------------------------------------------//
  172.  
  173. METHOD Set( cNewItem ) CLASS TListBox
  174.  
  175.    local nAt := AScan( ::aItems,;
  176.                        { | cItem | Upper( AllTrim( cItem ) ) == ;
  177.                                    Upper( AllTrim( cNewItem ) ) } )
  178.  
  179.    if nAt != 0
  180.       ::Select( nAt - 1 )
  181.    endif
  182.  
  183. return nil
  184.  
  185. //----------------------------------------------------------------------------//
  186.  
  187. METHOD LostFocus() CLASS TListBox
  188.  
  189.    local nAt := ::SendMsg( LB_GETCURSEL )
  190.  
  191.    Super:LostFocus()
  192.  
  193.    if nAt != -1
  194.       Eval( ::bSetGet, ::aItems[ nAt + 1 ] )
  195.    endif
  196.  
  197. return nil
  198.  
  199. //----------------------------------------------------------------------------//
  200.  
  201. METHOD Add( cItem, nAt ) CLASS TListBox
  202.  
  203.    DEFAULT nAt := Len( ::aItems )
  204.  
  205.    if nAt == Len( ::aItems )
  206.       AAdd( ::aItems, cItem )
  207.       ::SendMsg( LB_ADDSTRING, nAt, cItem )
  208.    else
  209.       ASize( ::aItems, Len( ::aItems ) + 1 )
  210.       AIns( ::aItems, nAt + 1 )
  211.       ::aItems[ nAt + 1 ] = cItem
  212.       ::SendMsg( LB_INSERTSTRING, nAt, cItem )
  213.    endif
  214.  
  215.    ::SendMsg( LB_SETCURSEL, nAt )
  216.  
  217. return nil
  218.  
  219. //----------------------------------------------------------------------------//
  220.  
  221. METHOD Modify( cItem, nAt ) CLASS TListBox
  222.  
  223.    if nAt == nil
  224.       if ( nAt := ::SendMsg( LB_GETCURSEL ) ) != -1
  225.          nAt++
  226.       endif
  227.    endif
  228.  
  229.    if nAt > 0
  230.       ::aItems[ nAt ] = cItem
  231.       ::SendMsg( LB_DELETESTRING, nAt - 1 )
  232.       ::SendMsg( LB_INSERTSTRING, nAt - 1, cItem )
  233.       ::SendMsg( LB_SETCURSEL, nAt - 1 )
  234.    endif
  235.  
  236. return nil
  237.  
  238. //----------------------------------------------------------------------------//
  239.  
  240. METHOD Insert( cItem, nAt ) CLASS TListBox
  241.  
  242.    if nAt == nil
  243.       if ( nAt := ::SendMsg( LB_GETCURSEL ) ) != -1
  244.          nAt++
  245.       endif
  246.    endif
  247.  
  248.    if nAt > 0
  249.       ASize( ::aItems, Len( ::aItems ) + 1 )
  250.       AIns( ::aItems, nAt )
  251.       ::aItems[ nAt ] = cItem
  252.       ::SendMsg( LB_INSERTSTRING, nAt - 1, cItem )
  253.    endif
  254.  
  255. return nil
  256.  
  257. //----------------------------------------------------------------------------//
  258.  
  259. METHOD Del( nAt ) CLASS TListBox
  260.  
  261.    if nAt == nil
  262.       if ( nAt := ::SendMsg( LB_GETCURSEL ) ) != -1
  263.          nAt++
  264.       endif
  265.    endif
  266.  
  267.    if nAt > 0
  268.       ADel( ::aItems, nAt )
  269.       ASize( ::aItems, Len( ::aItems ) - 1 )
  270.       ::SendMsg( LB_DELETESTRING, nAt - 1 )
  271.       ::SendMsg( LB_SETCURSEL, Min( nAt, Len( ::aItems ) ) - 1 )
  272.    endif
  273.  
  274. return nil
  275.  
  276. //----------------------------------------------------------------------------//
  277.  
  278. METHOD Change() CLASS TListBox
  279.  
  280.    Eval( ::bSetGet, ::aItems[ ::SendMsg( LB_GETCURSEL ) + 1 ] )
  281.  
  282.    if ::bChanged != nil
  283.       Eval( ::bChanged, Self )
  284.    endif
  285.  
  286. return nil
  287.  
  288. //----------------------------------------------------------------------------//
  289.  
  290. METHOD Default() CLASS TListBox
  291.  
  292.    local nAt
  293.    local cStart := Eval( ::bSetGet )
  294.    local aFiles
  295.  
  296.    if ! ::lOwnerDraw
  297.       if ! Empty( ::cFileSpec )
  298.          aFiles = Directory( ::cFileSpec )
  299.          for nAt = 1 to Len( aFiles )
  300.             AAdd( ::aItems, aFiles[ nAt ][ 1 ] )
  301.          next
  302.          ASort( ::aItems )
  303.       endif
  304.  
  305.       AEval( ::aItems, { | cItem, nAt | ::SendMsg( LB_ADDSTRING, nAt, cItem ) } )
  306.  
  307.       nAt = AScan( ::aItems, { | cItem | Upper( AllTrim( cItem ) ) == ;
  308.                                          Upper( AllTrim( cStart ) ) } )
  309.       if nAt != 0
  310.          ::SendMsg( LB_SETCURSEL, nAt - 1 )
  311.       endif
  312.    else
  313.       AEval( ::aItems, { | cItem | ::Add( "Testing..." ) } )
  314.    endif
  315.  
  316.    if ::oFont != nil
  317.       ::SetFont( ::oFont )
  318.    else
  319.       ::SetFont( ::oWnd:oFont )
  320.    endif
  321.  
  322. return nil
  323.  
  324. //----------------------------------------------------------------------------//
  325.  
  326. METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TListBox
  327.  
  328.    local nResult := Super:MouseMove( nRow, nCol, nKeyFlags )
  329.  
  330. return If( ::lDrag, nResult, nil )    // We want standard behavior !!!
  331.  
  332. //----------------------------------------------------------------------------//
  333.  
  334. METHOD cGenPrg() CLASS TListBox
  335.  
  336.    local cCode := ""
  337.    local n
  338.  
  339.    cCode += CRLF + "   @ " + Str( ::nTop, 3 ) + ", " + Str( ::nLeft, 3 ) + ;
  340.             " LISTBOX oLbx ITEMS { "
  341.  
  342.    for n = 1 to Len( ::aItems )
  343.       if n > 1
  344.          cCode += ", "
  345.       endif
  346.       cCode += '"' + ::aItems[ n ] + '"'
  347.    next
  348.  
  349.    cCode += " } ;" + CRLF + ;
  350.             "      SIZE " + Str( ::nRight - ::nLeft + 1, 3 ) + ", " + ;
  351.             Str( ::nBottom - ::nTop + 1, 3 ) + " PIXEL OF oWnd" + CRLF
  352.  
  353. return cCode
  354.  
  355. //----------------------------------------------------------------------------//
  356.