Версия для печати темы Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > VB6 > Форма поиска...

Автор: REVOLT 5.12.2004, 15:00

Помогите сделать форму поиска. При запуски главной формы нажимаем на кнопку поиск, открывается форма поиска. Там есть LIst1 текстовое поле. В текстовое поле вводим начальные буквы и происходит фильтрация в list1 т.е остаются фамилия только на эту буквы. Двойное нажати е на эту фамилию и в первой форме в текстовых полях отображаются его данные. Form1 Код Private Sub Form_Load()    Me.Data1.DatabaseName = App.Path & "\студенты.mdb"    Me.Data1.RecordSource = "stud"    Me.Data1.Refresh    If Me.Data1.Recordset.RecordCount > 0 Then        Me.Data1.Recordset.MoveLast        Me.Data1.Recordset.MoveFirst    End If    MoveToRecord "First"    NewRecordMode = False End Sub Private Sub txtAddress_Change()    CheckSaveVisibility End Sub Private Sub txtCourse_Change()    CheckSaveVisibility End Sub Private Sub txtFaculty_Change()    CheckSaveVisibility End Sub Private Sub txtGroup_Change()    CheckSaveVisibility End Sub Private Sub txtLastName_Change()    CheckSaveVisibility End Sub Private Sub txtMiddleName_Change()    CheckSaveVisibility End Sub Private Sub txtName_Change()    CheckSaveVisibility End Sub Private Sub txtPhone_Change()    CheckSaveVisibility End Sub Private Sub txtSchool_Change()    CheckSaveVisibility End Sub Private Sub txtSpeciality_Change()    CheckSaveVisibility End Sub Private Sub txtYear_Change()    CheckSaveVisibility End Sub frmFind Код Private Sub Form_Activate()   List1.Enabled = False   dtaFind.DatabaseName = App.Path & "\студенты.mdb"   dtaFind.Refresh If (dtaFind.Recordset.RecordCount > 0) Then   Screen.MousePointer = vbHourglass   dtaFind.Recordset.MoveFirst While Not dtaFind.Recordset.EOF   List1.AddItem dtaFind.Recordset.Fields(0) & ""   dtaFind.Recordset.MoveNext Wend   List1.Enabled = True   DoEvents End If   lblCount = " В списке " & dtaFind.Recordset.RecordCount & " записи"   Screen.MousePointer = vbDefault End Sub Private Sub Form_Unload(Cancel As Integer)   Set frmFind = Nothing End Sub Private Sub List1_DblClick()   gfindstring = List1   Unload frmFind End Sub Private Sub txtFind_Change() Dim entryNum As Long Dim txtToFind As String   txtToFind = txtFind   entryNum = SendMessage(List1.hwnd, LB_SELECTSTRING, 0, txtFind) End Sub Модуль1 Код Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As String) Public Const LB_SELECTSTRING = &H18C Public gfindstring As String Public Const gdatabasename = "\студенты.mdb" Исходник http://www.vb-planet.narod.ru/BD.exe

Автор: boevik 6.12.2004, 08:22

