frmtype.frm

客户关系管理系统(打包+源程序)是数据库系统开发项目方案精解系列丛书VB数据库管理中附带CD中的程序

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmType 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "供货类别 - [添加删除]"
   ClientHeight    =   4185
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6210
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4185
   ScaleWidth      =   6210
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   330
      Left            =   3480
      TabIndex        =   4
      Top             =   3650
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   330
      Left            =   1320
      TabIndex        =   3
      Top             =   3650
      Width           =   1215
   End
   Begin VB.TextBox txtTypeName 
      Height          =   330
      Left            =   3720
      TabIndex        =   0
      Top             =   2400
      Width           =   2175
   End
   Begin VB.OptionButton Opt_DelType 
      Caption         =   "删除类别"
      Height          =   255
      Left            =   600
      TabIndex        =   2
      Top             =   240
      Width           =   1215
   End
   Begin VB.OptionButton Opt_AddType 
      Caption         =   "添加类别"
      Height          =   255
      Left            =   3840
      TabIndex        =   1
      Top             =   240
      Value           =   -1  'True
      Width           =   1215
   End
   Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1 
      Height          =   2775
      Left            =   360
      TabIndex        =   5
      Top             =   480
      Width           =   2775
      _ExtentX        =   4895
      _ExtentY        =   4895
      _Version        =   393216
      Rows            =   6
      FixedCols       =   0
      BackColorSel    =   16776960
      AllowBigSelection=   0   'False
      FocusRect       =   0
      HighLight       =   2
      SelectionMode   =   1
      AllowUserResizing=   1
      FormatString    =   "^ 供货类别代码 |^ 供货类别名称 "
   End
   Begin VB.Shape Shape2 
      Height          =   3015
      Left            =   3600
      Top             =   360
      Width           =   2415
   End
   Begin VB.Shape Shape1 
      Height          =   3015
      Left            =   240
      Top             =   360
      Width           =   3015
   End
   Begin VB.Label lblTypeID 
      BorderStyle     =   1  'Fixed Single
      Height          =   330
      Left            =   3720
      TabIndex        =   8
      Top             =   1200
      Width           =   2175
   End
   Begin VB.Label Label2 
      Caption         =   "供货类别名称："
      Height          =   255
      Left            =   3720
      TabIndex        =   7
      Top             =   2040
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "供货类别代码："
      Height          =   255
      Left            =   3720
      TabIndex        =   6
      Top             =   840
      Width           =   1335
   End
End
Attribute VB_Name = "frmType"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
    Dim Rst As New ADODB.Recordset
    Dim strSQL As String
    Dim varMSG                          'msgbox的返回值
    
    If Opt_AddType.Value = True Then    '当前要进行的操作是添加类别
        If txtTypeName = "" Then        '检查类别名称不为空
            MsgBox "供货类别名称不得为空！", vbCritical, Me.Caption
            Exit Sub
        End If
        strSQL = "select * from tb_Type where TypeID ='" & Me.lblTypeID.Caption & "'"
        Rst.Open strSQL, CnnDatabase, adOpenStatic, adLockReadOnly
        If Rst.RecordCount > 0 Then     '类别代码重复性错误！
            MsgBox "供货类别代码已在数据库中！", vbCritical, "数据库错误-"
            Exit Sub
        End If
        Set Rst = Nothing
        Rst.Open "tb_Type", CnnDatabase, adOpenDynamic, adLockOptimistic
        Rst.AddNew                      '添加新记录
        Rst.Fields("TypeID").Value = lblTypeID.Caption
        Rst.Fields("TypeName").Value = txtTypeName.Text
        Rst.Update                      '添加结束
        MsgBox "新的供货类别添加成功。", vbInformation, Me.Caption
        FindNewTypeID                   '刷新界面
        txtTypeName.Text = ""
        Exit Sub
    End If
    If Opt_DelType.Value = True Then    '当前要进行的操作是删除类别
        If Me.MSFlexGrid1.Row = 0 Then  '没有选择要删除的记录行
            MsgBox "请先选择一条供货类别记录！", vbExclamation, Me.Caption
            Exit Sub
        End If
        varMSG = MsgBox("是否真的要删除此供货类别？（此操作不可逆转！）", _
            vbExclamation + vbYesNo, Me.Caption)
        If varMSG = vbYes Then          '删除
            Me.MSFlexGrid1.Col = 0
            strSQL = "TypeID = '" & Me.MSFlexGrid1.Text & "'"
            strSQL = "delete * from tb_Type where " & strSQL
            Rst.Open strSQL, CnnDatabase '删除记录成功
            MsgBox "删除成功！", vbInformation, "操作成功-"
            Opt_DelType_Click            '刷新界面
        End If
        Me.MSFlexGrid1.Row = 0
        Exit Sub
    End If
End Sub

