frmroominput.frm

教务管理系统,用VB 完成,以SQL SERVER 2000作为后台数据库

         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FFFF&
      Height          =   495
      Left            =   2880
      TabIndex        =   2
      Top             =   420
      Width           =   1335
   End
   Begin VB.Shape Shape1 
      BorderColor     =   &H00FF0000&
      BorderStyle     =   6  'Inside Solid
      BorderWidth     =   2
      FillColor       =   &H00C0C0FF&
      FillStyle       =   0  'Solid
      Height          =   6225
      Left            =   210
      Shape           =   4  'Rounded Rectangle
      Top             =   120
      Width           =   9105
   End
   Begin VB.Menu MNUFILE 
      Caption         =   "文件[&F]"
      Begin VB.Menu MNUEXIT 
         Caption         =   "退出[&X]"
      End
   End
End
Attribute VB_Name = "frmRoomInput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdExit_Click()
On Error Resume Next
Unload Me
'Frmstart.Show
End Sub

Private Sub cmdYes_Click()
On Error Resume Next
Dim sqlRepeat As String
Dim recRepeat As Recordset
Dim sqlInsert As String
'在原数据库中有否
sqlRepeat = "select * from room where ssh='" + Trim(txtSSH) + "'"
Set recRepeat = Dbstudent.OpenRecordset(sqlRepeat, dbOpenSnapshot)
If recRepeat.RecordCount <> 0 Then
    If txtOne <> " " Then
        sqlInsert = "update room set one='" + Trim(txtOne) + "' where ssh='" + Trim(txtSSH) + "'"
        Dbstudent.Execute sqlInsert
    End If
    If txtTwo <> " " Then
        sqlInsert = "update room set two='" + Trim(txtTwo) + "' where ssh='" + Trim(txtSSH) + "'"
        Dbstudent.Execute sqlInsert
    End If
    If txtThree <> " " Then
        sqlInsert = "update room set three='" + Trim(txtThree) + "' where ssh='" + Trim(txtSSH) + "'"
        Dbstudent.Execute sqlInsert
    End If
    If txtFour <> " " Then
        sqlInsert = "update room set four='" + Trim(txtFour) + "' where ssh='" + Trim(txtSSH) + "'"
        Dbstudent.Execute sqlInsert
    End If
    If txtFive <> " " Then
        sqlInsert = "update room set five='" + Trim(txtFive) + "' where ssh='" + Trim(txtSSH) + "'"
        Dbstudent.Execute sqlInsert
    End If
    If txtSix <> " " Then
        sqlInsert = "update room set six='" + Trim(txtSix) + "' where ssh='" + Trim(txtSSH) + "'"
        Dbstudent.Execute sqlInsert
    End If
    If txtSeven <> " " Then
        sqlInsert = "update room set seven='" + Trim(txtSeven) + "' where ssh='" + Trim(txtSSH) + "'"
        Dbstudent.Execute sqlInsert
    End If
    If txtEight <> " " Then
        sqlInsert = "update room set eight='" + Trim(txtEight) + "' where ssh='" + Trim(txtSSH) + "'"
        Dbstudent.Execute sqlInsert
    End If
    If txtNine <> " " Then
        sqlInsert = "update room set nine='" + Trim(txtNine) + "' where ssh='" + Trim(txtSSH) + "'"
        Dbstudent.Execute sqlInsert
    End If
    If txtTen <> " " Then
        sqlInsert = "update room set ten='" + Trim(txtTen) + "' where ssh='" + Trim(txtSSH) + "'"
        Dbstudent.Execute sqlInsert
    End If
    If txtOne <> " " Then
        sqlInsert = "update room set one='" + Trim(txtOne) + "' where ssh='" + Trim(txtSSH) + "'"
        Dbstudent.Execute sqlInsert
    End If
    If txtEleven <> " " Then
        sqlInsert = "update room set eleven='" + Trim(txtEleven) + "' where ssh='" + Trim(txtSSH) + "'"
        Dbstudent.Execute sqlInsert
    End If
    If txtTwelve <> " " Then
        sqlInsert = "update room set twelve='" + Trim(txtTwelve) + "' where ssh='" + Trim(txtSSH) + "'"
        Dbstudent.Execute sqlInsert
    End If
