frmitemnaturecard.frm

金算盘软件代码

        If CodeUsed(lngID) Then
            ShowMsg lnghWnd, "“" & Trim(recItemNature!strItemNatureName) _
                & "”商品性质已经有业务发生，不能删除！", vbExclamation + MB_TASKMODAL, "删除商品性质"
        Else
            If ShowMsg(lnghWnd, "你确实要删除“" & Trim(recItemNature!strItemNatureName) _
                & "”商品性质吗？", vbQuestion + vbYesNo + MB_TASKMODAL + vbDefaultButton2, "删除商品性质") = vbYes 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 SetForm(ByVal iVer As Integer)
    Dim i As Integer
    
    Select Case iVer
    Case 4, 8
        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
    Case 16
        lblTitle(1).Visible = False
        cboNature(0).Visible = False
        lblTitle(9).Left = lblTitle(1).Left
        lstNature(0).width = txtInput.width
        lstNature(0).Left = txtInput.Left
        lblTitle(2).Visible = False
        cboNature(1).Visible = False
        lblTitle(5).Visible = False
        lblTitle(6).Visible = False
        lblTitle(7).Visible = False
        lstNature(3).Visible = False
        lstNature(4).Visible = False
        lstNature(5).Visible = False
        lblTitle(4).Caption = "采购科目(&C)"
        lblTitle(4).top = lblTitle(3).top
        lstNature(2).top = lstNature(1).top
        lblTitle(3).Caption = "销售科目(&S)"
        lblTitle(3).top = lblTitle(2).top
        lstNature(1).top = cboNature(1).top
        Me.Height = 2475
    End Select
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim i As Integer
    
    mblnIsRefer = False
    If KeyCode = vbKeyEscape Or KeyCode = vbKeyReturn Then
        For i = 0 To 5
            If lstNature(i).ReferVisible Then mblnIsRefer = True
        Next i
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If mblnIsList Then
        mblnIsList = False
        Exit Sub
    End If
    If KeyAscii = vbKeyReturn Then
        If Not mblnIsRefer Then
            BKKEY Me.ActiveControl.hwnd, vbKeyTab
        End If
    ElseIf KeyAscii = vbKeyEscape Then
        cmdOKCancel(1).Value = Not mblnIsRefer
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn And Shift = 2 Then
        cmdOKCancel(0).Value = True
    End If
End Sub

Private Sub Form_Load()
    Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
'    SetHelpID hwnd, 30020
    Utility.LoadFormResPicture Me
    cboNature(0).AddItem "存货", 0
    cboNature(0).AddItem "加工费用", 1
    cboNature(0).AddItem "劳务", 2
    cboNature(0).AddItem "费用", 3
    #If conVersionType = 8 Or conVersionType = 4 Then
        SetForm 4
    #ElseIf conVersionType = 16 Then
        SetForm 16
    #End If
'    SendKeys "%{N}"
'    frmItemList.IsShowCard(3) = True
    Exit Sub
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
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)
    On Error Resume Next
    Unload frmItemTax
    Unload frmAccountCard
    Utility.UnLoadFormResPicture Me
'    frmItemList.IsShowCard(3) = False
End Sub

Private Sub Form_Paint()
    #If conVersionType = 16 Then
        FrameBox Me.hwnd, 120, 210, 5775 + 120, 1715 + 210
    #Else
        FrameBox Me.hwnd, 120, 180, 5775 + 120, 3315 + 180
    #End If
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
                If Not mblnIsInit Then lstNature(4).Text = ""
                lstNature(4).BackColor = &H80000004
                lstNature(4).Enabled = False
                If Not mblnIsInit Then 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
        
            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
        Else
            lblTitle(2).Enabled = True
            cboNature(1).Enabled = True
            cboNature(1).BackColor = &H80000005
            cboNature(1).ListIndex = 0
            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
    cboNature(1).TabStop = cboNature(1).Enabled
    lstNature(3).TabStop = lstNature(3).Enabled
    lstNature(4).TabStop = lstNature(4).Enabled
    lstNature(5).TabStop = lstNature(5).Enabled
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub Label1_Click(Index As Integer)

End Sub

Private Sub lstNature_AddNew(Index As Integer)
    Dim lngID As Long
    
    Select Case Index
        Case 0
             lngID = frmItemTax.AddCard(lstNature(0).Text, vbModal, True)
             If lngID <> 0 Then mlngLstID(0) = lngID
        Case 1, 2
             lngID = frmAccountCard.AddCard(lstNature(Index).Text, , vbModal, , True)
             If lngID <> 0 Then mlngLstID(Index) = lngID
        Case 3, 4, 5
             lngID = frmAccountCard.AddCard(lstNature(Index).Text, , vbModal, 5, True)
             If lngID <> 0 Then mlngLstID(Index) = lngID
    End Select
    If lngID = 0 Then
        lstNature(Index).Text = ""
    Else
        mlngLstID(Index) = lngID
    End If
    RefershList lstNature(Index), Index
    mblnIsChanged = True
End Sub

Private Sub lstNature_Change(Index As Integer)
    If ContainErrorChar(lstNature(Index).Text, "`~!@#$^&*=+'"";:,.?|") Then BKKEY lstNature(Index).hwnd
End Sub

Private Sub lstNature_Delete(Index As Integer)
    Select Case Index
        Case 0
            If frmItemTax.DelCard(mlngLstID(0), , Me.hwnd) Then mlngLstID(0) = 0