form3.frm

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

Dim Map   As Integer
Dim iAuto As Integer

iAuto = GetSetting(App.EXEName, "Settings", "AUTO", 0)
Map = GetSetting(App.EXEName, "Settings", "Mapped", 0)

Check2.Value = iAuto
Check3.Value = Map

Check2_Click
Check3_Click

    For i = 0 To 5
        Table1(i).DataFile = DataFile
    Next

    'Reload
End Sub

Private Sub Reload()


Dim R As Integer

If cmdSave.Enabled = True Then
    R = MsgBox("是否保存对当前页的更改?", vbYesNoCancel + vbQuestion, "未保存的数据")
   If R = vbYes Then
        cmdSave_Click
   ElseIf R = vbCancel Then
        Exit Sub
   End If
End If


Me.MousePointer = 11

Dim SQL  As String
Dim Dt   As Date
Dim Sjyj
Dim Rs   As New ADODB.Recordset


Dim Tmp As Variant


Tmp = GetValue("SELECT COUNT(*) FROM 汇款表 WHERE 客户编号=" & Me.Cust)

If CInt(Tmp) > 0 Then
    Check1.Value = 1
Else
    Check1.Value = 0
End If

txtCust = GetValue("SELECT 客户名称 FROM 客户表 Where 客户编号=" & Cust)
lblBh.Caption = GetValue("SELECT 编号 FROM 客户表 Where 客户编号=" & Cust)
Dt = CDate(GetValue("SELECT 入会时间 From 客户表 Where 客户编号=" & Cust))


'================取得每月实际应缴金额
'txtMoney.Text = GetMoney(Me.Cust)
'======================================

If GetMonthNo(Dt) = 0 Then
    Picture1.Width = (Table1(0).Width + 60) * 5 - 60
    Table1(5).Visible = False
Else
    Picture1.Width = (Table1(0).Width + 60) * 6 - 60
    Table1(5).Visible = True
End If

beginYear = Year(Dt)

    Dim i As Integer

    For i = 0 To 5
        Table1(i).Client = Cust
        Table1(i).curYear = beginYear + i
    Next
    '==================获取同一本的客户列表
    SZZB = GetValue("SELECT 所在帐本 FROM 客户表 Where 客户编号=" & Cust)
    SQL = "SELECT 客户编号,客户名称 From 客户表 Where 所在帐本=" & SZZB & " Order by 编号"
    AddToList SQL, List1
    lblZB.Caption = GetValue("SELECT 帐本 FROM 帐本表 WHERE 帐本编号=" & SZZB)
    
    
    '定位
    For i = 0 To List1.ListCount - 1
        If List1.ItemData(i) = Cust Then
            List1.ListIndex = i
            Exit For
        End If
    Next
    
    cmdPgUP.Enabled = IIf(List1.ListIndex > 0, True, False)
    cmdPGDW.Enabled = IIf(List1.ListIndex < List1.ListCount - 1, True, False)
    
    CountInfo
    
    HidePanel
    HidePanel2
    cmdSave.Enabled = False
    
    Me.MousePointer = 0
    
    
End Sub


Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
MoveObj Me.hwnd
End Sub

'Private Sub Form_Resize()

'On Error Resume Next

'Dim T As Long


'T = Me.ScaleHeight - Frame2.Height - Frame3.Height - Picture1.Height
'Frame3.Top = 0 ' T / 2
'Picture1.Top = Frame3.Top + Frame3.Height

'HSC.Top = Picture1.Top + Picture1.Height
'Frame2.Top = HSC.Top + HSC.Height


'Dim HscMax As Long




'HscMax = (Picture1.Width - Me.ScaleWidth)

'If HscMax > 0 Then
'    HSC.Max = HscMax
'    HSC.Width = Me.ScaleWidth
'    HSC.SmallChange = HSC.Max / 100
'    HSC.LargeChange = HSC.Max / 10
'    Picture1.Left = 0
'    HSC.Visible = True
'Else
'    Picture1.Left = Abs(HscMax / 2)
'    HSC.Visible = False
'End If

'Frame3.Width = Me.ScaleWidth
'Frame2.Width = Me.ScaleWidth
'Frame3.Left = 0
'Frame2.Left = 0

'End Sub

Private Sub Form_Unload(Cancel As Integer)

Dim R As Integer



If cmdSave.Enabled = True Then

    R = MsgBox("是否保存对当前页的更改?", vbYesNoCancel + vbQuestion, "未保存的数据")
   If R = vbYes Then
        cmdSave_Click
   ElseIf R = vbCancel Then
        Cancel = 1
   End If