Else
    sqlInsert = "insert into room(ssh,one,two,three,four,five,six,seven,eight,nine,ten,eleven,twelve) "
    sqlInsert = sqlInsert + "values('" + Trim(txtSSH) + "','" + Trim(txtOne) + "',"
    sqlInsert = sqlInsert + "'" + Trim(txtTwo) + "','" + Trim(txtThree) + "',"
    sqlInsert = sqlInsert + "'" + Trim(txtFour) + "','" + Trim(txtFive) + "',"
    sqlInsert = sqlInsert + "'" + Trim(txtSix) + "','" + Trim(txtSeven) + "',"
    sqlInsert = sqlInsert + "'" + Trim(txtEight) + "','" + Trim(txtNine) + "',"
    sqlInsert = sqlInsert + "'" + Trim(txtTen) + "','" + Trim(txtEleven) + "',"
    sqlInsert = sqlInsert + "'" + Trim(txtTwelve) + "')"
    Dbstudent.Execute sqlInsert
End If
CountZHF
InitItem
End Sub

Private Sub Form_Load()
On Error Resume Next
Dim sqlSS As String
Dim recSS As Recordset
Dim I As Integer
Line1.X1 = 0
Line1.X2 = frmRoomInput.Width
'frmRoomInput.Picture = LoadPicture(App.Path + "\picture\sky.bmp")
sqlSS = "select distinct ss from zbqkb"
Set recSS = Dbstudent.OpenRecordset(sqlSS, dbOpenSnapshot)
If recSS.RecordCount <> 0 Then
    recSS.MoveLast
    recSS.MoveFirst
    If Not IsNull(recSS!SS) Then
        lstSSH.AddItem "" + Trim(recSS!SS) + ""
    End If
    For I = 1 To recSS.RecordCount - 1
      recSS.MoveNext
      lstSSH.AddItem "" + Trim(recSS!SS) + ""
    Next I
Else
    MsgBox "数据库无宿舍号!", vbCritical
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Unload Me
'frmRoomMDI.Show
'frmRoomMDI.Enabled = True
End Sub

Private Sub lstSSH_DblClick()
On Error Resume Next
Dim recMember As Recordset
Dim sqlMember As String
Dim sqlUpdate As String
Dim recUpdate As Recordset
txtSSH = lstSSH.List(lstSSH.ListIndex)
'显示各框数字
sqlUpdate = "select * from room where ssh='" + Trim(txtSSH) + "'"
Set recUpdate = Dbstudent.OpenRecordset(sqlUpdate, dbOpenSnapshot)
If recUpdate.RecordCount <> 0 Then
    If Not IsNull(recUpdate!one) Then
        txtOne = recUpdate!one
    Else
        txtOne = ""
    End If
    If Not IsNull(recUpdate!two) Then
        txtTwo = recUpdate!two
    Else
        txtTwo = ""
    End If
    If Not IsNull(recUpdate!three) Then
        txtThree = recUpdate!three
    Else
        txtThree = ""
    End If
    If Not IsNull(recUpdate!four) Then
        txtFour = recUpdate!four
    Else
        txtFour = ""
    End If
    If Not IsNull(recUpdate!five) Then
        txtFive = recUpdate!five
    Else
        txtFive = ""
    End If
    If Not IsNull(recUpdate!six) Then
        txtSix = recUpdate!six
    Else
        txtSix = ""
    End If
    If Not IsNull(recUpdate!seven) Then
        txtSeven = recUpdate!seven
    Else
        txtSeven = ""
    End If
    If Not IsNull(recUpdate!eight) Then
        txtEight = recUpdate!eight
    Else
        txtEight = ""
    End If
    If Not IsNull(recUpdate!nine) Then
        txtNine = recUpdate!nine
    Else
        txtNine = ""
    End If
    If Not IsNull(recUpdate!ten) Then
        txtTen = recUpdate!ten
    Else
        txtTen = ""
    End If
    If Not IsNull(recUpdate!eleven) Then
        txtEleven = recUpdate!eleven
    Else
        txtEleven = ""
    End If
    If Not IsNull(recUpdate!twelve) Then
        txtTwelve = recUpdate!twelve
    Else
        txtTwelve = ""
    End If
