frmchfind.frm

本系统是本着实用的原则开发的

    MsgBox "没有可打印的信息！", vbOKOnly + vbExclamation, "机房管理"
End If
End Sub

Private Sub Form_Load()
lvwPerson.GridLines = True                          '配置lvwPerson控件
lvwPerson.Sorted = True
lvwPerson.View = lvwReport

lvwPerson.ColumnHeaders.Add , , "卡号", lvwPerson.Width / 7
lvwPerson.ColumnHeaders.Add , , "类别", lvwPerson.Width / 9
lvwPerson.ColumnHeaders.Add , , "姓名", lvwPerson.Width / 9
lvwPerson.ColumnHeaders.Add , , "院系", lvwPerson.Width / 6
lvwPerson.ColumnHeaders.Add , , "专业", lvwPerson.Width / 6
lvwPerson.ColumnHeaders.Add , , "班级", lvwPerson.Width / 10
lvwPerson.ColumnHeaders.Add , , "金额", lvwPerson.Width / 10
lvwPerson.ColumnHeaders.Add , , "状态", lvwPerson.Width / 10
lvwPerson.ColumnHeaders.Add , , "持卡人描述", lvwPerson.Width / 9

cboSType.AddItem "本科生"
cboSType.AddItem "专科生"
cboSType.AddItem "研究生"
cboSType.AddItem "计算机培训"
cboSType.AddItem "网络培训"
cboSType.AddItem "临时卡"
cboSType.AddItem ""

cboState.AddItem "正常"
cboState.AddItem "上机"
cboState.AddItem "挂失"
cboState.AddItem "停用"
cboState.AddItem ""

Set rsInstitute = New Recordset
rsInstitute.Open "select * from TbInstitute ", Modmain.conn, 3, 2
While Not rsInstitute.EOF
    cboI_name.AddItem (rsInstitute.Fields("I_Name"))
    rsInstitute.MoveNext
Wend
cboI_name.AddItem ""
Dim i As Integer
i = 0
Dim IntYear As Integer
IntYear = Year(Date)
If Month(Date) < 8 Then
IntYear = Year(Date)
    While i < 4
        cboGrade.AddItem (IntYear - 1)
        i = i + 1
        IntYear = IntYear - 1
    Wend
Else
    While i < 4
        cboGrade.AddItem (IntYear)
        i = i + 1
        IntYear = IntYear - 1
    Wend
End If
cboGrade.AddItem ""


Set rsCardholderFind = New Recordset
rsCardholderFind.Open "select * from TbCardholderFind", Modmain.conn, 3, 2

Set RsCardholder = New Recordset
RsCardholder.Open "select * from TbCardholder", Modmain.conn, 3, 2
lblnumber.Caption = RsCardholder.RecordCount
If RsCardholder.RecordCount <> 0 Then
    While Not RsCardholder.EOF
        LoadDate
        RsCardholder.MoveNext
    Wend
End If

End Sub


Private Sub cboGrade_Click()
If cboC_name.ListCount <> 0 Then
    cboC_name.Clear
End If
If cboS_name.Text <> "" And cboGrade.Text <> "" Then
    AddClass
    ElseIf cboS_name.Text <> "" And cboGrade.Text = "" Then
        AddClassPP
End If
End Sub
Private Sub cboI_name_Click()
If cboS_name.ListCount <> 0 Then
        cboS_name.Clear
End If
If cboI_name.Text <> "" Then
    Set rsInstituteI_ID = New Recordset
    rsInstituteI_ID.Open "select * from TbInstitute where I_name = '" & cboI_name.Text & "' ", Modmain.conn, 3, 2
    strInstituteI_ID = rsInstituteI_ID.Fields!I_ID
    
    Set rsSpeciality = New Recordset
    rsSpeciality.Open "select * from TbSpeciality where I_ID like '" & rsInstituteI_ID.Fields!I_ID & "' ", Modmain.conn, 3, 2
    If rsSpeciality.RecordCount <> 0 Then
        While Not rsSpeciality.EOF
            cboS_name.AddItem (rsSpeciality.Fields!S_Name)
            rsSpeciality.MoveNext
        Wend
        cboS_name.AddItem ""
    End If
End If
End Sub
Private Sub cboS_name_Click()
If cboC_name.ListCount <> 0 Then
    cboC_name.Clear
End If
If cboS_name.Text <> "" And cboGrade.Text <> "" Then
    AddClass
    ElseIf cboS_name.Text <> "" And cboGrade.Text = "" Then
        AddClassPP
End If
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub AddClass()
Dim strc_id As String
strc_id = CStr(rsInstituteI_ID.Fields!I_ID) & Right(cboGrade.Text, 2)
Set rsClass = New Recordset
rsClass.Open "select * from TbClass where left(C_ID,4) like '" & strc_id & "' ", Modmain.conn, 3, 2
If rsClass.RecordCount <> 0 Then
    While Not rsClass.EOF
        cboC_name.AddItem (rsClass.Fields!C_ID)
        rsClass.MoveNext
    Wend