End If

End Sub


Private Sub Image1_Click()
HidePanel
End Sub

Private Sub Image2_Click()
 Timer2.Enabled = False
 HidePanel2
 
End Sub

Private Sub LV1_DblClick()
If LV1.ListItems.Count > 0 Then
    If LV1.SelectedItem.Index > 0 Then
        Dim Id As String
        Id = Mid(LV1.SelectedItem.Key, 4)
        Me.Cust = CLng(Id)
    End If
End If
End Sub

Private Sub LV2_ItemClick(ByVal Item As MSComctlLib.ListItem)
txtHm.Text = Item.Text
txtSm.Text = Item.SubItems(1)
txtMh.Text = Item.SubItems(2)
txtHk.Text = Item.SubItems(3)
txtMHje.Text = Item.SubItems(4)
txtMoney.Text = Item.SubItems(5)

If Len(Item.SubItems(6)) > 6 Then
    DTP1.Value = CDate(Item.SubItems(6))
End If

cmdMhDel.Enabled = True
End Sub

Private Sub picPanel2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
MoveObj picPanel2.hwnd
End Sub

Private Sub Picture1_Resize()

On Error Resume Next

'Dim HscMax As Long

'HscMax = (Picture1.ScaleWidth - Me.Width)

'If HscMax > 0 Then
'    HSC.Max = HscMax
'    HSC.Width = Me.Width
'    HSC.SmallChange = HSC.Max / 100
''    HSC.LargeChange = HSC.Max / 10
'    Picture1.Left = 0
'    HSC.Visible = True
'Else
'    Picture1.Left = Abs(HscMax / 2)
'    HSC.Visible = False
''End If


End Sub

Private Sub Table1_Change(Index As Integer, iMonth As Integer)
cmdSave.Enabled = True
End Sub


Private Sub UPDateInfo()

    Dim SQL As String
   ' Dim T  As Integer
   ' SQL = ("SELECT count(*) FROM 买会表 Where 客户编号=" & Cust)
    'T = CInt(GetValue(SQL))
    
    'If T >= 1 Then
    '    SQL = "Update  买会表 Set "
    '    SQL = SQL & "活名=" & Val(txtHm)
    '    SQL = SQL & ",会款=" & Val(txtHk)
    '    SQL = SQL & ",实名=" & Val(txtSm)
    '    SQL = SQL & ",买会=" & Val(txtMh)
    '    SQL = SQL & ",买会金额=" & Val(txtMHje)
    '    SQL = SQL & " Where 客户编号=" & Cust
    'Else
        SQL = "Insert Into 买会表(客户编号,活名,会款,实名,买会,买会金额,应缴金额,日期) Values("
        SQL = SQL & Cust
        SQL = SQL & "," & Val(txtHm)
        SQL = SQL & "," & Val(txtHk)
        SQL = SQL & "," & Val(txtSm)
        SQL = SQL & "," & Val(txtMh)
        SQL = SQL & "," & Val(txtMHje)
        SQL = SQL & "," & Val(txtMoney)
        SQL = SQL & ",#" & DTP1.Value & "#"
        SQL = SQL & ")"
   ' End If
    ExecSQL SQL
    
End Sub



Public Property Get Cust() As Long
Cust = m_Cust
End Property

Public Property Let Cust(ByVal vNewValue As Long)
m_Cust = vNewValue
Me.SetFocus
Reload

End Property


Private Sub Timer1_Timer()


If picPanel.Top < 0 Then
   picPanel.Top = picPanel.Top + 150
End If
End Sub

Private Sub Timer2_Timer()
If picPanel2.Top < 0 Then
    picPanel2.Top = picPanel2.Top + 120
End If
End Sub

Private Sub GetTMList()
Dim TMBH As Long
Dim SQL As String
Dim Rs  As Recordset
Dim Tmp As Variant

SQL = "SELECT 同名编号 FROM 成员表 Where 客户编号=" & m_Cust
Tmp = GetValue(SQL)

If Tmp = "" Then Exit Sub

TMBH = CLng(Tmp)

If TMBH <= 0 Then '没有查到同名
  'Label1.Caption = "暂时没有和" & txtName.Text & "同名的客户！"
  Exit Sub
Else
    SQL = "SELECT 客户编号,帐本,编号,客户名称,入会时间 FROM 同名明细表 Where 同名编号=" & TMBH
    Set Rs = GetRecord(SQL)
    RSToListView2 Rs, LV1
