|
|
Post by wexhammer on Dec 28, 2019 8:33:08 GMT -5
Hope you all had a brilliant Xmas and i'm wishing you all a Happy New Year!
What i am trying to achieve is instead of having one filter option which can filter through my saved contacts in the program to see what matches against the saved stage type. But to have 2 filters to filter through. I have attached the code to help you see what i mean. I have managed to get one working but the other filter is not working. Please help me out!
[Initialize]
Global hMain, hFind, dupNum, dupo, addName, recordIndex, contactCount
Global filterCount, oldStage$
Nomainwin
Dim name$(1000), nameSearch$(1000), stage$(20), type$(20)
Dim builder$(1000, 13), existInfo$(10,10), hContents$(20)
If Not(exists("filter.lst")) Then
Open "filter.lst" For Output As #filter
Print #filter, 4
Print #filter, "All"
Print #filter, "Complete"
Print #filter, "Incomplete"
Print #filter, "Neutral"
Close #filter
End If
Open "filter.lst" For Input As #filter
Input #filter, filterCount
For filterIndex=0 to filterCount-1
Input #filter, filterName$
stage$(filterIndex)=filterName$
Next filterIndex
Close #filter
If Not(exists("filter2.lst")) Then
Open "filter2.lst" For Output As #filter2
Print #filter2, 4
Print #filter2, "All"
Print #filter2, "1"
Print #filter2, "2"
Print #filter2, "3"
Close #filter2
End If
Open "filter2.lst" For Input As #filter2
Input #filter2, filterCount
For filterIndex=0 to filterCount-1
Input #filter2, filterName$
type$(filterIndex)=filterName$
Next filterIndex
Close #filter2
dupo=0
addName=1
Call loadNames
[GUI]
Stylebits #main, 0,_WS_MAXIMIZEBOX,0,0
WindowWidth = 495 '595 695 795
WindowHeight = 460
UpperLeftX=Int((DisplayWidth-WindowWidth)/2)
UpperLeftY=Int((DisplayHeight-WindowHeight)/2)
Statictext #main, "Names", 10, 10, 60, 20
Listbox #main.contacts, name$(, modifyRecord, 10, 35, 160, 120
Statictext #main, "Filter type", 10, 170, 160, 20
Combobox #main.filtertype, stage$(, loadNamesFiltered, 10, 190, 160, 120
Statictext #main, "Filter name", 10, 220, 160, 20
Combobox #main.filtername, type$(, loadNamesFiltered, 10, 240, 160, 120
Statictext #main, "Name", 195, 10, 50, 20
Textbox #main.name, 250, 10, 225, 25
Statictext #main, "Number", 195, 40, 50, 20
Textbox #main.number, 250, 40, 225, 25
Statictext #main, "Type", 195, 70, 50, 20
Combobox #main.stage, stage$(, [inputLoop], 250, 70, 225, 110
Statictext #main, "Name", 195, 100, 50, 20
Combobox #main.type, type$(, [inputLoop], 250, 100, 225, 110
Button #main.new, "&New", addRecord, UL, 10, 360
Listbox #main.namel, dup$(, pick, 490, 10, 190, 395
Button #main.OK, "Save", acceptEntry, UL, 370, 360
Open "Test" For Window As #main
Print #main, "Trapclose endProgram"
Print #main.filtertype, "Select All";
Print #main.filtername, "Select All";
Print #main.contacts, "SingleClickSelect"
Print #main.namel, "SingleClickSelect"
hMain=hwnd(#main)
[Code]
Call noResize
Print #main.contacts, "Setfocus"
[inputLoop]
Wait
[acceptEntry]
Call acceptEntry handle$
Wait
[addRecord]
Call addRecord handle$
Wait
[sortem]
PopUpMenu "name sort", [byName], "city sort", [byCity]
Wait
[endProgram]
Call endProgram handle$
Wait
Sub endProgram handle$
close #main
end
End Sub
Sub loadNames
If exists("contact4old.bak") Then
Kill "contact4old.bak"
End If
If exists("contact4.bak") Then
Name "contact4.bak" As "contact4old.bak"
End If
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Open "contact4.bak" For Random As #contactsCopy Len = 110
Field #contactsCopy, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
If Eof(#contacts) <> 0 Then
Close #contacts
Close #contactsCopy
Call initializeNames
Goto [skipIt]
End If
Get #contacts, 1
Put #contactsCopy, 1
contactCount = Val(name$)
If contactCount = 0 Then
Close #contacts
Close #contactsCopy
Goto [skipIt]
End If
For index = 2 To contactCount + 1
Gettrim #contacts, index
Put #contactsCopy, index
name$(index - 1) = str$(index-1)+") "+name$
Next index
Close #contacts
Close #contactsCopy
[skipIt]
End Sub
Sub initializeNames
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
name$ = "0"
Put #contacts, 1
Close #contacts
End Sub
Sub noResize
Open "user32.dll" For Dll As #user
Calldll #user, "GetSystemMenu", _
hMain As Ulong, 0 As Ulong, hmenu As Ulong
' sysmenu.Restore=GetMenuItemID(hmenu,0)
' sysmenu.Move=GetMenuItemID(hmenu,1)
sysmenu.Size=GetMenuItemID(hmenu,2)
' sysmenu.Minimize=GetMenuItemID(hmenu,3)
sysmenu.Maximize=GetMenuItemID(hmenu,4)
' sysmenu.sep1=GetMenuItemID(hmenu,5)
' sysmenu.Close=GetMenuItemID(hmenu,6)
' sysmenu.sep2=GetMenuItemID(hmenu,7)
' sysmenu.KillApps=GetMenuItemID(hmenu,8)
Calldll #user, "DeleteMenu", hmenu As Ulong, sysmenu.Size As Ulong, _
_MF_BYCOMMAND As Ulong, re As Ulong
Calldll #user, "DeleteMenu", hmenu As Ulong, sysmenu.Maximize As Ulong, _
_MF_BYCOMMAND As Ulong, re As Ulong
Close #user
End Sub
Function GetMenuItemID(hmenu,index)
Calldll #user, "GetMenuItemID", hmenu As Ulong, index As Ulong, GetMenuItemID As Ulong
End Function
Sub loadNamesFiltered handle$
'show records matching filter
Call addRecord handle$
Print #main.filtertype, "selection? filter$"
Print #main.filtername, "selection? filter2$"
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Get #contacts, 1
contactCount = Val(name$)
If contactCount = 0 Then
Close #contacts
Goto [moveOn]
End If
'compare stage to filter
For index = 2 To contactCount + 1
Gettrim #contacts, index
If filter$ = stage$ Or filter$ = "All" Then
name$(index - 1) = str$(index-1)+") "+name$
Else
name$(index - 1) = ""
End If
Next index
For index = 2 To contactCount + 1
Gettrim #contacts, index
If filter2$ = type$ Or filter2$ = "All" Then
name$(index - 1) = str$(index-1)+") "+name$
Else
name$(index - 1) = ""
End If
Next index
Close #contacts
Print #main.contacts, "Reload"
[moveOn]
End Sub
Sub modifyRecord handle$
addName = 0
Print #main.contacts, "Selection? selection$"
If selection$ = "" Then [noName]
Print #main.contacts, "SelectionIndex? index"
If index = 0 Then [noName] 'This should never need to happen
recordIndex=val(selection$)
[getContactRecord]
getIndex=recordIndex+1
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Gettrim #contacts, getIndex
Close #contacts
Print #main.name, name$
Print #main.number, number$
Print #main.stage, "SelectIndex 20"
Print #main.type, "SelectIndex 20"
For stageIndex = 0 To filterCount-1
If stage$(stageIndex) = stage$ Then
Print #main.stage, "SelectIndex "; stageIndex + 1
end if
Next stageIndex
oldStage$=stage$
[noName]
End Sub
Sub addRecord handle$
addName = 1
Print #main.contacts, "SelectIndex 0"
Print #main.name, ""
Print #main.number, ""
Print #main.stage, "SelectIndex 20"
Print #main.type, "SelectIndex 20"
Print #main.name, "!SetFocus"
End Sub
Sub acceptEntry handle$
Print #main.name, "!contents? name$";
If name$<>"" Then
Print #main.name, "!contents? number$";
Print #main.number, "!contents? number$";
Print #main.type, "Selection? type$";
Print #main.stage, "Selection? stage$";
If addName = 1 Then
contactCount = contactCount + 1
recordIndex = contactCount
End If
name$(recordIndex) = Str$(recordIndex)+") "+name$
Print #main.contacts, "Reload"
date$=Date$()
If oldStage$="Opening Mailer" And stage$="Follow Up Call" then
mailDate$=Date$()
End If
[saveContactRecord]
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Put #contacts, recordIndex + 1
Close #contacts
If addName = 0 Then [goBack]
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As count$, 75 As fill$
count$ = Str$(contactCount)
Put #contacts, 1
Close #contacts
addName = 0
Call loadNamesFiltered " "
[goBack]
Print #main.contacts, "SelectIndex ";recordIndex
Call addRecord handle$
Else
Notice "NO BUSINESS NAME"+Chr$(13)+"The business name must be entered, "_
+Chr$(13)+"before a record can be saved. "
End If
End Sub
Sub populateList
Open "contact4.dat" For random As #contacts3 Len = 110
Field #contacts3, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Open "contact.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Get #contacts3, 1
contactCount = Val(name$)
Put #contacts, 1
For index2 = 2 To contactCount + 1
Gettrim #contacts3, index2
For column=1 To 4
Select Case column
Case 1
builder$(index2, column)=name$
Case 2
builder$(index2, column)=number$
Case 3
builder$(index2, column)=stage$
Case 4
builder$(index2, column)=type$
End Select
Next column
Next index2
End Sub
Sub saveList
For index2 = 2 To contactCount + 1
For column=1 To 4
Select Case column
Case 1
name$=builder$(index2, column)
Case 2
number$=builder$(index2, column)
Case 3
stage$=builder$(index2, column)
Case 4
type$=builder$(index2, column)
End Select
Next column
Put #contacts, index2
Next index2
Close #contacts3
Close #contacts
If exists("contact4recoverold.bak") Then
Kill "contact4recoverold.bak"
End If
If exists("contact4recover.bak") Then
Name "contact4recover.bak" As "contact4recoverold.bak"
End If
Name "contact4.dat" As "contact4recover.bak"
Name "contact.dat" As "contact4.dat"
End Sub
Function exists(a$)
Files DefaultDir$, a$, existInfo$()
exists=val(existInfo$(0,0))
End Function
Sub removeEntry
Print #main.filtertype, "selection? filter$"
If addName=0 Then
Confirm "YOU ARE ABOUT TO DELETE THIS RECORD"+Chr$(13)+" "+Chr$(13)+Chr$(34)_
+name$(recordIndex)+Chr$(34)+Chr$(13)+" "+Chr$(13)+"Do you want to proceed?";delAns$
If Lower$(delAns$)="no" Then [noDelete]
WindowWidth=150
WindowHeight=75
StaticText #patience, "PLEASE WAIT...", 10, 15, 100, 25
Open "DELETING...", For Dialog_Modal As #patience
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
For moveRecords=recordIndex+1 To contactCount
Get #contacts, moveRecords+1
Put #contacts, moveRecords
Next moveRecords
Get #contacts, 1
name$(Val(name$))=""
name$=Str$(Val(name$)-1)
Put #contacts, 1
Close #contacts
Close #patience
Call loadNames
Call loadNamesFiltered handle$
Notice "RECORD DELETED"+Chr$(13)+"Names reloaded"
Else
Notice "NO RECORD SELECTED!"+Chr$(13)+"Please select a record," _
+Chr$(13)+"then select delete from the menu."
End If
[noDelete]
End Sub
|
|
|
|
Post by Rod on Dec 28, 2019 9:53:01 GMT -5
Well when you apply your filters you have to apply them both at once not one after the other. I think you have some other issues because the textboxes don't seem to be named correctly and the bottom one loses its info, or its never displayed. Anyways the filter,
'compare stage to filter
For index = 2 To contactCount + 1
Gettrim #contacts, index
If filter$ = stage$ Or filter$ = "All" Then
If filter2$ = type$ Or filter2$ = "All" Then
name$(index - 1) = str$(index-1)+") "+name$
Else
name$(index - 1) = ""
end if
End If
Next index
|
|
|
|
Post by wexhammer on Dec 28, 2019 10:28:27 GMT -5
Thanks for the notice on the textboxes. I have just added your amended filter code however the second filter seems to be working but the first one still doesn't filter anything. What could be the problem?
[Initialize]
Global hMain, hFind, dupNum, dupo, addName, recordIndex, contactCount
Global filterCount, oldStage$
Nomainwin
Dim name$(1000), nameSearch$(1000), stage$(20), type$(20)
Dim builder$(1000, 13), existInfo$(10,10), hContents$(20)
If Not(exists("filter.lst")) Then
Open "filter.lst" For Output As #filter
Print #filter, 4
Print #filter, "All"
Print #filter, "Complete"
Print #filter, "Incomplete"
Print #filter, "Neutral"
Close #filter
End If
Open "filter.lst" For Input As #filter
Input #filter, filterCount
For filterIndex=0 to filterCount-1
Input #filter, filterName$
stage$(filterIndex)=filterName$
Next filterIndex
Close #filter
If Not(exists("filter2.lst")) Then
Open "filter2.lst" For Output As #filter2
Print #filter2, 4
Print #filter2, "All"
Print #filter2, "1"
Print #filter2, "2"
Print #filter2, "3"
Close #filter2
End If
Open "filter2.lst" For Input As #filter2
Input #filter2, filterCount
For filterIndex=0 to filterCount-1
Input #filter2, filterName$
type$(filterIndex)=filterName$
Next filterIndex
Close #filter2
dupo=0
addName=1
Call loadNames
[GUI]
Stylebits #main, 0,_WS_MAXIMIZEBOX,0,0
WindowWidth = 495 '595 695 795
WindowHeight = 460
UpperLeftX=Int((DisplayWidth-WindowWidth)/2)
UpperLeftY=Int((DisplayHeight-WindowHeight)/2)
Statictext #main, "Names", 10, 10, 60, 20
Listbox #main.contacts, name$(, modifyRecord, 10, 35, 160, 120
Statictext #main, "Filter stage", 10, 170, 160, 20
Combobox #main.filtername, stage$(, loadNamesFiltered, 10, 190, 160, 120
Statictext #main, "Filter type", 10, 220, 160, 20
Combobox #main.filtertype, type$(, loadNamesFiltered, 10, 240, 160, 120
Statictext #main, "Name", 195, 10, 50, 20
Textbox #main.name, 250, 10, 225, 25
Statictext #main, "Number", 195, 40, 50, 20
Textbox #main.number, 250, 40, 225, 25
Statictext #main, "Stage", 195, 70, 50, 20
Combobox #main.stage, stage$(, [inputLoop], 250, 70, 225, 110
Statictext #main, "Type", 195, 100, 50, 20
Combobox #main.type, type$(, [inputLoop], 250, 100, 225, 110
Button #main.new, "&New", addRecord, UL, 10, 360
Listbox #main.namel, dup$(, pick, 490, 10, 190, 395
Button #main.OK, "Save", acceptEntry, UL, 370, 360
Open "Test" For Window As #main
Print #main, "Trapclose endProgram"
Print #main.filtertype, "Select All";
Print #main.filtername, "Select All";
Print #main.contacts, "SingleClickSelect"
Print #main.namel, "SingleClickSelect"
hMain=hwnd(#main)
[Code]
Call noResize
Print #main.contacts, "Setfocus"
[inputLoop]
Wait
[acceptEntry]
Call acceptEntry handle$
Wait
[addRecord]
Call addRecord handle$
Wait
[sortem]
PopUpMenu "name sort", [byName], "city sort", [byCity]
Wait
[endProgram]
Call endProgram handle$
Wait
Sub endProgram handle$
close #main
end
End Sub
Sub loadNames
If exists("contact4old.bak") Then
Kill "contact4old.bak"
End If
If exists("contact4.bak") Then
Name "contact4.bak" As "contact4old.bak"
End If
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Open "contact4.bak" For Random As #contactsCopy Len = 110
Field #contactsCopy, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
If Eof(#contacts) <> 0 Then
Close #contacts
Close #contactsCopy
Call initializeNames
Goto [skipIt]
End If
Get #contacts, 1
Put #contactsCopy, 1
contactCount = Val(name$)
If contactCount = 0 Then
Close #contacts
Close #contactsCopy
Goto [skipIt]
End If
For index = 2 To contactCount + 1
Gettrim #contacts, index
Put #contactsCopy, index
name$(index - 1) = str$(index-1)+") "+name$
Next index
Close #contacts
Close #contactsCopy
[skipIt]
End Sub
Sub initializeNames
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
name$ = "0"
Put #contacts, 1
Close #contacts
End Sub
Sub noResize
Open "user32.dll" For Dll As #user
Calldll #user, "GetSystemMenu", _
hMain As Ulong, 0 As Ulong, hmenu As Ulong
' sysmenu.Restore=GetMenuItemID(hmenu,0)
' sysmenu.Move=GetMenuItemID(hmenu,1)
sysmenu.Size=GetMenuItemID(hmenu,2)
' sysmenu.Minimize=GetMenuItemID(hmenu,3)
sysmenu.Maximize=GetMenuItemID(hmenu,4)
' sysmenu.sep1=GetMenuItemID(hmenu,5)
' sysmenu.Close=GetMenuItemID(hmenu,6)
' sysmenu.sep2=GetMenuItemID(hmenu,7)
' sysmenu.KillApps=GetMenuItemID(hmenu,8)
Calldll #user, "DeleteMenu", hmenu As Ulong, sysmenu.Size As Ulong, _
_MF_BYCOMMAND As Ulong, re As Ulong
Calldll #user, "DeleteMenu", hmenu As Ulong, sysmenu.Maximize As Ulong, _
_MF_BYCOMMAND As Ulong, re As Ulong
Close #user
End Sub
Function GetMenuItemID(hmenu,index)
Calldll #user, "GetMenuItemID", hmenu As Ulong, index As Ulong, GetMenuItemID As Ulong
End Function
Sub loadNamesFiltered handle$
'show records matching filter
Call addRecord handle$
Print #main.filtername, "selection? filter$"
Print #main.filtertype, "selection? filter2$"
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Get #contacts, 1
contactCount = Val(name$)
If contactCount = 0 Then
Close #contacts
Goto [moveOn]
End If
'compare stage to filter
For index = 2 To contactCount + 1
Gettrim #contacts, index
If filter$ = stage$ Or filter$ = "All" Then
If filter2$ = type$ Or filter2$ = "All" Then
name$(index - 1) = str$(index-1)+") "+name$
Else
name$(index - 1) = ""
end if
End If
Next index
Close #contacts
Print #main.contacts, "Reload"
[moveOn]
End Sub
Sub modifyRecord handle$
addName = 0
Print #main.contacts, "Selection? selection$"
If selection$ = "" Then [noName]
Print #main.contacts, "SelectionIndex? index"
If index = 0 Then [noName] 'This should never need to happen
recordIndex=val(selection$)
[getContactRecord]
getIndex=recordIndex+1
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Gettrim #contacts, getIndex
Close #contacts
Print #main.name, name$
Print #main.number, number$
Print #main.stage, "SelectIndex 20"
Print #main.type, "SelectIndex 20"
For stageIndex = 0 To filterCount-1
If stage$(stageIndex) = stage$ Then
Print #main.stage, "SelectIndex "; stageIndex + 1
end if
Next stageIndex
oldStage$=stage$
[noName]
End Sub
Sub addRecord handle$
addName = 1
Print #main.contacts, "SelectIndex 0"
Print #main.name, ""
Print #main.number, ""
Print #main.stage, "SelectIndex 20"
Print #main.type, "SelectIndex 20"
Print #main.name, "!SetFocus"
End Sub
Sub acceptEntry handle$
Print #main.name, "!contents? name$";
If name$<>"" Then
Print #main.name, "!contents? number$";
Print #main.number, "!contents? number$";
Print #main.type, "Selection? type$";
Print #main.stage, "Selection? stage$";
If addName = 1 Then
contactCount = contactCount + 1
recordIndex = contactCount
End If
name$(recordIndex) = Str$(recordIndex)+") "+name$
Print #main.contacts, "Reload"
date$=Date$()
If oldStage$="Opening Mailer" And stage$="Follow Up Call" then
mailDate$=Date$()
End If
[saveContactRecord]
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Put #contacts, recordIndex + 1
Close #contacts
If addName = 0 Then [goBack]
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As count$, 75 As fill$
count$ = Str$(contactCount)
Put #contacts, 1
Close #contacts
addName = 0
Call loadNamesFiltered " "
[goBack]
Print #main.contacts, "SelectIndex ";recordIndex
Call addRecord handle$
Else
Notice "NO BUSINESS NAME"+Chr$(13)+"The business name must be entered, "_
+Chr$(13)+"before a record can be saved. "
End If
End Sub
Sub populateList
Open "contact4.dat" For random As #contacts3 Len = 110
Field #contacts3, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Open "contact.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Get #contacts3, 1
contactCount = Val(name$)
Put #contacts, 1
For index2 = 2 To contactCount + 1
Gettrim #contacts3, index2
For column=1 To 4
Select Case column
Case 1
builder$(index2, column)=name$
Case 2
builder$(index2, column)=number$
Case 3
builder$(index2, column)=stage$
Case 4
builder$(index2, column)=type$
End Select
Next column
Next index2
End Sub
Sub saveList
For index2 = 2 To contactCount + 1
For column=1 To 4
Select Case column
Case 1
name$=builder$(index2, column)
Case 2
number$=builder$(index2, column)
Case 3
stage$=builder$(index2, column)
Case 4
type$=builder$(index2, column)
End Select
Next column
Put #contacts, index2
Next index2
Close #contacts3
Close #contacts
If exists("contact4recoverold.bak") Then
Kill "contact4recoverold.bak"
End If
If exists("contact4recover.bak") Then
Name "contact4recover.bak" As "contact4recoverold.bak"
End If
Name "contact4.dat" As "contact4recover.bak"
Name "contact.dat" As "contact4.dat"
End Sub
Function exists(a$)
Files DefaultDir$, a$, existInfo$()
exists=val(existInfo$(0,0))
End Function
Sub removeEntry
Print #main.filtertype, "selection? filter$"
If addName=0 Then
Confirm "YOU ARE ABOUT TO DELETE THIS RECORD"+Chr$(13)+" "+Chr$(13)+Chr$(34)_
+name$(recordIndex)+Chr$(34)+Chr$(13)+" "+Chr$(13)+"Do you want to proceed?";delAns$
If Lower$(delAns$)="no" Then [noDelete]
WindowWidth=150
WindowHeight=75
StaticText #patience, "PLEASE WAIT...", 10, 15, 100, 25
Open "DELETING...", For Dialog_Modal As #patience
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
For moveRecords=recordIndex+1 To contactCount
Get #contacts, moveRecords+1
Put #contacts, moveRecords
Next moveRecords
Get #contacts, 1
name$(Val(name$))=""
name$=Str$(Val(name$)-1)
Put #contacts, 1
Close #contacts
Close #patience
Call loadNames
Call loadNamesFiltered handle$
Notice "RECORD DELETED"+Chr$(13)+"Names reloaded"
Else
Notice "NO RECORD SELECTED!"+Chr$(13)+"Please select a record," _
+Chr$(13)+"then select delete from the menu."
End If
[noDelete]
End Sub
|
|
|
|
Post by Rod on Dec 28, 2019 12:04:16 GMT -5
Click on the ladybug icon, now navigate to the filter sub and click on the left hand margin. That will add a break point. Now run the code, set the filters and the code will stop at the sub. Now single step through and look at what the variables contain. They can't be right else it would be working.
|
|
|
|
Post by wexhammer on Dec 28, 2019 14:22:28 GMT -5
I am absolutely clueless now, i have checked the variables and they have read the input saved in both combo boxes. I have edited some more code so that both combo boxes show data when clicking on a contact in the list box. But now again the filter only filters one name and when selecting a saved name the data for both combo boxes shows up once only and then when i save other names the data only shows in one combobox again.
[Initialize]
Global hMain, hFind, dupNum, dupo, addName, recordIndex, contactCount
Global filterCount, oldStage$
Nomainwin
Dim name$(1000), nameSearch$(1000), stage$(20), type$(20)
Dim builder$(1000, 13), existInfo$(10,10), hContents$(20)
If Not(exists("filter.lst")) Then
Open "filter.lst" For Output As #filter
Print #filter, 4
Print #filter, "All"
Print #filter, "Complete"
Print #filter, "Incomplete"
Print #filter, "Neutral"
Close #filter
End If
Open "filter.lst" For Input As #filter
Input #filter, filterCount
For filterIndex=0 to filterCount-1
Input #filter, filterName$
stage$(filterIndex)=filterName$
Next filterIndex
Close #filter
If Not(exists("filter2.lst")) Then
Open "filter2.lst" For Output As #filter2
Print #filter2, 4
Print #filter2, "All"
Print #filter2, "1"
Print #filter2, "2"
Print #filter2, "3"
Close #filter2
End If
Open "filter2.lst" For Input As #filter2
Input #filter2, filterCount
For filterIndex=0 to filterCount-1
Input #filter2, filterName$
type$(filterIndex)=filterName$
Next filterIndex
Close #filter2
dupo=0
addName=1
Call loadNames
[GUI]
Stylebits #main, 0,_WS_MAXIMIZEBOX,0,0
WindowWidth = 495 '595 695 795
WindowHeight = 460
UpperLeftX=Int((DisplayWidth-WindowWidth)/2)
UpperLeftY=Int((DisplayHeight-WindowHeight)/2)
Statictext #main, "Names", 10, 10, 60, 20
Listbox #main.contacts, name$(, modifyRecord, 10, 35, 160, 120
Statictext #main, "Filter stage", 10, 170, 160, 20
Combobox #main.filtername, stage$(, loadNamesFiltered, 10, 190, 160, 120
Statictext #main, "Filter type", 10, 220, 160, 20
Combobox #main.filtertype, type$(, loadNamesFiltered, 10, 240, 160, 120
Statictext #main, "Name", 195, 10, 50, 20
Textbox #main.name, 250, 10, 225, 25
Statictext #main, "Number", 195, 40, 50, 20
Textbox #main.number, 250, 40, 225, 25
Statictext #main, "Stage", 195, 70, 50, 20
Combobox #main.stage, stage$(, [inputLoop], 250, 70, 225, 110
Statictext #main, "Type", 195, 100, 50, 20
Combobox #main.type, type$(, [inputLoop], 250, 100, 225, 110
Button #main.new, "&New", addRecord, UL, 10, 360
Listbox #main.namel, dup$(, pick, 490, 10, 190, 395
Button #main.OK, "Save", acceptEntry, UL, 370, 360
Open "Test" For Window As #main
Print #main, "Trapclose endProgram"
Print #main.filtertype, "Select All";
Print #main.filtername, "Select All";
Print #main.contacts, "SingleClickSelect"
Print #main.namel, "SingleClickSelect"
hMain=hwnd(#main)
[Code]
Call noResize
Print #main.contacts, "Setfocus"
[inputLoop]
Wait
[acceptEntry]
Call acceptEntry handle$
Wait
[addRecord]
Call addRecord handle$
Wait
[sortem]
PopUpMenu "name sort", [byName], "city sort", [byCity]
Wait
[endProgram]
Call endProgram handle$
Wait
Sub endProgram handle$
close #main
end
End Sub
Sub loadNames
If exists("contact4old.bak") Then
Kill "contact4old.bak"
End If
If exists("contact4.bak") Then
Name "contact4.bak" As "contact4old.bak"
End If
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Open "contact4.bak" For Random As #contactsCopy Len = 110
Field #contactsCopy, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
If Eof(#contacts) <> 0 Then
Close #contacts
Close #contactsCopy
Call initializeNames
Goto [skipIt]
End If
Get #contacts, 1
Put #contactsCopy, 1
contactCount = Val(name$)
If contactCount = 0 Then
Close #contacts
Close #contactsCopy
Goto [skipIt]
End If
For index = 2 To contactCount + 1
Gettrim #contacts, index
Put #contactsCopy, index
name$(index - 1) = str$(index-1)+") "+name$
Next index
Close #contacts
Close #contactsCopy
[skipIt]
End Sub
Sub initializeNames
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
name$ = "0"
Put #contacts, 1
Close #contacts
End Sub
Sub noResize
Open "user32.dll" For Dll As #user
Calldll #user, "GetSystemMenu", _
hMain As Ulong, 0 As Ulong, hmenu As Ulong
' sysmenu.Restore=GetMenuItemID(hmenu,0)
' sysmenu.Move=GetMenuItemID(hmenu,1)
sysmenu.Size=GetMenuItemID(hmenu,2)
' sysmenu.Minimize=GetMenuItemID(hmenu,3)
sysmenu.Maximize=GetMenuItemID(hmenu,4)
' sysmenu.sep1=GetMenuItemID(hmenu,5)
' sysmenu.Close=GetMenuItemID(hmenu,6)
' sysmenu.sep2=GetMenuItemID(hmenu,7)
' sysmenu.KillApps=GetMenuItemID(hmenu,8)
Calldll #user, "DeleteMenu", hmenu As Ulong, sysmenu.Size As Ulong, _
_MF_BYCOMMAND As Ulong, re As Ulong
Calldll #user, "DeleteMenu", hmenu As Ulong, sysmenu.Maximize As Ulong, _
_MF_BYCOMMAND As Ulong, re As Ulong
Close #user
End Sub
Function GetMenuItemID(hmenu,index)
Calldll #user, "GetMenuItemID", hmenu As Ulong, index As Ulong, GetMenuItemID As Ulong
End Function
Sub loadNamesFiltered handle$
'show records matching filter
Call addRecord handle$
Print #main.filtername, "Selection? filter$"
Print #main.filtertype, "Selection? filter2$"
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Get #contacts, 1
contactCount = Val(name$)
If contactCount = 0 Then
Close #contacts
Goto [moveOn]
End If
'compare stage to filter
For index = 2 To contactCount + 1
Gettrim #contacts, index
If filter$ = stage$ Or filter$ = "All" then
If filter2$ = type$ Or filter2$ = "All" Then
name$(index - 1) = str$(index-1)+") "+name$
Else
name$(index - 1) = ""
end if
End If
Next index
Close #contacts
Print #main.contacts, "Reload"
[moveOn]
End Sub
Sub modifyRecord handle$
addName = 0
Print #main.contacts, "Selection? selection$"
If selection$ = "" Then [noName]
Print #main.contacts, "SelectionIndex? index"
If index = 0 Then [noName] 'This should never need to happen
recordIndex=val(selection$)
[getContactRecord]
getIndex=recordIndex+1
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Gettrim #contacts, getIndex
Close #contacts
Print #main.name, name$
Print #main.number, number$
Print #main.stage, "SelectIndex 20"
Print #main.type, "SelectIndex 20"
For stageIndex = 0 To filterCount-1
If stage$(stageIndex) = stage$ Then
Print #main.stage, "SelectIndex "; stageIndex + 1
If type$(stageIndex) = type$ Then
Print #main.type, "SelectIndex "; stageIndex + 1
end if
end if
Next stageIndex
oldStage$=stage$
[noName]
End Sub
Sub addRecord handle$
addName = 1
Print #main.contacts, "SelectIndex 0"
Print #main.name, ""
Print #main.number, ""
Print #main.stage, "SelectIndex 20"
Print #main.type, "SelectIndex 20"
Print #main.name, "!SetFocus"
End Sub
Sub acceptEntry handle$
Print #main.name, "!contents? name$";
If name$<>"" Then
Print #main.name, "!contents? number$";
Print #main.number, "!contents? number$";
Print #main.type, "Selection? type$";
Print #main.stage, "Selection? stage$";
If addName = 1 Then
contactCount = contactCount + 1
recordIndex = contactCount
End If
name$(recordIndex) = Str$(recordIndex)+") "+name$
Print #main.contacts, "Reload"
date$=Date$()
If oldStage$="Opening Mailer" And stage$="Follow Up Call" then
mailDate$=Date$()
End If
[saveContactRecord]
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Put #contacts, recordIndex + 1
Close #contacts
If addName = 0 Then [goBack]
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As count$, 75 As fill$
count$ = Str$(contactCount)
Put #contacts, 1
Close #contacts
addName = 0
Call loadNamesFiltered " "
[goBack]
Print #main.contacts, "SelectIndex ";recordIndex
Call addRecord handle$
Else
Notice "NO BUSINESS NAME"+Chr$(13)+"The business name must be entered, "_
+Chr$(13)+"before a record can be saved. "
End If
End Sub
Sub populateList
Open "contact4.dat" For random As #contacts3 Len = 110
Field #contacts3, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Open "contact.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Get #contacts3, 1
contactCount = Val(name$)
Put #contacts, 1
For index2 = 2 To contactCount + 1
Gettrim #contacts3, index2
For column=1 To 4
Select Case column
Case 1
builder$(index2, column)=name$
Case 2
builder$(index2, column)=number$
Case 3
builder$(index2, column)=stage$
Case 4
builder$(index2, column)=type$
End Select
Next column
Next index2
End Sub
Sub saveList
For index2 = 2 To contactCount + 1
For column=1 To 4
Select Case column
Case 1
name$=builder$(index2, column)
Case 2
number$=builder$(index2, column)
Case 3
stage$=builder$(index2, column)
Case 4
type$=builder$(index2, column)
End Select
Next column
Put #contacts, index2
Next index2
Close #contacts3
Close #contacts
If exists("contact4recoverold.bak") Then
Kill "contact4recoverold.bak"
End If
If exists("contact4recover.bak") Then
Name "contact4recover.bak" As "contact4recoverold.bak"
End If
Name "contact4.dat" As "contact4recover.bak"
Name "contact.dat" As "contact4.dat"
End Sub
Function exists(a$)
Files DefaultDir$, a$, existInfo$()
exists=val(existInfo$(0,0))
End Function
Sub removeEntry
Print #main.filtertype, "selection? filter$"
If addName=0 Then
Confirm "YOU ARE ABOUT TO DELETE THIS RECORD"+Chr$(13)+" "+Chr$(13)+Chr$(34)_
+name$(recordIndex)+Chr$(34)+Chr$(13)+" "+Chr$(13)+"Do you want to proceed?";delAns$
If Lower$(delAns$)="no" Then [noDelete]
WindowWidth=150
WindowHeight=75
StaticText #patience, "PLEASE WAIT...", 10, 15, 100, 25
Open "DELETING...", For Dialog_Modal As #patience
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
For moveRecords=recordIndex+1 To contactCount
Get #contacts, moveRecords+1
Put #contacts, moveRecords
Next moveRecords
Get #contacts, 1
name$(Val(name$))=""
name$=Str$(Val(name$)-1)
Put #contacts, 1
Close #contacts
Close #patience
Call loadNames
Call loadNamesFiltered handle$
Notice "RECORD DELETED"+Chr$(13)+"Names reloaded"
Else
Notice "NO RECORD SELECTED!"+Chr$(13)+"Please select a record," _
+Chr$(13)+"then select delete from the menu."
End If
[noDelete]
End Sub
|
|
|
|
Post by metro on Dec 28, 2019 19:08:46 GMT -5
Hi wexhammer, not sure if I understand the problem exactly (another sign of old age along with brain fog)
does this get you closer to what you want
EDIT: seems ...#main.type, type$ can be blank when the record is saved so type$ will sometimes = "" therefore no match sorry just read Rods post...same advice
Sub loadNamesFiltered handle$
redim name$(1000)
'show records matching filter
Call addRecord handle$
Print #main.filtertype, "selection? filter$"
Print #main.filtername, "selection? filter2$"
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Get #contacts, 1
contactCount = Val(name$)
If contactCount = 0 Then
Close #contacts
Goto [moveOn]
End If
'compare stage to filter
' For index = 2 To contactCount + 1
' Gettrim #contacts, index
' If filter$ = stage$ or filter$ = "All" Then
' name$(index - 1) = str$(index-1)+") "+name$
' Else
' name$(index - 1) = ""
' End If
' Next index
For index = 2 To contactCount + 1
Gettrim #contacts, index
If filter$ = stage$ or filter$ = "All" Then
If filter2$ = type$ or filter2$ = "All" Then
name$(index - 1) = str$(index-1)+") "+name$
Else
name$(index - 1) = ""
End If
end if
Next index
Close #contacts
Print #main.contacts, "Reload"
[moveOn]
End Sub
|
|
|
|
Post by Rod on Dec 29, 2019 4:07:29 GMT -5
What is wrong is that the wrong data is being used. The number/type/stage data is not getting filed in the right place so the filter is not seeing the data. I say again, debug the code. If you don't want to do it live with the debugger then put in some print statements so you see what the database fields contain, the comparison variables contain and the result of the comparison. Put that right in the middle of the filter code we show you. The database does not contain what you think making the second comparison.
You would have sorted this yourself if you had been more systematic with your naming convention. If it is the stage data, consistently use stage in the names of the comboboxes statictexts arrays and variables associated with stage. So too with type.
|
|
|
|
Post by wexhammer on Dec 29, 2019 5:29:46 GMT -5
Thanks Rod & Metro for your help! It seemed as though a good nights sleep was needed in order to re-evaluate and understand the wrongs in my code. The working code is posted below so others can learn from it! Thanks again...
[Initialize]
Global hMain, hFind, dupNum, dupo, addName, recordIndex, contactCount
Global filterCount, oldStage$
Nomainwin
Dim name$(1000), nameSearch$(1000), stage$(20), type$(20)
Dim builder$(1000, 13), existInfo$(10,10), hContents$(20)
If Not(exists("filter.lst")) Then
Open "filter.lst" For Output As #filter
Print #filter, 4
Print #filter, "All"
Print #filter, "Complete"
Print #filter, "Incomplete"
Print #filter, "Neutral"
Close #filter
End If
Open "filter.lst" For Input As #filter
Input #filter, filterCount
For filterIndex=0 to filterCount-1
Input #filter, filterName$
stage$(filterIndex)=filterName$
Next filterIndex
Close #filter
If Not(exists("filter2.lst")) Then
Open "filter2.lst" For Output As #filter2
Print #filter2, 4
Print #filter2, "All"
Print #filter2, "1"
Print #filter2, "2"
Print #filter2, "3"
Close #filter2
End If
Open "filter2.lst" For Input As #filter2
Input #filter2, filterCount
For filterIndex=0 to filterCount-1
Input #filter2, filterName$
type$(filterIndex)=filterName$
Next filterIndex
Close #filter2
dupo=0
addName=1
Call loadNames
[GUI]
Stylebits #main, 0,_WS_MAXIMIZEBOX,0,0
WindowWidth = 495 '595 695 795
WindowHeight = 460
UpperLeftX=Int((DisplayWidth-WindowWidth)/2)
UpperLeftY=Int((DisplayHeight-WindowHeight)/2)
Statictext #main, "Names", 10, 10, 60, 20
Listbox #main.contacts, name$(, modifyRecord, 10, 35, 160, 120
Statictext #main, "Filter stage", 10, 170, 160, 20
Combobox #main.filterstage, stage$(, loadNamesFiltered, 10, 190, 160, 120
Statictext #main, "Filter type", 10, 220, 160, 20
Combobox #main.filtertype, type$(, loadNamesFiltered, 10, 240, 160, 120
Statictext #main, "Name", 195, 10, 50, 20
Textbox #main.name, 250, 10, 225, 25
Statictext #main, "Number", 195, 40, 50, 20
Textbox #main.number, 250, 40, 225, 25
Statictext #main, "Stage", 195, 70, 50, 20
Combobox #main.stage, stage$(, [inputLoop], 250, 70, 225, 110
Statictext #main, "Type", 195, 100, 50, 20
Combobox #main.type, type$(, [inputLoop], 250, 100, 225, 110
Button #main.new, "&New", addRecord, UL, 10, 360
Listbox #main.namel, dup$(, pick, 490, 10, 190, 395
Button #main.OK, "Save", acceptEntry, UL, 370, 360
Open "Test" For Window As #main
Print #main, "Trapclose endProgram"
Print #main.filtertype, "Select All";
Print #main.filterstage, "Select All";
Print #main.contacts, "SingleClickSelect"
Print #main.namel, "SingleClickSelect"
hMain=hwnd(#main)
[Code]
Call noResize
Print #main.contacts, "Setfocus"
[inputLoop]
Wait
[acceptEntry]
Call acceptEntry handle$
Wait
[addRecord]
Call addRecord handle$
Wait
[sortem]
PopUpMenu "name sort", [byName], "city sort", [byCity]
Wait
[endProgram]
Call endProgram handle$
Wait
Sub endProgram handle$
close #main
end
End Sub
Sub loadNames
If exists("contact4old.bak") Then
Kill "contact4old.bak"
End If
If exists("contact4.bak") Then
Name "contact4.bak" As "contact4old.bak"
End If
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Open "contact4.bak" For Random As #contactsCopy Len = 110
Field #contactsCopy, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
If Eof(#contacts) <> 0 Then
Close #contacts
Close #contactsCopy
Call initializeNames
Goto [skipIt]
End If
Get #contacts, 1
Put #contactsCopy, 1
contactCount = Val(name$)
If contactCount = 0 Then
Close #contacts
Close #contactsCopy
Goto [skipIt]
End If
For index = 2 To contactCount + 1
Gettrim #contacts, index
Put #contactsCopy, index
name$(index - 1) = str$(index-1)+") "+name$
Next index
Close #contacts
Close #contactsCopy
[skipIt]
End Sub
Sub initializeNames
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
name$ = "0"
Put #contacts, 1
Close #contacts
End Sub
Sub noResize
Open "user32.dll" For Dll As #user
Calldll #user, "GetSystemMenu", _
hMain As Ulong, 0 As Ulong, hmenu As Ulong
' sysmenu.Restore=GetMenuItemID(hmenu,0)
' sysmenu.Move=GetMenuItemID(hmenu,1)
sysmenu.Size=GetMenuItemID(hmenu,2)
' sysmenu.Minimize=GetMenuItemID(hmenu,3)
sysmenu.Maximize=GetMenuItemID(hmenu,4)
' sysmenu.sep1=GetMenuItemID(hmenu,5)
' sysmenu.Close=GetMenuItemID(hmenu,6)
' sysmenu.sep2=GetMenuItemID(hmenu,7)
' sysmenu.KillApps=GetMenuItemID(hmenu,8)
Calldll #user, "DeleteMenu", hmenu As Ulong, sysmenu.Size As Ulong, _
_MF_BYCOMMAND As Ulong, re As Ulong
Calldll #user, "DeleteMenu", hmenu As Ulong, sysmenu.Maximize As Ulong, _
_MF_BYCOMMAND As Ulong, re As Ulong
Close #user
End Sub
Function GetMenuItemID(hmenu,index)
Calldll #user, "GetMenuItemID", hmenu As Ulong, index As Ulong, GetMenuItemID As Ulong
End Function
Sub loadNamesFiltered handle$
redim name$(1000)
'show records matching filter
Call addRecord handle$
Print #main.filterstage, "selection? filter$"
Print #main.filtertype, "selection? filter2$"
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Get #contacts, 1
contactCount = Val(name$)
If contactCount = 0 Then
Close #contacts
Goto [moveOn]
End If
'compare stage to filter
For index = 2 To contactCount + 1
Gettrim #contacts, index
If filter$ = stage$ or filter$ = "All" Then
If filter2$ = type$ or filter2$ = "All" Then
name$(index - 1) = str$(index-1)+") "+name$
Else
name$(index - 1) = ""
End If
end if
Next index
Close #contacts
Print #main.contacts, "Reload"
[moveOn]
End Sub
Sub modifyRecord handle$
addName = 0
Print #main.contacts, "Selection? selection$"
If selection$ = "" Then [noName]
Print #main.contacts, "SelectionIndex? index"
If index = 0 Then [noName] 'This should never need to happen
recordIndex=val(selection$)
[getContactRecord]
getIndex=recordIndex+1
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Gettrim #contacts, getIndex
Close #contacts
Print #main.name, name$
Print #main.number, number$
Print #main.stage, "SelectIndex 20"
Print #main.type, "SelectIndex 20"
For stageIndex = 0 To filterCount-1
If stage$(stageIndex) = stage$ Then
Print #main.stage, "SelectIndex "; stageIndex + 1
end if
If type$(stageIndex) = type$ Then
Print #main.type, "SelectIndex "; stageIndex + 1
end if
Next stageIndex
oldStage$=stage$
[noName]
End Sub
Sub addRecord handle$
addName = 1
Print #main.contacts, "SelectIndex 0"
Print #main.name, ""
Print #main.number, ""
Print #main.stage, "SelectIndex 20"
Print #main.type, "SelectIndex 20"
Print #main.name, "!SetFocus"
End Sub
Sub acceptEntry handle$
Print #main.name, "!contents? name$";
If name$<>"" Then
Print #main.name, "!contents? number$";
Print #main.number, "!contents? number$";
Print #main.type, "Selection? type$";
Print #main.stage, "Selection? stage$";
If addName = 1 Then
contactCount = contactCount + 1
recordIndex = contactCount
End If
name$(recordIndex) = Str$(recordIndex)+") "+name$
Print #main.contacts, "Reload"
date$=Date$()
If oldStage$="Opening Mailer" And stage$="Follow Up Call" then
mailDate$=Date$()
End If
[saveContactRecord]
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Put #contacts, recordIndex + 1
Close #contacts
If addName = 0 Then [goBack]
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As count$, 75 As fill$
count$ = Str$(contactCount)
Put #contacts, 1
Close #contacts
addName = 0
Call loadNamesFiltered " "
[goBack]
Print #main.contacts, "SelectIndex ";recordIndex
Call addRecord handle$
Else
Notice "NO BUSINESS NAME"+Chr$(13)+"The business name must be entered, "_
+Chr$(13)+"before a record can be saved. "
End If
End Sub
Sub populateList
Open "contact4.dat" For random As #contacts3 Len = 110
Field #contacts3, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Open "contact.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
Get #contacts3, 1
contactCount = Val(name$)
Put #contacts, 1
For index2 = 2 To contactCount + 1
Gettrim #contacts3, index2
For column=1 To 4
Select Case column
Case 1
builder$(index2, column)=name$
Case 2
builder$(index2, column)=number$
Case 3
builder$(index2, column)=stage$
Case 4
builder$(index2, column)=type$
End Select
Next column
Next index2
End Sub
Sub saveList
For index2 = 2 To contactCount + 1
For column=1 To 4
Select Case column
Case 1
name$=builder$(index2, column)
Case 2
number$=builder$(index2, column)
Case 3
stage$=builder$(index2, column)
Case 4
type$=builder$(index2, column)
End Select
Next column
Put #contacts, index2
Next index2
Close #contacts3
Close #contacts
If exists("contact4recoverold.bak") Then
Kill "contact4recoverold.bak"
End If
If exists("contact4recover.bak") Then
Name "contact4recover.bak" As "contact4recoverold.bak"
End If
Name "contact4.dat" As "contact4recover.bak"
Name "contact.dat" As "contact4.dat"
End Sub
Function exists(a$)
Files DefaultDir$, a$, existInfo$()
exists=val(existInfo$(0,0))
End Function
Sub removeEntry
Print #main.filtertype, "selection? filter$"
If addName=0 Then
Confirm "YOU ARE ABOUT TO DELETE THIS RECORD"+Chr$(13)+" "+Chr$(13)+Chr$(34)_
+name$(recordIndex)+Chr$(34)+Chr$(13)+" "+Chr$(13)+"Do you want to proceed?";delAns$
If Lower$(delAns$)="no" Then [noDelete]
WindowWidth=150
WindowHeight=75
StaticText #patience, "PLEASE WAIT...", 10, 15, 100, 25
Open "DELETING...", For Dialog_Modal As #patience
Open "contact4.dat" For Random As #contacts Len = 110
Field #contacts, 35 As name$, 35 As number$, 20 As stage$, 20 As type$
For moveRecords=recordIndex+1 To contactCount
Get #contacts, moveRecords+1
Put #contacts, moveRecords
Next moveRecords
Get #contacts, 1
name$(Val(name$))=""
name$=Str$(Val(name$)-1)
Put #contacts, 1
Close #contacts
Close #patience
Call loadNames
Call loadNamesFiltered handle$
Notice "RECORD DELETED"+Chr$(13)+"Names reloaded"
Else
Notice "NO RECORD SELECTED!"+Chr$(13)+"Please select a record," _
+Chr$(13)+"then select delete from the menu."
End If
[noDelete]
End Sub
|
|
|
|
Post by Rod on Dec 29, 2019 8:28:17 GMT -5
Cool, well done. filterstage$ and filtertype$ would be better than filter$ and filter2$ The more meaningful the name the easier the reread and debug.
|
|
