frmcladd.frm

此为水费收费管理系统

      Left            =   270
      TabIndex        =   15
      Top             =   2340
      Width           =   945
   End
End
Attribute VB_Name = "FrmClAdd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim i As Integer

Dim Rec As New ADODB.Recordset
Dim Sql As String

Private Sub Command3_Click()
    FrmJlDw.Show vbModal
    '初始化计量单位下拉框
    '======================================================================================================================================================
        Combo1.Clear
        If UBound(MdlMain.Jldw, 1) > 0 Then
            For i = 0 To UBound(MdlMain.Jldw, 1) - 1
                Combo1.AddItem MdlMain.Jldw(i).Mch
            Next i
        End If
    '======================================================================================================================================================
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyEscape Then Unload Me
End Sub

Private Sub Form_Load()
    Me.KeyPreview = True
    MdlMain.ReturnSql = ""
    For i = 0 To 8
        Text1(i).Text = ""
    Next i
    DTPicker1.Value = MdlMain.LoginTime.LgTime
    
    '初始化计量单位下拉框
    '======================================================================================================================================================
        If UBound(MdlMain.Jldw, 1) > 0 Then
            For i = 0 To UBound(MdlMain.Jldw, 1) - 1
                Combo1.AddItem MdlMain.Jldw(i).Mch
            Next i
        End If
    '======================================================================================================================================================
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Rec.Close
    Set Rec = Nothing
End Sub

Private Sub Text1_GotFocus(Index As Integer)
    If Index = 0 Then
        Text1(Index).SelStart = Len(Text1(Index).Text)
        Exit Sub
    End If
    Text1(Index).SelStart = 0
    Text1(Index).SelLength = Len(Text1(Index).Text)
End Sub

Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyUp
            Select Case Index
                Case 0
                    Text1(7).SetFocus
                Case 7
                    DTPicker1.SetFocus
                Case Else
                    Text1(Index - 1).SetFocus
            End Select
        Case vbKeyDown
            Select Case Index
                Case 4
                    Combo1.SetFocus
                Case 7
                    Text1(0).SetFocus
                Case Else
                    Text1(Index + 1).SetFocus
            End Select
    End Select
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
'    If KeyAscii = 39 Then KeyAscii = 0: Exit Sub
'    Select Case Index
'        Case 4, 5, 6
'            If KeyAscii <= vbKey9 And KeyAscii >= 46 Or KeyAscii = vbKeyBack Then Exit Sub
'            KeyAscii = 0
'    End Select
End Sub

