frmitemnaturelistcard.frm

金算盘软件代码

        mlngLstID(0) = 2
        lstNature(0).Text = GetTaxName(2)
        txtInput.Text = Trim(strName)
        mbytCostMethod = 0
        cboNature(0).ListIndex = 0
        cboNature(1).ListIndex = 0
        lstNature(4).Enabled = False
        lstNature(5).Enabled = False
    Else
'        Strsql = "SELECT ItemNature.* , Tax.strTaxName,SaleAccount.strAccountCode AS" _
            & " strSaleAccountCode,SaleAccount.strAccountName AS strSaleAccountName," _
            & "CostAccount.strAccountCode AS strCostAccountCode," _
            & "CostAccount.strAccountName AS strCostAccountName," _
            & "StockAccount.strAccountCode AS strStockAccountCode," _
            & "StockAccount.strAccountName AS strStockAccountName," _
            & "DiffAccount.strAccountCode AS strDiffAccountCode," _
            & "DiffAccount.strAccountName AS strDiffAccountName," _
            & "StockTaxAccount.strAccountCode AS strStockTaxAccountCode," _
            & "StockTaxAccount.strAccountName AS strStockTaxAccountName  " _
            & "FROM (((((ItemNature LEFT JOIN Tax ON ItemNature.lngTaxID=Tax.lngTaxID) " _
            & "LEFT JOIN Account AS SaleAccount ON " _
            & "ItemNature.lngSaleAccountID=SaleAccount.lngAccountID) LEFT JOIN " _
            & "Account AS CostAccount ON ItemNature.lngCostAccountID=CostAccount.lngAccountID) " _
            & "LEFT JOIN Account AS StockAccount ON ItemNature.lngStockAccountID=" _
            & "StockAccount.lngAccountID) LEFT JOIN Account AS DiffAccount ON " _
            & "ItemNature.lngDiffAccountID=DiffAccount.lngAccountID) LEFT JOIN " _
            & "Account AS StockTaxAccount ON ItemNature.lngStockTaxAccountID=" _
            & "StockTaxAccount.lngAccountID WHERE lngItemNatureID=" & mlngItemNatureID
        Strsql = "SELECT * FROM ITEMNATUREVIEW WHERE lngItemNatureID=" & mlngItemNatureID
        Set recItemNature = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenForwardOnly)
        With recItemNature
        txtInput.Text = !strItemNatureName
        mlngLstID(0) = !lngTaxID
        mlngLstID(1) = !lngSaleAccountID
        mlngLstID(2) = !lngCostAccountID
        mlngLstID(3) = !lngStockAccountID
        mlngLstID(4) = !lngDiffAccountID
        mlngLstID(5) = !lngStockTaxAccountID
        lstNature(0).Text = Format(!strTaxName, "@;;")
        lstNature(1).Text = Trim(Format(!strSaleAccountCode, "@;;")) & " " _
            & Trim(Format(!strSaleAccountName, "@;;"))
        lstNature(2).Text = Trim(Format(!strCostAccountCode, "@;;")) & " " _
            & Trim(Format(!strCostAccountName, "@;;"))
        lstNature(3).Text = Trim(Format(!strStockAccountCode, "@;;")) & " " _
            & Trim(Format(!strStockAccountName, "@;;"))
        lstNature(4).Text = Trim(Format(!strDiffAccountCode, "@;;")) & " " _
            & Trim(Format(!strDiffAccountName, "@;;"))
        lstNature(5).Text = Trim(Format(!strStockTaxAccountCode, "@;;")) & " " _
            & Trim(Format(!strStockTaxAccountName, "@;;"))
        #If conVersionType = 8 Then
            If !strCostMethod = 8 Then
                 mbytCostMethod = 6
            Else
                mbytCostMethod = CByte(!strCostMethod)
            End If
        #Else
            #If conVersionType = 16 Then
                mbytCostMethod = 1
            #Else
                mbytCostMethod = CByte(!strCostMethod)
            #End If
        #End If
        If blnFixCostMethod Then
            lblTitle(2).Enabled = False
            cboNature(1).Enabled = False
        Else
            lblTitle(2).Enabled = True
            cboNature(1).Enabled = True
        End If
        cboNature(0).ListIndex = CInt(!strItemCategory) - 1
        If mbytCostMethod > 0 Then
            cboNature(1).ListIndex = mbytCostMethod - 1
        Else
            lstNature(4).Enabled = False
            lstNature(5).Enabled = False
        End If
        End With
        recItemNature.Close
    End If
    mblnIsInit = False
