frmstsi.frm

明星档案管理系统,学生自己制作的,适合于全日制在校大学生,得了个优哦

      Height          =   255
      Index           =   8
      Left            =   9000
      TabIndex        =   31
      Top             =   600
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.Label Label2 
      Caption         =   "在此输入明星特长"
      Height          =   255
      Index           =   7
      Left            =   8040
      TabIndex        =   30
      Top             =   600
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.Label Label2 
      Caption         =   "查询入明星体重"
      Height          =   255
      Index           =   6
      Left            =   5400
      TabIndex        =   29
      Top             =   600
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.Label Label2 
      Caption         =   "查询入明星身高"
      Height          =   255
      Index           =   5
      Left            =   4440
      TabIndex        =   28
      Top             =   600
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.Label Label2 
      Caption         =   "在此输入明星籍贯"
      Height          =   255
      Index           =   4
      Left            =   3600
      TabIndex        =   27
      Top             =   600
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.Label Label2 
      Caption         =   "在此输入明星生日"
      Height          =   255
      Index           =   3
      Left            =   2760
      TabIndex        =   26
      Top             =   600
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.Label Label2 
      Caption         =   "在此选择明星性别"
      Height          =   255
      Index           =   2
      Left            =   1800
      TabIndex        =   25
      Top             =   600
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.Label Label2 
      Caption         =   "在此输入明星姓名"
      Height          =   255
      Index           =   1
      Left            =   960
      TabIndex        =   24
      Top             =   600
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.Label Label2 
      Caption         =   "在此输入明星编号"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   23
      Top             =   600
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.Label Label1 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "  删  除"
      ForeColor       =   &H80000008&
      Height          =   375
      Index           =   3
      Left            =   3720
      TabIndex        =   16
      Top             =   0
      Width           =   1215
   End
   Begin VB.Label Label1 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "  修  改"
      ForeColor       =   &H80000008&
      Height          =   375
      Index           =   2
      Left            =   2520
      TabIndex        =   15
      Top             =   0
      Width           =   1215
   End
   Begin VB.Label Label1 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "  查  询"
      ForeColor       =   &H80000008&
      Height          =   375
      Index           =   1
      Left            =   1320
      TabIndex        =   14
      Top             =   0
      Width           =   1215
   End
   Begin VB.Label Label1 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "  添  加"
      ForeColor       =   &H80000008&
      Height          =   375
      Index           =   0
      Left            =   120
      TabIndex        =   13
      Top             =   0
      Width           =   1215
   End
End
Attribute VB_Name = "frmstsi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mrc As ADODB.Recordset
Dim MsgText As String
Dim tSQL As String


