⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form3.frm

📁 民间标会的会员管理用的软件。是为一个顾客定做的!
💻 FRM
📖 第 1 页 / 共 2 页
字号:
         End
         Begin VB.CommandButton Command1 
            Caption         =   "注解"
            Height          =   375
            Left            =   9300
            TabIndex        =   10
            Top             =   0
            Width           =   1095
         End
      End
   End
End
Attribute VB_Name = "frmDj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private m_Cust      As Long
Public beginYear As Integer
Private SZZB     As Integer


Private Sub cboKH_Click()
cmdQh.Enabled = True
End Sub

Private Sub cmdPGDW_Click()

cmdPgUP.Enabled = True


If List1.ListIndex < List1.ListCount - 1 Then
    List1.ListIndex = List1.ListIndex + 1
    If List1.ListIndex = List1.ListCount - 1 Then cmdPGDW.Enabled = False
    Me.Cust = List1.ItemData(List1.ListIndex)
    Reload
End If

End Sub

Private Sub cmdPgUP_Click()

cmdPGDW.Enabled = True

If List1.ListIndex > 0 Then
    List1.ListIndex = List1.ListIndex - 1
    If List1.ListIndex = 0 Then cmdPgUP.Enabled = False
    Me.Cust = List1.ItemData(List1.ListIndex)
    Reload
End If

End Sub

'Private Sub cmdQh_Click()
'txtCust.Text = cboKH.Text
'Cust = cboKH.ItemData(cboKH.ListIndex)

'reload

'End Sub

Private Sub cmdSave_Click()

Dim SQL As String
cmdSave.Enabled = False
Table1(0).Save
Table1(1).Save
Table1(2).Save
Table1(3).Save
Table1(4).Save
Table1(5).Save

End Sub

Private Sub Command1_Click()
FrmDj2.Client = Cust

FrmDj2.Show
End Sub

Private Sub Command2_Click()
Dim I As Integer
For I = 0 To 5
    If Table1(I).Changed = True Then
        Table1(I).ReFlash
    End If
Next
cmdSave.Enabled = False
End Sub

Private Sub Command3_Click()
Unload Me
End Sub



Private Sub Command5_Click()
UPDateInfo

MsgBox "OK!"
End Sub

Private Sub Form_Initialize()
  InitCommonControls
End Sub

Private Sub Form_Load()

Dim SQL As String
Dim I As Integer

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

'Reload
End Sub

Private Sub Reload()
Dim Dt As Date
Dim Rs As New ADODB.Recordset

Set Rs = GetRecord("SELECT 活名,实名,买会,买会金额,会款 From 买会表 Where 客户编号=" & Cust)
If (Not Rs.EOF) Or (Not Rs.BOF) Then
    txtSm.Text = Rs!实名
    txtMh = Rs!买会
    txtMHje = Rs!买会金额
    txtHm = Rs!活名
    txtHk = Rs!会款
Else
    txtSm.Text = 0
    txtMh = 0
    txtMHje = 0
    txtHm = 0
    txtHk = 0
End If

txtCust = GetValue("SELECT 客户名称 FROM 客户表 Where 客户编号=" & Cust)
lblBh.Caption = GetValue("SELECT 编号 FROM 客户表 Where 客户编号=" & Cust)
Dt = CDate(GetValue("SELECT 入会时间 From 客户表 Where 客户编号=" & 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
    '定位
    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)

    
    '==========================备注信息
    Bz = GetValue("SELECT 备注 FROM 客户表 Where 客户编号=" & Cust)
    If Not IsNull(Bz) Then txtBz = Bz
End Sub


Private Sub Form_Resize()

On Error Resume Next

'Dim T As Long
'Dim C As Long
'Dim B As Long
'Dim A As Long

'A = Frame2.Height + Frame3.Height + Picture1.Height


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


Dim HscMax As Long

'Frame3.Width = Me.ScaleWidth


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 = Picture1.ScaleWidth
Frame2.Width = Picture1.ScaleWidth
Frame3.Left = Picture1.Left
Frame2.Left = Picture1.Left

End Sub

Private Sub Form_Unload(Cancel As Integer)
If cmdSave.Enabled = True Then
   If MsgBox("是否保存对当前页的更改?", vbYesNo + vbQuestion + vbDefaultButton1, "未保存的数据") = vbYes Then
        cmdSave_Click
   End If
End If
End Sub

Private Sub HSC_Change()
Picture1.Left = -HSC.Value

End Sub

Private Sub Picture1_Resize()

On Error Resume Next

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

Frame3.Width = Picture1.ScaleWidth
Frame2.Width = Picture1.ScaleWidth
Frame3.Left = Picture1.Left
Frame2.Left = Picture1.Left
End Sub

Private Sub Table1_Change(index 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 & ")"
    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
Reload
Me.SetFocus
End Property


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -