form4.frm

民间标会的会员管理用的软件。是为一个顾客定做的！

Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
    
Private Flag_Page As Long
Dim XG_Zbbh       As Long '修改帐本名称用


Private Sub Adodc1_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
  cmdDel.Enabled = Not (Adodc1.Recordset.EOF And Adodc1.Recordset.BOF = True)
End Sub


Private Sub Adodc1_RecordsetChangeComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)


    If Adodc1.Recordset.EOF = True Then
        cmdDel.Move DataGrid1.Left + 30, DataGrid1.RowHeight + DataGrid1.Top
    End If
    cmdDel.Enabled = Not Adodc1.Recordset.EOF

End Sub

Private Sub cmdBc_Click()
'Dim Lx As String

    'If (InStr(txtXm.Text, "'") > 0) Or (InStr(txtXm.Text, ";")) Then MsgBox "你输入的姓名含非法字符！", 16: Exit Sub

If (InStr(txtXm.Text, "'") > 0) Or (InStr(txtXm.Text, ";")) Then MsgBox "你输入的姓名含非法字符！", 16: Exit Sub
If (InStr(txtDh.Text, "'") > 0) Or (InStr(txtDh.Text, ";")) Then MsgBox "你输入的电话号码含非法字符！", 16: Exit Sub
If (InStr(txtSJ.Text, "'") > 0) Or (InStr(txtSJ.Text, ";")) Then MsgBox "你输入的手机号码含非法字符！", 16: Exit Sub

'Lx = Trim(txtDh)
'If Lx = "" Then Lx = Trim(txtSJ)
If Trim(txtXm) <> "" Then

    If Val(txtJhk) <> 0 Then
       ' If Len(Lx) >= 7 Or Val(txtSJ) > 13000000000# Then
       '     If Val(txtJe) > 0 Then
        '        If Val(txtHm) + Val(txtSm) > 0 Then
        '           If Val(txtHm) + Val(txtSm) <= 3 Then
                      AddNewClient
        '           Else
       '               If MsgBox("活名和实名数量超过3是否继续?", vbYesNo + vbQuestion + vbDefaultButton1, "买会") = vbYes Then AddNewClient
       '            End If
       '         Else
       '             If MsgBox("活名和实名数量均为0是否继续?", vbYesNo + vbQuestion + vbDefaultButton1, "买会") = vbYes Then AddNewClient
       '         End If
            Else
                MsgBox "加会款不能为0!"
            End If
       ' Else
       '     MsgBox "电话号码或手机号码无效!"
       ' End If
    'Else
    '    MsgBox "电话号码或手机号码必须有一个要填!"
    'End If
Else
    MsgBox "请输入姓名!"
End If
End Sub

Private Sub cmdDel_Click()
Dim Id   As Integer '编号
Dim Clnt As Long    '客户编号
Dim ZB   As Long    '帐本编号
Dim SQL  As String  'SQL语句


If Adodc1.Recordset.EOF = True Then Exit Sub


If MsgBox("你确定要删除(" & Adodc1.Recordset.Fields("客户名称").Value & (")的所有记录吗?"), vbOKCancel + vbDefaultButton2 + vbQuestion, "删除客户") = vbCancel Then Exit Sub


'删除客户信息
Clnt = Adodc1.Recordset.Fields("客户编号").Value
Id = Adodc1.Recordset.Fields("编号").Value
ZB = Adodc1.Recordset.Fields("所在帐本").Value

'删除主客户表记录
'SQL = "DELETE FROM 客户表 Where 客户编号=" & Clnt
'ExecSQL SQL
'删除买会表记录
SQL = "UPDATE 客户表 SET 编号=编号-1 WHERE 所在帐本=" & ZB & " AND 编号>" & Id
ExecSQL SQL