End If


End Sub

Private Sub HidePanel()

picPanel.Top = -picPanel.Height - 150
Timer1.Enabled = False
LV1.ListItems.Clear
LV1.ColumnHeaders.Clear
 DeleteTm
End Sub



Private Sub HidePanel2()
    picPanel2.Top = -picPanel2.Height - 150
    Timer2.Enabled = False
        txtHm.Text = "0"
        txtSm.Text = "0"
        txtMh.Text = "0"
        txtHk.Text = "0"
        txtMHje.Text = "0"
        txtMoney.Text = "0"
        'DTP1.Value = Date
    LV2.ColumnHeaders.Clear
    LV2.ListItems.Clear
    cmdMhDel.Enabled = False
End Sub

Private Sub ShowPanel2()
    Dim RhSJ As Date '入会时间
    Dim Tmp  As String
    Dim SQL  As String
    Dim Rs   As New ADODB.Recordset
    SQL = "SELECT 活名,实名,买会,会款,买会金额,应缴金额,日期 From 买会表 Where 客户编号=" & Cust
    SQL = SQL & " ORDER BY 日期 DESC"
    Set Rs = GetRecord(SQL)
    
    RSToListView Rs, LV2
    LV2.ColumnHeaders(1).Width = 600
    LV2.ColumnHeaders(2).Width = 600
    LV2.ColumnHeaders(3).Width = 600
    LV2.ColumnHeaders(4).Width = 1200
    LV2.ColumnHeaders(5).Width = 1200
    LV2.ColumnHeaders(6).Width = 1200
    
    RhSJ = CDate(GetValue("SELECT 入会时间 FROM 客户表 WHERE 客户编号=" & Me.Cust))
    
    Tmp = Year(RhSJ) & "-"
    Tmp = Tmp & Month(RhSJ) & "-"
    Tmp = Tmp & "1"
    
    DTP1.MinDate = CDate(Tmp)

    Tmp = (Year(RhSJ) + 5) & "-"
    Tmp = Tmp & Month(RhSJ) & "-"
    Tmp = Tmp & GetLastDay(Year(RhSJ) + 5, Month(RhSJ))
    DTP1.MaxDate = CDate(Tmp)
End Sub

Private Sub reckonMoney() '自动计算应缴金额

Dim Tmp As Long
Tmp = Val(txtHm) * Val(txtHk)
Tmp = Tmp + Val(txtSm) * 1000
Tmp = Tmp - Val(txtMh) * 1000
txtMoney.Text = Tmp

End Sub

Private Sub txtHk_Change()
reckonMoney
End Sub

Private Sub txtHm_Change()
reckonMoney
End Sub

Private Sub txtMh_Change()
reckonMoney
End Sub

Private Sub txtSm_Change()
reckonMoney
End Sub

Private Sub CountInfo() '计算总计加会款

Dim Tmp As Variant

Dim QM  As String
Dim WQM As String
Dim SQL As String


'Dim Rs As Recordset

SQL = "SELECT SUM(金额) FROM 明细表 WHERE 客户=" & Me.Cust
SQL = SQL & " AND 审核=True"

Tmp = GetValue(SQL)

If Not IsNull(Tmp) Then
    QM = CStr(Tmp)
Else
    Label14.Caption = ""
    Label15.Caption = ""
    lblQM.Caption = ""
    lblWQM.Caption = ""
End If


SQL = "SELECT SUM(金额) FROM 明细表 WHERE 客户=" & Me.Cust
SQL = SQL & " AND 审核=False"

Tmp = GetValue(SQL)

If Not IsNull(Tmp) Then
    WQM = CStr(Tmp)
Else
    Label14.Caption = ""
    Label15.Caption = ""
    lblWQM.Caption = ""
End If

 lblQM.Caption = QM
lblWQM.Caption = WQM


SQL = "SELECT COUNT(*) FROM 明细表 WHERE 客户=" & Me.Cust
SQL = SQL & " AND 审核=True"

Tmp = GetValue(SQL)

If Not IsNull(Tmp) Then QM = CStr(Tmp)



SQL = "SELECT COUNT(*) FROM 明细表 WHERE 客户=" & Me.Cust
SQL = SQL & " AND 审核=False AND 金额>0"

Tmp = GetValue(SQL)

If Not IsNull(Tmp) Then WQM = CStr(Tmp)

Label14.Caption = "(" & QM & ")"
Label15.Caption = "(" & WQM & ")"


End Sub