End If
cboC_name.AddItem ""
End Sub
Private Sub AddClassPP()
Dim strc_id As String
strc_id = CStr(rsInstituteI_ID.Fields!I_ID)
Set rsClass = New Recordset
rsClass.Open "select * from TbClass where left(C_ID,2) like '" & strc_id & "' ", Modmain.conn, 3, 2
If rsClass.RecordCount <> 0 Then
    While Not rsClass.EOF
        cboC_name.AddItem (rsClass.Fields!C_ID)
        rsClass.MoveNext
    Wend
End If
cboC_name.AddItem ""
End Sub
Private Function where() As String          '查询条件
Dim s As String
If txtCH_ID.Text <> "" Then
    s = " where CH_ID like '%" & Trim(txtCH_ID.Text) & "%'"
End If
If txtCH_Name.Text <> "" Then
    If s <> "" Then
        s = s & "and CH_Name like '%" & Trim(txtCH_Name.Text) & "%'"
    Else
    s = " where CH_Name like '%" & Trim(txtCH_Name.Text) & "%'"
    End If
End If
If txtCH_No.Text <> "" Then
    If s <> "" Then
        s = s & "and right(CH_ID,8) like '%" & Trim(txtCH_No.Text) & "%'"
    Else
        s = " where right(CH_ID,8) like '%" & Trim(txtCH_No.Text) & "%'"
    End If
End If
If cboSType.Text <> "" Then
    Set rsSort = New Recordset
    rsSort.Open "select * from TbSort where ST_Name like '" & cboSType.Text & "' ", Modmain.conn, 3, 2
    If s <> "" Then
        s = s & "and left(CH_ID,2) like '%" & Trim(rsSort.Fields!ST_ID) & "%'"
    Else
        s = " where left(CH_ID,2) like '%" & Trim(rsSort.Fields!ST_ID) & "%'"
    End If
End If
If cboState.Text <> "" Then
    If s <> "" Then
        s = s & "and State = '" & cboState.Text & "'"
    Else
        s = " where State = '" & cboState.Text & "'"
    End If
End If
If cboI_name.Text <> "" Then
    If s <> "" Then
    s = s & "and mid(CH_ID,3,2) like '%" & strInstituteI_ID & "%'"
    Else
    s = " where mid(CH_ID,3,2) like '%" & strInstituteI_ID & "%'"
    End If
End If
If cboS_name.Text <> "" Then
    Set rsSpecialityID = New Recordset
    rsSpecialityID.Open "select * from TbSpeciality where S_Name like '" & cboS_name.Text & "' ", Modmain.conn, 3, 2
    If s <> "" Then
        s = s & "and mid(ch_id,3,2) like '" & rsSpecialityID.Fields!I_ID & "'and mid(ch_id,7,1) like '" & rsSpecialityID.Fields!s_ID & "'"
    Else
        s = " where mid(ch_id,3,2) like '" & rsSpecialityID.Fields!I_ID & "'and mid(ch_id,7,1) like '" & rsSpecialityID.Fields!s_ID & "'"
    End If
End If
If cboGrade.Text <> "" Then
    If s <> "" Then
        s = s & "and mid(ch_id,5,2) like '" & Right(cboGrade.Text, 2) & "'"
    Else
        s = " where mid(ch_id,5,2) like '" & Right(cboGrade.Text, 2) & "'"
    End If
End If
If cboC_name.Text <> "" Then
    Set rsClassInfo = New Recordset
    rsClassInfo.Open "select * from TbClass where C_ID='" & cboC_name.Text & "'", Modmain.conn, 3, 2
    Dim aa As Integer, bb As Integer
    aa = CInt(CStr(rsClassInfo.Fields!StartNo))
    bb = CInt(CStr(rsClassInfo.Fields!EndNo))
    If s <> "" Then
        s = s & " and mid(CH_ID,3,5)='" & Left(rsClassInfo.Fields!C_ID, 5) & "'and right(CH_ID,3)> " & aa & " and right(CH_ID,3)<" & bb & ""
    Else
        s = " where mid(CH_ID,3,5)='" & Left(rsClassInfo.Fields!C_ID, 5) & "'and right(CH_ID,3)> " & aa & " and right(CH_ID,3)<" & bb & ""
    End If
End If
where = s
End Function
Private Sub LoadDate()
    
    rsCardholderFind.AddNew
    Set LPItem = lvwPerson.ListItems.Add