Adodc1.Recordset.Delete
SQL = "DELETE FROM 买会表 Where 客户编号=" & Clnt
ExecSQL SQL
'自动排列编号
DataGrid1.Refresh
If DataGrid1.Row = -1 Then
    cmdDel.Enabled = False
Else
    cmdDel.Enabled = True
End If
'cmdDel.Enabled = Not (Adodc1.Recordset.EOF And Adodc1.Recordset.BOF = True)


GetNewID ZB
End Sub

Private Sub cmdQc_Click()

txtXm = ""
txtDh = ""
txtSJ = ""
txtJe = ""
txtMh = ""
txtSm = ""
txtHm = ""
txtMHje = ""
txtJhk.Text = ""
chkHK.Value = 0


End Sub

Private Sub Command1_Click()
Dim Tmp As String

If Adodc1.Recordset.EOF = True Then Adodc1.Recordset.MoveFirst

Tmp = Trim(Text1)
If Tmp <> "" Then
    Adodc1.Recordset.Find "客户名称 Like %" & Tmp & "%"
End If
End Sub


Private Sub Command3_Click()
frmDel.Show 1

End Sub


Private Sub Command5_Click()
Dim C   As Integer
Dim SQL As String
Dim Zbbh As Integer
Dim ZB   As String

ZB = Trim(txtZb.Text)

C = List1.ListCount + 1

List1.AddItem ZB
SQL = "Insert Into 帐本表(帐本) Values("
SQL = SQL & "'" & ZB & "')"
ExecSQL SQL
SQL = "SELECT Max(帐本编号) FROM 帐本表"

Zbbh = CInt(GetValue(SQL))
List1.ItemData(C - 1) = Zbbh
List1.ListIndex = C - 1
txtZb.Text = ""

If frmNew.Enabled = False Then frmNew.Enabled = True


End Sub


'Private Sub cboGl_Click()
'AddToList "SELECT 客户编号,客户名称 From 客户表 Where 所在帐本=" & cboGl.ItemData(cboGl.ListIndex), lstKH


'End Sub



'Private Sub cmdOk_Click()

'Dim SQL As String



'End Sub

'Private Sub Command1_Click(Index As Integer)
'Dim I As Integer
'Dim Ct As Integer
'Ct = LstNew.ListCount - 1


'Select Case Index
'Case 0
'    For I = o To Ct
'        lstKH.AddItem LstNew.List(0), 0
'        LstNew.RemoveItem 0
'    Next
'Case 1
'        lstKH.AddItem LstNew.List(LstNew.ListIndex), 0
'        LstNew.RemoveItem LstNew.ListIndex
'End Select
'End Sub

'Private Sub Command2_Click()
'Unload Me

'End Sub

'Private Sub Form_KeyPress(KeyAscii As Integer)
'If KeyAscii = 13 Then
'    If Trim(txtKh.Text) <> "" Then
'        LstNew.AddItem Trim(txtKh), 0
'        txtKh = ""
'    End If
'End If

'End Sub

'Private Sub Form_Load()
'AddToList "SELECT 帐本编号,帐本 From 帐本表", cboGl

'cboGl.ListIndex = 0

'End Sub



Private Sub DataGrid1_ButtonClick(ByVal ColIndex As Integer)
'自动定位日期控件3

Dim T As Single
Dim L As Single

If ColIndex = -1 Then Exit Sub


L = DataGrid1.Columns.Item(ColIndex).Left + DataGrid1.Left
T = DataGrid1.RowTop(DataGrid1.Row)


If ColIndex = 6 Then
    MV.Move L, T
    MV.Visible = True
    MV.SetFocus
End If



End Sub

Private Sub DataGrid1_LostFocus()
    'If Adodc1.Recordset.State = 1 Then Adodc1.Recordset.Update

End Sub

Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)

If DataGrid1.Row >= 0 Then
    cmdDel.Move DataGrid1.Left + 30, DataGrid1.RowTop(DataGrid1.Row) + DataGrid1.RowHeight