Найди отличия: Form1 Код Private DataChanged As Boolean Private NewRecordMode As Boolean Private Function AskForDataChange()    Dim Result As VbMsgBoxResult        AskForDataChange = 0    If DataChanged = True Then        Result = MsgBox("Äàííûå áûëè èçìåíåíû." & vbCrLf & "Ñîõðàíèòü èçìåíåíèÿ?", vbApplicationModal + vbYesNoCancel, App.Title)        If Result = vbCancel Then            Exit Function        ElseIf Result = vbYes Then            SaveData        Else            AskForDataChange = -1        End If    End If End Function Private Sub CheckSaveVisibility()    DataChanged = True    If NewRecordMode = True Then        Me.cmdSaveNew.Enabled = True    Else        Me.cmdSave.Enabled = True    End If End Sub Private Sub CheckVisibility()    If Data1.Recordset Is Nothing Then        Me.cmdFirst.Enabled = False        Me.cmdPrevious.Enabled = False        Me.cmdNext.Enabled = False        Me.cmdLast.Enabled = False        Exit Sub    End If    With Data1.Recordset        If .RecordCount > 0 Then            Me.cmdFirst.Enabled = True            Me.cmdPrevious.Enabled = True            Me.cmdNext.Enabled = True            Me.cmdLast.Enabled = True            If .RecordCount > 1 Then                If .AbsolutePosition <= 0 Then                    Me.cmdFirst.Enabled = False                    Me.cmdPrevious.Enabled = False                End If                If .AbsolutePosition >= .RecordCount - 1 Then                    Me.cmdNext.Enabled = False                    Me.cmdLast.Enabled = False                End If            Else                Me.cmdFirst.Enabled = False                Me.cmdPrevious.Enabled = False                Me.cmdNext.Enabled = False                Me.cmdLast.Enabled = False            End If        End If    End With End Sub Private Sub ClearTexboxes()    Me.txtAddress.Text = ""    Me.txtCourse.Text = ""    Me.txtFaculty.Text = ""    Me.txtGroup.Text = ""    Me.txtLastName.Text = ""    Me.txtMiddleName.Text = ""    Me.txtName.Text = ""    Me.txtPhone.Text = ""    Me.txtSchool.Text = ""    Me.txtSpeciality.Text = ""    Me.txtYear.Text = ""        DataChanged = False End Sub Private Sub MoveToRecord(Where As String)    If AskForDataChange = -1 Then Exit Sub    Select Case Where        Case "First"            Data1.Recordset.MoveFirst        Case "Previous"            Data1.Recordset.MovePrevious        Case "Next"            Data1.Recordset.MoveNext        Case "Last"            Data1.Recordset.MoveLast    End Select    ShowData    CheckVisibility End Sub Private Sub SaveData()    If DataChanged = False Then Exit Sub        With Me.Data1.Recordset        .Edit        .Àäðåñ = "" & Me.txtAddress.Text        .Êóðñ = Me.txtCourse.Text        .Îòäåëåíèå = Me.txtFaculty.Text        .Ãðóïïà = Me.txtGroup.Text        .Ôàìèëèÿ = Me.txtLastName.Text        .Îò÷åñòâî = Me.txtMiddleName.Text        .Èìÿ = Me.txtName.Text        .Òåë = Me.txtPhone.Text        .Ó÷ü_çàâ = Me.txtSchool.Text        .Ñïåöèàëüíîñòü = Me.txtSpeciality.Text        .Äàòà_ðîæäåíèÿ = Me.txtYear.Text        .Update    End With    DataChanged = False    Me.cmdSave.Enabled = False End Sub Private Sub ShowData() On Error Resume Next    ClearTexboxes        With Me.Data1.Recordset        If Not IsNull(.Àäðåñ) Then Me.txtAddress.Text = CStr(.Àäðåñ)        Me.txtCourse.Text = .Êóðñ        Me.txtFaculty.Text = .Îòäåëåíèå        Me.txtGroup.Text = .Ãðóïïà        Me.txtLastName.Text = .Ôàìèëèÿ        Me.txtMiddleName.Text = .Îò÷åñòâî        Me.txtName.Text = .Èìÿ        Me.txtPhone.Text = .Òåë        Me.txtSchool.Text = .Ó÷ü_çàâ        Me.txtSpeciality.Text = .Ñïåöèàëüíîñòü        If Not IsNull(.Äàòà_ðîæäåíèÿ) Then Me.txtYear.Text = CStr(.Äàòà_ðîæäåíèÿ)    End With    DataChanged = False    Me.cmdSave.Enabled = False End Sub Private Sub cmdAdd_Click()    If AskForDataChange = -1 Then Exit Sub        Me.cmdFirst.Enabled = False    Me.cmdPrevious.Enabled = False    Me.cmdNext.Enabled = False    Me.cmdLast.Enabled = False    Me.cmdSave.Visible = False    Me.cmdAdd.Enabled = False    Me.cmdSaveNew.Visible = True        ClearTexboxes    NewRecordMode = True End Sub Private Sub cmdDelete_Click()    If MsgBox("Óäàëèòü çàïèñü?", vbApplicationModal + vbYesNo, App.Title) = vbYes Then        Me.Data1.Recordset.Delete        Me.Data1.Refresh        If Me.Data1.Recordset.RecordCount > 0 Then            Me.Data1.Recordset.MoveLast            Me.Data1.Recordset.MoveFirst        End If        MoveToRecord "First"    End If End Sub Private Sub cmdFind_Click()   frmFind.Show vbModal Dim iReturn As Integer '   gfindstring = "" If (Len(gfindstring) > 0) Then With Data1.Recordset   .FindFirst "[Èìÿ] = '" & gfindstring & " '"   varbookmark = .Bookmark If (.NoMatch) Then   iReturn = MsgBox("Ñòóäåíò " & gfindstring & " íå íàéäåí", vbInformation, "Ñòóäåíòû") Else   iReturn = MsgBox("Ñòóäåíò " & gfindstring & " íàéäåí", vbInformation, "Ñòóäåíòû")   ShowData End If End With End If End Sub Private Sub cmdFirst_Click()    MoveToRecord "First" End Sub Private Sub cmdLast_Click()    MoveToRecord "Last" End Sub Private Sub cmdNext_Click()    MoveToRecord "Next" End Sub Private Sub cmdPrevious_Click()    MoveToRecord "Previous" End Sub Private Sub cmdSave_Click()    SaveData End Sub Private Sub cmdSaveNew_Click()    With Me.Data1.Recordset        .AddNew        .Ôàìèëèÿ = Me.txtLastName.Text        .Èìÿ = Me.txtName.Text        .Îò÷åñòâî = Me.txtMiddleName.Text        If Len(Trim$(Me.txtYear.Text)) > 0 Then            .Äàòà_ðîæäåíèÿ = CDate(Trim$(Me.txtYear.Text))        End If        .Ñïåöèàëüíîñòü = Me.txtSpeciality.Text        .Îòäåëåíèå = Me.txtFaculty.Text        .Ãðóïïà = CInt(Val(Trim$(Me.txtGroup.Text)))        .Ó÷ü_çàâ = Me.txtSchool.Text        .Òåë = Me.txtPhone.Text        .Update        .Bookmark = Me.Data1.Recordset.LastModified    End With    Me.Data1.Refresh        Me.cmdAdd.Enabled = True    Me.cmdSave.Visible = True    Me.cmdSaveNew.Visible = False        NewRecordMode = False    DataChanged = False        MoveToRecord "Last" End Sub Private Sub Command1_Click() If MsgBox("Ïîäòâåðäèòå!", vbQuestion + 1, "Âûõîäèì?") = 1 Then End End If End Sub Private Sub Data1_Validate(Action As Integer, Save As Integer)    'If Action = 5 Then Save = 0     End Sub Private Sub Form_Load()    Me.Data1.DatabaseName = App.Path & "\ñòóäåíòû.mdb"    Me.Data1.RecordSource = "stud"    Me.Data1.Refresh    If Me.Data1.Recordset.RecordCount > 0 Then        Me.Data1.Recordset.MoveLast        Me.Data1.Recordset.MoveFirst    End If    MoveToRecord "First"    NewRecordMode = False End Sub Private Sub txtAddress_Change()    CheckSaveVisibility End Sub Private Sub txtCourse_Change()    CheckSaveVisibility End Sub Private Sub txtFaculty_Change()    CheckSaveVisibility End Sub Private Sub txtGroup_Change()    CheckSaveVisibility End Sub Private Sub txtLastName_Change()    CheckSaveVisibility End Sub Private Sub txtMiddleName_Change()    CheckSaveVisibility End Sub Private Sub txtName_Change()    CheckSaveVisibility End Sub Private Sub txtPhone_Change()    CheckSaveVisibility End Sub Private Sub txtSchool_Change()    CheckSaveVisibility End Sub Private Sub txtSpeciality_Change()    CheckSaveVisibility End Sub Private Sub txtYear_Change()    CheckSaveVisibility End Sub frmFind: Код Option Explicit Public Property Let recordSourse(ByVal ANewValue As String)   dtaFind.RecordSource = ANewValue End Property Public Property Let addCaption(ByVal ANewValue As String)   lblWichTable = ANewValue End Property Private Sub cmdCancel_Click()   Unload Me End Sub Private Sub Form_Activate()   List1.Enabled = False   dtaFind.DatabaseName = App.Path & "\ñòóäåíòû.mdb"   dtaFind.Refresh If (dtaFind.Recordset.RecordCount > 0) Then   Screen.MousePointer = vbHourglass   dtaFind.Recordset.MoveFirst While Not dtaFind.Recordset.EOF   List1.AddItem dtaFind.Recordset.Fields(0) & ""   dtaFind.Recordset.MoveNext Wend   List1.Enabled = True   DoEvents End If   lblCount = "  ñïèñêå " & dtaFind.Recordset.RecordCount & " çàïèñè"   Screen.MousePointer = vbDefault End Sub Private Sub Form_Unload(Cancel As Integer)   Set frmFind = Nothing End Sub Private Sub List1_DblClick()   gfindstring = List1   Unload frmFind End Sub Private Sub txtFind_Change() Dim entryNum As Long Dim txtToFind As String * 50   txtToFind = txtFind   entryNum = SendMessage(List1.hwnd, LB_SELECTSTRING, -1, txtFind) End Sub Модуль1 Код Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long Public Const LB_SELECTSTRING = &H18C Public gfindstring As String Public Const gdatabasename = "\студенты.mdb"

