frmeditcenter.frm

Visual basic + sql server2000学员管理系统原代码

End Sub

Private Sub cmdPrevious_Click()

With rs
    .MovePrevious
    If .BOF Then .MoveFirst
End With
 '显示当前记录内容,Display子程 见本窗体
Display

End Sub

Private Sub cmdSave_Click()

Dim ctlcontrol As Control

If cmdFlag = 1 Then
    '判断添加的中心代码是否已存在,存在则退出子程
    Dim strTemp As String
    strTemp = Trim(txtCode.Text)
    strFind = "select * from syscenterinfo where ccode='" & strTemp & "'"
    RsOpen rsTemp, con, strFind, "adcmdtext"
    If Not (rsTemp.BOF And rsTemp.EOF) Then
        MsgBox "中心代码已经存在" & Chr(10) & "添加失败！ ", vbOKOnly + vbCritical, "警告"
        RsClose rsTemp
        Exit Sub
    Else
        RsClose rsTemp
    End If
    
    '验证录入项,InputVerify函数 见本窗体
    If InputVerify = False Then
        Exit Sub
    End If
        
    '添加一行记录
    With rs
        .AddNew
        rs![ccode] = Trim(txtCode.Text)
        rs![cname] = Trim(txtName.Text)
        rs![mailaddress] = Trim(txtAddress.Text)
        rs![contactor] = Trim(txtContactor.Text)
        rs![tel] = Trim(txtTel.Text)
        
        If Trim(txtFax.Text) = "" Then
            rs![fax] = "无"
        Else
            rs![fax] = Trim(txtFax.Text)
        End If
        
        If Trim(txtEMail.Text) = "" Then
            rs![email] = "无"
        Else
            rs![email] = Trim(txtEMail.Text)
        End If
        
        If Trim(txtWeb.Text) = "" Then
            rs![website] = "无"
        Else
            rs![website] = Trim(txtWeb.Text)
        End If
        
        rs![ctype] = cmbCType.Text
        rs![city] = Trim(txtCity.Text)
        rs![province] = cmbProvince.Text
        rs![region] = cmbRegion.Text
        rs![postcode] = Trim(txtPostCode.Text)
        rs![centerstatus] = "1"
        .Update
    End With
    
    '清除所有控件的文本显示,DisplayRefresh子程 见本窗体
    DisplayRefresh
    '调用cmdCancel按钮的click事件
    cmdCancel_Click
    '按钮操作标记恢复为0
    cmdFlag = 0
    
ElseIf cmdFlag = 2 Then
    '判断添加的中心代码是否已存在,不存在则退出子程
    strFind = "select * from syscenterinfo where ccode='" & Trim(txtCode.Text) & "' and cname='" & Trim(txtName.Text) & "' and mailaddress='" & Trim(txtAddress.Text) & "'"
    RsOpen rsTemp, con, strFind, "adcmdtext"
    If (rsTemp.BOF And rsTemp.EOF) Then
        MsgBox "不存在此条记录！" & Chr(10) & "请用浏览键选择记录！", vbOKOnly + vbCritical, "警告"
        RsClose rsTemp
        Exit Sub
    Else
        RsClose rsTemp
    End If
    
    '确定是否真要删除记录
    If MsgBox("您确实要删除记录吗？", vbYesNo + vbExclamation, "提示") = vbNo Then
        '调用cmdCancel按钮的click事件
        cmdCancel_Click
        '按钮操作标记恢复为0
        cmdFlag = 0
        '显示当前记录内容,Display子程 见本窗体
        Display
        Exit Sub
    Else
        '删除一条记录
        With rs
            .Delete
            .MovePrevious
            If .EOF Then .MoveLast
            If .BOF Then .MoveFirst
        End With
    End If
    
    '调用cmdCancel按钮的click事件
    cmdCancel_Click
    '按钮操作标记恢复为0
    cmdFlag = 0
    '显示当前记录内容,Display子程 见本窗体
    Display
    
