home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
code
/
various
/
listsr
/
listbas.txt
next >
Wrap
Text File
|
1995-02-26
|
9KB
|
259 lines
'=======================================================================
' This module provides event handling and general routines for the
' LISTSRCH.FRM dialog.
'
' Author: Barth Riley
'==========================================================================
Option Explicit
'--Key Code Constants
Const KEY_BACK = &H8
Const KEY_DELETE = &H2E
Const KEY_CLEAR = &HC
'---Focus constants
Const TEXTBOX_FOCUS = 1 ' currently in text box
Const LISTBOX_FOCUS = 2 ' currently in list box
'---module level variables
Dim miCtrlFocus As Integer ' which control (textbox/listbox) has focus
Dim miNumKeys As Integer ' number of keys pressed by user
Dim mfScrolling As Integer ' True if textbox triggers listbox scroll.
Dim mfKeepKey As Integer ' False if user hit delete/backspace
Sub CursorArrow ()
Screen.MousePointer = 1
End Sub
Sub CursorWait ()
Screen.MousePointer = 11
End Sub
Sub LISTSRCH_Activate ()
MsgBox "Try typing: " & Chr(34) & "Windows 3.11 for Workgroups" & Chr(34), 64
frmListSearch.txtSearch.SetFocus
End Sub
Sub LISTSRCH_cmdClose_Click ()
Unload frmListSearch
End
End Sub
Sub LISTSRCH_Load ()
'---Start of Code
CursorWait
frmListSearch.lstSearch.AddItem "Windows"
frmListSearch.lstSearch.AddItem "Windows 3.1"
frmListSearch.lstSearch.AddItem "Windows 3.0"
frmListSearch.lstSearch.AddItem "Windows 3.1 API"
frmListSearch.lstSearch.AddItem "Winows Program Manager"
frmListSearch.lstSearch.AddItem "Windows File Manager"
frmListSearch.lstSearch.AddItem "Windows File Manager API"
frmListSearch.lstSearch.AddItem "VB"
frmListSearch.lstSearch.AddItem "VB Programmers Journal"
frmListSearch.lstSearch.AddItem "VB 1.0"
frmListSearch.lstSearch.AddItem "VB 2.0"
frmListSearch.lstSearch.AddItem "VB 3.0"
frmListSearch.lstSearch.AddItem "VB 3.0 Professional"
frmListSearch.lstSearch.AddItem "VBX's"
frmListSearch.lstSearch.AddItem "VB for Applications"
frmListSearch.lstSearch.AddItem "VB for DOS"
frmListSearch.lstSearch.AddItem "VBAssist"
frmListSearch.lstSearch.AddItem "VBA"
frmListSearch.lstSearch.AddItem "Windows 3.11 for Workgroups"
frmListSearch.lstSearch.AddItem "Windows 3.11"
miNumKeys = 0
CursorArrow
'---End of Code
End Sub
Sub LISTSRCH_lstSearch_Click (lstSearch As ListBox, txtSearch As TextBox)
'==========================================================
' This routine updates the contents of the txtSearch
' text box w. the current list item only if the list box
' has the focus and the current list index > 0.
'============================================================
'---Variable declarations
Dim szListText As String
Dim iListIndex As Integer
'---Start of Code
On Error Resume Next
If lstSearch.ListIndex >= 0 And miCtrlFocus = LISTBOX_FOCUS Then
' user has clicked on the liat box
iListIndex = lstSearch.ListIndex
szListText = lstSearch.List(iListIndex)
txtSearch.Text = szListText
End If
End Sub
Sub LISTSRCH_lstSearch_KeyDown ()
'=================================================
' KeyDown event handler for the list box. Set
' variables to indicate that the user has "cliked"
' on the list box
'====================================================
miCtrlFocus = LISTBOX_FOCUS
miNumKeys = 0
End Sub
Sub LISTSRCH_lstSearch_MouseDown ()
'=================================================
' MouseDown event handler for the list box. Sets
' variables to indciate that the user has clicked
' on the list box and now has the focus. This is
' necessary since setting the Selected property of the
' list, as well as clicking on the list box, generates
' a Click event.
'====================================================
miCtrlFocus = LISTBOX_FOCUS
miNumKeys = 0
End Sub
Sub LISTSRCH_txtSearch_Change (lstSearch As ListBox, txtSearch As TextBox)
'=====================================================
' If a new character has been typed into the text box,
' this procedure searches the list box for an item
' matching the contents of txtSearch. If found, the
' item in the list is selected and the portion of the
' text NOT typed by the user is highlighted in the
' text box. Note that mfScrolling is used to prevent
' re-entry into this event handler.
'=====================================================
'---Variable declaration
Dim szSrchText As String ' contents of text box
Dim iTxtLen As Integer ' length of search string
Dim iListIndex As Integer ' set by SearchListBox
Dim fReturn As Integer ' ret. from SearchListBox
'---Start of Code
On Error Resume Next
If miCtrlFocus = TEXTBOX_FOCUS And mfKeepKey And Not mfScrolling Then
iTxtLen = Len(txtSearch.Text)
If iTxtLen Then
miNumKeys = IIf(miNumKeys < iTxtLen, miNumKeys, iTxtLen)
szSrchText = txtSearch.Text
fReturn = SearchListBox(szSrchText, lstSearch, iListIndex)
mfScrolling = True
If iListIndex = -1 Then
lstSearch.ListIndex = -1
Else
' perfect match was found
lstSearch.Selected(iListIndex) = True
txtSearch = lstSearch.List(lstSearch.ListIndex)
txtSearch.SelStart = miNumKeys
txtSearch.SelLength = (Len(txtSearch.Text) - miNumKeys)
End If
mfScrolling = False
End If
End If
End Sub
Sub LISTSRCH_txtSearch_GotFocus ()
miNumKeys = 0
frmListSearch.txtSearch.SelStart = 0
frmListSearch.txtSearch.SelLength = Len(frmListSearch.txtSearch.Text)
End Sub
Sub LISTSRCH_txtSearch_KeyDown (ByVal KeyCode As Integer)
'=====================================================
' Determines if a valid (printable) character has been
' pressed. If the character is printable, the
' the txtSearch_Change event handler will search
' the list box for a matching item.
'=======================================================
If KeyCode = KEY_BACK Or KeyCode = KEY_DELETE Or KeyCode = KEY_CLEAR Then
mfKeepKey = False
If KeyCode = KEY_BACK Then
' unhilight current item; next search
' will start at top of list
frmListSearch.lstSearch.ListIndex = -1
End If
Else
mfKeepKey = True
End If
End Sub
Sub LISTSRCH_txtSearch_KeyPress (KeyAscii As Integer)
'===============================================================
' Keeps track of number of keys pressed
'===============================================================
miCtrlFocus = TEXTBOX_FOCUS
If mfKeepKey Then
miNumKeys = Len(frmListSearch.txtSearch.Text) + 1
End If
End Sub
Function SearchListBox (ByVal szSearchText As String, lbScroll As ListBox, iListIndex As Integer) As Integer
'=======================================================
' Simple function to create a scrolling list box.
' The procedure will select the first item in the list
' box in which Left(List box text,size of search string)
' matches the search string.
'==========================================================
'---Constants (returned from StrComp)
Const FOUND = 0
Const LT = -1
Const GT = 1
'---Variable declarations
Dim iListStart As Integer ' starting point in list
Dim iListCount As Integer ' no. of items in list box
Dim iTxtLen As Integer
Dim szListText As String ' current list item
Dim vCompResult ' result of string comp function
Dim fFound As Integer ' match found?
Dim fDone As Integer ' Terminates search if true
'---Start of Code
fFound = False
iTxtLen = Len(szSearchText)
If iTxtLen > 0 And lbScroll.ListCount > 0 Then
iListStart = lbScroll.ListIndex
If iListStart = -1 Then iListStart = 0
iListIndex = iListStart
iListCount = lbScroll.ListCount
szListText = Left(lbScroll.List(iListStart), iTxtLen)
' check to see if current item matches
fFound = CInt(StrComp(szSearchText, szListText, 1))
If fFound <> FOUND Then
fDone = False
If (fFound = LT) Then
iListIndex = 0
fFound = False
Else
iListIndex = iListIndex + 1
End If
Do While (iListIndex <= iListCount) And Not fDone
szListText = Left(lbScroll.List(iListIndex), iTxtLen)
vCompResult = StrComp(szSearchText, szListText, 1)
If IsNull(vCompResult) Then
iListIndex = -1
Exit Do
End If
fFound = (CInt(vCompResult) = FOUND)
fDone = fFound Or (CInt(vCompResult) = -1)
If Not fDone Then
iListIndex = iListIndex + 1
End If
Loop
If Not fFound Then
iListIndex = -1
End If
End If
End If
SearchListBox = fFound
End Function' ScrollListBox