Автор: REVOLT 6.12.2004, 14:22

boevik, пожалуйста скопируй кодик сначала в блокнот, а потом из блокнота сюда, а то иероглифы не охота переводить.... Плиз, плиз

Автор: REVOLT 6.12.2004, 15:48

Ладно не надо, так разобрался.

Автор: boevik 6.12.2004, 15:58

Цитата(REVOLT @ 6.12.2004, 14:22) boevik, пожалуйста скопируй кодик сначала в блокнот, а потом из блокнота сюда, а то иероглифы не охота переводить.... Плиз, плиз Не поможет.

Автор: korob2001 6.12.2004, 16:17

Цитата Не поможет. Через блокнот - нет, а через WordPad - да. ;))))))

Автор: boevik 6.12.2004, 16:51

Цитата(korob2001 @ 6.12.2004, 16:17) Через блокнот - нет, а через WordPad - да. ;)))))) Не помогает.

Автор: REVOLT 6.12.2004, 20:58

ЛАдно, забыли просто у меня устоновлен редактор, в место блокнота пашет, вот там нет глюковВсёравно всем спасибо

Автор: cardinal 6.12.2004, 21:51

Цитата(boevik @ 6.12.2004, 15:51) Не помогает. Но что-то надо придумывать... Глаза режет... Прошу заметить, что содержание Модуль1 читается.

