relaman.frm

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

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmRelaMan 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "联系人"
   ClientHeight    =   6210
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4965
   Icon            =   "RelaMan.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6210
   ScaleWidth      =   4965
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame1 
      Height          =   5505
      Left            =   90
      TabIndex        =   17
      Top             =   30
      Width           =   4785
      Begin VB.CheckBox chkLetter 
         Caption         =   "作为收信人"
         Height          =   255
         Left            =   2850
         TabIndex        =   2
         Top             =   570
         Width           =   1755
      End
      Begin VB.TextBox txtTel 
         Height          =   285
         Left            =   990
         TabIndex        =   6
         Text            =   "Text4"
         Top             =   1890
         Width           =   3705
      End
      Begin VB.TextBox txtPostcode 
         Height          =   285
         Left            =   990
         TabIndex        =   5
         Text            =   "Text3"
         Top             =   1560
         Width           =   1575
      End
      Begin VB.TextBox txtAddress 
         Height          =   285
         Left            =   990
         TabIndex        =   4
         Text            =   "Text2"
         Top             =   1230
         Width           =   3705
      End
      Begin VB.TextBox txtDescription 
         Height          =   765
         Left            =   990
         TabIndex        =   13
         Text            =   "Text31"
         Top             =   4650
         Width           =   3705
      End
      Begin VB.TextBox txtRelation 
         Height          =   705
         Left            =   990
         TabIndex        =   12
         Text            =   "Text18"
         Top             =   3870
         Width           =   3705
      End
      Begin VB.TextBox txtQQ 
         Height          =   285
         Left            =   990
         TabIndex        =   8
         Text            =   "Text17"
         Top             =   2550
         Width           =   3705
      End
      Begin VB.ComboBox cboSex 
         Height          =   300
         ItemData        =   "RelaMan.frx":000C
         Left            =   990
         List            =   "RelaMan.frx":0016
         Style           =   2  'Dropdown List
         TabIndex        =   1
         Top             =   540
         Width           =   825
      End
      Begin VB.TextBox txtMobile 
         Height          =   285
         Left            =   990
         TabIndex        =   7
         Text            =   "Text1"
         Top             =   2220
         Width           =   3705
      End
      Begin VB.ComboBox cboJob 
         Height          =   300
         Left            =   990
         TabIndex        =   3
         Text            =   "Combo6"
         Top             =   900
         Width           =   1575
      End
      Begin VB.TextBox txtName 
         Height          =   300
         Left            =   990
         TabIndex        =   0
         Text            =   "Text13"
         Top             =   210
         Width           =   1575
      End
      Begin MSComCtl2.DTPicker dtpOther 
         Height          =   285
         Left            =   990
         TabIndex        =   11
         Top             =   3540
         Width           =   1695
         _ExtentX        =   2990
         _ExtentY        =   503
         _Version        =   393216
         Format          =   30146560
         CurrentDate     =   37639
      End
      Begin MSComCtl2.DTPicker dtpWedding 
         Height          =   285
         Left            =   990
         TabIndex        =   10
         Top             =   3210
         Width           =   1695
         _ExtentX        =   2990
         _ExtentY        =   503
         _Version        =   393216
         Format          =   30146560
         CurrentDate     =   37639
      End
      Begin MSComCtl2.DTPicker dtpBirthday 
         Height          =   285
         Left            =   990
         TabIndex        =   9
         Top             =   2880
         Width           =   1695
         _ExtentX        =   2990
         _ExtentY        =   503
         _Version        =   393216
         Format          =   30146560
         CurrentDate     =   37639
      End
      Begin VB.Label Label3 
         Caption         =   "家庭电话："
         Height          =   285
         Left            =   120
         TabIndex        =   30
         Top             =   1950
         Width           =   1725
      End
      Begin VB.Label Label2 
         Caption         =   "邮编："
         Height          =   285
         Left            =   120
         TabIndex        =   29
         Top             =   1605
         Width           =   1725
      End
      Begin VB.Label Label1 
         Caption         =   "家庭住址："
         Height          =   285
         Left            =   120
         TabIndex        =   28
         Top             =   1260
         Width           =   1725
      End
      Begin VB.Label Label5 
         Caption         =   "QQ："
         Height          =   285
         Left            =   120
         TabIndex        =   27
         Top             =   2640
         Width           =   1725
      End
      Begin VB.Label Label32 
         Caption         =   "职务："
         Height          =   285
         Left            =   120
         TabIndex        =   26
         Top             =   930
         Width           =   1725
      End
      Begin VB.Label Label31 
         Caption         =   "结婚："
         Height          =   285
         Left            =   120
         TabIndex        =   25
         Top             =   3285
         Width           =   1725
      End
      Begin VB.Label Label30 
         Caption         =   "其它节日："
         Height          =   345
         Left            =   120
         TabIndex        =   24
         Top             =   3600
         Width           =   945
      End
      Begin VB.Label Label29 
         Caption         =   "手机："
         Height          =   285
         Left            =   120
         TabIndex        =   23
         Top             =   2295
         Width           =   1725
      End
      Begin VB.Label Label27 
         Caption         =   "与老板关系及作用："
         Height          =   555
         Left            =   120
         TabIndex        =   22
         Top             =   3975
         Width           =   675
      End
      Begin VB.Label Label26 
         Caption         =   "生日："
         Height          =   285
         Left            =   120
         TabIndex        =   21
         Top             =   2970
         Width           =   1725
      End
      Begin VB.Label Label21 
         Caption         =   "描述："
         Height          =   285
         Left            =   120
         TabIndex        =   20
         Top             =   4740
         Width           =   1725
      End
      Begin VB.Label Label8 
         Caption         =   "性别："
         Height          =   285
         Left            =   120
         TabIndex        =   19
         Top             =   585
         Width           =   1725
      End
      Begin VB.Label Label20 
         Caption         =   "姓名："
         Height          =   285
         Left            =   120
         TabIndex        =   18
         Top             =   240
         Width           =   1725
      End
   End
   Begin VB.CommandButton cmdSaveNew 
      Caption         =   "保存并新建"
      Height          =   375
      Left            =   270
      TabIndex        =   14
      Top             =   5700
      Width           =   1395
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "关闭"
      Height          =   375
      Left            =   3330
      TabIndex        =   16
      Top             =   5700
      Width           =   1395
   End
   Begin VB.CommandButton cmdSaveClose 
      Caption         =   "保存并关闭"
      Height          =   375
      Left            =   1755
      TabIndex        =   15
      Top             =   5700
      Width           =   1395
   End