ElseIf cmdFlag = 3 Then
    '判断添加的中心代码是否存在,不存在则退出子程
    strFind = "select * from syscenterinfo where ccode='" & Trim(txtCode.Text) & "'"
    RsOpen rsTemp, con, strFind, "adcmdtext"
    If (rsTemp.BOF And rsTemp.EOF) Then
        MsgBox "不存在此条记录！" & Chr(10) & "请用浏览键选择记录！", vbOKOnly + vbCritical, "警告"
        RsClose rsTemp
        Exit Sub
    Else
        RsClose rsTemp
    End If

    '验证录入项,InputVerify函数 见本窗体
    If InputVerify = False Then
        Exit Sub
    End If
        
    '修改一行记录
    With rs
        
        rs![ccode] = Trim(txtCode.Text)
        rs![cname] = Trim(txtName.Text)
        rs![mailaddress] = Trim(txtAddress.Text)
        rs![contactor] = Trim(txtContactor.Text)
        rs![tel] = Trim(txtTel.Text)
        
        If Trim(txtFax.Text) = "" Then
            rs![fax] = "无"
        Else
            rs![fax] = Trim(txtFax.Text)
        End If
        
        If Trim(txtFax.Text) = "" Then
            rs![email] = "无"
        Else
            rs![email] = Trim(txtEMail.Text)
        End If
        
        If Trim(txtWeb.Text) = "" Then
            rs![website] = "无"
        Else
            rs![website] = Trim(txtWeb.Text)
        End If
        
        rs![ctype] = cmbCType.Text
        rs![city] = Trim(txtCity.Text)
        rs![province] = cmbProvince.Text
        rs![region] = cmbRegion.Text
        rs![postcode] = Trim(txtPostCode.Text)
        rs![centerstatus] = cmbStatus.Text
        .Update
    End With
    
    '调用cmdCancel按钮的click事件
    cmdCancel_Click
    '按钮操作标记恢复为0
    cmdFlag = 0
    '显示当前记录内容,Display子程 见本窗体
    Display
End If


End Sub

Private Sub Form_Activate()
'窗体激活时焦点在cmdAdd上
cmdAdd.SetFocus

RsClose rs
'打开表syscenterinfo,创建记录集
RsOpen rs, con, "syscenterinfo", "adcmdtable"

'清除所有控件的文本显示,ComBoxRefresh子程 见本窗体
DisplayRefresh

'cmdFlag初始值为0
cmdFlag = 0
End Sub

Private Sub Form_Load()

'Debug.Print strUserName, strPassword
'Debug.Print "con.state", con.State

'设置窗体的背景色为GetColor函数的返回值,宽度8100缇,GetColor函数 见模块MdlSystem
Me.BackColor = GetColor
Me.Width = 8000
Me.Height = 5800


'遍历窗体上的所有控件,改变颜色为GetColor函数的返回值(GetColor函数 见模块MdlSystem)
Dim ctlcontrol As Control
For Each ctlcontrol In Controls
    ctlcontrol.BackColor = GetColor
Next


'设置控件的各种属性,字体大小,对齐类型,清空文本显示
For Each ctlcontrol In Controls
    If TypeOf ctlcontrol Is Label Then
        ctlcontrol.Alignment = 0
        ctlcontrol.FontSize = 10
    ElseIf TypeOf ctlcontrol Is TextBox Then
        ctlcontrol.FontSize = 10
        ctlcontrol.Text = ""
    ElseIf TypeOf ctlcontrol Is ComboBox Then
        '清空组合框的内容
        ctlcontrol.Clear
        '组合框的内容按字符排序
        'ctlControl.Sorted = True 设计时不可用
        ctlcontrol.FontSize = 10
    End If
Next

RsClose rs
'打开表syscenterinfo,创建记录集
RsOpen rs, con, "syscenterinfo", "adcmdtable"

