form1.frm

高校科研管理系统

            Else
                Txt(i) = ""
            End If
        Next i
    Else
        For i = 1 To Val(Txt(0).Text)
            Txt(i) = ""
        Next i
    End If
    End If
End If
Exit Sub
Err:
MsgBox Err.Description, vbInformation + vbOKOnly, "系统提示"
End Sub



Private Sub cmdRegFirst_Click() '''<<
Dim i As Integer

On Error GoTo Err
    rs.MoveFirst
    If Not rs.EOF Then
        For i = 1 To Val(Txt(0).Text)
            If Not IsNull(rs.Fields(i - 1)) Then
                Txt(i) = rs.Fields(i - 1)
            Else
                Txt(i) = ""
            End If
        Next i
    End If
Exit Sub
Err:
End Sub

Private Sub cmdRegLast_Click() '''>>
Dim i As Integer

On Error GoTo Err
rs.MoveLast
    If Not rs.EOF Then
        For i = 1 To Val(Txt(0).Text)
            If Not IsNull(rs.Fields(i - 1)) Then
                Txt(i) = rs.Fields(i - 1)
            Else
                Txt(i) = ""
            End If
        Next i
    End If
Exit Sub
Err:

End Sub



Private Sub cmdRegLook_Click() ''
strLook = Trim(Combo1.Text)
If strLook <> "" Then
frmLook.Show 1
End If
End Sub

Private Sub cmdRegNext_Click() '''>
Dim i As Integer

On Error GoTo Err
If rs.EOF Then
rs.MoveLast
    If Not rs.EOF Then
        For i = 1 To Val(Txt(0).Text)
            If Not IsNull(rs.Fields(i - 1)) Then
                Txt(i) = rs.Fields(i - 1)
            Else
                Txt(i) = ""
            End If
        Next i
    End If
Else
    rs.MoveNext
    If Not rs.EOF Then
        For i = 1 To Val(Txt(0).Text)
            If Not IsNull(rs.Fields(i - 1)) Then
                Txt(i) = rs.Fields(i - 1)
            Else
                Txt(i) = ""
            End If
        Next i
    End If
End If
Exit Sub
Err:

End Sub

Private Sub cmdRegPrevious_Click() '''<
Dim i As Integer

On Error GoTo Err
If rs.BOF Then
rs.MoveFirst
    If Not rs.BOF Then
        For i = 1 To Val(Txt(0).Text)
            If Not IsNull(rs.Fields(i - 1)) Then
                Txt(i) = rs.Fields(i - 1)
            Else
                Txt(i) = ""
            End If
        Next i
    End If
Else
    rs.MovePrevious
    If Not rs.BOF Then
        For i = 1 To Val(Txt(0).Text)
            If Not IsNull(rs.Fields(i - 1)) Then
                Txt(i) = rs.Fields(i - 1)
            Else
                Txt(i) = ""
            End If
        Next i
    End If
End If
Exit Sub
Err:


End Sub

Private Sub cmdRegSave_Click() '''保存
On Error GoTo Err
If nModeSys = 0 Then
    If rs.EOF Then rs.AddNew
    For i = 0 To Val(Txt(0).Text) - 1
        If Trim(Txt(i + 1).Text) = "" Then
            
        Else
        rs.Fields(i).Value = Trim(Txt(i + 1).Text)
        End If
    Next i
    rs.Update
ElseIf nModeSys = 2 Then
    rs.AddNew
    For i = 0 To Val(Txt(0).Text) - 1
        If Trim(Txt(i + 1).Text) = "" Then
            
        Else
        rs.Fields(i).Value = Trim(Txt(i + 1).Text)
        End If
    Next i
    rs.Update
End If
    nModeSys = 0
    MsgBox "操作已成功!", vbInformation + vbOKOnly, "系统提示"
Exit Sub
Err:
MsgBox Err.Description, vbInformation + vbOKOnly, "系统提示"
End Sub

Private Sub Combo1_Click() ''选择数据表
On Error GoTo Err
Dim strSql As String
strSql = "select * from " & Trim(Combo1.Text)
If rs.State Then rs.Close
rs.Open strSql, CN, adOpenStatic, adLockOptimistic
Dim i As Integer
Dim k As Integer
k = Txt.Count
For i = 1 To 20
    If k = 1 Then
        Load Txt(i)
        Load Lbl(i)
    End If
    Txt(i).Visible = False
    Lbl(i).Visible = False
Next i

For i = 1 To rs.Fields.Count
    Txt(i).Visible = True
    Lbl(i).Visible = True
    Lbl(i).Caption = Trim(rs.Fields(i - 1).Name)
    Txt(i).Text = ""
    If i Mod 2 = 1 Then
        Lbl(i).Left = 50
        Txt(i).Left = 1250
    Else
        Lbl(i).Left = 4420
        Txt(i).Left = 5620
    End If
        Lbl(i).Top = 120 + Int((i - 1) / 2) * 500 + 120
        Txt(i).Top = Lbl(i).Top - 120
Next i
Txt(0).Text = rs.Fields.Count ''用于记录字段数(列)
If Not rs.EOF Then
    rs.MoveLast
    For i = 0 To Val(Txt(0).Text) - 1
    If Not IsNull(rs.Fields(i)) Then
        Txt(i + 1) = Trim(rs.Fields(i))
    Else
        Txt(i + 1) = ""
    End If
    Next i
End If
Exit Sub
Err:
MsgBox Err.Description, vbInformation + vbOKOnly, "系统提示"

End Sub

Private Sub Combo2_Click() '''
Txt(CurrentIndex).Text = Trim(Combo2.Text)
Combo2.Visible = False
On Error GoTo Err
Dim rsZD As New ADODB.Recordset