Else
    cmdDel.Move DataGrid1.Left + 30, DataGrid1.RowHeight + DataGrid1.Top
End If

End Sub

Private Sub DataGrid1_SelChange(Cancel As Integer)
'a = 0

End Sub

Private Sub Form_Initialize()
  InitCommonControls
End Sub

Private Sub Form_Load()
MV.MinDate = "1993-01-01"
MV.MaxDate = "2030-01-01"
DTP.MinDate = "1993-01-01"
DTP.MaxDate = "2030-01-01"
MV.Value = VBA.Date
DTP.Value = VBA.Date

Flag_Page = GetSetting(App.EXEName, "ADD", "Page", 0)


AddToList "SELECT 帐本编号,帐本 From 帐本表 order by 帐本编号", List1
Adodc1.ConnectionString = mdCom.conStr
Adodc1.CommandType = adCmdText

If List1.ListCount > 0 Then
    'List1.ListIndex = Flag_Page
    List1.ListIndex = 0
Else
    frmNew.Enabled = False
End If

'Adodc1.RecordSource = "SELECT * from 客户表 Where 所在帐本=" & Flag_Page & " Order By 编号"

End Sub


Private Sub Form_Resize()

On Error Resume Next

Frame1.Height = Me.ScaleHeight - frmNew.Height
Frame1.Width = Me.ScaleWidth - Frame2.Width
DataGrid1.Height = Frame1.Height - DataGrid1.Top * 2
DataGrid1.Width = Frame1.Width - DataGrid1.Left * 2
Frame2.Left = Frame1.Left * 2 + Frame1.Width
Frame2.Height = Frame1.Height
frmNew.Top = Frame1.Top + Frame1.Height
frmNew.Width = Me.ScaleWidth
List1.Height = Frame2.Height - List1.Top - Picture2.Height
Picture2.Top = List1.Height + List1.Top

End Sub

Private Sub Form_Unload(Cancel As Integer)

    'SaveSetting App.EXEName, "ADD", "Page", List1.ListIndex

End Sub

Private Sub List1_Click()
'On Error Resume Next
Dim SQL As String

If List1.ListCount > 0 Then
    txtSc = List1.Text
    Flag_Page = List1.ItemData(List1.ListIndex) '当前所在页（帐本）
    txtSc.Tag = List1.ListIndex
    Command3.Enabled = True
    SQL = "SELECT * from 客户表 Where 所在帐本=" & _
    Flag_Page & " Order by 编号"
    '
    
    If Not (Adodc1.Recordset Is Nothing) Then
            If Adodc1.Recordset.State <> 0 Then
                If Not (Adodc1.Recordset.EOF And Adodc1.Recordset.BOF) Then Adodc1.Recordset.Update
                Adodc1.Recordset.Close
                Adodc1.Recordset.Open SQL
            End If
    Else
        Adodc1.RecordSource = SQL
    End If
    
    '
    Set DataGrid1.DataSource = Adodc1
        DataGrid1.Refresh
        DataGrid1.Columns(6).Button = True
        DataGrid1.Columns(6).Locked = True
        DataGrid1.Columns(2).Visible = False
        DataGrid1.Columns(1).Locked = True
        DataGrid1.Columns(0).Visible = False
        GetNewID Flag_Page
        


End If
End Sub

Private Sub List1_DblClick()
If List1.ListCount > 0 Then
    If List1.ListIndex >= 0 Then
        txtXg.Text = List1.Text
        txtXg.Visible = True
        XG_Zbbh = List1.ListIndex
        txtXg.Move List1.Left, List1.Top + List1.ListIndex * 180
        txtXg.SetFocus
    End If
End If
End Sub

Private Sub MV_DateClick(ByVal DateClicked As Date)

DataGrid1.Text = Format(MV.Value, "YYYY年MM月DD日")
MV.Visible = False


End Sub

Private Sub MV_LostFocus()