End Sub

Private Sub InitMethodBox()
    cboNature(1).Clear
    #If conVersionType = 1 Then
        cboNature(1).AddItem "全月平均", 0
        cboNature(1).AddItem "移动平均", 1
        cboNature(1).AddItem "先进先出", 2
        cboNature(1).AddItem "后进先出", 3
        cboNature(1).AddItem "个别计价", 4
        cboNature(1).AddItem "计划价", 5
        cboNature(1).AddItem "进销差价率", 6
        cboNature(1).AddItem "最后进价法", 7
    #Else
        #If conVersionType = 2 Then
        #Else
            #If conVersionType = 8 Then
                cboNature(1).AddItem "全月平均", 0
                cboNature(1).AddItem "移动平均", 1
                cboNature(1).AddItem "先进先出", 2
                cboNature(1).AddItem "后进先出", 3
                cboNature(1).AddItem "个别计价", 4
                cboNature(1).AddItem "最后进价法", 5
            #Else
                cboNature(1).AddItem "移动平均", 0
            #End If
        #End If
    #End If
    
End Sub

'进入修改商品性质
Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0, _
    Optional strItemNature As String)
    Dim blnFixCostMethod As Boolean
    Dim recItemNature As rdoResultset, Strsql As String
    Dim strMess As String
    
    If Not CheckIDUsed("ItemNature", "lngItemNatureID", lngID) Then
        If Trim(strItemNature) <> "" Then
            strMess = "“" & strItemNature & "”"
        Else
            strMess = "该"
        End If
        ShowMsg 0, strMess & "商品性质不存在,不能进行编辑!", _
            vbExclamation + MB_TASKMODAL, "修改商品性质"
        Unload Me
    Else
        Strsql = "SELECT * FROM Item WHERE lngItemNatureID=" & lngID
        Set recItemNature = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenForwardOnly)
        With recItemNature
        Do Until .EOF
            If frmItemCard.ItemIsUsed(!lngItemID) Then Exit Do
            .MoveNext
        Loop
        If .EOF Then
            blnFixCostMethod = False
        Else
            blnFixCostMethod = True
        End If
        .Close
        End With
        mlngItemNatureID = lngID
        mblnIsNew = False
        mblnIsChanged = False
        Caption = "修改商品性质"
        cmdOKCancel(0).Default = True
        cmdOKCancel(2).Visible = False
        InitCard , blnFixCostMethod
        If cboNature(0).ListCount > 0 And cboNature(1).ListCount > 0 Then
            Show intModal
            Refresh
            ZOrder 0
        Else
            Unload Me
        End If
    End If
'    Unload MsgForm
End Sub

'进入删除商品性质表，判断记录是否是末级和被使用，删除记录
Public Function DelCard(ByVal lngID As Long) As Boolean
    Dim recItemNature As rdoResultset, Strsql As String
    
    DelCard = False
    Strsql = "SELECT * FROM ItemNature WHERE lngItemNatureID=" & lngID
    Set recItemNature = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenForwardOnly)
    If recItemNature.EOF Then
        DelCard = True
        recItemNature.Close
        Exit Function
    Else
        If CodeUsed(lngID) Then
            ShowMsg 0, "“" & Trim(recItemNature!strItemNatureName) _
                & "”商品性质已经有业务发生，不能删除！", vbExclamation + MB_TASKMODAL, "删除商品性质"
        Else
            If ShowMsg(0, "你确实要删除“" & Trim(recItemNature!strItemNatureName) _
                & "”商品性质吗？", vbQuestion + vbOKCancel + MB_TASKMODAL, "删除商品性质") = vbOK Then
                Strsql = "DELETE FROM ItemNature WHERE lngItemNatureID = " & lngID
                DelCard = gclsBase.ExecSQL(Strsql)
