How to change listbox instead of list view - vb6

Below code is working for list view, but i want to use listbox instead of list view
lst = listview from the below code
Dim idx as integer
idx = 1
lst.ListItems.Clear
If Emp.Employees.RecordCount > 0 Then
Emp.Employees.MoveFirst
While Not Employees.EOF
lst.ListItems.Add idx, , EmployeeID
lst.ListItems(idx).ListSubItems.Add , , FirstName
If IsAssigned(EmployeeID, CurrentSchedule) Then
lst.ListItems(idx).Checked = True
Else
lst.ListItems(idx).Checked = False
End If
idx = idx + 1
Employees.MoveNext
Wend
End If
Listbox name is lstbox
I tried
lstbox.selected(I) = true is not working instead of lst.ListItems(idx).Checked = True

with aListbox
.Clear
'//loop here
.additem "The Item Text"
'//add the numeric id value
.itemdata(.NewIndex) = 112233
'//check it
if (condition) then
.Selected(.NewIndex) = True
end if
end with
'//sample click
msgbox aListbox.list(aListbox.listindex) & " id=" & aListbox.itemdata(aListbox.listindex)

Related

How to display the result using search button and textbox to listview

I'm coding a search button to listview and display the result data only
Private Sub Command3_Click()
Dim itmx As ListItem
Set itmx = Listview1.FindItem(Text3.Text, lvwText, , lvwPartial)
If itmx Is Nothing Then
MsgBox "record not found", vbCritical
Else
Listview1.ListItems(itmx.Index).Selected = True
Listview1.SetFocus
End If
End Sub
I expect the result will display only the data which I Search in textbox, the code above only highlighted the the row in listview.
This code will select multiple items in your ListView matching your search criteria and remove those that don't:
Private Sub Command3_Click()
Dim itmx As ListItem
Dim iIndex As Integer
Dim iRecordsFound As Integer
Dim fMultiSelect As Boolean
' Store state of ListView's MultiSelect property and set it to True
fMultiSelect = ListView1.MultiSelect
ListView1.MultiSelect = True
' Deselect any selected items
For iIndex = 1 To ListView1.ListItems.Count
ListView1.ListItems.Item(iIndex).Selected = False
Next
' Initialize variables
iIndex = 1
iRecordsFound = 0
Do While iIndex > 0 And iIndex <= ListView1.ListItems.Count
Set itmx = ListView1.FindItem(Text3.Text, lvwText, iIndex, lvwPartial)
If itmx Is Nothing Then
iIndex = 0
Else
itmx.Selected = True
iIndex = itmx.Index + 1
iRecordsFound = iRecordsFound + 1
End If
Loop
' Delete unselected items
For iIndex = ListView1.ListItems.Count To 1 Step -1
If Not ListView1.ListItems.Item(iIndex).Selected Then
ListView1.ListItems.Remove iIndex
End If
Next
If iRecordsFound = 0 Then
MsgBox "No records found", vbCritical
Else
MsgBox iRecordsFound & " records found", vbInformation
End If
' Restore state of ListView's MultiSelect property
ListView1.MultiSelect = fMultiSelect
ListView1.SetFocus
End Sub

Classic ASP: How to sort a dictionary If It has class Items for values