Private Sub Command1_Click()
    Dim txtSQL As String
    For i = 0 To 11
        If i <> 4 Then
            If Text1(i) = Label2(i).Caption Then
                MsgBox "请" & Label2(i).Caption & "!", vbOKOnly, "提示"
                Text1(i).SetFocus
                Exit Sub
            End If
        Else
            If Text1(i) = Label2(i).Caption Then
                MsgBox "请" & Label2(i).Caption & "!", vbOKOnly, "提示"
                
                Exit Sub
            End If
        End If
    Next
    
    txtSQL = "select * from starinfo_Form where starinfo_NO='" & Trim(Text1(0)) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF = False Then
        MsgBox "编号不能重复!", vbOKOnly, "警告"
        Text1(0).SetFocus
        Exit Sub
    End If
    mrc.Close
    txtSQL = "select * from starinfo_Form"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    mrc.AddNew
    mrc.Fields(0) = Trim(Text1(0))
    mrc.Fields(1) = Trim(Text1(1))
    mrc.Fields(2) = Trim(Text1(2))
    mrc.Fields(3) = Trim(Text1(3))
    mrc.Fields(4) = Trim(Text1(4))
    mrc.Fields(5) = Trim(Text1(5))
    mrc.Fields(6) = Trim(Text1(6))
    mrc.Fields(7) = Trim(Text1(7))
    mrc.Fields(8) = Trim(Text1(8))
    mrc.Fields(9) = Trim(Text1(9))
    mrc.Fields(10) = Trim(Text1(10))
    mrc.Fields(11) = Trim(Text1(11))
    If Text1(11) = Label2(11).Caption Then
        mrc.Fields(11) = ""
    Else
        mrc.Fields(11) = Trim(Text1(11))
    End If
    mrc.Update
    mrc.Close
    MsgBox "明星档案添加成功!", vbOKOnly, "提示"
    With MSFlexGrid1
        .Rows = .Rows + 1
        .TextMatrix(.Rows - 1, 0) = Trim(Text1(0))
        .TextMatrix(.Rows - 1, 1) = Trim(Text1(1))
        .TextMatrix(.Rows - 1, 2) = Trim(Text1(2))
        .TextMatrix(.Rows - 1, 3) = Trim(Text1(3))
        .TextMatrix(.Rows - 1, 4) = Trim(Text1(4))
        .TextMatrix(.Rows - 1, 5) = Trim(Text1(5))
        .TextMatrix(.Rows - 1, 6) = Trim(Text1(6))
        .TextMatrix(.Rows - 1, 7) = Trim(Text1(7))
        .TextMatrix(.Rows - 1, 8) = Trim(Text1(8))
        .TextMatrix(.Rows - 1, 9) = Trim(Text1(9))
        .TextMatrix(.Rows - 1, 10) = Trim(Text1(10))
        .TextMatrix(.Rows - 1, 11) = Trim(Text1(11))
        If Text1(11) <> Label2(11).Caption Then
            .TextMatrix(.Rows - 1, 11) = Trim(Text1(11))
        End If
    End With
    MSFlexGrid1.TopRow = MSFlexGrid1.Rows - 1
    TextDcolor
    Text1(4).Visible = True
    Combo1.Visible = False
End Sub

Private Sub Command2_Click()
    Dim j As Integer
    Dim txtSQL As String
    
    txtSQL = "select * from starinfo_Form"
    If Text1(0) <> Label2(0).Caption Then
        txtSQL = txtSQL & " where starinfo_NO='" & Trim(Text1(0)) & "'"
    End If
    If Text1(1) <> Label2(1).Caption Then
        If txtSQL = "select * from starinfo_Form" Then
            txtSQL = txtSQL & " where starinfo_Name='" & Trim(Text1(1)) & "'"
        Else
            txtSQL = txtSQL & " and starinfo_Name='" & Trim(Text1(1)) & "'"
        End If
    End If
    If Text1(11) <> Label2(11).Caption Then
        If txtSQL = "select * from starinfo_Form" Then
            txtSQL = txtSQL & " where starinfo_Dy='" & Trim(Text1(11)) & "'"
        Else
            txtSQL = txtSQL & " and starinfo_Dy='" & Trim(Text1(11)) & "'"
        End If
    End If
    
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    j = 1
    Do While Not mrc.EOF
        j = j + 1
    mrc.MoveNext
    Loop
    ProgressBar1.Visible = True
    ProgressBar1.Min = CInt(0)
    ProgressBar1.Max = CInt(j)
    Set mrc = ExecuteSQL(txtSQL, MsgText)
        Frame1.Visible = True
        With MSFlexGrid1
        .Visible = False
        .Rows = 1
        ProgressBar1.Value = .Rows
        Do While Not mrc.EOF
            .Rows = .Rows + 1
            For i = 0 To mrc.Fields.Count - 1
                Select Case mrc.Fields(i).Type
                    Case adDBDate
                        .TextMatrix(.Rows - 1, i) = Format(mrc.Fields(i) & "")
                    Case Else
                        .TextMatrix(.Rows - 1, i) = mrc.Fields(i) & ""
                End Select
            Next i
            mrc.MoveNext
        Loop
        .Visible = True
        End With
        Frame1.Visible = False
    mrc.Close
    TextDcolor
    Text1(4).Visible = True
    Combo1.Visible = False
    Text1(2).Enabled = False
    Text1(3).Enabled = False
    Text1(4).Enabled = False
    Text1(5).Enabled = False
    Text1(6).Enabled = False
    Text1(7).Enabled = False
    Text1(8).Enabled = False
    Text1(9).Enabled = False
    Text1(10).Enabled = False
    
