customerinitdetail.frm

金算盘软件代码

            strSql = "Select lngEmployeeID,strEmployeeCode,strEmployeeName From Employee Where blnIsInActive=0 Order By strEmployeeCode"
        Case 9  '工程
            strSql = "Select lngJobID,strJobCode,strJobName From Job Where blnIsInActive=0 Order By strJobCode"
        Case 10  '统计
            strSql = "Select lngClassID,strClassCode,strClassName From Class1 Where blnIsInActive=0 Order By strClassCode"
        Case 11  '项目
            strSql = "Select lngClassID,strClassCode,strClassName From Class2 Where blnIsInActive=0 Order By strClassCode"
        Case 12  '商品
            Select Case msgCustomerInitDetail.TextMatrix(mlngRow, 30)
                Case 5
                    strSql = "Select lngItemID,strItemCode,strItemName From Item Where blnIsInActive=0 and blnIsBorrow Order By strItemCode"
                Case 7
                    strSql = "Select lngItemID,strItemCode,strItemName From Item INNER JOIN ItemNature ON Item.lngItemNatureID=ItemNature.lngItemNatureID" _
                        & " Where blnIsInActive=0 AND strItemCategory='4' Order By strItemCode"
                Case Else
                    strSql = "Select lngItemID,strItemCode,strItemName From Item Where blnIsInActive=0 Order By strItemCode"
            End Select
        Case 13  '计量单位
            strSql = "Select lngUnitID,strUnitName From ItemUnit Where lngItemID=" & msgCustomerInitDetail.TextMatrix(mlngRow, 37)
        Case 20     '税率
'            Select Case msgCustomerInitDetail.TextMatrix(mlngRow, 30)
'                Case "2", "3"
'                    strSql = "Select lngTaxID,dblSaleTaxRate From Tax Where blnIsInActive=0"
'                Case "13", "14"
                    strSql = "Select lngTaxID,strTaxName From Tax Where blnIsInActive=0"
'            End Select
        Case 23     '自定项目1
            strSql = "Select lngCustomID,strCustomCode,strCustomName From Custom0 Where blnIsInActive=0 Order By strCustomCode"
        Case 24     '自定项目2
            strSql = "Select lngCustomID,strCustomCode,strCustomName From Custom1 Where blnIsInActive=0 Order By strCustomCode"
        Case 25     '自定项目3
            strSql = "Select lngCustomID,strCustomCode,strCustomName From Custom2 Where blnIsInActive=0 Order By strCustomCode"
        Case 26     '自定项目4
            strSql = "Select lngCustomID,strCustomCode,strCustomName From Custom3 Where blnIsInActive=0 Order By strCustomCode"
        Case 27     '自定项目5
            strSql = "Select lngCustomID,strCustomCode,strCustomName From Custom4 Where blnIsInActive=0 Order By strCustomCode"
        Case 28     '自定项目6
            strSql = "Select lngCustomID,strCustomCode,strCustomName From Custom5 Where blnIsInActive=0 Order By strCustomCode"
        Case 30  '科目
            strSql = "Select lngAccountID,strAccountCode,strAccountName From Account Where blnIsDetail=1" _
                & " And blnIsInActive=0 And lngAccountNatureID In (3,4)  Order By strAccountCode"
        Case 31  '币种
            If mudtAccount.IsAllCur Then
                strSql = "Select lngCurrencyID,strCurrencyCode,strCurrencyName From Currencys"
            Else
                If mudtAccount.IsMutCur Then
                    strSql = "Select Currencys.lngCurrencyID,strCurrencyCode,strCurrencyName From AccountCurrency " _
                        & "Inner Join Currencys On AccountCurrency.lngCurrencyID=Currencys.lngCurrencyID " _
                        & "Where AccountCurrency.lngAccountID=" & mudtAccount.ID
                Else
                    strSql = "Select lngCurrencyID,strCurrencyCode,strCurrencyName From Currencys Where lngCurrencyID=1"
                End If
            End If
        Case 32  '单位
            strSql = "Select lngCustomerID,strCustomerCode,strCustomerName From Customer Where blnIsInActive=0 Order By strCustomerCode" _
'                & "Where lngARAccountID=" & mudtAccount.ID & " Or lngAPAccountID=" & mudtAccount.ID
    End Select
    Select Case Index
        Case 1, 3, 4, 7, 8, 9, 10, 11, 12, 13, 20, 23, 24, 25, 26, 27, 28
            With lstCustomerInitdetail(3)
                .ClearRefer
                .SeekCol = "1,2,3"
                Set .Resultset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            End With