Автор: REVOLT 6.12.2004, 21:58

Cardinal, здорово подметил, внимание главное одужие программера!

Автор: boevik 7.12.2004, 08:11

cardinal, содержание модуля1 исправленно вручную.

Автор: Naghual 7.12.2004, 10:09

Господа. Просто следуйте простому правилу: 1. при КОПИРОВАНИИ раскладка должна быть РУССКОЙ 2. при ВСТАВКЕ раскладка должна быть РУССКОЙ И не будет у Вас проблем с иероглифами. P.S. А в чем проблема с формой поиска?

Автор: boevik 7.12.2004, 15:33

Цитата(Naghual @ 7.12.2004, 10:09) Господа. Просто следуйте простому правилу: 1. при КОПИРОВАНИИ раскладка должна быть РУССКОЙ 2. при ВСТАВКЕ раскладка должна быть РУССКОЙ Помогает.

Автор: REVOLT 7.12.2004, 16:06

Опять проблемка... Ошибка 3070 и выделяет Код .FindFirst "Студент='" & gfindstring & " '" Я сделал так, открывается форма поиска и на листбок нажимаем двумя кликами, всмысле на чела, и данные этого чела должны перейти на главную форму, эта строка которую выделяет находиться в главной форме.

Автор: boevik 7.12.2004, 16:19

