home *** CD-ROM | disk | FTP | other *** search
/ BUG 4 / BUGCD1997_05.BIN / aplic / clip4win / clip4win.exe / C4W30E.HUF / SOURCE / LISTBOX.PRG < prev    next >
Text File  |  1995-01-13  |  14KB  |  547 lines
  1. ////////////////////////////
  2. //
  3. //    Clip-4-Win listbox demo
  4. //
  5. //    Copyright (C) 1992,1993,1994 Skelton Software, Kendal Cottage, Hillam, Leeds, UK.
  6. //    All Rights Reserved.
  7. //
  8. //    Compile:    listbox /n /w
  9. //    Link:        /se:600 listbox,,,clip4win,clip4win.def
  10. //
  11. //    NOTE: Look at achoice.prg for a sample dialog with a listbox.
  12. //
  13. //    ALSO: See the code below for how to make a simple browser.
  14. //
  15. ////////////////////////////
  16.  
  17. #ifndef    LIB_ONLY
  18.   #define WIN_WANT_ALL            // to get WM_SETREDRAW
  19. #endif    // LIB_ONLY
  20. #define    WIN_WANT_LBS
  21. #define    WIN_WANT_LB
  22. #include "windows.ch"
  23.  
  24.  
  25. #define    MAKELPARAM(nLow, nHigh)        ((nLow) + (nHigh) * 65536)
  26.  
  27.  
  28. #ifndef    LIB_ONLY
  29.  
  30.  
  31. #define    TAB    chr(9)
  32. #define    CR    chr(13)
  33.  
  34.  
  35. #define    ID_LBOX    1            // unique id (used for the listbox)
  36.  
  37. static    hWnd, hInst, cText, hLBox, cAppName := "Clip-4-Win"
  38. static    bEvent := {|nEvent| nil}    // current event handler
  39.  
  40.  
  41. function main()
  42. local    hMenu, nEvent
  43.  
  44. hWnd = WinSetup(cAppName, "Clip-4-Win ListBox Demo", , , 550, 400, , , , ;
  45.         WS_OVERLAPPEDWINDOW + WS_CLIPCHILDREN)
  46. hInst = _GetInstance()
  47. hMenu = MenuSetup()
  48. HideCaret(hWnd)
  49.  
  50. do while .t.
  51.     do while (nEvent := ChkEvent()) == EVENT_NONE
  52.         // some "background" processing could go here
  53.     enddo
  54.     eval(bEvent, nEvent)        // give the event to the right handler
  55. enddo
  56.  
  57. return 0
  58.  
  59.  
  60. procedure DoAbout()
  61. MessageBox( , "Written by John Skelton.", "Info", MB_OK)
  62. return
  63.  
  64.  
  65. procedure DoExit()
  66. quit
  67. return
  68.  
  69.  
  70. // This one is non-modal, but you have to send/receive messages.
  71. //
  72. // It also shows how to use Tab Stops to make columns, which makes
  73. // a simple browser.  You put tabs between the items you want the
  74. // listbox to align in columns.  Remember to use LBS_USETABSTOPS.
  75.  
  76. procedure DoLBox()
  77. local    aList :=            ;
  78. {                    ;
  79.   "Record 1" + TAB + "Column 2" + TAB + "Column 3" + TAB + "Column 4",;
  80.   "Record 2" + TAB + "a ListBox" + TAB + "with columns" + TAB + "for you",;
  81.   "Record 3" + TAB + "      " + TAB + "     " + TAB + "     ",;
  82.   "Record 4" + TAB + "      " + TAB + "     " + TAB + "     ",;
  83.   "Record 5" + TAB + "      " + TAB + "     " + TAB + "     ",;
  84.   "Record 6" + TAB + "A"      + TAB + "Simple" + TAB + "Browser!",;
  85.   "Record 7" + TAB + "      " + TAB + "     " + TAB + "     ",;
  86.   "Record 8" + TAB + "      " + TAB + "     " + TAB + "     ",;
  87.   "Record 9" + TAB + "      " + TAB + "     " + TAB + "     ",;
  88.   "Record 10" + TAB + "      " + TAB + "     " + TAB + "     ",;
  89.   "Record 11" + TAB + "      " + TAB + "     " + TAB + "     " ;
  90. }
  91. local    aTabs := {0, 50, 100, 150}    // the columns
  92. if hLBox != nil
  93.     DestroyWindow(hLBox)
  94. endif
  95. hLBox = CreateWindow("listbox",        ;    // window class
  96.             "title",         ;    // caption for title bar
  97. ;// LBS_STANDARD would sort the items, as it includes LBS_SORT (see windows.ch)
  98. ;// LBS_NOTIFY means the parent is sent LBN_* messages as things happen
  99. ;// (a more complex version of this function would SKIP in a database and
  100. ;//  alter the listbox contents)
  101.             LBS_USETABSTOPS + LBS_NOTIFY ;//
  102.             + WS_VSCROLL + WS_BORDER    ;//
  103.             + WS_CHILD + WS_VISIBLE,;    // window style
  104.             20,            ;    // x co-ordinate
  105.             20,            ;    // y co-ordinate
  106.             500,        ;    // width
  107.             150,        ;    // height
  108.             hWnd,        ;    // hWnd of parent
  109.             ID_LBOX,        ;    // id for child control to use
  110.             hInst)            // our own app instance
  111.  
  112. // set up the tab stops (note: len(aTabs) == 3, so the last param is "int[3]")
  113. SendMessage(hLBox, LB_SETTABSTOPS, len(aTabs), a2bin(aTabs, "int[" + str(len(aTabs)) + "]"))
  114.  
  115. // it's faster to fill with re-drawing turned off
  116. SendMessage(hLBox, WM_SETREDRAW, 0, 0)
  117. aeval(aList, {|cStr| SendMessage(hLBox, LB_ADDSTRING, 0, cStr)} )
  118.  
  119. #define    LBLINE    5
  120. SendMessage(hLBox, LB_SETCURSEL, LBLINE, 0)    // select the interesting one
  121. cText = LBGetText(hLBox, LBLINE)        // fetch the line
  122. SetFocus(hLBox)
  123.  
  124. // now set redrawing on, and force a redraw
  125. SendMessage(hLBox, WM_SETREDRAW, 1, 0)
  126. InvalidateRect(hLBox)
  127.  
  128. bEvent = {|nEvent| LBoxEvent(nEvent)}
  129. return
  130.  
  131.  
  132. procedure LBoxEvent(nEvent)
  133. local    i
  134. do case
  135. case nEvent == EVENT_CONTROL
  136.     if _lastwParam() == ID_LBOX    // child id
  137.         if _lastHilParam() == LBN_SELCHANGE
  138.             // the user changed the selected item
  139.             i = SendMessage(hLBox, LB_GETCURSEL, 0, 0)
  140.             cText = LBGetText(hLBox, i)
  141. //            MessageBox( , nstr(i) + cText, "LBGetText", MB_OK)
  142.             InvalidateRect(hWnd)    // send ourself a redraw event
  143.         endif
  144.     endif
  145. case nEvent == EVENT_REDRAW
  146.     SetPos(13, 1)
  147.     ? "Text chosen:" ; ? ; ? strtran(cText, TAB, "   ")
  148. endcase
  149. return
  150.  
  151.  
  152. // This one is modal
  153. procedure DoLBoxDlog()
  154. local    aDlg, aChoices := {"List Box", "Sorted automatically", "A standard"}
  155. if hLBox != nil
  156.     DestroyWindow(hLBox)
  157.     hLBox = nil
  158. endif
  159. aDlg = CreateDialog("Sample Dialog",                    ;
  160.             WS_CAPTION + WS_SYSMENU + WS_GROUP + WS_TABSTOP    ;
  161.             + WS_THICKFRAME + WS_VISIBLE + WS_POPUP,        ;
  162.             100, 30, 100, 100)
  163. aDlg = AppendDialog(aDlg, "ok", DLG_BUTTON,                ;
  164.             BS_DEFPUSHBUTTON + WS_TABSTOP + WS_CHILD + WS_VISIBLE,  ;
  165.             10, 75, 35, 15,                    ;
  166.             "&Ok")
  167. aDlg = AppendDialog(aDlg, "cancel", DLG_BUTTON,                ;
  168.             BS_PUSHBUTTON + WS_TABSTOP + WS_CHILD + WS_VISIBLE,    ;
  169.             55, 75, 35, 15,                    ;
  170.             "&Cancel")
  171. aDlg = AppendDialog(aDlg, "listbox", DLG_LISTBOX,            ;
  172.             LBS_STANDARD + WS_CHILD + WS_VISIBLE,        ;
  173.             10, 10, 80, 60,                    ;
  174.             aChoices)
  175.  
  176. if ModalDialog(aDlg, hInst, hWnd) = 0 .or. GetDialogResult(aDlg, "cancel") = .T.
  177.     cText = "<cancelled>"
  178. else
  179.     cText = GetDialogResult(aDlg, "listbox")
  180. endif
  181. bEvent = {|nEvent| LBoxDlogEvent(nEvent)}
  182. InvalidateRect(hWnd)            // send ourself a redraw event
  183. return
  184.  
  185.  
  186. procedure LBoxDlogEvent(nEvent)
  187. do case
  188. case nEvent == EVENT_REDRAW
  189.     SetPos(10, 15)
  190.     if cText == nil
  191.         ? "No text chosen"
  192.     else
  193.         ? "Text chosen:" ; ? ; ? cText
  194.     endif
  195. endcase
  196. return
  197.  
  198.  
  199. function nstr(n)
  200. return alltrim(str(n)) + " "
  201.  
  202.  
  203. #endif // !LIB_ONLY
  204.  
  205.  
  206. /////////
  207. //
  208. //    LBAddString( <hLBox>, <cNewStr> )  -->  nLine
  209. //
  210. //    Add a new string to a list box
  211. //
  212. //    Returns the position of the string added, or LB_ERR if an
  213. //    error occurs (but LB_ERRSPACE if not enough room)
  214. //
  215. /////////
  216.  
  217. function LBAddString(hLBox, cNewStr)
  218. return SendMessage(hLBox, LB_ADDSTRING, 0, cNewStr)
  219.  
  220.  
  221. /////////
  222. //
  223. //    LBDeleteString( <hLBox>, <nLine> )  -->  nCount
  224. //
  225. //    Deletes a string from a list box.
  226. //    <nLine> is the position of the string to delete
  227. //
  228. //    Returns the the number of strings left, or LB_ERR if an
  229. //    error occurs
  230. //
  231. /////////
  232.  
  233. function LBDeleteString(hLBox, nLine)
  234. return SendMessage(hLBox, LB_DELETESTRING, nLine, 0)
  235.  
  236.  
  237. /////////
  238. //
  239. //    LBDir( <hLBox>, <nAttr>, <cFileSpec> )  -->  nLine
  240. //
  241. //    Add a list of filenames to a list box
  242. //
  243. //    Returns the position of the last filename added, or LB_ERR if an
  244. //    error occurs (but LB_ERRSPACE if not enough room)
  245. //
  246. /////////
  247.  
  248. function LBDir(hLBox, nAttr, cFileSpec)
  249. return SendMessage(hLBox, LB_DIR, nAttr, cFileSpec)
  250.  
  251.  
  252. /////////
  253. //
  254. //    LBFindString( <hLBox>, <cStr>, [ <nStart> ] )  -->  nLine
  255. //
  256. //    Find a string in a list box.
  257. //    <nStart> optionally specifies the start of the search
  258. //
  259. //    Returns the position of the string found, or LB_ERR if not found
  260. //
  261. //    See Also: LBFindStrExact()
  262. //
  263. /////////
  264.  
  265. function LBFindString(hLBox, cStr, nStart)
  266. if nStart == nil
  267.     nStart = -1            // search from the start
  268. endif
  269. return SendMessage(hLBox, LB_FINDSTRING, nStart, cStr)
  270.  
  271.  
  272. /////////
  273. //
  274. //    LBFindStrExact( <hLBox>, <cStr>, [ <nStart> ] )  -->  nLine
  275. //
  276. //    Find a string in a list box.
  277. //    <nStart> optionally specifies the start of the search
  278. //
  279. //    Returns the position of the string found, or LB_ERR if not found
  280. //
  281. //    See Also: LBFindString()
  282. //
  283. /////////
  284.  
  285. function LBFindStrExact(hLBox, cStr, nStart)
  286. if nStart == nil
  287.     nStart = -1            // search from the start
  288. endif
  289. return SendMessage(hLBox, LB_FINDSTRINGEXACT, nStart, cStr)
  290.  
  291.  
  292. /////////
  293. //
  294. //    LBGetCount( <hLBox> )  -->  nCount
  295. //
  296. //    Returns the number of items in a list box
  297. //
  298. /////////
  299.  
  300. function LBGetCount(hLBox)
  301. return SendMessage(hLBox, LB_GETCOUNT, 0, 0)
  302.  
  303.  
  304. /////////
  305. //
  306. //    LBGetCurSel( <hLBox> )  -->  nLine
  307. //
  308. //    Returns the position of the currently selected item in a list box
  309. //    (or LB_ERR if nothing is selected)
  310. //
  311. /////////
  312.  
  313. function LBGetCurSel(hLBox)
  314. return SendMessage(hLBox, LB_GETCURSEL, 0, 0)
  315.  
  316.  
  317. /////////
  318. //
  319. //    LBGetItemRect( <hLBox>, <nLine> )  -->  aRect
  320. //
  321. //    Returns the client co-ordinates of the rectangle that bounds
  322. //    an item as it is currently displayed in a list box, in
  323. //    the form {left, top, right, bottom}
  324. //
  325. /////////
  326.  
  327. function LBGetItemRect(hLBox, nLine)
  328. local    cRect := space(8)        // room for int[4]
  329. SendMessage(hLBox, LB_GETITEMRECT, nLine, @cRect)
  330. return bin2a(cRect, "int[4]")
  331.  
  332.  
  333. /////////
  334. //
  335. //    LBGetSel( <hLBox>, <nLine> )  -->  nRet
  336. //
  337. //    Returns the selection status of an item in a list box
  338. //    (0 if not selected, > 0 if selected, LB_ERR if an error occurs)
  339. //
  340. /////////
  341.  
  342. function LBGetSel(hLBox, nLine)
  343. return SendMessage(hLBox, LB_GETSEL, nLine, 0)
  344.  
  345.  
  346. /////////
  347. //
  348. //    LBGetSelCount( <hLBox> )  -->  nCount
  349. //
  350. //    Returns the number of selected items in a multiple selection list box
  351. //
  352. /////////
  353.  
  354. function LBGetSelCount(hLBox)
  355. return SendMessage(hLBox, LB_GETSELCOUNT, 0, 0)
  356.  
  357.  
  358. /////////
  359. //
  360. //    LBGetSelItems( <hLBox> )  -->  aPositions
  361. //
  362. //    Returns the positions of selected items in a multiple selection list box
  363. //
  364. /////////
  365.  
  366. function LBGetSelItems(hLBox)
  367. local    n := SendMessage(hLBox, LB_GETSELCOUNT, 0, 0)
  368. local    cBuf := space(n * 2)    // space for n integers
  369. SendMessage(hLBox, LB_GETSELITEMS, n, @cBuf)
  370. return bin2a(cBuf, "int[" + str(n) + "]")
  371.  
  372.  
  373. /////////
  374. //
  375. //    LBGetSelLines( <hLBox> )  -->  aItems
  376. //
  377. //    Returns the selected lines in a multiple selection list box
  378. //
  379. /////////
  380.  
  381. function LBGetSelLines(hLBox)
  382. local    i, a := LBGetSelItems(hLBox)
  383. for i = 1 to len(a)
  384.     a[i] = LBGetText(hLBox, a[i])
  385. next i
  386. return a
  387.  
  388.  
  389. /////////
  390. //
  391. //    LBGetText( <hLBox>, <nLine> )  -->  cLine or nil
  392. //
  393. //    Returns the specified line from within a list box
  394. //    (<nLine> starts at 0)
  395. //
  396. /////////
  397.  
  398. function LBGetText(hLBox, nLine)
  399. local    nLen, cBuf := space(SendMessage(hLBox, LB_GETTEXTLEN, nLine, 0) + 1)
  400. nLen = SendMessage(hLBox, LB_GETTEXT, nLine, @cBuf)
  401. return iif(nLen == LB_ERR, nil, left(cBuf, nLen))
  402.  
  403.  
  404. /////////
  405. //
  406. //    LBGetTextLen( <hLBox>, <nLine> )  -->  nLen
  407. //
  408. //    Returns the length of a line in a list box
  409. //
  410. //    <nLine> counts from zero.
  411. //
  412. /////////
  413.  
  414. function LBGetTextLen(hLBox, nLine)
  415. return SendMessage(hLBox, LB_GETTEXTLEN, nLine, 0)
  416.  
  417.  
  418. /////////
  419. //
  420. //    LBInsertString( <hLBox>, <cNewStr>, <nLine> )  -->  nLen
  421. //
  422. //    Insert a new string in a list box
  423. //
  424. //    Returns the length of the string added, or LB_ERR if an
  425. //    error occurs (but LB_ERRSPACE if not enough room)
  426. //
  427. /////////
  428.  
  429. function LBInsertString(hLBox, cNewStr, nLine)
  430. return SendMessage(hLBox, LB_INSERTSTRING, nLine, cNewStr)
  431.  
  432.  
  433. /////////
  434. //
  435. //    LBResetContent( <hLBox> )  -->  nil
  436. //
  437. //    Empty a list box
  438. //
  439. /////////
  440.  
  441. procedure LBResetContent(hLBox)
  442. SendMessage(hLBox, LB_RESETCONTENT, 0, 0)
  443. return
  444.  
  445.  
  446. /////////
  447. //
  448. //    LBSelectString( <hLBox>, <cStr>, [ <nStart> ] )  -->  nLine
  449. //
  450. //    Find a string in a list box, and (if found) select it
  451. //    <nStart> optionally specifies the start of the search
  452. //
  453. //    Returns the position of the string found, or LB_ERR if not found
  454. //
  455. /////////
  456.  
  457. function LBSelectString(hLBox, cStr, nStart)
  458. if nStart == nil
  459.     nStart = -1            // search from the start
  460. endif
  461. return SendMessage(hLBox, LB_SELECTSTRING, nStart, cStr)
  462.  
  463.  
  464. /////////
  465. //
  466. //    LBSetCurSel( <hLBox>, <nLine> )  -->  nRet
  467. //
  468. //    Sets the position of the currently selected item in a list box
  469. //
  470. //    <nLine> can be -1 to remove any selection
  471. //
  472. //    Returns <nLine> (or LB_ERR if <nLine> is too big or -1)
  473. //
  474. /////////
  475.  
  476. function LBSetCurSel(hLBox, nLine)
  477. return SendMessage(hLBox, LB_SETCURSEL, nLine, 0)
  478.  
  479.  
  480. /////////
  481. //
  482. //    LBSetSel( <hLBox>, <nLine>, <lSelect> )  -->  nRet
  483. //
  484. //    Sets whether a string is selected in a multiple-selection list box
  485. //
  486. //    Special values:
  487. //
  488. //        nLine = -1        all strings are selected/unselected
  489. //                    (according to lSelect)
  490. //
  491. //    Returns <nLine> (or LB_ERR if <nLine> is invalid)
  492. //
  493. /////////
  494.  
  495. function LBSetSel(hLBox, nLine, lSelect)
  496. return SendMessage(hLBox, LB_SETSEL, iif(lSelect,1,0), MAKELPARAM(nLine, 0))
  497.  
  498.  
  499. /////////
  500. //
  501. //    LBSetTabStops( <hLBox>, <aTabs> )  -->  lSuccess
  502. //
  503. //    Sets the tab-stop positions in a list box
  504. //
  505. /////////
  506.  
  507. function LBSetTabStops(hLBox, aTabs)
  508. local    nLen, cTabs := ""
  509. if aTabs == nil
  510.     cTabs := nLen := 0        // Windows default is 2 dialog units
  511. else
  512.     nLen = len(aTabs)
  513.     aeval(aTabs, {|n| cTabs += i2bin(n)})
  514. endif
  515. return SendMessage(hLBox, LB_SETTABSTOPS, nLen, cTabs) != 0
  516.  
  517.  
  518. #ifndef    LIB_ONLY
  519.  
  520.  
  521. function MenuSetup()
  522. local    hWnd := SelectWindow(), hMenu, hPopupMenu
  523.  
  524. if (hMenu := GetMenu(hWnd)) != nil
  525.     DestroyMenu(hMenu)
  526. endif
  527.  
  528. // do new one (forget old value)
  529. hMenu = CreateMenu()
  530. hPopupMenu = CreatePopupMenu()
  531. AppendMenu(hMenu, "file", MF_ENABLED + MF_POPUP, "&File", hPopupMenu)
  532. AppendMenu(hPopupMenu, "exit", MF_ENABLED + MF_STRING, "E&xit", {|| Alert("Thanks for running this demo"), DoExit()})
  533. hPopupMenu = CreatePopupMenu()
  534. AppendMenu(hMenu, "demo", MF_ENABLED + MF_POPUP, "&Demo", hPopupMenu)
  535. AppendMenu(hPopupMenu, "list1", MF_ENABLED + MF_STRING, "&Dialog", {|c| DoLBoxDlog()})
  536. AppendMenu(hPopupMenu, "list2", MF_ENABLED + MF_STRING, "&Listbox", {|c| DoLBox()})
  537. hPopupMenu = CreatePopupMenu()
  538. AppendMenu(hMenu, "help", MF_ENABLED + MF_POPUP, "&Help", hPopupMenu)
  539. AppendMenu(hPopupMenu, "about", MF_ENABLED + MF_STRING, "&About", {|| DoAbout()})
  540. SetMenu(hWnd, hMenu)
  541.  
  542. return hMenu
  543.  
  544.  
  545. #endif // !LIB_ONLY
  546.  
  547.