Attribute VB_Name = "modListBox"
Option Explicit
Public Function GetArrayData(tmpArray As Variant, InputCode As String, DataIndex As Integer) As String
Dim intX As Integer
For intX = 0 To UBound(tmpArray, 2)
If UCase(tmpArray(1, intX)) = UCase(InputCode) Then
GetArrayData = cuStr(tmpArray(DataIndex, intX))
Exit Function
End If
Next
GetArrayData = Empty
End Function
Public Sub ListBoxKeyDown(tmpListBox As ListBox, KeyCode As Integer, Optional MaxListDisplay As Integer = 8, Optional Shift As Integer)
If tmpListBox.Visible = True Then
Select Case KeyCode
Case vbKeyUp
If tmpListBox.ListIndex > 0 Then
tmpListBox.ListIndex = tmpListBox.ListIndex - 1
End If
Case vbKeyDown
If tmpListBox.ListIndex < tmpListBox.ListCount - 1 Then
tmpListBox.ListIndex = tmpListBox.ListIndex + 1
End If
Case vbKeyPageUp
If tmpListBox.ListIndex < MaxListDisplay Then
tmpListBox.ListIndex = 0
Else
tmpListBox.ListIndex = tmpListBox.ListIndex - (MaxListDisplay - 1)
End If
Case vbKeyPageDown
If tmpListBox.ListCount - tmpListBox.ListIndex < MaxListDisplay Then
tmpListBox.ListIndex = tmpListBox.ListCount - 1
Else
tmpListBox.ListIndex = tmpListBox.ListIndex + (MaxListDisplay - 1)
End If
End Select
KeyCode = 0
End If
End Sub
Public Function ChkListBoxCode(tmpArray As Variant, InputCode As String, ByRef tmpListStr As String, Optional tmpXPos As Integer = 1, Optional tmpListPos As Integer = 2) As Boolean
Dim intX As Integer
If UBound(tmpArray, 1) > 0 Then
For intX = 0 To UBound(tmpArray, 2)
If UCase(tmpArray(tmpXPos, intX)) = UCase(InputCode) Then
tmpListStr = cuStr(tmpArray(tmpListPos, intX))
ChkListBoxCode = True
Exit Function
End If
Next
End If
ChkListBoxCode = False
tmpListStr = Empty
End Function
Public Function isInsideProductLstBox(tmpArray As Variant, tmpLstBox As ListBox, InputCode As String, Optional tmpXPos As Integer = 1) As Boolean
On Local Error GoTo ErrHandler
Dim intX As Integer
Dim tmpLen As Integer
tmpLstBox.Clear
tmpLen = Len(InputCode)
If UBound(tmpArray, 1) > 0 Then
For intX = 0 To UBound(tmpArray, 2)
If UCase(Left(Trim(tmpArray(tmpXPos, intX)), tmpLen)) = UCase(InputCode) Then
tmpLstBox.AddItem cuStr(tmpArray(1, intX)) & vbTab & cuStr(tmpArray(2, intX)) & vbTab & IIf(Len(Trim(tmpArray(3, intX))) < 1, vbTab, cuStr(tmpArray(3, intX))) & vbTab & cuStr(tmpArray(4, intX))
tmpLstBox.ItemData(tmpLstBox.NewIndex) = tmpArray(0, intX)
End If
Next
End If
If tmpLstBox.ListCount > 0 Then isInsideProductLstBox = True Else: isInsideProductLstBox = False
Exit Function
ErrHandler:
isInsideProductLstBox = False
End Function
Public Function isInsideLstBox(tmpArray As Variant, tmpLstBox As ListBox, InputCode As String, Optional tmpXPos As Integer = 1, Optional tmpListPos As Integer = 2) As Boolean
On Local Error GoTo ErrHandler
Dim intX As Integer
Dim tmpLen As Integer
tmpLstBox.Clear
tmpLen = Len(InputCode)
If UBound(tmpArray, 1) > 0 Then
For intX = 0 To UBound(tmpArray, 2)
If UCase(Left(Trim(tmpArray(tmpXPos, intX)), tmpLen)) = UCase(InputCode) Then
If tmpListPos <> 2 Then
If Len(cuStr(tmpArray(tmpListPos, intX))) > 0 Then
tmpLstBox.AddItem cuStr(tmpArray(tmpListPos, intX))
Else
tmpLstBox.AddItem cuStr(tmpArray(2, intX))
End If
Else
tmpLstBox.AddItem cuStr(tmpArray(tmpListPos, intX))
End If
tmpLstBox.ItemData(tmpLstBox.NewIndex) = tmpArray(0, intX)
End If
Next
End If
If tmpLstBox.ListCount > 0 Then isInsideLstBox = True Else: isInsideLstBox = False
Exit Function
ErrHandler:
isInsideLstBox = False
End Function
Public Function GetListBoxListStr(tmpArray As Variant, tmpKeyCode As String, Optional tmpXPos As Integer = 2) As String
Dim intX As Integer
For intX = 0 To UBound(tmpArray, 2)
If tmpArray(1, intX) = tmpKeyCode Then
GetListBoxListStr = tmpArray(tmpXPos, intX)
Exit Function
End If
Next
GetListBoxListStr = Empty
End Function
Public Function GetListBoxCode(tmpArray As Variant, tmpItemData As Integer) As String
Dim intX As Integer
For intX = 0 To UBound(tmpArray, 2)
If tmpArray(0, intX) = tmpItemData Then
GetListBoxCode = tmpArray(1, intX)
Exit Function
End If
Next
GetListBoxCode = Empty
End Function
Public Sub FillListBoxAry(tmpListBox As ListBox, tmpArray As Variant)
Dim intX As Integer
On Local Error GoTo ErrFillListBoxAry
tmpListBox.Clear
For intX = 0 To UBound(tmpArray, 2)
tmpListBox.AddItem (tmpArray(0, intX))
tmpListBox.ItemData(tmpListBox.NewIndex) = tmpArray(2, intX)
Next
Exit Sub
ErrFillListBoxAry:
End Sub
Public Sub FillListBoxInt(tmpListBox As ListBox, inputSQL As String, inputList As String, inputKey As String, Optional NoClear As Boolean)
On Local Error GoTo ErrFillListBoxInt
If NoClear <> True Then tmpListBox.Clear
rsTemp.Open inputSQL, Conn, adOpenForwardOnly, adLockReadOnly
While Not rsTemp.EOF
If Len(cuStr(rsTemp(inputList))) > 0 Then
tmpListBox.AddItem cuStr(rsTemp(inputList))
tmpListBox.ItemData(tmpListBox.NewIndex) = Val(rsTemp(inputKey))
End If
rsTemp.MoveNext
Wend
rsTemp.Close
Exit Sub
ErrFillListBoxInt:
MsgBox Err.Description
End Sub
