frmcardmanage.frm

来自「通用书店管理系统」· FRM 代码 · 共 1,276 行 · 第 1/4 页

      End If
        
      Set rstmp = New ADODB.Recordset
      rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
      Set tdbMemberData.DataSource = rstmp
      
      
      SetToolBar ("1000X00X001X111")
      Call clearAll
    Case "解挂"
      sqlstring = "select max(intNo) as intMaxNo from MemberCard where IntMemCardNo=" & CInt(txtFields(2).Text)
      rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
      
      If rstmp.EOF Then
         intMaxNo = 1
      Else
         intMaxNo = IIf(IsNull(rstmp.Fields(0)), 0, rstmp.Fields(0)) + 1
      End If
      
      sqlstring = "insert into MemberCard (IntNo,IntMemCardNo,ChrName,chrLevel,DatInitiate,DatDQDate,ChrMemberType," & _
                  "DatDate,ChrType) values (" & intMaxNo & "," & CInt(txtFields(2).Text) & _
                  ",'" & txtFields(3).Text & "','" & txtFields(4).Text & "',#" & Format((txtFields(5).Text), "yyyy-mm-dd") & _
                  "#,#" & Format((txtFields(6).Text), "yyyy-mm-dd") & "#,'" & txtFields(7).Text & "',#" & Format(Date, "yyyy-mm-dd") & "#,'解挂')"
      intMonth = GetAvailability(cmbFields.Text)
      cN.BeginTrans
      cN.Execute (sqlstring)
      '原会员卡恢复使用
      sqlstring = "Update MemberData set ChrState='正常'" & _
                "  where intMemberNo=" & CInt(txtFields(2).Text)
      cN.Execute sqlstring
      cN.CommitTrans
      
      
      If optFields(0).Value Then
           sqlstring = "select * from MemberData where intMemberNo=" & Trim(txtFields(0).Text)
                       
      Else
           sqlstring = "select * from MemberData where chrClientNo='" & Trim(txtFields(1).Text) & _
                       "'  order by intMemberNo"
      End If
        
      Set rstmp = New ADODB.Recordset
      rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
      Set tdbMemberData.DataSource = rstmp
      
      
      SetToolBar ("1000X00X001X111")
      Call clearAll
    Case "作废"
      sqlstring = "select max(intNo) as intMaxNo from MemberCard where IntMemCardNo=" & CInt(txtFields(2).Text)
      rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
      
      If rstmp.EOF Then
         intMaxNo = 1
      Else
         intMaxNo = IIf(IsNull(rstmp.Fields(0)), 0, rstmp.Fields(0)) + 1
      End If
      
      sqlstring = "insert into MemberCard (IntNo,IntMemCardNo,ChrName,chrLevel,DatInitiate,DatDQDate,ChrMemberType," & _
                  "DatDate,ChrType) values (" & intMaxNo & "," & CInt(txtFields(2).Text) & _
                  ",'" & txtFields(3).Text & "','" & txtFields(4).Text & "',#" & Format((txtFields(5).Text), "yyyy-mm-dd") & _
                  "#,#" & Format((txtFields(6).Text), "yyyy-mm-dd") & "#,'" & txtFields(7).Text & "',#" & Format(Date, "yyyy-mm-dd") & "#,'作废')"
      intMonth = GetAvailability(cmbFields.Text)
      cN.BeginTrans
      cN.Execute (sqlstring)
      '作废会员卡
      sqlstring = "Update MemberData set ChrState='作废'" & _
                "  where intMemberNo=" & CInt(txtFields(2).Text)
      cN.Execute sqlstring
      cN.CommitTrans
      
      
      If optFields(0).Value Then
           sqlstring = "select * from MemberData where intMemberNo=" & Trim(txtFields(0).Text)
                       
      Else
           sqlstring = "select * from MemberData where chrClientNo='" & Trim(txtFields(1).Text) & _
                       "'  order by intMemberNo"
      End If
        
      Set rstmp = New ADODB.Recordset
      rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
      Set tdbMemberData.DataSource = rstmp
      
      
      Call cmdOK_Click
      SetToolBar ("1000X00X001X111")
      Call clearAll
  End Select

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

