import.frm

哈哈

    MsgBox "数据库内已经导入数据，请选清空临时数据后再进行操作！", vbOKOnly + 48, title
      StatusBar1.Panels(2).Text = "当前用户操作：" & " 非法操作，" & Err.Description
Else
      
    MsgBox "不是期望的错误，错误号是:" & Err.Number & ",错误描述：" & Err.Description & ",请速与提供商联系！ ", vbOKOnly + 48, title
End If
End Sub

Private Sub Command1_Click()
 MsgBox listview1.ColumnHeaders.Item(1).Text
End Sub

Private Sub delclass_Click()
 deleteclass   '调用自定义过程，删除班级
End Sub

Private Sub delstu_Click()
 deletestu    '调用自定义过程，删除学生
End Sub

Private Sub finishtree_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
 If Button = vbRightButton Then
    fp = True
 End If
End Sub

Private Sub finishtree_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

addchengyuan  '调用添加过程
End Sub

Private Sub finishtree_NodeClick(ByVal Node As MSComctlLib.Node)
StatusBar1.Panels(2).Text = "客户当前动作：" & Node & "被客户选中......."
 If Len(Node.Key) < 6 Then
    Exit Sub
 End If
 
 mynode.choosenode = Node         '接受存储所选变量
 mynode.choosefront = Node.Parent.Text
 mynode.nodekey = Len(Node.Key)
 mynode.nodechild = Node.Children
 If fp = False Then
    Exit Sub
 Else
    fp = False
    If mynode.nodekey > 6 Then
       delclass.Enabled = False   '如果是选择的学生，将删除班级变为不可用
       delstu.Enabled = True
       PopupMenu menuhide
       If keshan Then         '判断是否选择了弹出菜单的删除选项
          finishtree.Nodes.Remove (Node.Key)
          keshan = False
       End If
    ElseIf mynode.nodekey = 6 Then
           If mynode.nodechild < 1 Then
              Exit Sub
           End If
           delstu.Enabled = False   '如果是选择的班级，将删除学生变为不可用
           
           delclass.Enabled = True
           PopupMenu menuhide
           If keshan Then           '判断是否选择了弹出菜单的删除选项
              finishtree.Nodes.Remove (Node.Key)
           End If
        End If
     End If
End Sub



Private Sub finishtree_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)

    Call listviewtuozhuai
End Sub

  

Private Sub Form_Initialize()
'判断分辨率

 If (Screen.Width / Screen.TwipsPerPixelX) = 800 Then
     
     resulttree.Width = 11415
     resulttree.Height = 5055
     resulttree.Left = 240
     resulttree.Top = 1920
     finishtree.Width = 3615
     finishtree.Height = 5055
     finishtree.Left = 7800
     finishtree.Top = 1920
     importtree.Width = 3375
     importtree.Height = 5055
     importtree.Left = 240
     importtree.Top = 1920
     
     listview1.Width = 3495
     listview1.Height = 5055
     listview1.Left = 3840
     listview1.Top = 1920
     
     
     biaoqian1(0).Height = 495
     biaoqian1(0).Left = 240
     biaoqian1(0).Top = 1200
     biaoqian1(0).Width = 3375
     biaoqian1(1).Height = 495
     biaoqian1(1).Left = 3840
     biaoqian1(1).Top = 1200
     biaoqian1(1).Width = 3495
     
     biaoqian1(2).Height = 495
     biaoqian1(2).Left = 7800
     biaoqian1(2).Top = 1200
     biaoqian1(2).Width = 3615
     
     biaoqian1(3).Height = 495
     biaoqian1(3).Left = 3840
     biaoqian1(3).Top = 1200
     biaoqian1(3).Width = 3495
     Me.Height = 8505
     Me.Top = 105
     Me.Width = 12000
     Me.Left = 105
Else
     resultgrid.Width = 14535
     resultgrid.Height = 7455
     resultgrid.Left = 360
     resultgrid.Top = 1920
     jindu.Height = 255
     jindu.Left = 360
     jindu.Top = 1680
     jindu.Width = 14535
End If

End Sub

