frmmemberdata.frm

通用书店管理系统

   End
   Begin VB.Label Label12 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      Caption         =   "最大借书数"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   60
      TabIndex        =   26
      Top             =   3180
      Width           =   975
   End
   Begin VB.Label Label7 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      Caption         =   "类型"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   180
      TabIndex        =   25
      Top             =   2760
      Width           =   735
   End
   Begin VB.Label Label4 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      Caption         =   "性别"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   180
      TabIndex        =   24
      Top             =   1920
      Width           =   735
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      Caption         =   "出生日期"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   120
      TabIndex        =   23
      Top             =   1500
      Width           =   855
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      Caption         =   "姓名"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   180
      TabIndex        =   22
      Top             =   1080
      Width           =   735
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      Caption         =   "会员号"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   180
      TabIndex        =   21
      Top             =   180
      Width           =   735
   End
End
Attribute VB_Name = "frmMemberData"
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


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) = "" Or _
'        Trim(TxtFields(2).Text) = "" Or Trim(TxtFields(8).Text) = "" Or _
'        Trim(TxtFields(9).Text) = "" Or Trim(TxtFields(10).Text) = "" Or _
'        Trim(TxtFields(13).Text) = "" Then
'       MsgBox "编码、名称、日期、金额等不能为空！", vbInformation
'       Exit Sub
'     End If
'    If TxtFields(3) = "" Then TxtFields(3) = "1900-01-01"
'    If Trim(TxtFields(0).Text) = "" Then
'        MsgBox "编码不能为空。"
'        TxtFields(0).SetFocus
'        Exit Sub
'    End If
'    If Trim(TxtFields(1).Text) = "" Then
'        MsgBox "客户编码不能为空。"
'        TxtFields(1).SetFocus
'        Exit Sub
'    End If
    If Trim(TxtFields(2).Text) = "" Then
        MsgBox "姓名不能为空。"
        TxtFields(2).SetFocus
        Exit Sub
    End If
'    If Trim(txtFields(8).Text) = "" Then
'        MsgBox "有效期不能为空。"
'        txtFields(8).SetFocus
'        Exit Sub
'    End If
    
    
'       MsgBox "编码、名称、日期、金额等不能为空！", vbInformation
'       Exit Sub
'     End If

     If CheckExist Then
        MsgBox "此会员卡号已存在，请修改。", vbInformation + vbOKOnly
        Call setselect(TxtFields(0))
        Exit Sub
     End If