Public Sub cmdUndo_Click()
   If MsgBox("当前修改的内容会丢失。确认要取消吗？", vbOKCancel, "询问") <> vbOK Then Exit Sub
   clearAll
   SetToolBar ("1000X00X001X111")
End Sub

Private Sub cmdOK_Click()
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  On Error GoTo err
  
  If txtFields(0).Text <> "" Or txtFields(1).Text <> "" Then
     
  Select Case strWindowCaption
    Case "续卡"
        If optFields(0).Value Then
           sqlstring = "select * from MemberData where intMemberNo=" & Trim(txtFields(0).Text) & _
                       " and ChrState in ('正常','挂失')"
        Else
           sqlstring = "select * from MemberData where chrClientNo='" & Trim(txtFields(1).Text) & _
                       "' and ChrState in ('正常','挂失') order by intMemberNo"
        End If
        
        rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        If rstmp.EOF Then
          MsgBox "没有要续卡的会员卡信息或该卡已作废！", vbInformation
        End If
    Case "换卡"
        If optFields(0).Value Then
           sqlstring = "select * from MemberData where intMemberNo=" & Trim(txtFields(0).Text) & _
                       " and ChrState in ('正常','挂失')"
        Else
           sqlstring = "select * from MemberData where chrClientNo='" & Trim(txtFields(1).Text) & _
                       "' and ChrState in ('正常','挂失') order by intMemberNo"
        End If
        
        rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        If rstmp.EOF Then
          MsgBox "没有要换卡的会员卡信息或该卡已作废！", vbInformation
        End If
    Case "挂失"
        If optFields(0).Value Then
           sqlstring = "select * from MemberData where intMemberNo=" & Trim(txtFields(0).Text) & _
                       " and ChrState in ('正常')"
        Else
           sqlstring = "select * from MemberData where chrClientNo='" & Trim(txtFields(1).Text) & _
                       "' and ChrState in ('正常') order by intMemberNo"
        End If
        
        rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        If rstmp.EOF Then
          MsgBox "没有要挂失的会员卡信息或该卡已作废、挂失！", vbInformation
        End If
    Case "解挂"
        If optFields(0).Value Then
           sqlstring = "select * from MemberData where intMemberNo=" & Trim(txtFields(0).Text) & _
                       " and ChrState in ('挂失')"
        Else
           sqlstring = "select * from MemberData where chrClientNo='" & Trim(txtFields(1).Text) & _
                       "' and ChrState in ('挂失') order by intMemberNo"
        End If
        
        rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        If rstmp.EOF Then
          MsgBox "没有要解挂的会员卡信息或该卡已作废或还没挂失！", vbInformation
        End If
    Case "作废"
        If optFields(0).Value Then
           sqlstring = "select * from MemberData where intMemberNo=" & Trim(txtFields(0).Text) & _
                       " and chrState not in ('作废')"
        Else
           sqlstring = "select * from MemberData where chrClientNo='" & Trim(txtFields(1).Text) & _
           "' and chrState not in ('作废') order by intMemberNo"
        End If
        rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        If rstmp.EOF Then
          MsgBox "没有要作废的会员卡信息或该卡已作废！", vbInformation
        End If
        
  End Select
  End If
  Set tdbMemberData.DataSource = rstmp
  
  Exit Sub
err:
  MsgBox "查询记录出错：" & err.Description, vbInformation
End Sub

Private Sub cmdSearch_Click(Index As Integer)
  Dim strQuery As String
  
  Select Case Index
    Case 0
      strQuery = g_CommonSelect("   会员卡号   |    客户号   |   姓名  |  级别  |  类型  |  状态  ", "select IntMemberNo,ChrClientNo,ChrName,ChrLevel," & _
                            "ChrType,ChrState From MemberData order by IntMemberNo")
      txtFields(0).Text = strQuery
    Case 1
      strQuery = g_CommonSelect("   客户号   |    客户名称   |   联系人  |  电话  |  地址  ", "select ChrClientNo,ChrClientName,ChrLinkman,ChrPhoneCode,ChrAddress " & _
                            " From ClientData where intFlag=1 order by ChrClientNo")
      txtFields(1).Text = strQuery
  End Select