Private Sub Form_Load()
  
  On Error GoTo chuli:
  Me.Picture = LoadPicture(App.Path & "\pic\bg1.bmp") '设置窗体背景
  Dim mybutton As Object            '声明一个按钮对象
  Dim imgs As ListImage           '定义图象列表，并初始化
  Set imgs = img.ListImages.Add(1, "daoru", LoadPicture(App.Path & "/pic/daoru.ICO"))
  Set imgs = img.ListImages.Add(2, "shezhi", LoadPicture(App.Path & "/pic/shezhi.ICO"))
  Set imgs = img.ListImages.Add(3, "qingkong", LoadPicture(App.Path & "/pic/clear.ICO"))
  Set imgs = img.ListImages.Add(4, "help", LoadPicture(App.Path & "/pic/help.ICO"))
  Set imgs = img.ListImages.Add(5, "exit", LoadPicture(App.Path & "/pic/OOFL.ICO"))
  Set imgs = img.ListImages.Add(6, "create", LoadPicture(App.Path & "/pic/create.ICO"))
  Set imgs = img.ListImages.Add(6, "about", LoadPicture(App.Path & "/pic/about.ICO"))
  Set imgs = img.ListImages.Add(7, "daochu", LoadPicture(App.Path & "/pic/daochu.ICO"))
      Toolbar.ImageList = img    '将图象列表添加到工具条
                                 '初始化工具栏
  Set mybutton = Toolbar.Buttons.Add(1, "import", "导入原始数据", 0, "daoru")
  Set mybutton = Toolbar.Buttons.Add(2, "kong1", , 3)
  Set mybutton = Toolbar.Buttons.Add(3, "setting", "设置考场属性", 0, "shezhi")
  Set mybutton = Toolbar.Buttons.Add(4, "kong2", , 3)
  Set mybutton = Toolbar.Buttons.Add(5, "clear", "清空临时数据库", 0, "qingkong")
  Set mybutton = Toolbar.Buttons.Add(6, "kong3", , 3)
  Set mybutton = Toolbar.Buttons.Add(7, "create", "生成考号", 0, "create")
  Set mybutton = Toolbar.Buttons.Add(8, "kong4", , 3)
  Set mybutton = Toolbar.Buttons.Add(9, "daochu", "导出到EXCEL", 0, "daochu")
  Set mybutton = Toolbar.Buttons.Add(10, "kong5", , 3)
  Set mybutton = Toolbar.Buttons.Add(11, "help", "帮助", 0, "help")
  Set mybutton = Toolbar.Buttons.Add(12, "kong6", , 3)
  Set mybutton = Toolbar.Buttons.Add(13, "about", "关于本软件", 0, "about")
  Set mybutton = Toolbar.Buttons.Add(14, "kong7", , 3)
  Set mybutton = Toolbar.Buttons.Add(15, "exit", "退出", 0, "exit")
      Toolbar.Buttons(9).Enabled = False   '设置导出菜单和按钮不可用
      menudaochu.Enabled = False
                                  '初始化状态栏
      StatusBar1.Panels.Clear
  Set mypanel = StatusBar1.Panels.Add(1)
      StatusBar1.Panels(1).AutoSize = sbrSpring
      StatusBar1.Panels(1).Alignment = sbrLeft
      StatusBar1.Panels(1).Bevel = sbrInset
      StatusBar1.Panels(1).Text = "当前登录时间为： " & Now()
      StatusBar1.Panels(1).Picture = LoadPicture(App.Path & "\pic\1.ico")
      StatusBar1.Panels.Add (2)
      StatusBar1.Panels(2).Text = "当前用户操作：" & " 当前数据库为空，树行列表为空......."
      StatusBar1.Panels(2).AutoSize = sbrSpring
      StatusBar1.Panels(2).Picture = LoadPicture(App.Path & "\pic\2.ico")
      StatusBar1.Panels(2).Alignment = sbrLeft
      StatusBar1.Panels(2).Bevel = sbrInset
      Set mynode = New nodetree       '初始化自定义类
      Set tuozhuainode = New nodetree
          title = "学生考号分配系统"      ' 初始化设置对话框标题
         '初始化连接字符串
          pubconnstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\student_infor.mdb"
         '初始化全局数据连接
  Set pubconn = New ADODB.Connection
      pubconn.ConnectionString = pubconnstr
      pubconn.Open