'清除所有控件的文本显示,DisplayRefresh子程 见本窗体
DisplayRefresh

'cmdFlag初始值为0
cmdFlag = 0

End Sub

Private Sub Form_LostFocus()
'关闭记录集,RsClose函数 见模块MdlConnection
RsClose rs
End Sub

Private Sub Form_Unload(Cancel As Integer)
'关闭记录集,RsClose函数 见模块MdlConnection
RsClose rs
End Sub



Private Sub txtCode_KeyPress(KeyAscii As Integer)
'只能键入数字和退格
If (KeyAscii > 0 And KeyAscii < 8) Or (KeyAscii > 8 And KeyAscii < 48) Or KeyAscii > 57 Then
    KeyAscii = 0
    MsgBox "中心代码必须是三位数字！", vbOKOnly + vbExclamation, "提示"
End If
End Sub

Private Sub txtPostCode_KeyPress(KeyAscii As Integer)
'只能键入数字和退格
If (KeyAscii > 0 And KeyAscii < 8) Or (KeyAscii > 8 And KeyAscii < 48) Or KeyAscii > 57 Then
    KeyAscii = 0
    MsgBox "邮政编码必须是六位数字！", vbOKOnly + vbExclamation, "提示"
End If
End Sub


'InputVerify函数,当验证输入项均符合要求时,值为True
Private Function InputVerify() As Boolean

InputVerify = True
'中心代码必须是三位数字,也不能为空
If Len(Trim(txtCode.Text)) <> 3 Then
    InputVerify = False
    MsgBox "中心代码必须是三位数字！", vbOKOnly + vbExclamation, "提示"
End If

'中心名称不能多于20个汉字,也不能为空
If Len(Trim(txtName.Text)) > 20 Or Len(Trim(txtName.Text)) = 0 Then
    InputVerify = False
    MsgBox "中心名称不能为空" & Chr(10) & "不能多于20个汉字！", vbOKOnly + vbExclamation, "提示"
End If

'中心地址不能多于30个汉字,也不能为空
If Len(Trim(txtAddress.Text)) > 30 Or Len(Trim(txtAddress.Text)) = 0 Then
    InputVerify = False
    MsgBox "中心地址不能为空" & Chr(10) & "不能多于30个汉字！", vbOKOnly + vbExclamation, "提示"
End If

'联系人名称不能多于25个汉字,也不能为少于2个汉字
If Len(Trim(txtContactor.Text)) > 25 Or Len(Trim(txtContactor.Text)) < 2 Then
    InputVerify = False
    MsgBox "联系人的名字最少2个汉字" & Chr(10) & "不能多于25个汉字！", vbOKOnly + vbExclamation, "提示"
End If

'电话号码不能多于50个字符,也不能为空
If Len(Trim(txtTel.Text)) > 50 Or Len(Trim(txtTel.Text)) = 0 Then
    InputVerify = False
    MsgBox "电话号码不能为空" & Chr(10) & "不能多于50个字符！", vbOKOnly + vbExclamation, "提示"
End If

'传真号码不能多于50个字符
If Len(Trim(txtFax.Text)) > 50 Then
    InputVerify = False
    MsgBox "传真号码不能多于50个字符！", vbOKOnly + vbExclamation, "提示"
End If

'E-Mail不能多于20个字符
If Len(Trim(txtEMail.Text)) > 20 Then
    InputVerify = False
    MsgBox "E-Mail不能多于20个字符！", vbOKOnly + vbExclamation, "提示"
End If

'网址不能多于20个字符
If Len(Trim(txtWeb.Text)) > 20 Then
    InputVerify = False
    MsgBox "网址不能多于20个字符！", vbOKOnly + vbExclamation, "提示"
End If

'中心类型不能为空
If Len(Trim(cmbCType.Text)) = 0 Then
    InputVerify = False
    MsgBox "中心类型不能为空！", vbOKOnly + vbExclamation, "提示"
End If


