\    File: Listbox.f
\  Author: Jeff Kelm
\ Created: 08-Dec-1998
\ Updated: 21-May-1999
\ Generic List box class

Comment:  Revision History (most recent first)
19990521
 - Cosmetic cleanup
19981231
 - Incorporated the new ChildWindow class.
19981208
 - Created
Comment;



NEEDS BasicWin.f
CR .( Loading Listbox class...)



:Class BasicListbox  <Super ChildWindow

   :M DefClassName: ( -- ClassName)   \ default class name
       Z" LISTBOX"
       ;M

   \ add a new string to the list box list
   :M AddString: ( lpszString)
      rel>abs 0 LB_ADDSTRING SendMessage: self
      LB_ERR OVER = SWAP LB_ERRSPACE = OR
         ABORT" Error adding string to list box"
      ;M

   \ insert string in specified position (0 based)
   :M InsertString: ( lpszString index)
      >R rel>abs R> LB_INSERTSTRING SendMessage: self
      LB_ERR OVER = SWAP LB_ERRSPACE = OR
         ABORT" Error inserting string in list box"
      ;M

   \ delete string in specified position (0 based)
   :M DeleteString: ( index)
      0 SWAP LB_DELETESTRING SendMessage: self  DROP
      ;M

   :M Clear: ( -- )   \ clears all strings from list box
      0 0 LB_RESETCONTENT SendMessage: self  DROP
      ;M

   \ search the list for an item beginning
   \ with the string (case-insensitive)
   :M Find: ( lpszString -- index)
      rel>abs -1 LB_FINDSTRING SendMessage: self
      ;M

   \ find the first item that matches
   \ the string exactly (case-insensitive)
   :M FindExact: ( lpszString -- index)
      rel>abs -1 LB_FINDSTRINGEXACT SendMessage: self
      ;M

   :M GetCount: ( -- n)   \ return count of items in list
      0 0 LB_GETCOUNT SendMessage: self
      ;M

   \ return string of specified item
   :M GetString: ( index -- a n)
      HERE rel>abs SWAP LB_GETTEXT SendMessage: self  HERE SWAP
      ;M

   :M GetCurrent: ( -- index)   \ return current selection item
      0 0 LB_GETCURSEL SendMessage: self
      ;M

   \ select item beginning with string
   :M SelectString: ( lpszString -- index)
      rel>abs -1 LB_SELECTSTRING SendMessage: self
      ;M

   \ returns selection state of list item, tf=selected
   :M GetState: ( index -- f)
      0 SWAP LB_GETSEL SendMessage: self
      LB_ERR OVER = ABORT" GetState: error occurred."
      0<>
      ;M

;Class



\ Listbox allows only one item to be selected at a time
:Class Listbox  <Super BasicListbox

   :M DefStyle: ( -- style)   \ default control style
      DefStyle: super
      ;M

   :M Select: ( index)   \ set current selection to item
                         \ use -1 to unselect all
      0 SWAP LB_SETCURSEL SendMessage: self  DROP
      ;M

;Class



\ MultiListbox allows multiple selections to be made.
\ Click once on an item to select it.  Click again to deselect.
:Class MultiListbox  <Super Listbox

   :M DefStyle: ( -- style)   \ default control style
      DefStyle: super
      LBS_MULTIPLESEL OR
      ;M

   :M Select: ( index)   \ set selection of item
      TRUE LB_SETSEL SendMessage: self
      LB_ERR = ABORT" Select: error occurred."
      ;M

   :M Unselect: ( index)   \ clear selection of item
      FALSE LB_SETSEL SendMessage: self
      LB_ERR = ABORT" Unselect: error occurred."
      ;M

   \ returns number of selected items in list
   :M GetSelCount: ( -- n)
      0 0 LB_GETSELCOUNT SendMessage: self  DROP
      ;M

;Class



\ MultiExListbox also allows multiple selections to be made.
\ The difference is that Ctrl-Click selects and unselects
\ individual items and Shift-Click will select a range (as will
\ Shift-Drag.
:Class MultiExListbox  <Super MultiListbox

   :M DefStyle: ( -- style)   \ default control style
      DefStyle: super
      LBS_EXTENDEDSEL OR
      ;M

;Class



\ allows dragging of items in list box to re-order them
\ requires processing of drag list notification messages by the
\ application to actually do the dragging.
:Class DragListbox  <Super Listbox

   :M DefStyle: ( -- style)   \ default control style
      DefStyle: super
      LBS_EXTENDEDSEL OR
      ;M

   :M Create: ( hParent)   \ create an empty drag list box
      \ create a single-selection list box
      Create: super
      \ convert it to a Drag-type
      hWnd Call MakeDragList  ?WinError
      ;M

;Class