main.frm

一个简单的大学宿舍管理系统环境：vb6.0+acce

Private Sub addjc_Click()
weisheng.Show 1
End Sub

Private Sub bzzt_Click()
SendKeys "{F1}"
End Sub

Private Sub ckjl_Click()
wslook.Show 1
End Sub

Private Sub ckwp_Click()
wupinlook.Show 1
End Sub

Private Sub DataGrid1_DblClick()
'On Error GoTo next1
'Dim I As Adodc
'Set I = DataGrid1.datasource
'If I.RecordSource = "users" Then
'edit.Show 1
'End If
'next1:
If DataGrid1.Columns(0).Caption = "公寓" And DataGrid1.Columns(1).Caption = "寝室" And DataGrid1.Columns(2).Caption = "姓名" And DataGrid1.Columns(3).Caption = "学号" Then
edit.Show 1
Exit Sub
End If
'If DataGrid1.Columns(0).Caption = "公寓" And DataGrid1.Columns(1).Caption = "寝室" And DataGrid1.Columns(2).Caption = "检查1" And DataGrid1.Columns(3).Caption = "检查2" Then
'editws.Show 1
'Exit Sub
'End If
End Sub

Private Sub DataGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
If Button = 2 And DataGrid1.Columns(0).Caption = "公寓" And DataGrid1.Columns(1).Caption = "寝室" And DataGrid1.Columns(2).Caption = "姓名" And DataGrid1.Columns(3).Caption = "学号" Then
PopupMenu Me.aa
End If
End Sub

Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
    On Error Resume Next
    a = DataGrid1.Row
    Text3.Text = a
   ' MsgBox a
End Sub

Private Sub fjzs_Click()
Dim X As Integer
Adodc7.Refresh
X = Adodc7.Recordset.RecordCount
MsgBox "学校共有住宿房间:" & "  " & X & "  " & "间", vbOKOnly, "房间总计"
End Sub

Private Sub Form_Activate()
'设置主窗体状态栏
StatusBar1.Panels(2).Text = "当前用户：" & Text2.Text
StatusBar1.Panels(3).Text = "用户模式：" & Text1.Text
StatusBar1.Panels(4).Text = Date & "    " & Time
'设置普通用户模式
If Text1.Text = "普通用户" Then
yhgl.Visible = False
g1.Visible = False
jlsc.Visible = False
gysz.Visible = False

Toolbar1.Buttons(5).Visible = False
Toolbar1.Buttons(6).Visible = False
Toolbar1.Buttons(7).Visible = False
Toolbar1.Buttons(8).Visible = False
End If

End Sub

Private Sub Form_GotFocus()
Call startree1
End Sub

Private Sub Form_Load()
App.HelpFile = App.Path & "\help.chm"
z = main.Width
u = StatusBar1.Panels(1).Width
v = StatusBar1.Panels(2).Width
w = StatusBar1.Panels(3).Width
m = StatusBar1.Panels(4).Width
provider = "provider=Microsoft.jet.oledb.4.0"
datasource = "data source=" & App.Path & "\DB.mdb"

With Adodc1
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "users" '
.Refresh
End With

With Adodc2
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "gongyu"
.Refresh
End With


With Adodc3
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "class"
.Refresh
End With

With Adodc4
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "weisheng"
.Refresh
End With

With Adodc5
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
End With

With Adodc6
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "dengji"
.Refresh
End With

With Adodc7
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "qinshi"
.Refresh
End With

With Adodc9
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "zichan"
.Refresh
End With

'添加treeview1
Call startree1

'添加treeview2
Call startree2
'添加treeview3
Dim l As Integer
TreeView3.LineStyle = tvwRootLines
Set nod5 = TreeView3.Nodes.add(, , "评分等级", "评分等级")
For l = 1 To Adodc6.Recordset.RecordCount
Set nod6 = TreeView3.Nodes.add("评分等级", tvwChild, "dengji" & l, Adodc6.Recordset.Fields("等级"))
Adodc6.Recordset.MoveNext
Next