End If
Dim I As Integer
lstCY.Clear
sqlMember = "select xm from zbqkb where ss='" + Trim(txtSSH) + "' "
Set recMember = Dbstudent.OpenRecordset(sqlMember, dbOpenSnapshot)
If recMember.RecordCount <> 0 Then
    recMember.MoveLast
    recMember.MoveFirst
    lstCY.AddItem "" + Trim(recMember!XM) + ""
    For I = 1 To recMember.RecordCount - 1
      recMember.MoveNext
      lstCY.AddItem "" + Trim(recMember!XM) + ""
    Next I
Else
    lstCY.Clear
End If

End Sub

Public Sub InitItem()
On Error Resume Next
txtSSH = ""
txtOne = ""
txtTwo = ""
txtThree = ""
txtFour = ""
txtFive = ""
txtSix = ""
txtSeven = ""
txtEight = ""
txtNine = ""
txtTen = ""
txtEleven = ""
txtTwelve = ""
End Sub

Public Sub CountZHF()
On Error Resume Next
Dim ZHF As Integer
Dim ZHFALL As Integer
Dim Count As Integer
Dim sqlCount As String
Dim recUpdate As Recordset
Dim sqlInsert As String
sqlCount = "select * from room where ssh='" + Trim(txtSSH) + "'"
Set recUpdate = Dbstudent.OpenRecordset(sqlCount, dbOpenSnapshot)
Count = 0
ZHFALL = 0
ZHF = 0
If recUpdate.RecordCount <> 0 Then
    If recUpdate!one <> "" Then
        ZHFALL = ZHFALL + CInt(recUpdate!one)
        Count = Count + 1
    End If
    If recUpdate!two <> "" Then
        ZHFALL = ZHFALL + CInt(recUpdate!two)
        Count = Count + 1
    End If
    If recUpdate!three <> "" Then
        ZHFALL = ZHFALL + CInt(recUpdate!three)
        Count = Count + 1
    End If
    If recUpdate!four <> "" Then
        ZHFALL = ZHFALL + CInt(recUpdate!four)
        Count = Count + 1
    End If
    If recUpdate!five <> "" Then
        ZHFALL = ZHFALL + CInt(recUpdate!five)
        Count = Count + 1
    End If
    If recUpdate!six <> "" Then
        ZHFALL = ZHFALL + CInt(recUpdate!six)
        Count = Count + 1
    End If
    If recUpdate!seven <> "" Then
        ZHFALL = ZHFALL + CInt(recUpdate!seven)
        Count = Count + 1
    End If
    If recUpdate!eight <> "" Then
        ZHFALL = ZHFALL + CInt(recUpdate!eight)
        Count = Count + 1
    End If
    If recUpdate!nine <> "" Then
        ZHFALL = ZHFALL + CInt(recUpdate!nine)
        Count = Count + 1
    End If
    If recUpdate!ten <> "" Then
        ZHFALL = ZHFALL + CInt(recUpdate!ten)
        Count = Count + 1
    End If
    If recUpdate!eleven <> "" Then
        ZHFALL = ZHFALL + CInt(recUpdate!eleven)
        Count = Count + 1
    End If
    If recUpdate!twelve <> "" Then
        ZHFALL = ZHFALL + CInt(recUpdate!twelve)
        Count = Count + 1
    End If
    ZHF = ZHFALL / Count
    sqlInsert = "update room set zhf='" + Trim(CStr(ZHF)) + "'"
    Dbstudent.Execute sqlInsert
End If
End Sub

Private Sub MNUEXIT_Click()
On Error Resume Next
Call cmdExit_Click
End Sub