Private Sub Command1_Click(Index As Integer)
    Select Case Index
        Case 0              '退出
            Unload Me
        Case 1              '新增加
            If Len(Trim(Text1(0).Text)) = 0 Then
                MsgBox "《商品编码》不能为空...", vbOKOnly + vbExclamation, "不能为空"
                Text1(0).SetFocus
                Exit Sub
            End If
            If Len(Trim(Text1(0).Text)) < 5 Then
                MsgBox "商品编码不能少于五位...", vbOKOnly + vbExclamation, "编码位数出错"
                Text1(0).SetFocus
                Exit Sub
            End If
            If Len(Trim(Text1(1).Text)) = 0 Then
                MsgBox "《商品名称》不能为空...", vbOKOnly + vbExclamation, "不能为空"
                Text1(1).SetFocus
                Exit Sub
            End If
            If Len(Trim(Text1(0).Text)) <> 13 Then
                If MsgBox("商品编码不是13位，请按《确定》进行保存，按《取消》进行修改...", _
                    vbOKCancel + vbExclamation, "编码位数出错") = vbCancel Then
                    Text1(0).SetFocus
                    Exit Sub
                End If
            End If
            Rec.CursorLocation = adUseClient
            Rec.Open "select * from lqclk where clbm='" & Text1(0).Text & "'", Cn_Rsh, _
                adOpenDynamic, adLockOptimistic
            On Error GoTo Er1
            If Not Rec.EOF And Not Rec.BOF Then
                MsgBox "商品编码重复，请重新输入商品编码...", vbOKOnly + vbExclamation, "编码重复"
                Text1(0).SetFocus
                Rec.Close
                Set Rec = Nothing
            Else
                MdlMain.ReturnSql = "已增加"
                Cn_Rsh.BeginTrans
                    With Rec
                        .AddNew
                        .Fields("clbm").Value = Trim(Text1(0).Text)
                        .Fields("clmch").Value = Trim(Text1(1).Text)
                        .Fields("zhjm").Value = MdlPY.GetCode(Trim(Text1(1).Text)) ' IIf(Trim((Text1(8).Text)) = "", " ", Text1(8).Text)
                        
                        .Fields("ys").Value = IIf(Trim(Text1(2).Text) = "", " ", Trim(Text1(2).Text))
                        .Fields("xh").Value = IIf(Trim(Text1(3).Text) = "", " ", Trim(Text1(3).Text))
                        .Fields("kd").Value = IIf(Trim(Text1(4).Text) = "", " ", Trim(Text1(4).Text))
                        .Fields("kcshl").Value = Val(Text1(5).Text)
                        .Fields("demo").Value = IIf(Trim(Text1(7).Text) = "", " ", Trim(Text1(7).Text))
                        .Fields("rqshj").Value = DTPicker1.Value
                        .Fields("clgg").Value = " "
                        .Fields("jhdj").Value = 0
                        .Fields("kcje").Value = 0
                        
                        .Fields("clgg").Value = " "
                        .Fields("jhdj").Value = 0
                        .Fields("kcje").Value = 0
                        If Trim(Combo1.Text) <> "" Then
                            .Fields("jldw").Value = MdlMain.Jldw(Combo1.ListIndex).Id
                        Else
                            .Fields("jldw").Value = 0
                        End If
                        .Update
                    End With
                    
                    '更新《商品类别》和《计量单位》使用数量
                    '================================================================================================================
                        If Trim(Combo1.Text) <> "" Then
                            Cn_Rsh.Execute "update lqjldw set shl=(shl+1) where id=" & MdlMain.Jldw(Combo1.ListIndex).Id
                        End If
                    '================================================================================================================
                    '商品发生改变时触发相应的动作进行数据库变化：增加、修改、删除
                    '=============================================================================================================================
                        Call MdlMain.Cl_Change_Update(Cn_Rsh, Trim(Text1(0).Text), "增加", _
                            IIf(Len(Trim((Text1(4).Text))) = 0, 0, Val(Text1(4).Text)))
                    '=============================================================================================================================
                Cn_Rsh.CommitTrans
                Rec.Close
                Set Rec = Nothing
                For i = 0 To 8
                    If i <> 1 And i <> 2 And i <> 4 Then Text1(i).Text = ""
                Next i
'                Text1(0).Text = MdlMain.SetDjId("lqclk", "clbm", "1", "", 5)
                Text1(0).SetFocus
            End If
            Exit Sub
Er1:
            MsgBox "错误号：" & Err.Number & vbCrLf & vbCrLf & "错误描述：" & Err.Description, _
                vbOKOnly + vbCritical, "保存出错"
            On Error Resume Next
            Cn_Rsh.RollbackTrans
        Case 2      '修改
            If Len(Trim(Text1(0).Text)) = 0 Then
                MsgBox "《商品编码》不能为空...", vbOKOnly + vbExclamation, "不能为空"
                Text1(0).SetFocus
                Exit Sub
            End If
            If Len(Trim(Text1(1).Text)) = 0 Then
                MsgBox "《商品名称》不能为空...", vbOKOnly + vbExclamation, "不能为空"
                Text1(1).SetFocus
                Exit Sub
            End If
            If Len(Trim(Text1(0).Text)) < 5 Then
                MsgBox "商品编码不能少于五位...", vbOKOnly + vbExclamation, "编码位数出错"
                Text1(0).SetFocus
                Exit Sub
            End If
            If MdlMain.ReturnSql <> Trim(Text1(0).Text) Then
                Set Rec = Cn_Rsh.Execute("select * from lqclk where clbm='" & Trim(Text1(0).Text) & "'")
                If Not Rec.EOF And Not Rec.BOF Then
                    MsgBox "商品编码重复，请重新输入商品编码...", vbOKOnly + vbExclamation, "编码重复"
                    Text1(0).SetFocus
                    Rec.Close
                    Set Rec = Nothing
                    Exit Sub
                End If
                Set Rec = Nothing
            End If
            MdlMain.ReturnSql = "已保存"
            On Error GoTo ER2
            Cn_Rsh.BeginTrans
                With FrmClGl_Kc.Rec1