'        Case 3
'            With lstCustomerInitdetail(3)
'                .ClearRefer
'                .SeekCol = "1,2,3"
'                Set .resultset = gclsBase.BaseDB.openresultset(strSql)
'                .AddRefer "<新增>", 0, 1  '设置固定选项
'                .AddRefer "<删除>", 1, 1
'            End With
        Case 30, 32
            With lstCustomerInitdetail(Index - 30)
                .ClearRefer
                .SeekCol = "1,2,3"
                Set .Resultset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                .AddRefer "<新增>", 0, 1  '设置固定选项
                .AddRefer "<修改>", 1, 1
                .AddRefer "<删除>", 2, 1
            End With
        Case 31
            With lstCustomerInitdetail(Index - 30)
                .ClearRefer
                .SeekCol = "1,2,3"
                Set .Resultset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                If mudtAccount.IsAllCur Or mudtAccount.IsMutCur Then
                    .AddRefer "<新增>", 0, 1  '设置固定选项
                    .AddRefer "<修改>", 1, 1
                    .AddRefer "<删除>", 2, 1
                End If
            End With
    End Select
    With lstCustomerInitdetail(3)
        Select Case Index
            Case 3, 4, 7, 8, 9, 10, 11, 12, 13, 20, 23, 24, 25, 26, 27, 28
                .AddRefer "<新增>", 0, 1  '设置固定选项
                .AddRefer "<修改>", 1, 1
                .AddRefer "<删除>", 2, 1
        End Select
    End With
End Sub

'处理回车键
Private Sub ReturnProc()
  Dim intCount As Integer
  Dim intVisibleRow As Integer
    
    If InputFinish() Then
        With msgCustomerInitDetail
            For intCount = mintCol + 1 To .Cols - 1
                If .ColWidth(intCount) > 0 Then Exit For
            Next
            If intCount <= .Cols - 1 Then
                .col = intCount
                .Row = mlngRow
                FlexInput .Row, .col
                mblnisReturn = True
            Else
                If mlngRow < .Rows - 1 Then
                    .Row = mlngRow + 1
                    .col = 0
                    intVisibleRow = GetVisibleRow - 3
                    If .Row - intVisibleRow > 0 Then
                       .TopRow = IIf(.Rows - intVisibleRow <= .Rows - 1, .Rows - intVisibleRow, .Rows - 1)
                    End If
                    FlexInput .Row, .col
                    mblnisReturn = True
                End If
            End If
        End With
    End If
End Sub

Private Function GetVisibleRow()
  Dim intRow As Integer
  
   With msgCustomerInitDetail
      For intRow = .TopRow To .Rows - 1
         If Not .RowIsVisible(intRow) Then
            Exit Function
         End If
         GetVisibleRow = GetVisibleRow + 1
      Next intRow
   End With
End Function

'参照新增
Private Sub ListTextAddNew()
    Dim lngID As Long
    Dim lngOldID As Long
    
    With lstCustomerInitdetail(3)
        lngOldID = .ID
        Select Case mintCol
            Case 3
                lngID = Card.AddCard(Message.msgRemark)
            Case 4
                lngID = Card.AddCard(Message.msgTerm)
            Case 7
                lngID = Card.AddCard(Message.msgDepartment)
            Case 8
                lngID = Card.AddCard(Message.msgEmployee)
            Case 9
                lngID = Card.AddCard(Message.msgJob)
            Case 10
                lngID = Card.AddCard(Message.msgClass)
            Case 11
                lngID = Card.AddCard(Message.msgClass2)
            Case 12
                lngID = Card.AddCard(Message.msgItem)
            Case 13
                lngID = frmItemUnitCard.AddCard(, vbModal, msgCustomerInitDetail.TextMatrix(mlngRow, 37))
            Case 20
                lngID = Card.AddCard(Message.msgTax)
            Case 23
                lngID = Card.AddCard(Message.msgCustom1)
            Case 24
                lngID = Card.AddCard(Message.msgCustom2)
            Case 25
                lngID = Card.AddCard(Message.msgCustom3)
            Case 26
                lngID = Card.AddCard(Message.msgCustom4)
            Case 27
                lngID = Card.AddCard(Message.msgCustom5)
            Case 28
                lngID = Card.AddCard(Message.msgCustom6)
        End Select
        If lngID > 0 Then
            SetListText mintCol
            mblnIsAddNew = True
            .SeekId lngID
        Else
            .SeekId lngOldID
        End If
    End With
End Sub