End Sub

Private Sub Command3_Click()
    Dim txtSQL As String
    Dim j As Integer
    For i = 0 To 11
        If i <> 4 Then
            If Text1(i) = Label2(i).Caption Then
                MsgBox "请" & Label2(i).Caption & "!", vbOKOnly, "提示"
                Text1(i).SetFocus
                Exit Sub
            End If
        Else
            If Text1(i) = Label2(i).Caption Then
                MsgBox "请" & Label2(i).Caption & "!", vbOKOnly, "提示"
                Combo1.SetFocus
                Exit Sub
            End If
        End If
    Next
    
    txtSQL = "delete from starinfo_Form where starinfo_NO='" & Trim(Text1(0)) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
   
    txtSQL = "select * from starinfo_Form"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    mrc.AddNew
    mrc.Fields(0) = Trim(Text1(0))
    mrc.Fields(1) = Trim(Text1(1))
    mrc.Fields(2) = Trim(Text1(2))
    mrc.Fields(3) = Trim(Text1(3))
    mrc.Fields(4) = Trim(Text1(4))
    mrc.Fields(5) = Trim(Text1(5))
    mrc.Fields(6) = Trim(Text1(6))
    mrc.Fields(7) = Trim(Text1(7))
    mrc.Fields(8) = Trim(Text1(8))
    mrc.Fields(9) = Trim(Text1(9))
    mrc.Fields(10) = Trim(Text1(10))
    mrc.Fields(11) = Trim(Text1(11))
    If Text1(11) = Label2(11).Caption Then
        mrc.Fields(11) = ""
    Else
        mrc.Fields(11) = Trim(Text1(11))
    End If
    mrc.Update
    mrc.Close
    MsgBox "明星档案修改成功!", vbOKOnly, "提示"
    j = 0
    For i = 1 To MSFlexGrid1.Rows - 1
        If MSFlexGrid1.TextMatrix(i, 0) = Text1(0) Then
            j = i
        End If
    Next
    If j <> 0 Then
        MSFlexGrid1.TextMatrix(j, 0) = Trim(Text1(0))
        MSFlexGrid1.TextMatrix(j, 1) = Trim(Text1(1))
        MSFlexGrid1.TextMatrix(j, 2) = Trim(Text1(2))
        MSFlexGrid1.TextMatrix(j, 3) = Trim(Text1(3))
        MSFlexGrid1.TextMatrix(j, 4) = Trim(Text1(4))
        MSFlexGrid1.TextMatrix(j, 5) = Trim(Text1(5))
        MSFlexGrid1.TextMatrix(j, 6) = Trim(Text1(6))
        MSFlexGrid1.TextMatrix(j, 7) = Trim(Text1(7))
        MSFlexGrid1.TextMatrix(j, 8) = Trim(Text1(8))
        MSFlexGrid1.TextMatrix(j, 9) = Trim(Text1(9))
        MSFlexGrid1.TextMatrix(j, 10) = Trim(Text1(10))
        MSFlexGrid1.TextMatrix(j, 11) = Trim(Text1(11))
        If Text1(11) <> Label2(11).Caption Then
            MSFlexGrid1.TextMatrix(j, 11) = Trim(Text1(11))
        End If
    End If
    MSFlexGrid1.TopRow = j
    j = 0
    TextDcolor
    Text1(4).Visible = True
    Combo1.Visible = False

End Sub

Private Sub Command4_Click()
    Dim txtSQL As String
    Dim j As Integer