'清空导入数据
      'setempty
      tuozhuai = False '初始化变量
      tuozhuai1 = False
      resulttree.Visible = False
      
      '++++++++++++++++++++
    showimporttree
    Exit Sub
chuli:
      MsgBox "系统所使用的数据库丢失或是被误删除，请找到其它文件放到程序所以目录或是与供应商联系！", vbOKOnly + 48, title
      End
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
 If Button = vbRightButton Then '右键菜单
    PopupMenu menufile
 End If
End Sub

'Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
''If Button = 1 And tuozhuai = True Then  '判断当鼠标离开所在树后鼠标是否放下
''   tuozhuai1 = True
''Else
''   tuozhuai = False
''   tuozhuai1 = False
''End If
'
'End Sub

Private Sub Form_Unload(Cancel As Integer)
'退出窗体时关闭数据库
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Set con = New ADODB.Connection
    con.ConnectionString = pubconnstr
    con.Open
Set rs = New ADODB.Recordset
    rs.Open "delete * from import", con, adOpenDynamic, adLockPessimistic
    End
End Sub





Private Sub importtree_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then '右键菜单
       PopupMenu menuall
    End If
End Sub

Private Sub importtree_NodeClick(ByVal Node As MSComctlLib.Node)
 Dim sql As String                                 '存储查询语句变量                                                 '定义数据连接到import表记录集
 Dim sturs As ADODB.Recordset
 Set pubconn = New ADODB.Connection                '重新连接，获取最新数据
 pubconn.ConnectionString = pubconnstr
 pubconn.Open
 If Mid(Node.Key, 1, 5) = "class" Then              '判断当前的子节点是否为班级
    Set sturs = New ADODB.Recordset
    sql = "select * from import where [班级]='" & Node & "'"
    sturs.Open sql, pubconn, adOpenDynamic, adLockReadOnly
    temp = 0
    '尝试用LISTVIEW显示
          listview1.ColumnHeaders.Clear
          If Screen.Width / Screen.TwipsPerPixelX = 800 Then
          listview1.ColumnHeaders.Add , , "            " & Node, "3400"
          Else
          listview1.ColumnHeaders.Add , , "                    " & Node, "4200"
          End If
          listview1.ListItems.Clear
          
    '+++++++++++++++++
    While sturs.EOF = False
          temp = temp + 1                            '防止关键字冲突，用TEMP进行累加
                                       '移动记录到下一条
         '尝试用LISTVIEW显示
         
         'listview1.ListItems.Add.Text = sturs.Fields("姓名")
         
          listview1.ListItems.Add , , sturs.Fields("姓名"), "xingming", "xingming"
        '+++++++++++++++++
         sturs.MoveNext
    Wend
    chooseclass = Node                               '保存当前选中根的名称
    choosekey = Node.Key                             '保存当前选中根的名称的关键字
  End If
  StatusBar1.Panels(2).Text = "客户当前动作：" & Node & "被客户选中......."
End Sub









Private Sub listview1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
  tuozhuai = True
  tuozhuai1 = True
  tuozhuainode.choosenode = Trim(listview1.ColumnHeaders.Item(1).Text) '保存选择的班级
  If ColumnHeader.Text = "" Then
  Exit Sub
  Else
  tuozhuainode.nodekey = "class1"
  End If
  Call addchengyuan '调用添加过程
  listview1.ListItems.Clear
  listview1.ColumnHeaders.Clear
  Call showlistview
End Sub

Private Sub menuabout_Click()
frmAbout.Show
End Sub

Private Sub menuaddall_Click()
    If pubconn.State <> 0 Then
        pubconn.close
    End If
    pubconn.ConnectionString = pubconnstr
    pubconn.Open
    Dim TmpRs As New ADODB.Recordset
    TmpRs.Open "select * from import", pubconn, adOpenKeyset, adLockOptimistic
    If TmpRs.RecordCount > 0 Then
        TmpRs.close