class.frm

这个是我以前做的一个客户管理系统.包内已经含有源码和所用到的控件.代码是用VB写的,数据库采用MSSQL的.

VERSION 5.00
Begin VB.Form frmClass 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   1815
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4500
   Icon            =   "Class.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1815
   ScaleWidth      =   4500
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox txtMemo 
      Height          =   345
      Left            =   780
      MultiLine       =   -1  'True
      TabIndex        =   3
      Text            =   "Class.frx":000C
      Top             =   690
      Width           =   3450
   End
   Begin VB.TextBox txtName 
      Height          =   285
      Left            =   780
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   240
      Width           =   1260
   End
   Begin VB.TextBox txtNo 
      Height          =   285
      Left            =   3000
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   225
      Width           =   1260
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   315
      Left            =   2280
      TabIndex        =   5
      Top             =   1260
      Width           =   1260
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定"
      Height          =   315
      Left            =   870
      MaskColor       =   &H00000000&
      TabIndex        =   4
      Top             =   1260
      Width           =   1260
   End
   Begin VB.Label Label3 
      Caption         =   "说明："
      Height          =   285
      Left            =   120
      TabIndex        =   7
      Top             =   720
      Width           =   1095
   End
   Begin VB.Label Label2 
      Caption         =   "名称："
      Height          =   285
      Left            =   120
      TabIndex        =   6
      Top             =   270
      Width           =   1095
   End
   Begin VB.Label Label1 
      Caption         =   "编号："
      Height          =   285
      Left            =   2340
      TabIndex        =   0
      Top             =   240
      Width           =   1095
   End
End
Attribute VB_Name = "frmClass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public mbAdd            As Boolean '记录是否是新增还是修改

Public mClassType       As String  '记录类别类型
Public mClassLevel      As Integer '记录类别级别

Public mC_ID            As Long

Private mOldC_No            As String

Public mFormTitle       As String '窗体标题

Private Function mbSaveClass() As Boolean
'**************************************************
'
'保存类别
'
'**************************************************

    Dim Rst         As New ADODB.Recordset
    Dim sSql        As String
    Dim lID         As Long
    
On Error GoTo ErrSave

    
    '合法性判断
        If Trim(txtNo) = "" Then
            MsgBox "类别名称不能为空！！！", vbInformation, ""
            mbSaveClass = False
            Exit Function
        ElseIf Trim(txtName) = "" Then
            MsgBox "类别编号不能为空！！！", vbInformation, ""
            mbSaveClass = False
            Exit Function
        End If
        
        If mClassLevel = 6 Then
            MsgBox "类别级别不能超出5级！！！", vbExclamation, "警告"
            mbSaveClass = False
            Exit Function
        End If

        
        Rst.Open "Select A=Count(*) from Class where C_Type='" & mClassType & "' and C_Delflag='n' and C_No='" & DoubleQuote(txtNo) & "'", CN
        If Rst!A <> 0 Then
            If mbAdd Then
                MsgBox "类别编号已经存在！！！", vbExclamation, "提醒"
                mbSaveClass = False
                Exit Function
            Else
                If mOldC_No <> Trim(txtNo) Then
                    MsgBox "类别编号已经存在！！！", vbExclamation, "提醒"
                    mbSaveClass = False
                    Exit Function
                End If
            End If
        End If
        Rst.Close
        
        Rst.Open "Select C_Name from Class where C_Type='" & mClassType & "' and C_Delflag='n' and C_Name='" & DoubleQuote(Trim(txtName)) & "'", CN
        If Not Rst.EOF Then
            MsgBox "此类别名称已经存在，请重新填写！！！", vbExclamation, "提醒"
            mbSaveClass = False
            Exit Function
        End If
        Rst.Close

    If mbAdd Then   '添加类别
        
        '取得内部编号
        Rst.Open "select RowID=max(C_ID)+1 from Class", CN
        If IsNull(Rst!RowID) Then
            lID = 1
        Else
            lID = Rst!RowID + 1
        End If
        Rst.Close
        
        sSql = "Insert Class(C_ID,C_No,C_Name,C_Level,C_Type,C_P1,C_P2,C_P3,C_P4,C_DelFlag,C_Memo)"
        sSql = sSql & " values(" & lID & ",'" & DoubleQuote(Trim(txtNo)) & "','" & DoubleQuote(Trim(txtName)) & "','"
        sSql = sSql & mClassLevel & "','" & mClassType & "'," & iFather(1) & "," & iFather(2) & "," & iFather(3) & "," & iFather(4) & ",'n','" & DoubleQuote(Trim(txtMemo)) & "')"
        Screen.MousePointer = vbHourglass
        CN.Execute sSql
        Screen.MousePointer = vbDefault
    
    Else   '修改类别信息
    
        sSql = "Update Class set C_No='" & DoubleQuote(Trim(txtNo)) & "',C_Name='" & Trim(txtName) & "',C_Memo='" & Trim(txtMemo) & "' where C_ID=" & mC_ID
        
        Screen.MousePointer = vbHourglass
        CN.Execute sSql
        Screen.MousePointer = vbDefault
        
    End If
    
mbSaveClass = True
    
Exit Function
ErrSave:
    Screen.MousePointer = vbDefault
    mbSaveClass = False
    gShowMsg "保存类别时出错，frmClass.mbSaveClass"
End Function

Private Sub mInitForm()
'************************************
'
'初始化窗体
'
'************************************
    Dim Rst         As New ADODB.Recordset
    

On Error GoTo errInitForm
    
    KeyPreview = True
    Center Me
    Me.Caption = mFormTitle
    
    If mbAdd Then '新增
        Call mClear
    Else
        Call mClear
        Screen.MousePointer = vbHourglass
        Rst.Open "select C_ID,C_No,C_Name,C_Memo from Class where C_ID=" & mC_ID & " and C_Delflag='n'", CN
        Screen.MousePointer = vbDefault
        
        If Rst.EOF = False Then
                Rst.MoveFirst
                mOldC_No = Rst(1)
                frmClass.txtNo.Text = IIf(IsNull(Rst(1)), "", Rst(1))
                frmClass.txtName.Text = IIf(IsNull(Rst(2)), "", Rst(2))
                frmClass.txtMemo.Text = IIf(IsNull(Rst(3)), "", Rst(3))
        End If
        Rst.Close
    End If


Exit Sub
errInitForm:
    Screen.MousePointer = vbDefault
    gShowMsg "初始化窗体时出错,frmClass.mInitForm()"

End Sub

Private Sub mClear()

'清除控件的值

    txtNo = ""
    txtName = ""
    txtMemo = ""
    
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub


Private Sub cmdOK_Click()
    If mbSaveClass Then
        Call SendMessageToCtl(frmArchivesClass.tvClass, WM_KEYDOWN, VK_F5, 0)
        Unload Me
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        SendKeys "{tab}"
    ElseIf KeyAscii = vbKeyEscape Then
        KeyAscii = 0
        Unload Me
    End If
End Sub

Private Sub Form_Load()
    Call mInitForm
End Sub

Private Sub txtMemo_GotFocus()
    InitTextBox txtMemo
End Sub

Private Sub txtName_GotFocus()
    InitTextBox txtName
End Sub

Private Sub txtNo_GotFocus()
    InitTextBox txtNo
End Sub