'参照删除
Private Sub ListTextDelete()
    Dim lngID As Long
    Dim blnSuccess As Boolean
    
    With lstCustomerInitdetail(3)
        lngID = .ID
        Select Case mintCol
            Case 3
                blnSuccess = Card.DelCard(Message.msgRemark, lngID)
            Case 4
                If IsUsed(lngID, 31) Then
                    ShowMsg Me.hwnd, "付款条件“" & .Text & "”已经使用，不能删除！", vbInformation, Me.Caption
                Else
                    blnSuccess = Card.DelCard(Message.msgTerm, lngID)
                End If
            Case 7
                If IsUsed(lngID, 32) Then
                    ShowMsg Me.hwnd, "部门“" & .Text & "”已经使用，不能删除！", vbInformation, Me.Caption
                Else
                    blnSuccess = Card.DelCard(Message.msgDepartment, lngID)
                End If
            Case 8
                If IsUsed(lngID, 33) Then
                    ShowMsg Me.hwnd, "职员“" & .Text & "”已经使用，不能删除！", vbInformation, Me.Caption
                Else
                    blnSuccess = Card.DelCard(Message.msgEmployee, lngID)
                End If
            Case 9
                If IsUsed(lngID, 34) Then
                    ShowMsg Me.hwnd, "工程“" & .Text & "”已经使用，不能删除！", vbInformation, Me.Caption
                Else
                    blnSuccess = Card.DelCard(Message.msgJob, lngID)
                End If
            Case 10
                If IsUsed(lngID, 35) Then
                    ShowMsg Me.hwnd, "统计“" & .Text & "”已经使用，不能删除！", vbInformation, Me.Caption
                Else
                    blnSuccess = Card.DelCard(Message.msgClass, lngID)
                End If
            Case 11
                If IsUsed(lngID, 36) Then
                    ShowMsg Me.hwnd, "项目“" & .Text & "”已经使用，不能删除！", vbInformation, Me.Caption
                Else
                    blnSuccess = Card.DelCard(Message.msgClass2, lngID)
                End If
            Case 12
                If IsUsed(lngID, 37) Then
                    ShowMsg Me.hwnd, "商品“" & .Text & "”已经使用，不能删除！", vbInformation, Me.Caption
                Else
                    blnSuccess = Card.DelCard(Message.msgItem, lngID)
                End If
            Case 13
                If IsUsed(lngID, 38) Then
                    ShowMsg Me.hwnd, "计量单位“" & .Text & "”已经使用，不能删除！", vbInformation, Me.Caption
                Else
                    blnSuccess = Card.DelCard(Message.msgItemUnit, lngID)
                End If
            Case 20
                If IsUsed(lngID, 39) Then
                    ShowMsg Me.hwnd, "税率“" & .Text & "”已经使用，不能删除！", vbInformation, Me.Caption
                Else
                    blnSuccess = Card.DelCard(Message.msgTax, lngID)
                End If
            Case 23
                If IsUsed(lngID, 40) Then
                    ShowMsg Me.hwnd, "自定义项目1“" & .Text & "”已经使用，不能删除！", vbInformation, Me.Caption
                Else
                    blnSuccess = Card.DelCard(Message.msgCustom1, lngID)
                End If
            Case 24
                If IsUsed(lngID, 41) Then
                    ShowMsg Me.hwnd, "自定义项目2“" & .Text & "”已经使用，不能删除！", vbInformation, Me.Caption
                Else
                    blnSuccess = Card.DelCard(Message.msgCustom2, lngID)
                End If
            Case 25
                If IsUsed(lngID, 42) Then
                    ShowMsg Me.hwnd, "自定义项目3“" & .Text & "”已经使用，不能删除！", vbInformation, Me.Caption
                Else
                    blnSuccess = Card.DelCard(Message.msgCustom3, lngID)
                End If
            Case 26
                If IsUsed(lngID, 43) Then
                    ShowMsg Me.hwnd, "自定义项目4“" & .Text & "”已经使用，不能删除！", vbInformation, Me.Caption
                Else
                   blnSuccess = Card.DelCard(Message.msgCustom4, lngID)
                End If
            Case 27
                If IsUsed(lngID, 44) Then
                    ShowMsg Me.hwnd, "自定义项目5“" & .Text & "”已经使用，不能删除！", vbInformation, Me.Caption
                Else
                    blnSuccess = Card.DelCard(Message.msgCustom5, lngID)
                End If
            Case 28
                If IsUsed(lngID, 45) Then
                    ShowMsg Me.hwnd, "自定义项目6“" & .Text & "”已经使用，不能删除！", vbInformation, Me.Caption
                Else
                    blnSuccess = Card.DelCard(Message.msgCustom6, lngID)
                End If
        End Select
        If blnSuccess Then
            SetListText mintCol
            If mintCol = 31 And Not (mudtAccount.IsAllCur Or mudtAccount.IsMutCur) Then
                If .Referrows > 0 Then
                    .ReferRow = 0
                End If
            Else
                If .Referrows > 3 Then
                    .ReferRow = 4
                End If
            End If
            If mintCol = 12 Then
                .TextMatrix(mlngRow, 13) = ""
                .TextMatrix(mlngRow, 14) = ""
                .TextMatrix(mlngRow, 16) = ""
                .TextMatrix(mlngRow, 38) = "0"
            End If
        End If
    End With
End Sub

'参照编辑
Private Sub ListTextEdit()
    Dim lngID As Long
    Dim intCount As Integer
    
    With lstCustomerInitdetail(3)
        lngID = .ID
        Select Case mintCol
            Case 3
                Card.EditCard Message.msgRemark, lngID
            Case 4
                Card.EditCard Message.msgTerm, lngID
            Case 7
                Card.EditCard Message.msgDepartment, lngID
            Case 8
                Card.EditCard Message.msgEmployee, lngID
            Case 9
                Card.EditCard Message.msgJob, lngID
            Case 10
                Card.EditCard Message.msgClass, lngID
            Case 11
                Card.EditCard Message.msgClass2, lngID
            Case 12
                Card.EditCard Message.msgItem, lngID
            Case 13
                Card.EditCard Message.msgItemUnit, lngID
            Case 20
                Card.EditCard Message.msgTax, lngID
            Case 23