'     If Trim(TxtFields(3).Text) = "" Then
'            sqlstring = "Insert into MemberData (IntMemberNo,ChrClientNo,ChrName,DatBronDate,ChrSex," & _
'                 "ChrLevel,ChrType,IntMaxBorrow,IntMaxDay,chrYXQ,DatLoginDate,DatDQDate,DecTax," & _
'                 "DecDeposit,ChrMissionary,ChrState) values (" & TxtFields(0).Text & ",'" & TxtFields(1).Text & _
'                 "','" & TxtFields(2).Text & "','','" & CmbFields(0).Text & "'," & _
'                 ",'" & IIf(IsNull(TxtFields(4).Text), "", TxtFields(4).Text) & "'," & _
'                 "'" & IIf(IsNull(TxtFields(5).Text), "", TxtFields(5).Text) & "'," & _
'                 "" & IIf(IsNull(TxtFields(6).Text), "", TxtFields(6).Text) & _
'                 "," & IIf(IsNull(TxtFields(7).Text), "", TxtFields(7).Text) & "," & _
'                 "'" & IIf(IsNull(TxtFields(8).Text), "", TxtFields(8).Text) & "'," & _
'                 "#" & IIf(IsNull(TxtFields(9).Text), "", TxtFields(9).Text) & "#" & _
'                 ",#" & IIf(IsNull(TxtFields(10).Text), "", TxtFields(10).Text) & "#," & _
'                 "'" & IIf(IsNull(TxtFields(11).Text), "", TxtFields(11).Text) & "'," & _
'                 "'" & IIf(IsNull(TxtFields(12).Text), "", TxtFields(12).Text) & "," & _
'                 "'" & TxtFields(13).Text & "','正常')"
'     Else
    sqlstring = "Insert into MemberData (IntMemberNo,ChrClientNo,ChrName,DatBronDate,ChrSex," & _
                 "ChrLevel,ChrType,IntMaxBorrow,IntMaxDay,chrYXQ,DatLoginDate,DatDQDate,DecTax," & _
                 "DecDeposit,ChrMissionary,ChrState) values (" & TxtFields(0).Text & ",'" & TxtFields(1).Text & _
                 "','" & TxtFields(2).Text & "',#" & TxtFields(3).Text & "#,'" & CmbFields(0).Text & "'," & _
                 "'" & IIf(IsNull(TxtFields(4).Text) Or Trim(TxtFields(4)) = "", "", TxtFields(4).Text) & "'," & _
                 "'" & IIf(IsNull(TxtFields(5).Text) Or Trim(TxtFields(5)) = "", "", TxtFields(5).Text) & "'," & _
                 "" & IIf(IsNull(TxtFields(6).Text) Or Trim(TxtFields(6)) = "", 0, TxtFields(6).Text) & _
                 "," & IIf(IsNull(TxtFields(7).Text) Or Trim(TxtFields(7)) = "", 0, TxtFields(7).Text) & "," & _
                 "'" & IIf(IsNull(TxtFields(8).Text) Or Trim(TxtFields(8)) = "", "", TxtFields(8).Text) & "'," & _
                 "#" & TxtFields(9).Text & "#" & _
                 ",#" & TxtFields(10).Text & "#," & _
                 "" & IIf(IsNull(TxtFields(11).Text) Or Trim(TxtFields(11)) = "", 0#, TxtFields(11).Text) & "," & _
                 "" & IIf(IsNull(TxtFields(12).Text) Or Trim(TxtFields(12)) = "", 0#, TxtFields(12).Text) & "," & _
                 "'" & TxtFields(13).Text & "','正常')"
'     End If

     cN.BeginTrans
     cN.Execute sqlstring
     cN.CommitTrans
     Unload Me
     Call frmFields.cmdRefresh_Click
  Else
'     If Trim(TxtFields(0).Text) = "" Or Trim(TxtFields(1).Text) = "" Or _
'        Trim(TxtFields(2).Text) = "" Or Trim(TxtFields(8).Text) = "" Or _
'        Trim(TxtFields(9).Text) = "" Or Trim(TxtFields(10).Text) = "" Or _
'        Trim(TxtFields(13).Text) = "" Then
'       MsgBox "编码、名称、日期、金额等不能为空！", vbInformation
'       Exit Sub
'     End If
     
     
     If Trim(TxtFields(3).Text) = "" Then
        sqlstring = "Update MemberData set ChrClientNo='" & TxtFields(1).Text & "'," & _
                 " ChrName='" & TxtFields(2).Text & _
                 "','',ChrSex='" & CmbFields(0).Text & "',ChrLevel='" & TxtFields(4).Text & _
                 ",ChrType='" & TxtFields(5).Text & "',IntMaxBorrow=" & CInt(TxtFields(6).Text) & _
                 ",IntMaxDay=" & CInt(TxtFields(7).Text) & ",chrYXQ='" & TxtFields(8).Text & _
                 "',DatLoginDate=#" & TxtFields(9).Text & "#,DatDQDate=#" & TxtFields(10).Text & _
                 "#,DecTax=" & CDbl(TxtFields(11).Text) & ",DecDeposit=" & CDbl(TxtFields(12).Text) & _
                 ",ChrMissionary='" & TxtFields(13).Text & "' where IntMemberNo=" & CInt(TxtFields(0).Text) & ""
     Else
    sqlstring = "Update MemberData set ChrClientNo='" & TxtFields(1).Text & "'," & _
                 " ChrName='" & TxtFields(2).Text & "',DatBronDate=#" & TxtFields(3).Text & _
                 "#,ChrSex='" & CmbFields(0).Text & "',ChrLevel='" & TxtFields(4).Text & _
                 "',ChrType='" & TxtFields(5).Text & "',IntMaxBorrow=" & CInt(TxtFields(6).Text) & _
                 ",IntMaxDay=" & CInt(TxtFields(7).Text) & ",chrYXQ='" & TxtFields(8).Text & _
                 "',DatLoginDate=#" & TxtFields(9).Text & "#,DatDQDate=#" & TxtFields(10).Text & _
                 "#,DecTax=" & CDbl(TxtFields(11).Text) & ",DecDeposit=" & CDbl(TxtFields(12).Text) & _
                 ",ChrMissionary='" & TxtFields(13).Text & "' where IntMemberNo=" & CInt(TxtFields(0).Text) & ""
     End If
     
     cN.BeginTrans
     cN.Execute (sqlstring)
     cN.CommitTrans
     Unload Me
     Call frmFields.ShowRecorder("MemberData", "IntMemberNo", "会员号|客户编码|姓名|出生日期|性别|级别|类型|最大借书数|最多可借天数|有效期|注册日期|到期日期|会费|押金|业务员|状态")
'     Call frmFields.cmdRefresh_Click
  End If
  
  Exit Sub
SaveErr:
  cN.RollbackTrans
  MsgBox "保存记录失败：" & err.Description, vbInformation
End Sub

Private Sub cmdSearch_Click(Index As Integer)
  On Error GoTo err
  Dim strQuery As String
  Dim arrQuery
  
  Select Case Index
    Case 0 '客户
      strQuery = g_CommonSelect("   客户编码   |    客户名称   |   联系人  |  地址  ", "select chrClientNo,chrClientName,chrLinkman,chrAddress from ClientData where intFlag=1 order by chrClientNo", "0,1,2", , , , -1, arrQuery)
      If TypeName(arrQuery) = "Variant()" Then
           TxtFields(1).Text = arrQuery(0, 0)
           TxtFields(2).Text = arrQuery(0, 1)
      End If
    Case 1 '级别
      strQuery = g_CommonSelect("   级别   |    折扣   ", "select ChrLevel,DecAgio from MemberClass ", "0,1", , , , -1, arrQuery)
      If TypeName(arrQuery) = "Variant()" Then
           TxtFields(4).Text = arrQuery(0, 0)
      End If
    Case 2 '类型
      strQuery = g_CommonSelect("   类型   |    类型名称   |   会费  |  押金  |  最大借书数  |  最多可借天数  ", "select ChrType,ChrTypeName,DecTax,DecDeposit,IntMaxBorrow,IntMaxDay from MemberType ", "0,1,2,3,4,5", , , , -1, arrQuery)
      If TypeName(arrQuery) = "Variant()" Then
           TxtFields(5).Text = arrQuery(0, 0)
           TxtFields(6).Text = arrQuery(0, 4)
           TxtFields(7).Text = arrQuery(0, 5)
           TxtFields(11).Text = arrQuery(0, 2)
           TxtFields(12).Text = arrQuery(0, 3)
      End If
    Case 3 '有效期
      strQuery = g_CommonSelect("   有效期   |    月数  ", "select chrYXQ,intMonth from MemberAvailability", "0,1", , , , -1, arrQuery)
      If TypeName(arrQuery) = "Variant()" Then
           TxtFields(8).Text = arrQuery(0, 0)
           TxtFields(10).Text = Format(DateAdd("m", GetAvailability(TxtFields(8)), TxtFields(9)), "yyyy-mm-dd")
      End If
  End Select
  
  
  Exit Sub
err:
   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 MemberData where IntMemberNo=" & CInt(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 Form_Load()
  If blnAddNew Then
    TxtFields(10).Text = Date
  End If
  
  CmbFields(0).Text = "男"
  CmbFields(0).AddItem "男", 0
  CmbFields(0).AddItem "女", 1
 
'  TxtFields(0).Locked = True
''  TxtFields(0).BackColor = gColor_LockedText
'  TxtFields(6).Locked = True
'  TxtFields(6).BackColor = gColor_LockedText
'  TxtFields(7).Locked = True
'  TxtFields(7).BackColor = gColor_LockedText
''  TxtFields(9).Locked = True
''  TxtFields(9).BackColor = gColor_LockedText
''  TxtFields(10).Locked = True
''  TxtFields(10).BackColor = gColor_LockedText
'  TxtFields(11).Locked = True
'  TxtFields(11).BackColor = gColor_LockedText
''  TxtFields(12).Locked = True
''  TxtFields(12).BackColor = gColor_LockedText
'  TxtFields(13).Locked = True
'  TxtFields(13).BackColor = gColor_LockedText
  
End Sub

Private Sub TxtFields_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        SendKeys "{TAB}"
        Exit Sub
    End If
End Sub

Private Sub txtFields_KeyPress(Index As Integer, KeyAscii As Integer)
  Select Case Index
    Case 0 '卡号
      KeyAscii = ValiText(KeyAscii, vbExpInteger, "", TxtFields(Index).Text)
'    Case 4
'      KeyAscii = ValiText(KeyAscii, vbExpDefault, "男女", TxtFields(Index).Text)
    Case 9, 10  '日期
      KeyAscii = ValiText(KeyAscii, vbExpDate, "", TxtFields(Index).Text, 10)
    Case 6, 7 '数量
      KeyAscii = ValiText(KeyAscii, vbExpInteger, "", TxtFields(Index).Text)
    Case 11, 12 '金额
      KeyAscii = ValiText(KeyAscii, vbExpDecimal, "", TxtFields(Index).Text)
  End Select
End Sub