Select Case Trim(Lbl(CurrentIndex).Caption)
Case "员工编号"
    If rsZD.State Then rsZD.Close
    rsZD.Open "select 姓名 from 员工信息表 where 员工编号='" & Trim(Combo2.Text) & "'", CN, adOpenStatic, adLockOptimistic
    If Not rsZD.EOF Then
        If Not IsNull(rsZD.Fields(0)) Then Txt(CurrentIndex + 1).Text = Trim(rsZD.Fields(0))
    End If
End Select
Exit Sub
Err:
MsgBox Err.Description, vbInformation + vbOKOnly, "系统提示"
End Sub

Private Sub DTPicker1_Change()
Txt(CurrentIndex).Text = DateChange(DTPicker1.Value)
DTPicker1.Visible = False
End Sub

Private Sub DTPicker1_Click()
Txt(CurrentIndex).Text = DateChange(DTPicker1.Value)
DTPicker1.Visible = False
End Sub

Private Sub Form_Load()
Label2.Caption = strTableName & "管理："
Form1.Caption = strTableName & "管理"

Combo1.Text = strTableName
Call Combo1_Click

End Sub

Private Sub Txt_Click(Index As Integer)
''''判断是否有字典字段
CurrentIndex = Index
DTPicker1.Visible = False
Combo2.Visible = False

''''日期判断
Dim ss As String
ss = Mid(Trim(Lbl(Index).Caption), Len(Trim(Lbl(Index).Caption)) - 1, 2)
If ss = "日期" Then
DTPicker1.Top = Txt(Index).Top
DTPicker1.Left = Txt(Index).Left
DTPicker1.Width = Txt(Index).Width
DTPicker1.Visible = True
Exit Sub
End If

''字典下拉判断
Combo2.Clear
On Error GoTo Err
Select Case Trim(Lbl(Index).Caption)

Case "检索源"
    Combo2.Top = Txt(Index).Top
    Combo2.Left = Txt(Index).Left
    Combo2.Width = Txt(Index).Width
    Combo2.AddItem "EI"
    Combo2.AddItem "SCI"
    Combo2.AddItem "核心"
    Combo2.AddItem "一般"
    Combo2.Visible = True
Case "范围"
    Combo2.Top = Txt(Index).Top
    Combo2.Left = Txt(Index).Left
    Combo2.Width = Txt(Index).Width
    Combo2.AddItem "全国"
    Combo2.AddItem "国际"
    Combo2.AddItem "地方"
    Combo2.Visible = True
Case "项目性质"
    Combo2.Top = Txt(Index).Top
    Combo2.Left = Txt(Index).Left
    Combo2.Width = Txt(Index).Width
    Combo2.AddItem "国家自然科学基金"
    Combo2.AddItem "863"
    Combo2.AddItem "部省科委"
    Combo2.AddItem "企业集团"
    Combo2.Visible = True
Case "项目名称"
    If Trim(Combo1.Text) = "项目获奖信息" Then
        Dim rsZD As New ADODB.Recordset
        If rsZD.State Then rsZD.Close
        rsZD.Open "select distinct 项目名称 from 项目基本信息", CN, adOpenStatic, adLockOptimistic
        Combo2.Clear
        Combo2.Top = Txt(Index).Top
        Combo2.Left = Txt(Index).Left
        Combo2.Width = Txt(Index).Width
        While Not rsZD.EOF
            If Not IsNull(rsZD.Fields(0)) Then Combo2.AddItem Trim(rsZD.Fields(0))
        rsZD.MoveNext
        Wend
        Combo2.Visible = True
    End If
End Select
Exit Sub
Err:
MsgBox Err.Description, vbInformation + vbOKOnly, "系统提示"

End Sub