'                gclsSys.SendMessage CStr(Me.hwnd), Message.msgItemNature
            End If
        End If
    End If
    recItemNature.Close
End Function

'判断记录是否被使用（可能有多张表会使用此编码）
Private Function CodeUsed(lngID As Long) As Boolean
    CodeUsed = True
    If CheckIDUsed("Item", "lngItemNatureID", lngID) Then Exit Function
    CodeUsed = False
End Function

Private Sub Form_Activate()
    mclsMainControl_ChildActive
    frmMain.mnuEditShowList = True
    gclsSys.CurrFormName = Me.hwnd
End Sub

Private Sub SetFormHeigh()
    Dim i As Integer
    
    lblTitle(6).Visible = False
    lblTitle(7).Visible = False
    lstNature(4).Visible = False
    lstNature(4).TabStop = False
    lstNature(5).Visible = False
    lstNature(5).TabStop = False
    cboNature(0).top = txtInput.top + 549
    lstNature(0).top = cboNature(0).top
    cboNature(1).top = cboNature(0).top + 549
    lstNature(1).top = cboNature(1).top + 549
    lstNature(2).top = lstNature(1).top + 549
    lstNature(3).top = lstNature(2).top + 549
    For i = 1 To 5
        lblTitle(i).top = lblTitle(i - 1).top + 549
    Next i
    lblTitle(9).top = lblTitle(1).top
End Sub

Private Sub Form_Load()
'    Me.Hide
'    Me.Left = -30000
'    MsgForm.PleaseWait
    SetHelpID hwnd, 30020
    cboNature(0).AddItem "存货", 0
    cboNature(0).AddItem "非存货", 1
    cboNature(0).AddItem "劳务", 2
    cboNature(0).AddItem "费用", 3
    #If conVersionType = 8 Or conVersionType = 4 Then
        SetFormHeigh
    #End If
    frmItemList.IsShowCard(3) = True
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intMsgReturn As Integer, strMess As String
    
    If UnloadMode <> vbFormControlMenu Then Exit Sub
    If Trim(txtInput.Text) = "" Then Exit Sub
    If mblnIsChanged Then
        If mblnIsNew Then
            strMess = "您要保存新增的商品性质“" & txtInput.Text & "”吗？"
        Else
            strMess = "“" & txtInput.Text & "”" & "商品性质已被修改，是否保存？"
        End If
        intMsgReturn = ShowMsg(hwnd, strMess, vbQuestion + vbYesNoCancel, Caption)
        If intMsgReturn = vbYes Then
            Cancel = Not SaveCard
        ElseIf intMsgReturn = vbCancel Then
            Cancel = True
        End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    frmItemList.IsShowCard(3) = False
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
End Sub

Private Sub Form_Paint()
    FrameBox Me.hwnd, 120, 210, 5775 + 120, 3315 + 210
End Sub

Private Sub cboNature_Click(Index As Integer)
    