End
Attribute VB_Name = "frmRelaMan"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public mvsfRow          As Integer      '记录当前行数
Public mbAddNew         As Boolean      '是插入新记录还是修改记录

Public mName            As String
Public mSex             As String
Public mLetter          As String
Public mJob             As String
Public mAddress         As String
Public mPostCode        As String
Public mTel             As String
Public mMobile          As String
Public mQQ              As String
Public mBirthday        As Date
Public mWedding         As Date
Public mOther           As Date
Public mRelation        As String
Public mDescription     As String


Private Sub Form_Load()
    Call mInitForm
End Sub

Private Sub mClear()
'***************************
'
'清空数据
'
'***************************

    txtName.Text = ""
    chkLetter.Value = vbUnchecked
    cboSex.ListIndex = 1
    cboJob.Text = ""
    txtAddress.Text = ""
    txtTel.Text = ""
    txtPostCode.Text = ""
    txtMobile.Text = ""
    txtQQ.Text = ""
    dtpBirthday.Value = Now
    dtpWedding.Value = Now
    dtpOther.Value = Now
    txtRelation.Text = ""
    txtDescription.Text = ""
    
    
End Sub

Private Sub mInitForm()
'********************************
'初始化界面
    
    Dim sSql            As String
    Dim Rs              As New ADODB.Recordset
    
    On Error GoTo errInitForm
    
    Center Me
    KeyPreview = True
    
    '列表职务
    sSql = "Select Distinct LM_Job from LinkMan "
    Screen.MousePointer = vbHourglass
    Rs.Open sSql, CN
    Screen.MousePointer = vbDefault
    Do While Rs.EOF = False
        cboJob.AddItem Rs.Fields(0)
        Rs.MoveNext
    Loop
    Rs.Close
    
    If mbAddNew = False Then
        cmdSaveNew.Enabled = False
        txtName.Text = mName
        cboSex.ListIndex = IIf(mSex = "男", 0, 1)
        cboJob.Text = mJob
        txtAddress.Text = mAddress
        txtTel.Text = mTel
        txtPostCode.Text = mPostCode
        txtMobile.Text = mMobile
        txtQQ.Text = mQQ
        dtpBirthday.Value = CDate(mBirthday)
        dtpWedding.Value = CDate(mWedding)
        dtpOther.Value = CDate(mOther)
        txtRelation.Text = mRelation
        txtDescription.Text = mDescription
        If mLetter = "" Or mLetter = "n" Then
            chkLetter.Value = vbUnchecked
        Else
            chkLetter.Value = vbChecked
        End If
            
    Else
       Call mClear
        mName = ""
        mSex = ""
        mLetter = ""
        mJob = ""
        mAddress = ""
        mPostCode = ""
        mTel = ""
        mMobile = ""
        mQQ = ""
        mBirthday = Now
        mWedding = Now
        mOther = Now
        mRelation = ""
        mDescription = ""

    End If
    
    Exit Sub