'                    .Fields("clbm").Value = Trim(Text1(0).Text)
                    .Fields("clmch").Value = Trim(Text1(1).Text)
                    .Fields("zhjm").Value = MdlPY.GetCode(Trim(Text1(1).Text)) ' IIf(Trim((Text1(8).Text)) = "", " ", Text1(8).Text)
                    .Fields("ys").Value = IIf(Trim(Text1(2).Text) = "", " ", Trim(Text1(2).Text))
                    .Fields("xh").Value = IIf(Trim(Text1(3).Text) = "", " ", Trim(Text1(3).Text))
                    .Fields("kd").Value = IIf(Trim(Text1(4).Text) = "", " ", Trim(Text1(4).Text))
                    .Fields("kcshl").Value = Val(Text1(5).Text)
                    .Fields("demo").Value = IIf(Trim(Text1(7).Text) = "", " ", Trim(Text1(7).Text))
                    .Fields("rqshj").Value = DTPicker1.Value
                    .Fields("clgg").Value = " "
                    .Fields("jhdj").Value = 0
                    .Fields("kcje").Value = 0
                    
                    '更新《计量单位》使用数量
                    '================================================================================================================
                        If Trim(Combo1.Text) <> "" Then
                            If MdlMain.OldJldw <> MdlMain.Jldw(Combo1.ListIndex).Id Then
                                '因为更改了计量单位，要对盘点数量和库存数量进行重新计算
                                '===========================================================================
                                If Rec.State = 1 Then Rec.Close: Set Rec = Nothing
                                Rec.CursorLocation = adUseClient
                                Rec.Open "select * from lqclkd where clbm='" & Trim(Text1(0).Text) & _
                                    "'", Cn_Rsh, adOpenDynamic, adLockOptimistic
                                If Not Rec.EOF And Not Rec.BOF Then
                                    Do While Not Rec.EOF
                                        Rec.Fields("clshl").Value = IIf( _
                                            MdlMain.Jldw_Change(MdlMain.OldJldw, _
                                                MdlMain.Jldw(Combo1.ListIndex).Id, _
                                                Rec.Fields("clshl").Value) = 0, _
                                            Rec.Fields("clshl").Value, _
                                            MdlMain.Jldw_Change(MdlMain.OldJldw, _
                                                MdlMain.Jldw(Combo1.ListIndex).Id, _
                                                Rec.Fields("clshl").Value))
                                        Rec.MoveNext
                                    Loop
                                End If
                                
                                .Fields("kcshl").Value = IIf( _
                                    MdlMain.Jldw_Change(MdlMain.OldJldw, _
                                        MdlMain.Jldw(Combo1.ListIndex).Id, _
                                        Val(Text1(5).Text)) = 0, _
                                    Val(Text1(5).Text), _
                                    MdlMain.Jldw_Change(MdlMain.OldJldw, _
                                        MdlMain.Jldw(Combo1.ListIndex).Id, _
                                        Val(Text1(5).Text)))
                                
                                For i = 0 To UBound(MdlMain.KSh)
                                    If Trim(MdlMain.KSh(i).Id) <> "" Then
                                        .Fields("field" & MdlMain.KSh(i).Id).Value = IIf( _
                                            MdlMain.Jldw_Change(MdlMain.OldJldw, _
                                                MdlMain.Jldw(Combo1.ListIndex).Id, _
                                                Val(Text1(5).Text)) = 0, _
                                            Val(Text1(5).Text), _
                                            MdlMain.Jldw_Change(MdlMain.OldJldw, _
                                                MdlMain.Jldw(Combo1.ListIndex).Id, _
                                                Val(Text1(5).Text)))
                                    End If
                                Next i
                                '===========================================================================
                                
                                .Fields("jldw").Value = MdlMain.Jldw(Combo1.ListIndex).Id
                                If Trim(MdlMain.OldJldw) <> "" Then
                                    Cn_Rsh.Execute "update lqjldw set shl=(shl-1) where id=" & MdlMain.OldJldw
                                End If
                                Cn_Rsh.Execute "update lqjldw set shl=(shl+1) where id=" & MdlMain.Jldw(Combo1.ListIndex).Id
                            End If
                        End If
                    '================================================================================================================
                    .Update
                End With
                '商品发生改变时触发相应的动作进行数据库变化：增加、修改、删除
                '=============================================================================================================================
'                    Call MdlMain.Cl_Change_Update(Cn_Rsh, Trim(Text1(0).Text), "修改单价", , _
                        IIf(Len(Trim((Text1(4).Text))) = 0, 0, Val(Text1(4).Text)))
                '=============================================================================================================================
            Cn_Rsh.CommitTrans
            Unload Me
            Exit Sub
ER2:
            MsgBox "错误号：" & Err.Number & vbCrLf & vbCrLf & "错误描述：" & Err.Description, _
                vbOKOnly + vbCritical, "修改出错"
            On Error Resume Next
            Cn_Rsh.RollbackTrans
    End Select
End Sub