'    If Index = 1 Then
'        #If conVersionType = 1 Then
'            If cboNature(1).ListIndex = 5 Or cboNature(1).ListIndex = 6 Then
'                lstNature(4).Enabled = True
'                lstNature(4).BackColor = &H80000005
'                lblTitle(6).Enabled = True
'                If cboNature(1).ListIndex = 6 Then
'                    lstNature(5).Enabled = True
'                    lstNature(5).BackColor = &H80000005
'                    lblTitle(7).Enabled = True
'                Else
'                    lstNature(5).Text = ""
'                    lstNature(5).BackColor = &H80000004
'                    lstNature(5).Enabled = False
'                    lblTitle(7).Enabled = False
'                End If
'            Else
'                lblTitle(6).Enabled = False
'                lstNature(4).Text = ""
'                lstNature(4).BackColor = &H80000004
'                lstNature(4).Enabled = False
'                lstNature(5).Text = ""
'                lstNature(5).BackColor = &H80000004
'                lstNature(5).Enabled = False
'                lblTitle(7).Enabled = False
'            End If
'        #Else
'            #If conVersionType = 2 Then
'            #Else
'                lblTitle(6).Enabled = False
'                lstNature(4).Text = ""
'                lstNature(4).BackColor = &H80000004
'                lstNature(4).Enabled = False
'                lstNature(5).Text = ""
'                lstNature(5).BackColor = &H80000004
'                lstNature(5).Enabled = False
'                lblTitle(7).Enabled = False
'            #End If
'        #End If
'    Else
'        If cboNature(0).ListIndex > 0 Then
'            InitMethodBox
'            lblTitle(2).Enabled = False
'            cboNature(1).Enabled = False
''            If mbytCostMethod > 0 Then cboNature(1).ListIndex = 0
'            cboNature(1).BackColor = &H80000004
'            lstNature(3).Text = ""
'            lstNature(3).BackColor = &H80000004
'            lstNature(3).Enabled = False
'            lblTitle(5).Enabled = False
'        Else
'            lblTitle(2).Enabled = True
'            cboNature(1).Enabled = True
'            cboNature(1).ListIndex = 0
'            cboNature(1).BackColor = &H80000005
'            lstNature(3).BackColor = &H80000005
'            lstNature(3).Enabled = True
'            lblTitle(5).Enabled = True
'        End If
'        If cboNature(0).ListIndex > 1 Then
''            lstNature(3).Text = ""
''            lstNature(3).BackColor = &H80000004
''            lstNature(3).Enabled = False
''            lblTitle(5).Enabled = False
''            If cboNature(0).ListIndex = 3 Then
''                lstNature(1).Text = ""
''                lstNature(1).BackColor = &H80000004
''                lstNature(1).Enabled = False
''                LblTitle(3).Enabled = False
''            Else
''                lstNature(1).BackColor = &H80000005
''                lstNature(1).Enabled = True
''                LblTitle(3).Enabled = True
''            End If
''            If cboNature(0).ListIndex = 2 Then
''                lstNature(2).Text = ""
''                lstNature(2).BackColor = &H80000004
''                lstNature(2).Enabled = False
''                LblTitle(4).Enabled = False
''            Else
''                lstNature(2).BackColor = &H80000005
''                lstNature(2).Enabled = True
''                LblTitle(4).Enabled = True
''            End If
'        Else
'            lstNature(1).BackColor = &H80000005
'            lstNature(1).Enabled = True
'            lblTitle(3).Enabled = True
'            lstNature(2).BackColor = &H80000005
'            lstNature(2).Enabled = True
'            lblTitle(4).Enabled = True
'        End If
'    End If
'    If Not mblnIsInit Then mblnIsChanged = True
    If Index = 1 Then
        #If conVersionType = 1 Then
            If cboNature(1).ListIndex = 5 Or cboNature(1).ListIndex = 6 Then
                lstNature(4).Enabled = True
                lstNature(4).BackColor = &H80000005
                lblTitle(6).Enabled = True
                If cboNature(1).ListIndex = 6 Then
                    lstNature(5).Enabled = True
                    lstNature(5).BackColor = &H80000005
                    lblTitle(7).Enabled = True
                Else
                    lstNature(5).Text = ""
                    lstNature(5).BackColor = &H80000004
                    lstNature(5).Enabled = False
                    lblTitle(7).Enabled = False
                End If