I need to sort a dictionary by its key, but the values are class items.
Here is the class:
CLASS Person
PUBLIC PersonID
PUBLIC PersonName
PUBLIC GenderID
PUBLIC PersonAdditional
PRIVATE SUB class_initialize()
PersonID = null
PersonName = null
GenderID = null
PersonAdditional = null
END SUB
END CLASS
And here is my dictionary, filled with data from an array:
Set dict = Server.CreateObject("Scripting.Dictionary")
FOR i = 0 TO UBOUND(arr_People)
key_person = arr_People(i).GenderID & arr_People(i).PersonName
dict.Add key_person, new Person
dict.Item(key_person).PersonName = arr_People(i).PersonName
dict.Item(key_person).GenderID = arr_People(i).GenderID
dict.Item(key_person).PersonID = arr_People(i).PersonID
dict.Item(key_person).PersonAdditional = arr_People(i).PersonAdditional
NEXT
I use this function for sorting, but it doesn't seem to work:
Function SortDictionary(objDict,intSort)
Dim strDict()
Dim objKey
Dim strKey,strItem
Dim X,Y,Z
Z = objDict.Count
If Z > 1 Then
ReDim strDict(Z,2)
X = 0
For Each objKey In objDict
strDict(X,dictKey) = CStr(objKey)
strDict(X,dictItem) = CStr(objDict(objKey))
X = X + 1
Next
For X = 0 to (Z - 2)
For Y = X to (Z - 1)
If StrComp(strDict(X,intSort),strDict(Y,intSort),vbTextCompare) > 0 Then
strKey = strDict(X,dictKey)
strItem = strDict(X,dictItem)
strDict(X,dictKey) = strDict(Y,dictKey)
strDict(X,dictItem) = strDict(Y,dictItem)
strDict(Y,dictKey) = strKey
strDict(Y,dictItem) = strItem
End If
Next
Next
objDict.RemoveAll
For X = 0 to (Z - 1)
objDict.Add strDict(X,dictKey), strDict(X,dictItem)
Next
End If
End Function
It gives me the following error:
Object doesn't support this property or method
on this row:
strDict(X,dictItem) = CStr(objDict(objKey)
I'm assuming that this happens because the values in the dictionary contains class instead of just a string or integer, but I don't know how to handle it.
There's a workaround that you can use:
Create another array containing only the keys of the dictonary
Sort the array
Read the dictionary values by iterating trough the array of keys
And here's the code:
Set dict = Server.CreateObject("Scripting.Dictionary")
Set arr_personKeys = CreateObject("System.Collections.ArrayList")
FOR i = 0 TO UBOUND(arr_People)
key_person = arr_People(i).GenderID & arr_People(i).PersonName
arr_personKeys.Add key_person
dict.Add key_person, new Person
dict.Item(key_person).PersonName = arr_People(i).PersonName
dict.Item(key_person).GenderID = arr_People(i).GenderID
dict.Item(key_person).PersonID = arr_People(i).PersonID
dict.Item(key_person).PersonAdditional = arr_People(i).PersonAdditional
NEXT
arrLength_personKeys = arr_personKeys.count - 2
SortArray arr_personKeys,arrLength_personKeys
And here is the sorting function:
Function SortArray(arrayForSorting, arraySize)
for a = arraySize To 0 Step -1
for j = 0 to a
if arrayForSorting(j)>arrayForSorting(j+1) then
temp=arrayForSorting(j+1)
arrayForSorting(j+1)=arrayForSorting(j)
arrayForSorting(j)=temp
end if
next
next
End Function
Now you can iterate trough your sorted dictionary like this:
For i = 0 To arrLength_personKeys + 1
key = arr_personKeys(i)
Response.write dict(key).PersonID
Response.write dict(key).PersonName
Response.write dict(key).GenderID
Response.write dict(key).PersonAdditional
Next

Errror when trying to set the text of a ComboBox control

This is my code that tries to set the text of a ComboBox when I click an item in a ListView.
Private Sub ListView1_Click()
If ListView1.ListItems.Count > 0 Then
Text1.Text = ListView1.ListItems(ListView1.SelectedItem.Index).Text
Text2.Text = ListView1.ListItems(ListView1.SelectedItem.Index).ListSubItems(1).Text
Sql = "SELECT A.AID,B.LOC_NAME,C.SNAME FROM ASSET A,LOCATION B,SUPPLIER C WHERE "
Sql = Sql + "A.LOC_ID=B.LOC_ID AND A.SUP_ID=C.SUP_ID AND AID=" & Text1.Text
RS.Open Sql, CON, 1, 2
COM1
Combo1.Text = RS!LOC_NAME //combo with style - 2
COM5
Combo5.Text = RS!SNAME //combo with style - 2
End If
End Sub
Private Sub COM5()
If Combo5.ListIndex = -1 Then
For I = 0 To Combo5.ListCount - 1
Combo5.ListIndex = I
Next
End If
End Sub
Private Sub COM1()
If Combo1.ListIndex = -1 Then
For I = 0 To Combo1.ListCount - 1
Combo1.ListIndex = I
Next
End If
End Sub
However, when I click on the ListView1, I get this error:
'text' property is read only
Can anyone explain why?
For a combobox with the dropdown list style you can only select an item with .text if that item already exists, so combo1.text = "xxx" errors if "xxx" is not present in the list.
To select or add based on existence you can;
Private Sub SelectOrAddToCombo(combo As ComboBox, value As String)
Dim i As Long
With combo
For i = 0 To combo.ListCount - 1
If StrComp(.List(i), value, vbTextCompare) = 0 Then
combo.ListIndex = i
Exit Sub
End If
Next
.AddItem value
.ListIndex = .NewIndex
End With
End Sub
...
SelectOrAddToCombo Combo1, RS!LOC_NAME
SelectOrAddToCombo Combo5, RS!SNAME
It's not clear what the point of your COM5()/COM1() routines are.
For the listview, rather than click look at the
ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
event which passes you the clicked item negating the need for ListView1.SelectedItem (which can cause errors if its Nothing).
yes, you must populate the combobox with the array(using additem value) before set the .text propierty, if the text that you want to set on the combobox does not exits in the array you get this error

how search for an item in a datagrid view

I am having a problem while searching for an item in datagridview
here is my code but whenever i search for an item which already exist in the database, it is telling not found
If txtfirstname.Text = "" Then
MsgBox("Please enter first name!")
Else
Dim totalrow As Integer = DataGridView1.RowCount - 2
Dim rowin As Integer
Dim flag As Boolean = False
Dim sear As String = CStr(txtfirstname.Text)
For rowin = 0 To totalrow
Dim id As String = DataGridView1.Item(0, rowin).Value
If sear = id Then
DataGridView1.ClearSelection()
DataGridView1.Rows(rowin).Selected = True
DataGridView1.CurrentCell = DataGridView1.Item(0, rowin)
flag = True
Exit Sub
Else
flag = False
End If
Next rowin
If flag = False Then
MessageBox.Show("Firstname " & txtfirstname.Text & " is not found in database.", "Search Information", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
End If
By setting
Dim totalrow As Integer = DataGridView1.RowCount - 2
you are always missing the last record in your dataset.
Try
Dim totalrow As Integer = DataGridView1.RowCount - 1
to set the upper bound value of your For loop.

Flex grid non editable column

I don't want to edit some of the column in flex gird.
Flex Grid
column1, column2, .... column35
i want to edit from column1... column10 only, remaining columns i don't want to edit or type.
How to do in vb6.
I believe the MS Flex Grid was designed for displaying data and not editing. If you need to edit cell data you can accomplish it using the Flex Grid using an approach of superimposing a textbox at runtime to capture user data entry and set the "Text" property of the cell in code. Otherwise you can choose to use a different control.
Here are some examples of the aforementioned approach:
http://support.microsoft.com/kb/241355
http://www.vb-helper.com/howto_edit_flexgrid_control.html
I've made a special user control in VB6 to an editable grid. If you want I can send you a copy.
The code I use to enable to edit a cell is the follow:
Private Sub fg_KeyDown(KeyCode As Integer, Shift As Integer)
Dim Cancel As Boolean
Dim Idc As Long
Dim x
If KeyCode = vbKeyEscape And Shift = 0 Then
If Not fgLocked Then
If fgRowChanged Then
RaiseEvent BeforeRestoreBuffer
For Idc = 1 To UBound(fgBuffer)
x = fgBuffer(Idc)
fgValues(Idc, fg.Row) = x
If fgColFormat(Idc) = "*" And fgBuffer(Idc) <> "" Then
fg.TextMatrix(fg.Row, Idc) = "*******"
ElseIf fgColFormat(Idc) = "RTF" Then
fg.TextMatrix(fg.Row, Idc) = Format(fgBuffer(Idc), "")
Else
fg.TextMatrix(fg.Row, Idc) = Format(fgBuffer(Idc), fgColFormat(Idc))
End If
Next
fgRowChanged = False
RaiseEvent RestoreBuffer
End If
End If
ElseIf KeyCode = vbKeyReturn And Shift = 0 Then
NextCell
ElseIf KeyCode = vbKeyF2 And Shift = 0 Then
If Not fgLocked Then
If fgColFormat(fg.Col) = "RTF" Then
CellEditBig fgValues(fg.Col, fg.Row)
Else
CellEdit fgValues(fg.Col, fg.Row)
End If
End If
ElseIf KeyCode = vbKeyF2 And Shift = vbShiftMask Then
If Not fgLocked Then
CellEditBig fgValues(fg.Col, fg.Row)
End If
ElseIf KeyCode = vbKeyDelete And Shift = 0 Then
If Not fgLocked Then
RaiseEvent BeforeDelete(Cancel)
If Not Cancel Then
If fg.Rows = fg.FixedRows + 1 Then
fg.AddItem ""
If fgRowNumber Then fg.TextMatrix(fg.Rows - 1, 0) = fg.Rows - 1
fgValues_AddItem ""
End If
fg.RemoveItem fg.Row
If fgRowNumber Then Renumera
fgValues_RemoveItem fg.Row
LoadBuffer fg.Row
RaiseEvent AfterDelete
End If
End If
ElseIf KeyCode = vbKeyInsert And Shift = 0 Then
If Not fgLocked Then
RaiseEvent BeforeInsert(Cancel)
If Not Cancel Then
fg.AddItem "", fg.Row
If fgRowNumber Then Renumera
fgValues_AddItem "", fg.Row
RaiseEvent AfterInsert
End If
End If
Else
RaiseEvent KeyDown(KeyCode, Shift)
End If
End Sub

Resources