frmclientdata.frm

通用书店管理系统

      Width           =   855
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "编号"
      Height          =   255
      Index           =   0
      Left            =   0
      TabIndex        =   24
      Top             =   120
      Width           =   855
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "名称"
      Height          =   255
      Index           =   1
      Left            =   2520
      TabIndex        =   23
      Top             =   120
      Width           =   855
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "联系人"
      Height          =   255
      Index           =   2
      Left            =   0
      TabIndex        =   22
      Top             =   585
      Width           =   855
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "邮编"
      Height          =   255
      Index           =   3
      Left            =   2520
      TabIndex        =   21
      Top             =   585
      Width           =   855
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "地址"
      Height          =   255
      Index           =   4
      Left            =   0
      TabIndex        =   20
      Top             =   1005
      Width           =   855
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "折扣"
      Height          =   255
      Index           =   5
      Left            =   0
      TabIndex        =   19
      Top             =   1380
      Width           =   855
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "开户银行"
      Height          =   255
      Index           =   6
      Left            =   15
      TabIndex        =   18
      Top             =   1800
      Width           =   855
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "银行帐号"
      Height          =   255
      Index           =   7
      Left            =   0
      TabIndex        =   17
      Top             =   2205
      Width           =   855
   End
End
Attribute VB_Name = "frmClientData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public blnAddNew As Boolean
Public intFlag As Integer '0 供货商 ; 1  客户

Private Sub cmdExit_Click()
  Unload Me
End Sub