End Sub

Private Sub Form_Activate()
   SetToolBar ("1000X00X001X111")

End Sub

Private Sub clearAll()          '清除所有可填数据的位置
    Dim i As Integer

    
    For i = 0 To txtFields.UBound
        Select Case i
          Case 0, 1
              txtFields(i).Text = ""
          Case Else
              txtFields(i).Text = ""
              txtFields(i).Enabled = False
        End Select
    Next i
    
    X.ReDim 0, -1, 0, 16
    tdbMemberData.ReBind
    
End Sub



Private Sub ShowRecord()
  Dim rstmp As New ADODB.Recordset
    
  On Error GoTo err
    
  Set rstmp = tdbMemberData.DataSource
    
  txtFields(2).Text = rstmp.Fields("intMemberNo").Value
  txtFields(3).Text = rstmp.Fields("chrName").Value
  txtFields(4).Text = rstmp.Fields("chrLevel").Value
  txtFields(5).Text = Format((rstmp.Fields("datLoginDate").Value), "yyyy-mm-dd")
  txtFields(6).Text = Format((rstmp.Fields("datDQDate").Value), "yyyy-mm-dd")
  txtFields(7).Text = IIf(IsNull(rstmp.Fields("chrType").Value), "", rstmp.Fields("chrType").Value)
  Exit Sub
err:
  MsgBox "错误：" & err.Description, , "警告"
End Sub

Private Sub Form_Load()
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  
  On Error GoTo err
  cmbFields.Clear
  sqlstring = "select * from MemberAvailability order by intMonth"
  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  Do While Not rstmp.EOF
     cmbFields.AddItem Trim(rstmp.Fields("chrYXQ").Value)
     rstmp.MoveNext
  Loop
  
  Select Case strWindowCaption
    Case "续卡"
      Label1(6).Caption = "续卡费"
      Label1(7).Caption = "续卡周期"
      txtFields(8).Enabled = True
      Label1(8).Visible = False
      txtFields(9).Visible = False
      Me.Caption = "会员卡管理——续卡"
    Case "换卡"
      Label1(6).Caption = "换卡费"
      Label1(7).Caption = "有效期"
      txtFields(8).Enabled = True
      txtFields(9).Enabled = True
      Label1(6).Caption = "换卡费"
      Label1(7).Caption = "周期"
      Label1(8).Visible = True
      txtFields(9).Visible = True
      Me.Caption = "会员卡管理——换卡"
    Case "挂失"
      Label1(6).Visible = False
      txtFields(8).Visible = False
      Label1(7).Visible = False
      cmbFields.Visible = False
      Label1(8).Visible = False
      txtFields(9).Visible = False
      Me.Caption = "会员卡管理——挂失"
    Case "解挂"
      Label1(6).Visible = False
      txtFields(8).Visible = False
      Label1(7).Visible = False
      cmbFields.Visible = False
      Label1(8).Visible = False
      txtFields(9).Visible = False
      Me.Caption = "会员卡管理——解挂"
    Case "作废"
      Label1(6).Visible = False
      txtFields(8).Visible = False
      Label1(7).Visible = False
      cmbFields.Visible = False
      Label1(8).Visible = False
      txtFields(9).Visible = False
      Me.Caption = "会员卡管理——作废"
  End Select
  
  Exit Sub
err:
  MsgBox "初始化出错：" & err.Description, vbInformation
End Sub


Private Sub Form_Unload(Cancel As Integer)
  SetToolBar ("0000X00X001X111")
End Sub

Private Sub txtFields_KeyPress(Index As Integer, KeyAscii As Integer)
  Select Case Index
    Case 8
      KeyAscii = ValiText(KeyAscii, vbExpDecimal, "", txtFields(9).Text)
    Case 9
      KeyAscii = ValiText(KeyAscii, vbExpInteger, "", txtFields(9).Text, 6)
  End Select
End Sub