If Left(RsCardholder.Fields!ch_id, 2) = "0B" Or Left(RsCardholder.Fields!ch_id, 2) = "0Z" Or Left(RsCardholder.Fields!ch_id, 2) = "0Y" Then    '给学生信息赋值
    LPItem.Text = RsCardholder.Fields!ch_id                    '给卡号赋值
    rsCardholderFind.Fields!ch_id = RsCardholder.Fields!ch_id

    Set rsSort = New Recordset
    rsSort.Open "select * from TbSort where ST_ID like '" & Left(RsCardholder.Fields!ch_id, 2) & "'", Modmain.conn, 3, 2
    LPItem.SubItems(1) = rsSort.Fields!ST_Name          '给类别赋值
    rsCardholderFind.Fields!ST_Name = rsSort.Fields!ST_Name
    
    LPItem.SubItems(2) = RsCardholder.Fields!CH_Name       '给姓名赋值
    rsCardholderFind.Fields!CH_Name = RsCardholder.Fields!CH_Name
    
    Set rsInstitute = New Recordset
    rsInstitute.Open "select * from TBInstitute where I_ID like '" & Mid(RsCardholder.Fields!ch_id, 3, 2) & "'", Modmain.conn, 3, 2
    LPItem.SubItems(3) = rsInstitute.Fields!I_Name         '给院系赋值
    rsCardholderFind.Fields!I_Name = rsInstitute.Fields!I_Name
    
    Set rsSpeciality = New Recordset
    rsSpeciality.Open "select * from TBSpeciality where I_ID like '" & Mid(RsCardholder.Fields!ch_id, 3, 2) & "' and S_ID like '" & Mid(RsCardholder.Fields!ch_id, 7, 1) & "'", Modmain.conn, 3, 2
    LPItem.SubItems(4) = rsSpeciality.Fields!S_Name        '给专业赋值
    rsCardholderFind.Fields!S_Name = rsSpeciality.Fields!S_Name

    Set rsClass = New Recordset
    Dim aa As Integer
    aa = Right(RsCardholder.Fields!ch_id, 3)
    rsClass.Open "select * from TBClass where left(C_ID,5) like '" & Mid(RsCardholder.Fields!ch_id, 3, 5) & "' and  CInt(StartNo)<=" & aa & " and CInt(EndNo) >=" & aa & "", Modmain.conn, 3, 2
     LPItem.SubItems(5) = rsClass.Fields!C_ID        '给班级赋值
    rsCardholderFind.Fields!C_ID = rsClass.Fields!C_ID
    
      LPItem.SubItems(6) = RsCardholder.Fields!Money      '给金额赋值
     rsCardholderFind.Fields!Money = RsCardholder.Fields!Money
     
      LPItem.SubItems(7) = RsCardholder.Fields!State       '给状态赋值
      rsCardholderFind.Fields!State = RsCardholder.Fields!State
      
     If RsCardholder.Fields!CH_Memo <> "" Then
        LPItem.SubItems(8) = RsCardholder.Fields!CH_Memo      '给持卡人描述赋值
        rsCardholderFind.Fields!CH_Memo = RsCardholder.Fields!CH_Memo
     End If
     rsCardholderFind.Update
End If
If Left(RsCardholder.Fields!ch_id, 2) = "0J" Or Left(RsCardholder.Fields!ch_id, 2) = "0L" Or Left(RsCardholder.Fields!ch_id, 2) = "0W" Then             '给学员和临时卡赋值
    LPItem.Text = RsCardholder.Fields!ch_id                    '给卡号赋值
    rsCardholderFind.Fields!ch_id = RsCardholder.Fields!ch_id

    Set rsSort = New Recordset
    rsSort.Open "select * from TbSort where ST_ID like '" & Left(RsCardholder.Fields!ch_id, 2) & "'", Modmain.conn, 3, 2
    LPItem.SubItems(1) = rsSort.Fields!ST_Name          '给类别赋值
    rsCardholderFind.Fields!ST_Name = rsSort.Fields!ST_Name

    LPItem.SubItems(2) = RsCardholder.Fields!CH_Name      '给姓名赋值
    rsCardholderFind.Fields!CH_Name = RsCardholder.Fields!CH_Name
    
    LPItem.SubItems(3) = ""                          '给院系赋值
    rsCardholderFind.Fields!I_Name = ""
    
    LPItem.SubItems(4) = ""                        '给专业赋值
    rsCardholderFind.Fields!S_Name = ""


    LPItem.SubItems(5) = ""                         '给班级赋值
    rsCardholderFind.Fields!C_ID = ""

    LPItem.SubItems(6) = RsCardholder.Fields!Money      '给金额赋值
     rsCardholderFind.Fields!Money = RsCardholder.Fields!Money
     
     LPItem.SubItems(7) = RsCardholder.Fields!State    '给状态赋值
    rsCardholderFind.Fields!State = RsCardholder.Fields!State
   
     LPItem.SubItems(8) = RsCardholder.Fields!CH_Memo      '给持卡人描述赋值
     rsCardholderFind.Fields!CH_Memo = RsCardholder.Fields!CH_Memo
     rsCardholderFind.Update
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
If rsCardholderFind.RecordCount <> 0 Then
    rsCardholderFind.MoveFirst
    While Not rsCardholderFind.EOF
        rsCardholderFind.Delete
        rsCardholderFind.MoveNext
    Wend
End If
End Sub

Private Sub lvwPerson_ItemClick(ByVal Item As MSComctlLib.ListItem)
Set itmX = lvwPerson.FindItem(Item, , , lvwPartial)
End Sub

Private Sub lvwPerson_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
    PopupMenu MnuList, vbPopupMenuRightButton
End If

End Sub

Private Sub MnuLook_Click()
frmListCH.Show 1
End Sub