Set DataGrid1.datasource = Adodc1
DataGrid1.Refresh
Set users.datasource = Nothing
Set users.datasource = Adodc1
Call dx
next3:
End Sub

Private Sub Form_Resize()
 On Error GoTo next1
DataGrid1.Width = main.Width - SSTab1.Width
DataGrid1.Height = main.Height - StatusBar1.Height - CoolBar1.Height - 750
SSTab1.Height = main.Height - StatusBar1.Height - CoolBar1.Height - 750
Frame1.Height = main.Height - StatusBar1.Height - CoolBar1.Height - 1200
Frame2.Height = main.Height - StatusBar1.Height - CoolBar1.Height - 1200
Frame3.Height = main.Height - StatusBar1.Height - CoolBar1.Height - 1200
TreeView1.Height = main.Height - StatusBar1.Height - CoolBar1.Height - 1500
TreeView2.Height = main.Height - StatusBar1.Height - CoolBar1.Height - 1500
TreeView3.Height = main.Height - StatusBar1.Height - CoolBar1.Height - 1500
Y = main.Width

X = (Y - z) / 4
StatusBar1.Panels(1).Width = u + X
StatusBar1.Panels(2).Width = v + X
StatusBar1.Panels(3).Width = w + X
StatusBar1.Panels(4).Width = m + X
next1:
End Sub

Private Sub gysz_Click()
shezhi.Show 1
End Sub

Private Sub jl_Click()
riji.Show 1
End Sub

Private Sub mryt_Click()
frmtip.Show 1
End Sub

Private Sub nvbl_Click()
rsbili.Show 1
End Sub

Private Sub printf_Click()
On Error Resume Next
SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 3
Dim X As Adodc
Set X = DataGrid1.datasource
Set users.datasource = X
users.Refresh
users.Show
End Sub

Private Sub qjjl_Click()
delqj.Show 1
End Sub

Private Sub qjjl1_Click()
qjlook.Show 1
End Sub

Private Sub rstj_Click()
Dim a As Integer
Adodc1.Refresh
a = Adodc1.Recordset.RecordCount
MsgBox "学校共有住宿人数:" & "  " & a & "  " & "人", vbOKOnly, "人数总计"
End Sub

Private Sub sjbf_Click()
back.Show 1
End Sub

Private Sub sjzh_Click()
change.Show
End Sub
Private Sub SSTab1_GotFocus()
Call startree1
Call startree2
End Sub

Private Sub sycw_Click()
cwck.Show 1
End Sub

Private Sub tc_Click()
Unload Me
End Sub

Private Sub tjwp_Click()
wupinadd.Show 1
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case 1
sel.Show 1
Case 3
add.Show 1
Case 5
edit.Show 1
Case 7
'On Error Resume Next
If (MsgBox("你真的想删除当前记录吗？", vbOKCancel, "系统提示")) = vbOK Then
Dim o As Adodc
Set o = DataGrid1.datasource
    o.Recordset.Delete
    o.Recordset.Update
End If
Case 9
back.Show 1
Case 11
With Adodc1
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "users"
.Refresh
End With
Set DataGrid1.datasource = Adodc1
DataGrid1.Refresh
Set users.datasource = Nothing
Set users.datasource = Adodc1
Case 13
Unload Me
End Select
End Sub

Private Sub TreeView1_Click()
TreeView1.Refresh
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
On Error GoTo next3
'Call startree1
provider = "provider=Microsoft.jet.oledb.4.0"
datasource = "data source=" & App.Path & "\DB.mdb"
With Adodc3
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "class"
.Refresh
End With
Dim a As String
s = TreeView1.SelectedItem.Text
e = TreeView1.SelectedItem.Parent
If e = "公寓管理系统" Then
a = "select * from users where 公寓='" & Trim(s) & "'"
Else
a = "select * from users where 公寓='" & Trim(e) & "' and 寝室='" & Trim(s) & "'"
End If
With Adodc1
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdText
.RecordSource = a
.Refresh
End With
Set DataGrid1.datasource = Adodc1
DataGrid1.Refresh
Set users.datasource = Nothing
Set users.datasource = Adodc1
Call dx
next3:
End Sub