'所在城市不能多于10个字符,也不能为空
If Len(Trim(txtCity.Text)) > 20 Or Len(Trim(txtCity.Text)) = 0 Then
    InputVerify = False
    MsgBox "所在城市不能为空" & Chr(10) & "不能多于10个字符！", vbOKOnly + vbExclamation, "提示"
End If

'城市所属不能为空
If Len(Trim(cmbProvince.Text)) = 0 Then
    InputVerify = False
    MsgBox "城市所属不能为空！", vbOKOnly + vbExclamation, "提示"
End If

'城市区域不能为空
If Len(Trim(cmbRegion.Text)) = 0 Then
    InputVerify = False
    MsgBox "城市区域不能为空！", vbOKOnly + vbExclamation, "提示"
End If

'邮政编码必须是6位数字
If Len(Trim(txtPostCode.Text)) <> 6 Then
    InputVerify = False
    MsgBox "邮政编码必须是6位数字！", vbOKOnly + vbExclamation, "提示"
End If

End Function

Private Sub DisplayRefresh()

Dim ctlcontrol As Control
'清空组合框文本显示
For Each ctlcontrol In Controls
    If TypeOf ctlcontrol Is ComboBox Then
        '清空组合框的内容
        ctlcontrol.Clear
    ElseIf TypeOf ctlcontrol Is TextBox Then
        ctlcontrol.FontSize = 10
        ctlcontrol.Text = ""
    End If
Next

'从表TempCType中取得所有的中心类型,放入cmbCType中
strFind = "select * from tempctype"
RsOpen rsTemp, con, strFind, "adcmdtext"
Do While (rsTemp.EOF = False)
        cmbCType.AddItem rsTemp.Fields("ctype")
        rsTemp.MoveNext
Loop
RsClose rsTemp

'从表TempRegion中取得所有的所属区域,放入cmbRegion中
strFind = "select * from tempregion"
RsOpen rsTemp, con, strFind, "adcmdtext"
Do While (rsTemp.EOF = False)
        cmbRegion.AddItem rsTemp.Fields("region")
        rsTemp.MoveNext
Loop
RsClose rsTemp

'从表TempProvince中取得所有的所属省,放入cmbProvince中
strFind = "select * from tempProvince"
RsOpen rsTemp, con, strFind, "adcmdtext"
Do While (rsTemp.EOF = False)
        cmbProvince.AddItem rsTemp.Fields("province")
        rsTemp.MoveNext
Loop
RsClose rsTemp

'从表TempCenterStatus中取得所有的中心状态,放入CenterStatus中
strFind = "select * from tempCenterStatus"
RsOpen rsTemp, con, strFind, "adcmdtext"
Do While (rsTemp.EOF = False)
        cmbStatus.AddItem rsTemp.Fields("centerstatus")
        rsTemp.MoveNext
Loop
RsClose rsTemp

End Sub

Private Sub Display()

txtCode.Text = rs!ccode
txtName.Text = rs!cname
txtAddress.Text = rs!mailaddress
txtContactor.Text = rs!contactor
txtTel.Text = rs!tel
txtFax.Text = rs!fax
txtEMail.Text = rs!email
txtWeb.Text = rs!website
cmbCType.Text = rs!ctype
txtCity.Text = rs!city
cmbProvince.Text = rs!province
cmbRegion.Text = rs!region
txtPostCode.Text = rs!postcode
cmbStatus.Text = rs!centerstatus

End Sub

Private Sub ControlEnabled()

'消除控件的禁用
Dim ctlEnabled As Control
For Each ctlEnabled In Controls
    ctlEnabled.Enabled = True
Next

End Sub

Private Sub ControlDisabled()

'禁用控件文本框和组合框
Dim ctlDisabled As Control
For Each ctlDisabled In Controls
    If TypeOf ctlDisabled Is TextBox Or TypeOf ctlDisabled Is ComboBox Then
            ctlDisabled.Enabled = False
    End If
Next

End Sub