Private Sub CmdSave_Click()
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  On Error GoTo SaveErr
  
  If blnAddNew Then
     If Trim(txtFields(0).Text) = "" Or Trim(txtFields(1).Text) = "" Then
       MsgBox "编码、名称不能为空！", vbInformation
       Exit Sub
     End If

     If CheckExist Then
        MsgBox "此客户编码已存在，请修改。", vbInformation + vbOKOnly
        Call setselect(txtFields(0))
        Exit Sub
     End If
     Select Case intFlag
       Case 0
         If Trim(txtFields(5).Text) = "" Then
            sqlstring = "Insert into ClientData (chrClientNo,chrClientName,ChrLinkman,ChrAddress,ChrYouBian," & _
                 "DecAgio,ChrBank,ChrAccounts,ChrYHHM,ChrTexNo,ChrPhoneCode,ChrReticulation,ChrMail," & _
                 "ChrMissionary,ChrRemark,IntFlag) values ('" & txtFields(0).Text & "','" & txtFields(1).Text & _
                 "','" & txtFields(2).Text & "','" & txtFields(3).Text & "','" & txtFields(4).Text & "',1" & _
                 ",'" & txtFields(6).Text & "','" & txtFields(7).Text & _
                 "','" & txtFields(8).Text & "','" & txtFields(9).Text & "','" & txtFields(10).Text & "'" & _
                 ",'" & txtFields(11).Text & "','" & txtFields(12).Text & "','" & txtFields(13).Text & "'," & _
                 "'" & txtFields(14).Text & "',0)"
         Else
            sqlstring = "Insert into ClientData (chrClientNo,chrClientName,ChrLinkman,ChrAddress,ChrYouBian," & _
                 "DecAgio,ChrBank,ChrAccounts,ChrYHHM,ChrTexNo,ChrPhoneCode,ChrReticulation,ChrMail," & _
                 "ChrMissionary,ChrRemark,IntFlag) values ('" & txtFields(0).Text & "','" & txtFields(1).Text & _
                 "','" & txtFields(2).Text & "','" & txtFields(3).Text & "','" & txtFields(4).Text & "'," & _
                 txtFields(5).Text & ",'" & txtFields(6).Text & "','" & txtFields(7).Text & _
                 "','" & txtFields(8).Text & "','" & txtFields(9).Text & "','" & txtFields(10).Text & "'" & _
                 ",'" & txtFields(11).Text & "','" & txtFields(12).Text & "','" & txtFields(13).Text & "'," & _
                 "'" & txtFields(14).Text & "',0)"
         End If
         
       Case 1
          If Trim(txtFields(5).Text) = "" Then
            sqlstring = "Insert into ClientData (chrClientNo,chrClientName,ChrLinkman,ChrAddress,ChrYouBian," & _
                 "DecAgio,ChrBank,ChrAccounts,ChrYHHM,ChrTexNo,ChrPhoneCode,ChrReticulation,ChrMail," & _
                 "ChrMissionary,ChrRemark,IntFlag) values ('" & txtFields(0).Text & "','" & txtFields(1).Text & _
                 "','" & txtFields(2).Text & "','" & txtFields(3).Text & "','" & txtFields(4).Text & "',1" & _
                 ",'" & txtFields(6).Text & "','" & txtFields(7).Text & _
                 "','" & txtFields(8).Text & "','" & txtFields(9).Text & "','" & txtFields(10).Text & "'" & _
                 ",'" & txtFields(11).Text & "','" & txtFields(12).Text & "','" & txtFields(13).Text & "'," & _
                 "'" & txtFields(14).Text & "',1)"
         Else
            sqlstring = "Insert into ClientData (chrClientNo,chrClientName,ChrLinkman,ChrAddress,ChrYouBian," & _
                 "DecAgio,ChrBank,ChrAccounts,ChrYHHM,ChrTexNo,ChrPhoneCode,ChrReticulation,ChrMail," & _
                 "ChrMissionary,ChrRemark,IntFlag) values ('" & txtFields(0).Text & "','" & txtFields(1).Text & _
                 "','" & txtFields(2).Text & "','" & txtFields(3).Text & "','" & txtFields(4).Text & "'," & _
                 txtFields(5).Text & ",'" & txtFields(6).Text & "','" & txtFields(7).Text & _
                 "','" & txtFields(8).Text & "','" & txtFields(9).Text & "','" & txtFields(10).Text & "'" & _
                 ",'" & txtFields(11).Text & "','" & txtFields(12).Text & "','" & txtFields(13).Text & "'," & _
                 "'" & txtFields(14).Text & "',1)"
         End If
     End Select
     
     cN.BeginTrans
     cN.Execute (sqlstring)
     cN.CommitTrans
     Unload Me
     Call frmFields.cmdRefresh_Click
  Else
     If Trim(txtFields(0).Text) = "" Or Trim(txtFields(1).Text) = "" Then
       MsgBox "编码、名称不能为空！", vbInformation
       Exit Sub
     End If
     
     If Trim(txtFields(5).Text) = "" Then
        sqlstring = "Update ClientData set chrClientName='" & txtFields(1).Text & "'," & _
                 " ChrLinkman='" & txtFields(2).Text & "',ChrAddress='" & txtFields(3).Text & _
                 "',ChrYouBian='" & txtFields(4).Text & "',DecAgio=1" & _
                 ",ChrBank='" & txtFields(6).Text & "',ChrAccounts='" & txtFields(7).Text & _
                 "',ChrYHHM='" & txtFields(8).Text & "',ChrTexNo='" & txtFields(9).Text & _
                 "',ChrPhoneCode='" & txtFields(10).Text & "',ChrReticulation='" & txtFields(11).Text & _
                 "',ChrMail='" & txtFields(12).Text & "',ChrMissionary='" & txtFields(13).Text & _
                 "',ChrRemark='" & txtFields(14).Text & "' where chrClientNo='" & Trim(txtFields(0).Text) & "'"
     Else
        sqlstring = "Update ClientData set chrClientName='" & txtFields(1).Text & "'," & _
                 " ChrLinkman='" & txtFields(2).Text & "',ChrAddress='" & txtFields(3).Text & _
                 "',ChrYouBian='" & txtFields(4).Text & "',DecAgio=" & CDbl(txtFields(5).Text) & _
                 ",ChrBank='" & txtFields(6).Text & "',ChrAccounts='" & txtFields(7).Text & _
                 "',ChrYHHM='" & txtFields(8).Text & "',ChrTexNo='" & txtFields(9).Text & _
                 "',ChrPhoneCode='" & txtFields(10).Text & "',ChrReticulation='" & txtFields(11).Text & _
                 "',ChrMail='" & txtFields(12).Text & "',ChrMissionary='" & txtFields(13).Text & _
                 "',ChrRemark='" & txtFields(14).Text & "' where chrClientNo='" & Trim(txtFields(0).Text) & "'"
     End If
     
     cN.BeginTrans
     cN.Execute (sqlstring)
     cN.CommitTrans
     Unload Me
     Call frmFields.ShowRecorder("ClientData", "chrClientNo", "客户号|名称|联系人|地址|邮编|折扣|开户银行|银行帐号|银行户名|税号|电话号码|网页|电子邮箱|业务员|备注|标志位")

'     Call frmFields.cmdRefresh_Click
  End If
  
  Exit Sub
SaveErr:
  cN.RollbackTrans
  MsgBox "保存记录失败：" & err.Description, vbInformation
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  Call autoreturn(KeyCode)
End Sub

Private Function CheckExist() As Boolean
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  On Error GoTo err
  
  sqlstring = "select * from ClientData where chrClientNo='" & Trim(txtFields(0).Text) & "'"
  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  If rstmp.EOF Then
    CheckExist = False
  Else
    CheckExist = True
  End If
  
  Exit Function
err:
  MsgBox "打开记录失败：" & err.Description, vbInformation
End Function


Private Sub txtFields_KeyPress(Index As Integer, KeyAscii As Integer)
  Select Case Index
    Case 0
      KeyAscii = ValiText(KeyAscii, vbExpInteger, "", txtFields(Index).Text, 4)
    Case 10
      KeyAscii = ValiText(KeyAscii, vbExpInteger, "-", txtFields(Index).Text)
    Case 4
      KeyAscii = ValiText(KeyAscii, vbExpInteger, "", txtFields(Index).Text)
    Case 5
      KeyAscii = ValiText(KeyAscii, vbExpDecimal, "", txtFields(Index).Text)
  End Select
End Sub