Private Sub TreeView2_NodeClick(ByVal Node As MSComctlLib.Node)
On Error Resume Next
provider = "provider=Microsoft.jet.oledb.4.0"
datasource = "data source=" & App.Path & "\DB.mdb"

Dim a As String
s = TreeView2.SelectedItem.Text
a = "select * from users where 班级='" & Trim(s) & "'"

With Adodc1
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdText
.RecordSource = a
.Refresh
End With
Set DataGrid1.datasource = Adodc1
DataGrid1.Refresh
Set users.datasource = Nothing
Set users.datasource = Adodc1
Call dx
End Sub

Private Sub TreeView3_NodeClick(ByVal Node As MSComctlLib.Node)
On Error Resume Next
provider = "provider=Microsoft.jet.oledb.4.0"
datasource = "data source=" & App.Path & "\DB.mdb"

Dim a As String
s = TreeView3.SelectedItem.Text
a = "select * from weisheng where 等级='" & Trim(s) & "'"

With Adodc1
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdText
.RecordSource = a
.Refresh
End With
Set DataGrid1.datasource = Adodc1
DataGrid1.Refresh

End Sub

Private Sub wgjl_Click()
delwg.Show 1
End Sub

Private Sub wgjl1_Click()
wglook.Show 1
End Sub

Private Sub wsjl_Click()
delws.Show 1
End Sub

Private Sub xsqj_Click()
qingjia.Show 1
End Sub

Private Sub xswg_Click()
weigui.Show 1
End Sub

Private Sub yhgl_Click()
useradd.Show 1
End Sub
Public Function startree1()
On Error Resume Next
Adodc2.Refresh
Adodc7.Refresh
TreeView1.Nodes.Clear
Dim I As Integer
TreeView1.LineStyle = tvwRootLines
Set nod1 = TreeView1.Nodes.add(, , "公寓管理系统", "公寓管理系统")
For I = 1 To Adodc2.Recordset.RecordCount
Set nod2 = TreeView1.Nodes.add("公寓管理系统", tvwChild, "child" & I, Adodc2.Recordset.Fields("公寓名称"))
    Adodc8.Mode = adModeReadWrite
    Adodc8.ConnectionString = provider & ";" & datasource
    Adodc2.Recordset.MoveNext
    Adodc8.CommandType = adCmdText
    Adodc8.RecordSource = "select 寝室 from qinshi where 公寓名称='" & nod2.Text & "'"
    Adodc8.Refresh
    Dim k As Long
    Do While Not Adodc8.Recordset.EOF
        Call TreeView1.Nodes.add(nod2, tvwChild, "childdorm" & CStr(k), Adodc8.Recordset.Fields("寝室"))
        k = k + 1
        Adodc8.Recordset.MoveNext
    Loop
Next

End Function
Public Function startree2()
On Error Resume Next
Adodc3.Refresh
TreeView2.Nodes.Clear
Dim J As Integer
TreeView2.LineStyle = tvwRootLines
Set nod3 = TreeView2.Nodes.add(, , "所有注册班级", "所有注册班级")
For J = 1 To Adodc3.Recordset.RecordCount
Set nod4 = TreeView2.Nodes.add("所有注册班级", tvwChild, "child" & J, Adodc3.Recordset.Fields("class"))
Adodc3.Recordset.MoveNext
Next
End Function
Public Function dx()
With DataGrid1
'.Columns(0).Width = 1200
'.Columns(1).Width = 600
'.Columns(2).Width = 900
'.Columns(3).Width = 500
'.Columns(4).Width = 800
'.Columns(5).Width = 600
'.Columns(6).Width = 800
'.Columns(7).Width = 800
'.Columns(8).Width = 1200
'.Columns(9).Width = 1400
End With
End Function


Private Sub zcjl_Click()
delzc.Show 1
End Sub