//***************************************************************************** //*** cList.pkg *** //*** *** //*** Author: Ben Weijers *** //*** Data Access Europe *** //*** August 2001 *** //*** *** //*** Purpose: *** //*** An implementation of the Windows ListBox class for VDF. See the *** //*** Windows documentation for more information of the ListBox class. *** //*** *** //*** You will notice some special handling for horizontal scrollbar *** //*** support. If a scrollbar appears depends on the setting of *** //*** HORIZONTALEXTENT. If the horizontal extent is wider then the width *** //*** of the list itself, a horizontal scrollbar will appear, if it is *** //*** set to 0 (szero) no horizontal scrollbar appears. To fuly support *** //*** horizontal scrollbars we need to do special things when adding or *** //*** deleting items from the list. Messages that do this have special *** //*** code for horizontal scrollbar support. Messages that have this *** //*** support are: AddItem, DeleteItem and ResetContent. *** //*** *** //*** Public Interface: *** //*** Properties: *** //*** piCurrent_Item - The number of the curent item. *** //*** piItemData - Extra data that can be stored for each item. The *** //*** extra data is an 32 bit integer value. *** //*** psItemText - The text of a given item. *** //*** pbSorted - Inidicates if the list must be sorted. The ListBox*** //*** style LBS_SORT is used to implement this. This *** //*** will ensure items are sorted as they are inserted *** //*** in the list. *** //*** pbMultiSelect - Indicates that the list should support multi *** //*** select. This supports all standard ways of multi *** //*** selecting in Windows including ranges (which is *** //*** not really supported by the VDF list class). *** //*** pbSelectState - The select state of a given item. *** //*** *** //*** Messages: *** //*** AddItem - Procedure that adds an item to the list. *** //*** DeleteItem - Procedure that deletes on specified item. *** //*** FindText - Function hat returns the item number of the item *** //*** beginning with a specified text. *** //*** FindExactText - Function hat returns the item number of the item *** //*** exactly matching a specified text. *** //*** ItemCount - Funtion that returns the total number of items in *** //*** the list. *** //*** ResetContent - Procedure that deletes all data from the list. *** //*** SelectCount - Function that returns the number of selected items*** //*** in the list. *** //*** SelectRange - Procedure that selects a range of items in the *** //*** list. *** //*** *** //*** Private interface: *** //*** Messages: *** //*** AdjustHorizontalScrollExtent - Make sure horizintal scrollbar*** //*** is set to correct width when *** //*** adding or deleting an item. *** //*** DetermineHorizontalScrollExtent - Set horizontal scrollbar to *** //*** accomodate largest string *** //*** currently in list. *** //*** Page - The procedure page has been *** //*** augmented to enforce the *** //*** desired Windows styles. *** //***************************************************************************** Use cWinControl.pkg // replaces obsolete dfcontrol class //*** Define return values Define LB_OKAY For 0 Define LB_ERR For (-1) Define LB_ERRSPACE For (-2) //*** Define functions that are references before actual declaration Register_Function ItemCount Returns Integer Class cList Is A cWinControl Procedure Construct_object Forward Send Construct_Object Set External_Class_Name "dfclist" To "listbox" Set External_Message WM_COMMAND To MSG_Command Property Integer pbSorted True Property Integer pbMultiSelect False End_Procedure // Construct_object //************************************************************************* //*** Property defintions *** //*** A property is nothing more then memory, a way to store it and a *** //*** way to retrive it (set and get). We define some properties here *** //*** rather then by using the property command since we let Windows *** //*** handle the memory management. We only need to create a way to *** //*** set and get the memory. *** //************************************************************************* //*** //*** Property: piCurrentItem //*** Purpose : The number of the current item. //*** Procedure Set piCurrentItem Integer iNewItem If (ItemCount(Self) > iNewItem) Begin If (pbMultiSelect(Self)) ; Function_return (SendMessage(Window_Handle(Self), LB_SETCARETINDEX, iNewItem, 0)) Else ; Function_return (SendMessage(Window_Handle(Self), LB_SETCURSEL, iNewItem, 0)) End End_Procedure // Set piCurrentItem Function piCurrentItem Returns Integer If (pbMultiSelect(Self)) ; Function_return (SendMessage(Window_Handle(Self), LB_GETCARETINDEX, 0, 0)) Else ; Function_return (SendMessage(Window_Handle(Self), LB_GETCURSEL, 0, 0)) End_Function // piCurrentItem //*** //*** Property: piItemData //*** Purpose : The item data. Every item can store a 32 bit integer extra //*** data element. You can set and get this element by using //*** this property. When adding item through the AddItem //*** message, the piItemData setting of the new item is passed //*** as an argument. //*** //*** Arguments: //*** iIndex - The index number of the item. Item numbers start at 0 //*** (zero). //*** Procedure Set piItemdata Integer iIndex Integer iExtraData Integer iVoid If (ItemCount(Self) > iIndex) ; Move (SendMessage(Window_Handle(Self), LB_SETITEMDATA, iIndex, iExtraData)) To iVoid End_Procedure // Set piItemData Function piItemData Integer iIndex Returns Integer If (ItemCount(Self) > iIndex) ; Function_Return (SendMessage(Window_Handle(Self), LB_GETITEMDATA, iIndex, 0)) End_Function // ItemData //*** //*** Property: psItemText //*** Purpose : The value of an item. No messasge is defined in the ListBox //*** to set this value so we delete and add an item. If the list //*** is sorted we use delete and add, if the list is not sorted //*** we use delete and insert. //*** //*** Arguments: //*** iItemNUmber - The index number of the item. Item numbers start at 0 //*** (zero). //*** Procedure Set psItemText Integer iItemNumber String sNewValue Integer iExtraData Integer bSorted Integer iVoid If (ItemCount(Self) > iItemNumber) Begin //*** Make sure we keep the extra data for the item Get piItemData iItemNumber To iExtraData Send DeleteItem iItemNumber Get pbSorted To bSorted If (bSorted) ; Send AddItem iExtraData sNewValue Else Begin If (Ascii(Right(sNewValue, 1)) <> 0) ; Move (Append(sNewValue, Character(0))) To sNewValue Move (SendMessage(Window_Handle(Self), LB_INSERTSTRING, iItemNUmber, AddressOf(sNewValue))) To iItemNumber If (iItemNUmber >= 0) ; Move (SendMessage(Window_Handle(Self), LB_SETITEMDATA, iItemNUmber, iExtraData)) To iVoid //*** Adjust the horizontal extent Send AdjustHorizontalScrollExtent True sNewValue End End End_Procedure // Set psItemText Function psItemText Integer iItemNumber Returns String String sValue Integer iVoid Move "" To sValue If (ItemCount(Self) > iItemNumber) Begin Move (Repeat(Character(0), SendMessage(Window_Handle(Self), LB_GETTEXTLEN, iItemNumber, 0) + 1)) To sValue Move (SendMessage(Window_Handle(Self), LB_GETTEXT, iItemNumber, AddressOf(sValue))) To iVoid End Function_Return (CString(sValue)) End_Function // psItemText //*** //*** Property: pbSelectState //*** Purpose : is a given item selected or not. //*** //*** Arguments: //*** iIndex - The index number of the item. Item numbers start at 0 //*** (zero). //*** Procedure Set pbSelectState Integer iIndex Integer bNewState Integer iVoid If (ItemCount(Self) > iIndex) ; Move (SendMessage(Window_Handle(Self), LB_SETSEL, bNewState, iIndex)) To iVoid End_Procedure // Set pbSelectState Function pbSelectState Integer iIndex Returns Integer If (ItemCount(Self) > iIndex) ; Function_return (SendMessage(Window_Handle(Self), LB_GETSEL, iIndex, 0)) End_Function // pbSelectState //************************************************************************** //*** Public Interface *** //************************************************************************** //*** //*** Procedure: Additem //*** Purpose : Add an item to the list. //*** //*** In a listbox extra data per item (32 bits integer) can be //*** stored. We use the first argument to pass this extra //*** information. Since by default we have the LBS_SORT style //*** switched on the item number of the item that is added, //*** will not be the last item as it is in the DataFlex list //*** class. You can get at the extra data by using the piItemData //*** property. //*** //*** Arguments: //*** iExtraData - The extra data property of the new item. //*** sValue - The text used for the new item. //*** Procedure AddItem Integer iExtraData String sValue Integer iIndex If (Ascii(Right(sValue, 1)) <> 0) ; Move (Append(sValue, Character(0))) To sValue Move (SendMessage(Window_Handle(Self), LB_ADDSTRING, 0, AddressOf(sValue))) To iIndex Set piItemData iIndex To iExtraData Send AdjustHorizontalScrollExtent True sValue End_Procedure // AddItem //*** //*** Procedure: DeleteItem //*** Purpose : Delete an item from the list. //*** //*** Arguments: //*** iIndex - The index number of the item. Item numbers start at 0 //*** (zero). //*** Procedure DeleteItem Integer iIndex String sValue Integer iRemainingItems Integer iVoid If (ItemCount(Self) > iIndex) Begin Get psItemtext iIndex To sValue Move (SendMessage(Window_Handle(Self), LB_DELETESTRING, iIndex, 0)) To iRemainingItems If (iRemainingItems = 0) ; Move (SendMessage(Window_Handle(Self), LB_SETHORIZONTALEXTENT, 0, 0)) To iVoid Else ; Send AdjustHorizontalScrollExtent False sValue End End_Procedure // DeleteItem //*** //*** Function: FindText //*** Purpose : Find the item that begins with the specified text. The //*** search is case independent you can mix lower and uppercase. //*** //*** Arguments: //*** iStartItem - The item from wich to start looking. The find logic //*** will wrap when the end of the list is reached and //*** search until iStartItem is reached. If iStartItem is //*** -1 the entire lsit will be searched. //*** sText - The string for which to search. //*** //*** Returns: //*** LB_ERR - Search string not found. //*** 0 .. - The item number of the item that begins with the search //*** string. //*** Function FindText Integer iStartItem String sText Returns Integer Integer iFoundItem If (Ascii(Right(sText, 1)) <> 0) ; Move (Append(sText, Character(0))) To sText Move (SendMessage(Window_Handle(Self), LB_FINDSTRING, iStartItem, AddressOf(sText))) To iFoundItem Function_Return iFoundItem End_Function // FindText //*** //*** Function: FindExactText //*** Purpose : Find the item that matches the specified text exactly. The //*** search is case independent you can mix lower and uppercase. //*** //*** Arguments: //*** iStartItem - The item from wich to start looking. The find logic //*** will wrap when the end of the list is reached and //*** search until iStartItem is reached. If iStartItem is //*** -1 the entire lsit will be searched. //*** sText - The string for which to search. //*** //*** Returns: //*** LB_ERR - Search string not found. //*** 0 .. - The item number of the item that begins with the search //*** string. //*** Function FindExactText Integer iStartItem String sText Returns Integer Integer iFoundItem If (Ascii(Right(sText, 1)) <> 0) ; Move (Append(sText, Character(0))) To sText Move (SendMessage(Window_Handle(Self), LB_FINDSTRINGEXACT, iStartItem, AddressOf(sText))) To iFoundItem Function_Return iFoundItem End_Function // FindExactText //*** //*** Function: ItemCount //*** Purpsoe : The total number of itmes in the list. //*** Function ItemCount Returns Integer Function_Return (SendMessage(Window_Handle(Self), LB_GETCOUNT, 0, 0)) End_Function // ItemCount //*** //*** Procedure: ResetContent //*** Purpose : Delete all data from the list. Since after this no data //*** will be left in the list we can remove the horizontal //*** scrollbar. //*** //*** Procedure ResetContent Integer iVoid Move (SendMessage(Window_Handle(Self), LB_RESETCONTENT, 0, 0)) To iVoid Move (SendMessage(Window_Handle(Self), LB_SETHORIZONTALEXTENT, 0, 0)) To iVoid End_Procedure // ResetContent // **WvA Procedure SelectAll Integer iItem Integer iCount Get ItemCount To iCount For iItem From 0 To (iCount-1) Set pbSelectState iItem To True Loop End_Procedure // SelectAll // **WvA Procedure ResetAll Integer iItem Integer iCount Get ItemCount To iCount For iItem From 0 To (iCount-1) Set pbSelectState iItem To False Loop End_Procedure // ResetAll //*** //*** Function: SelectCount //*** Purpose : The number of selected items in the list. //*** Function SelectCount Returns Integer Function_Return (SendMessage(Window_Handle(Self), LB_GETSELCOUNT, 0, 0)) End_Function // SelectCount //*** //*** Procedure: SelectRange //*** Purpose : Select or de-select a range of items. //*** //*** Arguments: //*** iStartItem - The first item of the range //*** iEndItem - The last item of the range //*** bNewState - If true the range will be selected, if false the //*** range will be de-selected. //*** Procedure SelectRange Integer iStartItem Integer iEndItem Integer bNewState Integer iVoid If (pbMultiSelect(Self) And iStartItem >= 0 And iEndItem < ItemCount(Self) And iStartItem <= iEndItem) ; Move (SendMessage(Window_Handle(Self), LB_SELITEMRANGE, bNewState, (iEndItem * |CI$10000) + iStartItem)) To iVoid End_Procedure // SelectRange //************************************************************************** //*** Private Interface *** //*** The messages below are considered private. *** //************************************************************************** //*** //*** Procedure: Page //*** Purpose : Enforce the windows styles we need. Two styles can be //*** setup through the pbSorted and pbMultiSelect properties. //*** Furthermore we setup a border, and a horizontal and //*** vertical scrollbar. We also use the same typeface as the //*** parent object does. //*** Procedure Page Integer bMode If (bMode) Begin Set Border_Style To BORDER_CLIENTEDGE Set Window_Style LBS_EXTENDEDSEL To (pbMultiSelect(Self)) Set Window_Style LBS_SORT To (pbSorted(Self)) Set Window_Style WS_HSCROLL To True Set Window_Style WS_VSCROLL To True End Forward Send Page bMode Set TypeFace To (TypeFace(Parent(Self))) End_Procedure // Page //*** //*** Procedure: AdjustHorizontalScrollExtent //*** Purpose : Adjust the horizontal scroll extent for the passed string. //*** The horizontal scroll extenet is used to determine the //*** horizontal scrollbar size. This proxcedure should be //*** called whenever a new text is placed in the list. The //*** procedure will check if the new text requires a new //*** horizontal scroll extent setting. //*** //*** Arguments: //*** bNewText - Is the text a new text added to the list (true) or //*** has the text been removed (false). //*** sValue - The value to adjust for //*** Procedure AdjustHorizontalScrollExtent Integer bNewText String sValue Integer cTextSize Integer iTextWidth Integer iCurrentWidest Integer iVoid Integer cListSize //*** Determine horizontal scroll extent Get Text_Extent sValue To cTextSize Move (Low(cTextSize)) To iTextWidth Move (iTextWidth + GetSystemMetrics(SM_CXVSCROLL)) To iTextWidth Move (SendMessage(Window_Handle(Self), LB_GETHORIZONTALEXTENT, 0, 0)) To iCurrentWidest If (bNewText) Begin //*** Adding a new text, adjust the extent if the new text requires //*** a larger extent then the current If (iCurrentWidest < iTextWidth) Begin //*** If the new widest string is smaller then the width of the //*** list itself, set horizontal extent to 0 (zero) thus removing //*** the horizontal scrollbar. Get GUISize To cListSize If (Low(cListSize) > iTextWidth) ; Move (SendMessage(Window_Handle(Self), LB_SETHORIZONTALEXTENT, 0, 0)) To iVoid Else ; Move (SendMessage(Window_Handle(Self), LB_SETHORIZONTALEXTENT, iTextWidth, 0)) To iVoid End End Else Begin //*** Removing a text, adjust the extent if the removed text //*** happened to be the widest text. The removed text was the //*** widest text if the current extent fits the text. If (iCurrentWidest <> iTextWidth) ; Send DetermineHorizontalScrollExtent End End_Procedure // AdjustHorizontalScrollExtent //*** //*** Procedure: DetermineHorizontalScrollExtent //*** Purpose : Determine the horizontal scroll extent setting. Traverse //*** all items in the list and set the scroll extent so it //*** accomodates the largest text. //*** Procedure DetermineHorizontalScrollExtent String sValue Integer iTextWidth Integer iCurrentWidest Integer iNewWidest Integer iCurIndex Integer cTextSize Integer cListSize Integer iVoid Move 0 To iNewWidest For iCurIndex From 0 To (ItemCount(Self) - 1) Get psItemText iCurIndex To sValue Get Text_Extent sValue To cTextSize Move (Low(cTextSize)) To iTextWidth Move (iTextWidth + GetSystemMetrics(SM_CXVSCROLL) + 4) To iTextWidth If (iTextWidth > iNewWidest) ; Move iTextWidth To iNewWidest Loop //*** If the new widest string is smaller then the width of the //*** list itself, set horizontal extent to 0 (zero) thus removing //*** the horizontal scrollbar. Get GUISize To cListSize If (Low(cListSize) > iNewWidest) ; Move (SendMessage(Window_Handle(Self), LB_SETHORIZONTALEXTENT, 0, 0)) To iVoid Else ; Move (SendMessage(Window_Handle(Self), LB_SETHORIZONTALEXTENT, iNewWidest, 0)) To iVoid End_Procedure // DetermineHorizontalScrollExtent End_class // cList