MV.Visible = False

End Sub

Private Sub Picture1_GotFocus()
cmdBc.Default = True
End Sub

Private Sub Text1_Change()

Dim Tmp As String

Tmp = Trim(Text1)
Command1.Enabled = Not (Tmp = "")

End Sub

Private Sub AddNewClient()

Dim SQL   As String
Dim NewID As Long

    '添加客户基本信息
    
    Adodc1.Recordset.AddNew
    Adodc1.Recordset.Fields("编号") = txtBh
    Adodc1.Recordset.Fields("所在帐本") = Flag_Page
    Adodc1.Recordset.Fields("客户名称") = Trim(txtXm)
    Adodc1.Recordset.Fields("电话号码") = Trim(txtDh)
    Adodc1.Recordset.Fields("手机号码") = Trim(txtSJ)
    Adodc1.Recordset.Fields("入会时间") = DTP.Value
    Adodc1.Recordset.Fields("备注") = txtBz
    Adodc1.Recordset.Update
    
    NewID = CLng(GetValue("SELECT Max(客户编号) From 客户表"))
    
    
    ' 汇款表
    
    If chkHK.Value = 1 Then
        SQL = "insert into 汇款表(客户编号) VALUES(" & NewID & ")"
        ExecSQL SQL
    End If
    '添加顾客买会信息
    SQL = "Insert Into 买会表"
    SQL = SQL & "(客户编号,活名,会款,实名,买会,买会金额,应缴金额,日期)"
    SQL = SQL & " Values("
    SQL = SQL & NewID
    SQL = SQL & "," & Val(txtHm)
    SQL = SQL & "," & Val(txtJe)
    SQL = SQL & "," & Val(txtSm)
    SQL = SQL & "," & Val(txtMh)
    SQL = SQL & "," & Val(txtMHje)
    SQL = SQL & "," & Val(txtJhk)
    SQL = SQL & ",#" & DTP.Value & "#"
    SQL = SQL & ")"
    ExecSQL SQL
    '刷新列表
    cmdQc_Click
    DataGrid1.Refresh
    SQL = "SELECT MAX(编号) FROM 客户表 Where 所在帐本=" & Flag_Page
    Bh = CInt(GetValue(SQL)) + 1
    txtBh.Text = Bh
End Sub




Private Sub txtXg_LostFocus()

Dim NewName As String
Dim SQL     As String


NewName = Trim(txtXg)
If NewName <> "" Then
    If NewName <> List1.List(XG_Zbbh) Then
        SQL = "UPDATE 帐本表 SET 帐本='" & NewName & "' Where 帐本编号=" & List1.ItemData(XG_Zbbh)
         List1.List(XG_Zbbh) = NewName
         ExecSQL SQL
    End If
End If
txtXg.Visible = False

End Sub

Private Sub txtXm_GotFocus()
cmdBc.Default = True
End Sub

Private Sub txtZb_Change()
If Trim(txtZb.Text) <> "" Then
    Command5.Enabled = True
Else
    Command5.Enabled = False
End If
End Sub

Private Sub txtZb_GotFocus()
    Command5.Default = True
End Sub

Private Sub txtZb_LostFocus()
    Command5.Default = False
End Sub
 
 
 '自动获取新编号
Private Sub GetNewID(ByVal SZZB As Long)
Dim SQL As String
Dim Tmp As Variant
Dim Bh  As String

        SQL = "SELECT MAX(编号) FROM 客户表 Where 所在帐本=" & SZZB
        Tmp = GetValue(SQL)
        If IsNull(Tmp) = True Then
            Bh = 1
        Else
            Bh = CInt(Tmp) + 1
        End If
        txtBh.Text = Bh
        
    If Val(txtBh) >= 131 Then
      cmdBc.Enabled = False
      txtBh = "已满"
    Else
      cmdBc.Enabled = True
    End If
    
End Sub