Private Sub Form_Load()
    Opt_AddType.Value = True        '选择option控件
    Me.MSFlexGrid1.Enabled = False  '使MSFlex控件不可用
    Me.MSFlexGrid1.BackColor = &H8000000F
    Me.MSFlexGrid1.Rows = 1
    FindNewTypeID                   '给供货类别编号
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim Rst As New ADODB.Recordset
    Dim strSQL As String
    Dim strCombo As String              '记录combo控件原text内容
    Dim inti As Integer                 '用于for循环语句
    Dim blCombo As Boolean              'True表示combo的新列表中还有原text内容
    
    blCombo = False
    strSQL = "select * from tb_Type order by TypeID ASC"
    Rst.Open strSQL, CnnDatabase, adOpenDynamic, adLockReadOnly
    strCombo = frmSupplierInfo.Combo_Type.Text
    frmSupplierInfo.Combo_Type.Clear    '修改供应商信息窗体上的combo控件
    Do While Rst.EOF = False            '向控件中添加项目
        frmSupplierInfo.Combo_Type.AddItem Rst.Fields("TypeID").Value
        Rst.MoveNext
    Loop
    If flagAddSupplier = False Then     '当前是“修改供应商信息”操作
        With frmSupplierInfo.Combo_Type
            For inti = 0 To .ListCount - 1
                If .List(inti) = strCombo Then
                    .Text = strCombo
                    blCombo = True
                    Exit For
                End If
            Next
            If blCombo = False Then
                .ListIndex = -1
            End If
        End With
    End If
                
End Sub

Private Sub MSFlexGrid1_SelChange()
    Me.MSFlexGrid1.RowSel = Me.MSFlexGrid1.Row
End Sub

Private Sub Opt_AddType_Click()
    Me.MSFlexGrid1.Enabled = False  '使MSFlex控件不可用
    Me.MSFlexGrid1.BackColor = &H8000000F
    Me.MSFlexGrid1.Rows = 1
    Me.txtTypeName.Enabled = True   '使textbox控件可用
    Me.txtTypeName.BackColor = &H80000005
    Me.txtTypeName.Text = ""
    Me.txtTypeName.SetFocus
    FindNewTypeID                   '给类别号编号
End Sub

Private Sub Opt_DelType_Click()
    Dim Rst As New ADODB.Recordset
    Dim strSQL As String
    
    Me.MSFlexGrid1.Enabled = True           '使MSFlex控件可用
    Me.MSFlexGrid1.BackColor = &H80000005
    Me.txtTypeName.BackColor = &H8000000F   '使textbox控件可用
    Me.txtTypeName.Text = ""
    Me.txtTypeName.Enabled = False
    lblTypeID.Caption = ""                  '使label控件内容清空
    strSQL = "select * from tb_Type order by TypeID ASC"
    Rst.Open strSQL, CnnDatabase, adOpenDynamic, adLockReadOnly
    Me.MSFlexGrid1.Rows = 1
    Do While Rst.EOF = False                '准备向MSFlex中添加记录
        Me.MSFlexGrid1.Rows = Me.MSFlexGrid1.Rows + 1   '增加一行
        Me.MSFlexGrid1.Row = Me.MSFlexGrid1.Rows - 1    '将焦点放到新增加的行(最后一行)上
        Me.MSFlexGrid1.Col = 0              '将焦点放到第一列上
        Me.MSFlexGrid1.Text = Rst!TypeID    '向MSFlex中添加内容
        Me.MSFlexGrid1.Col = 1              '将焦点放到第二列上
        Me.MSFlexGrid1.Text = Rst!TypeName
        Rst.MoveNext
    Loop
    Me.MSFlexGrid1.Row = 0
End Sub

Private Sub FindNewTypeID()         '查找新的空位作为类别编号
    Dim Rst As New ADODB.Recordset
    Dim strSQL As String
    Dim inti As Integer             '记录集中当前类别编号的数字
    
On Error GoTo ErrorExit
    strSQL = "select * from tb_Type order by TypeID ASC"   '给控件号编号
    Rst.Open strSQL, CnnDatabase, adOpenDynamic, adLockOptimistic
    If Rst.BOF = True And Rst.EOF = True Then              '如果没有类别记录
        lblTypeID.Caption = "1类"
        Exit Sub
    End If
    If Rst!TypeID <> "1类" Then
        lblTypeID.Caption = "1类"
        Exit Sub
    End If
    inti = 1
    Rst.MoveNext
    Do While Rst.EOF = False        '从第一个开始查找第一个空位（不连贯处）
        If Left(Rst!TypeID, 1) = inti + 1 Then             '连续，进行下一条
            inti = inti + 1
            Rst.MoveNext
        Else                        '不连续，跳出循环
            Exit Do
        End If
    Loop
    lblTypeID.Caption = inti + 1 & "类"                    '给lable控件赋值
    Exit Sub

ErrorExit:
    MsgBox Err.Description, vbCritical, Me.Caption
End Sub