REVOLT, нет у тебя такого поля в базе данных. Код Private DataChanged As Boolean Private NewRecordMode As Boolean Private Function AskForDataChange()    Dim Result As VbMsgBoxResult        AskForDataChange = 0    If DataChanged = True Then        Result = MsgBox("Данные были изменены." & vbCrLf & "Сохранить изменения?", vbApplicationModal + vbYesNoCancel, App.Title)        If Result = vbCancel Then            Exit Function        ElseIf Result = vbYes Then            SaveData        Else            AskForDataChange = -1        End If    End If End Function Private Sub CheckSaveVisibility()    DataChanged = True    If NewRecordMode = True Then        Me.cmdSaveNew.Enabled = True    Else        Me.cmdSave.Enabled = True    End If End Sub Private Sub CheckVisibility()    If Data1.Recordset Is Nothing Then        Me.cmdFirst.Enabled = False        Me.cmdPrevious.Enabled = False        Me.cmdNext.Enabled = False        Me.cmdLast.Enabled = False        Exit Sub    End If    With Data1.Recordset        If .RecordCount > 0 Then            Me.cmdFirst.Enabled = True            Me.cmdPrevious.Enabled = True            Me.cmdNext.Enabled = True            Me.cmdLast.Enabled = True            If .RecordCount > 1 Then                If .AbsolutePosition <= 0 Then                    Me.cmdFirst.Enabled = False                    Me.cmdPrevious.Enabled = False                End If                If .AbsolutePosition >= .RecordCount - 1 Then                    Me.cmdNext.Enabled = False                    Me.cmdLast.Enabled = False                End If            Else                Me.cmdFirst.Enabled = False                Me.cmdPrevious.Enabled = False                Me.cmdNext.Enabled = False                Me.cmdLast.Enabled = False            End If        End If    End With End Sub Private Sub ClearTexboxes()    Me.txtAddress.Text = ""    Me.txtCourse.Text = ""    Me.txtFaculty.Text = ""    Me.txtGroup.Text = ""    Me.txtLastName.Text = ""    Me.txtMiddleName.Text = ""    Me.txtName.Text = ""    Me.txtPhone.Text = ""    Me.txtSchool.Text = ""    Me.txtSpeciality.Text = ""    Me.txtYear.Text = ""        DataChanged = False End Sub Private Sub MoveToRecord(Where As String)    If AskForDataChange = -1 Then Exit Sub    Select Case Where        Case "First"            Data1.Recordset.MoveFirst        Case "Previous"            Data1.Recordset.MovePrevious        Case "Next"            Data1.Recordset.MoveNext        Case "Last"            Data1.Recordset.MoveLast    End Select    ShowData    CheckVisibility End Sub Private Sub SaveData()    If DataChanged = False Then Exit Sub        With Me.Data1.Recordset        .Edit        .Адрес = "" & Me.txtAddress.Text        .Курс = Me.txtCourse.Text        .Отделение = Me.txtFaculty.Text        .Группа = Me.txtGroup.Text        .Фамилия = Me.txtLastName.Text        .Отчество = Me.txtMiddleName.Text        .Имя = Me.txtName.Text        .Тел = Me.txtPhone.Text        .Учь_зав = Me.txtSchool.Text        .Специальность = Me.txtSpeciality.Text        .Дата_рождения = Me.txtYear.Text        .Update    End With    DataChanged = False    Me.cmdSave.Enabled = False End Sub Private Sub ShowData() On Error Resume Next    ClearTexboxes        With Me.Data1.Recordset        If Not IsNull(.Адрес) Then Me.txtAddress.Text = CStr(.Адрес)        Me.txtCourse.Text = .Курс        Me.txtFaculty.Text = .Отделение        Me.txtGroup.Text = .Группа        Me.txtLastName.Text = .Фамилия        Me.txtMiddleName.Text = .Отчество        Me.txtName.Text = .Имя        Me.txtPhone.Text = .Тел        Me.txtSchool.Text = .Учь_зав        Me.txtSpeciality.Text = .Специальность        If Not IsNull(.Дата_рождения) Then Me.txtYear.Text = CStr(.Дата_рождения)    End With    DataChanged = False    Me.cmdSave.Enabled = False End Sub Private Sub cmdAdd_Click()    If AskForDataChange = -1 Then Exit Sub        Me.cmdFirst.Enabled = False    Me.cmdPrevious.Enabled = False    Me.cmdNext.Enabled = False    Me.cmdLast.Enabled = False    Me.cmdSave.Visible = False    Me.cmdAdd.Enabled = False    Me.cmdSaveNew.Visible = True        ClearTexboxes    NewRecordMode = True End Sub Private Sub cmdDelete_Click()    If MsgBox("Удалить запись?", vbApplicationModal + vbYesNo, App.Title) = vbYes Then        Me.Data1.Recordset.Delete        Me.Data1.Refresh        If Me.Data1.Recordset.RecordCount > 0 Then            Me.Data1.Recordset.MoveLast            Me.Data1.Recordset.MoveFirst        End If        MoveToRecord "First"    End If End Sub Private Sub cmdFind_Click()   frmFind.Show vbModal Dim iReturn As Integer '   gfindstring = "" If (Len(gfindstring) > 0) Then With Data1.Recordset   .FindFirst "[Имя] = '" & gfindstring & " '"   varbookmark = .Bookmark If (.NoMatch) Then   iReturn = MsgBox("Студент " & gfindstring & " не найден", vbInformation, "Студенты") Else   iReturn = MsgBox("Студент " & gfindstring & " найден", vbInformation, "Студенты")   ShowData End If End With End If End Sub Private Sub cmdFirst_Click()    MoveToRecord "First" End Sub Private Sub cmdLast_Click()    MoveToRecord "Last" End Sub Private Sub cmdNext_Click()    MoveToRecord "Next" End Sub Private Sub cmdPrevious_Click()    MoveToRecord "Previous" End Sub Private Sub cmdSave_Click()    SaveData End Sub Private Sub cmdSaveNew_Click()    With Me.Data1.Recordset        .AddNew        .Фамилия = Me.txtLastName.Text        .Имя = Me.txtName.Text        .Отчество = Me.txtMiddleName.Text        If Len(Trim$(Me.txtYear.Text)) > 0 Then            .Дата_рождения = CDate(Trim$(Me.txtYear.Text))        End If        .Специальность = Me.txtSpeciality.Text        .Отделение = Me.txtFaculty.Text        .Группа = CInt(Val(Trim$(Me.txtGroup.Text)))        .Учь_зав = Me.txtSchool.Text        .Тел = Me.txtPhone.Text        .Update        .Bookmark = Me.Data1.Recordset.LastModified    End With    Me.Data1.Refresh        Me.cmdAdd.Enabled = True    Me.cmdSave.Visible = True    Me.cmdSaveNew.Visible = False        NewRecordMode = False    DataChanged = False        MoveToRecord "Last" End Sub Private Sub Command1_Click() If MsgBox("Подтвердите!", vbQuestion + 1, "Выходим?") = 1 Then End End If End Sub Private Sub Data1_Validate(Action As Integer, Save As Integer)    'If Action = 5 Then Save = 0     End Sub Private Sub Form_Load()    Me.Data1.DatabaseName = App.Path & "\студенты.mdb"    Me.Data1.RecordSource = "stud"    Me.Data1.Refresh    If Me.Data1.Recordset.RecordCount > 0 Then        Me.Data1.Recordset.MoveLast        Me.Data1.Recordset.MoveFirst    End If    MoveToRecord "First"    NewRecordMode = False End Sub Private Sub txtAddress_Change()    CheckSaveVisibility End Sub Private Sub txtCourse_Change()    CheckSaveVisibility End Sub Private Sub txtFaculty_Change()    CheckSaveVisibility End Sub Private Sub txtGroup_Change()    CheckSaveVisibility End Sub Private Sub txtLastName_Change()    CheckSaveVisibility End Sub Private Sub txtMiddleName_Change()    CheckSaveVisibility End Sub Private Sub txtName_Change()    CheckSaveVisibility End Sub Private Sub txtPhone_Change()    CheckSaveVisibility End Sub Private Sub txtSchool_Change()    CheckSaveVisibility End Sub Private Sub txtSpeciality_Change()    CheckSaveVisibility End Sub Private Sub txtYear_Change()    CheckSaveVisibility End Sub

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)