errInitForm:
    
    Screen.MousePointer = vbDefault
    gShowMsg "初始化窗体出错 frmRelaMan.mInitForm"
    
End Sub

Private Function mbAddNewData() As Boolean
    
    If mbSetData(True) Then
        frmMain.mbRefresh = True
        mvsfRow = mvsfRow + 1
        Call SendMessageToCtl(frmMain.vsfRelaMan, WM_KEYDOWN, VK_F5, 0)
        mbAddNewData = True
    Else
        mbAddNewData = False
    End If
    
End Function

Private Function mbCheckData() As Boolean
'************************************************
'
'检验输入数据的正确性
'
'************************************************
    
    If Trim(txtName.Text) = "" Then
        MsgBox "请输入联系人的姓名!!!", vbInformation, ""
        txtName.SetFocus
        mbCheckData = False
    Else
        mbCheckData = True
    End If
    
End Function
Private Function mbSetData(mbSet As Boolean) As Boolean
'********************************************
'
'将当前记录信息复制到vsf表格中
'
'*********************************************

    On Error GoTo ErrSetData
    
    If mbSet Then
        If mbCheckData() = False Then mbSetData = False: Exit Function
    End If

    If mbSet Then
        mName = Trim(txtName.Text)
        mSex = cboSex.Text
        mLetter = IIf(chkLetter.Value = vbChecked, "y", "n")
        mJob = Trim(cboJob.Text)
        mAddress = Trim(txtAddress.Text)
        mPostCode = Trim(txtPostCode.Text)
        mTel = Trim(txtTel.Text)
        mMobile = Trim(txtMobile.Text)
        mQQ = Trim(txtQQ.Text)
        mBirthday = dtpBirthday.Value
        mWedding = dtpWedding.Value
        mOther = dtpOther.Value
        mRelation = Trim(txtRelation.Text)
        mDescription = Trim(txtDescription.Text)
    Else
        mName = ""
        mSex = ""
        mLetter = ""
        mJob = ""
        mAddress = ""
        mPostCode = ""
        mTel = ""
        mMobile = ""
        mQQ = ""
        mBirthday = Now
        mWedding = Now
        mOther = Now
        mRelation = ""
        mDescription = ""
    End If
    mbSetData = True
    Exit Function
ErrSetData:
    mbSetData = False
    gShowMsg "保存输入数据出错 frmRelaman.mbSetData"
    
End Function


Private Sub cmdSaveNew_Click()
    
    If mbAddNewData() Then
        Call mClear
        txtName.SetFocus
    End If
    
End Sub

Private Sub cmdClose_Click()
    Call mbSetData(False)
    Unload Me
End Sub

Private Sub cmdSaveClose_Click()
    
    If mbSetData(True) Then Me.Hide
        
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