Visual Basic 4 Unleashed

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic 4 Unleashed / Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso / source / chap35 / frmlooku.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1995-09-09 | 15.6 KB | 430 lines

VERSION 4.00 Begin VB.Form frmLookup Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Lookup Customer" ClientHeight = 4605 ClientLeft = 2865 ClientTop = 1110 ClientWidth = 6255 BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 700 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 5010 Left = 2805 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 4605 ScaleWidth = 6255 Top = 765 Width = 6375 Begin VB.ComboBox lstSearch Height = 300 ItemData = "FRMLOOKU.frx":0000 Left = 2040 List = "FRMLOOKU.frx":0002 Style = 2 'Dropdown List TabIndex = 1 Top = 2400 Width = 2775 End Begin VB.ComboBox lstmultimatch Height = 300 ItemData = "FRMLOOKU.frx":0004 Left = 600 List = "FRMLOOKU.frx":0006 Sorted = -1 'True Style = 2 'Dropdown List TabIndex = 3 Top = 1920 Visible = 0 'False Width = 5175 End Begin VB.TextBox txtCustID BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 700 size = 12 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 420 Left = 2400 TabIndex = 0 Top = 1320 Width = 2295 End Begin VB.CommandButton btnOK2 Appearance = 0 'Flat BackColor = &H80000005& Caption = "&OK" Enabled = 0 'False Height = 615 Left = 2760 TabIndex = 4 Top = 3360 Visible = 0 'False Width = 1095 End Begin VB.CommandButton btnCancel Appearance = 0 'Flat BackColor = &H80000005& Caption = "&Cancel" Height = 615 Left = 4440 TabIndex = 5 TabStop = 0 'False Top = 3360 Width = 1095 End Begin VB.CommandButton btnOK1 Appearance = 0 'Flat BackColor = &H80000005& Caption = "&OK" Height = 615 Index = 0 Left = 1080 TabIndex = 2 Top = 3360 Width = 1095 End Begin VB.Label lblin Alignment = 2 'Center Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "in" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 700 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 255 Left = 1560 TabIndex = 8 Top = 2400 Width = 375 End Begin VB.Label Label1 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = $"FRMLOOKU.frx":0008 ForeColor = &H80000008& Height = 495 Left = 600 TabIndex = 7 Top = 360 Width = 5055 End Begin VB.Label lblFind Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Find" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 700 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 255 Left = 1560 TabIndex = 6 Top = 1440 Width = 495 End Attribute VB_Name = "frmLookup" Attribute VB_Creatable = False Attribute VB_Exposed = False Private Sub cmbSrchField_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub btnCancel_Click() ' User changed their mind. Reset the Dynaset to ' the old customer. Call FindCust(ByVal tmpCustNum, "CustomerNum") Unload frmLookup End Sub Private Sub btnOK1_Click(Index As Integer) Dim SrchField As String Dim foundcust As Integer Dim ListCount As Integer Dim addcriteria As String Dim mbox 'On Error GoTo lookuperr MousePointer = 11 ' hourglass ' Check if any values have been left out from the search. If ' So, let the user know what they should do. If Len(txtCustID.Text) = 0 Then MsgBox ("Please enter a value to search for.") txtCustID.SetFocus MousePointer = 0 Exit Sub End If If Len(Trim$(lstSearch.Text)) = 0 Then MsgBox ("Please select a field name in which you would like to find '" & txtCustID.Text) & "'" lstSearch.SetFocus MousePointer = 0 Exit Sub End If 'Back up the customer number in case the search is unsuccessful. tmpCustNum = Customer_number ' Assign the database field based on the selection in the list box Select Case lstSearch Case "Customer Number": If IsNumeric(txtCustID.Text) = False Then mbox = MsgBox("Customer number must be numeric.", MB_ICONSTOP) MousePointer = 0 txtCustID.Text = "" txtCustID.SetFocus Exit Sub End If SrchField = "CustomerNum" Case "Address": SrchField = "Address" Case "Company": SrchField = "Company" Case "Last Name": SrchField = "Last_name" Case Else: Customer_number = tmpCustNum MousePointer = 0 Exit Sub End Select ' Call the FindCust function. This function will return ' True if it set the customer number to a new number, ' False if it was unable to, ' or the number of matches if more than one record matched the criteria. foundcust = FindCust(ByVal txtCustID, SrchField) ' Found none If foundcust = False Then MsgBox ("Can not find " & lstSearch & " '" & txtCustID & "' in the database.") txtCustID.Text = "" Customer_number = tmpCustNum MousePointer = 0 Exit Sub Else ' Found one If foundcust = True Then 'If we found who we wanted, we are done with this screen Unload frmLookup Exit Sub Else ' Found more than one. ' Get the correct number of records by going to the last one CustmainDynaset.MoveLast 'Tell the user how many were found. Label1.Caption = "Found " & CustmainDynaset.RecordCount & " '" & UCase(txtCustID.Text) & "'s. Please select the one you want." ' Turn off the parts of the screen that don't apply now. lblFind.Visible = False lblin.Visible = False txtCustID.Visible = False lstSearch.Visible = False btnOK1(0).Visible = False lblFind.Enabled = False lblin.Enabled = False txtCustID.Enabled = False lstSearch.Enabled = False btnOK1(0).Enabled = False ' Activate & place the lstMultiMatch control and ' associated controls. lstmultimatch.Visible = True lstmultimatch.Enabled = True btnOK2.Visible = True btnOK2.Enabled = True btnOK2.Left = 1080 btnOK2.Top = 3360 'Make sure the list empty before adding items to it. lstmultimatch.Clear ' Go to the beginning of the dynaset and populate the list. CustmainDynaset.MoveFirst ' Put a default value in the control addcriteria = Str$(CustmainDynaset.Fields("CustomerNum")) If IsNull(CustmainDynaset.Fields("First_Name")) <> True Then addcriteria = addcriteria & ", " & CustmainDynaset.Fields("First_Name") End If If IsNull(CustmainDynaset.Fields("Last_name")) <> True Then addcriteria = addcriteria & " " & CustmainDynaset.Fields("Last_Name") End If If IsNull(CustmainDynaset.Fields("Company")) <> True Then addcriteria = addcriteria & ", " & CustmainDynaset.Fields("Company") End If If IsNull(CustmainDynaset.Fields("Address")) <> True Then addcriteria = addcriteria & ", " & CustmainDynaset.Fields("Address") End If ' start populating the combo box list ListCount = 0 While CustmainDynaset.RecordCount > ListCount addcriteria = Str$(CustmainDynaset.Fields("CustomerNum")) If IsNull(CustmainDynaset.Fields("First_Name")) <> True Then addcriteria = addcriteria & ", " & CustmainDynaset.Fields("First_Name") End If If IsNull(CustmainDynaset.Fields("Last_name")) <> True Then addcriteria = addcriteria & " " & CustmainDynaset.Fields("Last_Name") End If If IsNull(CustmainDynaset.Fields("Company")) <> True Then addcriteria = addcriteria & ", " & CustmainDynaset.Fields("Company") End If If IsNull(CustmainDynaset.Fields("Address")) <> True Then addcriteria = addcriteria & ", " & CustmainDynaset.Fields("Address") End If lstmultimatch.AddItem addcriteria CustmainDynaset.MoveNext ListCount = ListCount & 1 Wend End If End If MousePointer = 0 ' hourglass Exit Sub lookuperr: MsgBox Err.Description End Sub Private Sub btnOK2_Click() Dim foundcust As Integer Dim tmpCustNum Dim srchCustNumstr As String Dim srchCustNum Dim custnumlen As Integer MousePointer = 11 ' hourglass tmpCustNum = Customer_number If Len(lstmultimatch.Text) < 1 Then MsgBox ("Please select an item from the list or press Cancel.") MousePointer = 0 Exit Sub End If ' The length of the customer number is everything up ' until the comma, so find out where the comma is, ' and subtract 1 to get the length of the customer num. custnumlen = (InStr(lstmultimatch.Text, ", ")) custnumlen = custnumlen - 1 ' Get the customer number from the listbox text srchCustNumstr = Mid$(lstmultimatch.Text, 1, custnumlen) srchCustNum = Val(srchCustNumstr) ' Use the customer number to create the dynaset. foundcust = FindCust(ByVal srchCustNum, "CustomerNum") If foundcust = True Then MousePointer = 0 Unload frmLookup Exit Sub Else MsgBox ("Error in search, please retry with a different lookup field.") Customer_number = tmpCustNum End If MousePointer = 0 ' default End Sub Private Sub CSCombo1_Click() If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Function FindCust(ByVal CustID As String, SrchField) As Integer Dim tmpCustNum ' CustID is the actual text to use for the search ' SrchField is the name of the field to use, which could be ' any field in the CUSTMAIN table. tmpCustNum = Customer_number 'If there is no active record, 'then return without doing anything If Len(CustID) = 0 Or Len(SrchField) = 0 Then FindCust = False Exit Function Else ' Set one criteria if the user is searching by Number If SrchField = "CustomerNum" Then Qcriteria = "SELECT * FROM CUSTMAIN WHERE " & SrchField & " = " & CustID & ";" Else ' Set a different criteria for an non-numeric searches Qcriteria = "SELECT * FROM CUSTMAIN WHERE " & SrchField & " LIKE """ & CustID & """;" End If ' Create the dynaset Set CustmainDynaset = CustDB.CreateDynaset(Qcriteria) ' Check for a successful record search. ' Populate the fields on the screen if a record is found. If CustmainDynaset.RecordCount = 0 Then ' Could not find the customer, ' so reset the Dynaset back to the original customer. ' If there was no original customer, then just get out. If Len(tmpCustNum) = 0 Then FindCust = False Exit Function End If Customer_number = tmpCustNum Qcriteria = "SELECT * FROM CUSTMAIN WHERE CustomerNum" & " = " & Customer_number & ";" Set CustmainDynaset = CustDB.CreateDynaset(Qcriteria) FindCust = False Else ' Get to the last record so we can determine how ' many matches there were. CustmainDynaset.MoveLast ' Found more than 1 match If CustmainDynaset.RecordCount > 1 Then Customer_number = tmpCustNum FindCust = CustmainDynaset.RecordCount Else ' Found only 1 match Customer_number = CustmainDynaset.Fields("CustomerNum") FindCust = True End If End If End If End Function Private Sub Form_Activate() ' Reset to the default pointer when returning to this form. MousePointer = 0 lstSearch = "Customer Number" End Sub Private Sub Form_Load() Left = (Screen.Width - Width) / 2 Top = (Screen.Height - Height) / 2 lstSearch.AddItem "Customer Number" lstSearch.AddItem "Address" lstSearch.AddItem "Company" lstSearch.AddItem "Last Name" End Sub Private Sub lstmultimatch_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = KEY_RETURN Then btnOK2.SetFocus End If End Sub Private Sub lstSearch_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = KEY_RETURN Then btnOK1(0).SetFocus End If End Sub Private Sub lstSearch_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub lstSrchField_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub txtCustID_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub