frmitemtaxlistcard.frm

金算盘软件代码

            If rectemp.RowCount > 0 Then
               msetlistbox lstTxtItemTax(0), 0
               lstTxtItemTax(0).SeekId mlngLastPurchaseTaxAccountID
            End If
            rectemp.Close
            
            strSql = "SELECT strAccountName FROM Account WHERE lngAccountID=" & mlngLastSaleTaxAccountID
            Set rectemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If rectemp.RowCount > 0 Then
               msetlistbox lstTxtItemTax(1), 1
               lstTxtItemTax(1).SeekId mlngLastSaleTaxAccountID
            End If
            rectemp.Close
        End If
        If TaxIsPlan(mlngTaxID) Then
           For i = 1 To 2
               txtItemTax(i).Enabled = False
               txtItemTax(i).BackColor = &H80000004
           Next
        Else
           For i = 1 To 2
               txtItemTax(i).Enabled = True
               txtItemTax(i).BackColor = &H80000005
           Next
        End If
    Else
        cmdItemTax(2).Visible = True
        mstrLastTaxName = strName
        txtItemTax(0).Text = mstrLastTaxName
        mdblLastPurchaseTaxRate = 0
        txtItemTax(1).Text = CStr(mdblLastPurchaseTaxRate)
        mdblLastSaleTaxRate = 0
        txtItemTax(2).Text = CStr(mdblLastSaleTaxRate)
        mblnLastIsInActive = False
        chkStop.Value = IIf(mblnLastIsInActive, 1, 0)
        mlngLastPurchaseTaxAccountID = 0
        lstTxtItemTax(0).Text = ""
        mlngLastSaleTaxAccountID = 0
        lstTxtItemTax(1).Text = ""
    End If
    For i = 1 To 2
        If txtItemTax(i) = 0 Then
           lstTxtItemTax(i - 1).Enabled = False
           lstTxtItemTax(i - 1).BackColor = &H80000004
           lblItemTax(i + 2).Enabled = False
        End If
    Next
    mblnChangeIsFirst = False
End Function

Private Sub chkStop_Click()
    mblnIsChanged = True
End Sub

Private Sub chkStop_LostFocus()
    If chkStop.Value = 0 Then
        mblnIsInActive = False
    Else
        mblnIsInActive = True
    End If
    mblnIsChanged = True
End Sub

Private Sub cmdItemTax_Click(Index As Integer)
    Dim i As Integer
    Dim strSql As String
    Dim recTax As rdoResultset
    Dim intMsg As Integer
    
    Select Case Index
    Case 0
        If Caption = "修改商品税率" Then
            If Not EditRecord Then
               Exit Sub
            Else
               Unload Me
               Exit Sub
            End If
        Else
            If Not AddRecord Then
               Exit Sub
            Else
                strSql = "select * from tax order by lngTaxID"
                Set recTax = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                If recTax.RowCount > 0 Then
                   recTax.MoveLast
                   ID = recTax!lngTaxID
                Else
                   ID = 0
                End If
            End If
        End If
        Unload Me
    Case 1
        mblnIsChanged = False
        Unload Me
    Case 2
        If Not AddRecord Then
           Exit Sub
        End If
        mlngTaxID = 0
        InitCard
    End Select
End Sub

Private Sub cmdItemTax_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Index = 1 Then mblnIsCancel = True
End Sub

Private Sub Form_Activate()
    txtItemTax(0).SelStart = 0
    txtItemTax(0).SelLength = strLen(txtItemTax(0).Text)
    gclsSys.CurrFormName = Me.hwnd
    frmMain.mnuEditShowList.Enabled = True
    'txtItemTax(0).SetFocus
End Sub

Private Sub Form_Load()
    On Error GoTo ErrHandle
    SetHelpID Me.hwnd, 30034     '22007
    mblnIsChanged = False
    station(0) = None
    station(1) = None
'    Set cmdItemTax(0).Picture = LoadResPicture(1001, vbResBitmap)
'    Set cmdItemTax(1).Picture = LoadResPicture(1002, vbResBitmap)
'    Set cmdItemTax(2).Picture = LoadResPicture(1009, vbResBitmap)
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    frmItemList.IsShowCard(4) = True
    Exit Sub
    Dim edtErrReturn As ErrDealType
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Sub

Private Sub Form_Paint()
  FrameBox Me.hwnd, 210, 300, 5235, 2385
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
        Dim intResponse As Integer
        If UnloadMode = vbFormControlMenu Then
           If mblnIsChanged Then
              intResponse = ShowMsg(0, "当前商品税率已被修改，是否保存？", _
                            vbYesNoCancel + vbQuestion + MB_TASKMODAL, Caption)
              If intResponse = vbYes Then
                 If getID > 0 Then
                    Cancel = Not EditRecord()
                 Else
                    Cancel = Not AddRecord()
                 End If
              ElseIf intResponse = vbCancel Then
                 Cancel = True
              End If
           End If
        End If
        If Not Cancel Then mblnIsChanged = False
    End Sub

Private Sub Form_Resize()
    If Me.Left + Me.Width < 0 Or Me.Left > Screen.Width Then
       Me.Left = 300
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    mblnIsCancel = False
    frmItemList.IsShowCard(4) = False
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
End Sub

Private Sub lstTxtItemTax_AddNew(Index As Integer)
    Dim intID As Long
    
    mblnIsEditAdd = True
    intID = Card.AddCard(Message.msgAccount)
    Select Case Index
           Case 0
                msetlistbox lstTxtItemTax(0), 0
                msetlistbox lstTxtItemTax(1), 1
           Case 1
                msetlistbox lstTxtItemTax(0), 0
                msetlistbox lstTxtItemTax(1), 1
    End Select
    lstTxtItemTax(Index).SeekId intID
    station(Index) = Add
End Sub

Private Sub lstTxtItemTax_Choose(Index As Integer)
    Dim intID As Long
    Dim blnIsDel As Boolean

    If mblnChangeIsFirst = True Then Exit Sub
    If Index = 0 Then
       mlngPurchaseTaxAccountID = lstTxtItemTax(Index).ID
    Else
       mlngSaleTaxAccountID = lstTxtItemTax(Index).ID
    End If
    
End Sub


'设置列表框选项
Public Sub msetlistbox(lstSetting As ListText, Index As Integer)
    Dim strSql As String
    
    Select Case Index
           Case 0
                Card.setlistbox lstSetting, 0, mlngPurchaseTaxAccountID
           Case 1
                Card.setlistbox lstSetting, 0, mlngSaleTaxAccountID
    End Select
    
End Sub

Private Sub lstTxtItemTax_Delete(Index As Integer)
        Dim blnIsDel As Boolean
        
        mblnIsEditAdd = True
        Select Case Index
               Case 0
                    If mlngPurchaseTaxAccountID = 0 Then
                       ShowMsg 0, "编码不存在", vbExclamation + MB_TASKMODAL, Me.Caption
                       lstTxtItemTax(0).SetFocus
                       Exit Sub
                    End If
                    
                    blnIsDel = Card.DelCard(Message.msgAccount, mlngPurchaseTaxAccountID, frmItemTaxListCard.hwnd)
                    If blnIsDel = True Then
                       mlngPurchaseTaxAccountID = -1
                       msetlistbox lstTxtItemTax(0), 0
                       msetlistbox lstTxtItemTax(1), 1
                       lstTxtItemTax(Index).Text = ""
                       lstTxtItemTax(Index).SetFocus
                    Else
                       lstTxtItemTax(Index).SeekId mlngPurchaseTaxAccountID
                    End If
               Case 1
                    If mlngSaleTaxAccountID = 0 Then
                       ShowMsg 0, "编码不存在", vbExclamation + MB_TASKMODAL, Me.Caption
                       lstTxtItemTax(1).SetFocus
                       Exit Sub
                    End If
                    blnIsDel = Card.DelCard(Message.msgAccount, mlngSaleTaxAccountID, frmItemTaxListCard.hwnd)
                    If blnIsDel = True Then
                       mlngSaleTaxAccountID = -1
                       msetlistbox lstTxtItemTax(0), 0
                       msetlistbox lstTxtItemTax(1), 1
                       lstTxtItemTax(Index).Text = ""
                       lstTxtItemTax(Index).SetFocus
                    Else
                       lstTxtItemTax(Index).SeekId mlngSaleTaxAccountID
                    End If
        End Select
End Sub

Private Sub lstTxtItemTax_Edit(Index As Integer)
        mblnIsEditAdd = True
        If Index = 0 Then
            If mlngPurchaseTaxAccountID = 0 Then
                ShowMsg 0, "编码不存在", vbExclamation + MB_TASKMODAL, Me.Caption
                lstTxtItemTax(0).SetFocus
                Exit Sub
            End If
            Card.EditCard Message.msgAccount, mlngPurchaseTaxAccountID
            msetlistbox lstTxtItemTax(0), 0
            msetlistbox lstTxtItemTax(1), 1
            lstTxtItemTax(Index).SeekId mlngPurchaseTaxAccountID
        End If
        If Index = 1 Then
            If mlngSaleTaxAccountID = 0 Then
                ShowMsg 0, "编码不存在", vbExclamation + MB_TASKMODAL, Me.Caption
                lstTxtItemTax(1).SetFocus
                Exit Sub
            End If
            Card.EditCard Message.msgAccount, mlngSaleTaxAccountID
            msetlistbox lstTxtItemTax(0), 0
            msetlistbox lstTxtItemTax(1), 1
            lstTxtItemTax(Index).SeekId mlngSaleTaxAccountID
        End If
        station(Index) = Edit
End Sub

Private Sub lstTxtItemTax_GotFocus(Index As Integer)
   If txtItemTax(2).Text = "0" Or Trim(txtItemTax(2).Text) = "" Then
      lstTxtItemTax(1).TabStop = False
   Else
      lstTxtItemTax(1).TabStop = True
   End If
   If Me.Caption = "修改商品税率" Then
      cmdItemTax(0).Default = False
   Else
      cmdItemTax(0).Default = False
      cmdItemTax(2).Default = False
   End If
   If mblnChangeIsFirst = True Then Exit Sub
   If lstTxtItemTax(Index).Referrows <= 1 Then
       msetlistbox lstTxtItemTax(Index), Index
   End If
End Sub

Private Sub lstTxtItemTax_ItemNotExist(Index As Integer)
    Dim intMsgReturn As Integer
    Dim intID As Long
    
    If mblnIsCancel = True Then Exit Sub
    Select Case Index
    Case 0
        '调窗体
        intMsgReturn = frmMsgAdd.MsgAddShow(Caption, "进项税科目中没有" & lstTxtItemTax(0).Text)
    Case 1
        intMsgReturn = frmMsgAdd.MsgAddShow(Caption, "销项税科目中没有" & lstTxtItemTax(1).Text)
    End Select
    If intMsgReturn = vbOK Then
        intID = Card.AddCard(Message.msgAccount, lstTxtItemTax(Index).Text)
        Select Case Index
               Case 0
                    msetlistbox lstTxtItemTax(0), 0
                    msetlistbox lstTxtItemTax(1), 1
               Case 1
                    msetlistbox lstTxtItemTax(1), 1
                    msetlistbox lstTxtItemTax(0), 0
        End Select
        lstTxtItemTax(Index).SeekId intID
        station(Index) = Add
    Else
        lstTxtItemTax(Index).SelStart = 0
        lstTxtItemTax(Index).SelLength = Len(lstTxtItemTax(Index).Text)
        'lstTxtItemTax(Index).SetFocus
        If Index = 0 Then
           SendKeys "%{A}"
        Else
           SendKeys "%{C}"
        End If
    End If
End Sub

Private Sub lstTxtItemTax_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = vbEnter Then SendKeys "{TAB}"
End Sub

Private Sub lstTxtItemTax_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = 13 Then SendKeys "{TAB}"
     mblnIsChanged = True
End Sub

Private Sub lstTxtItemTax_LostFocus(Index As Integer)
    Dim lngID As Long
    Dim strSql As String
    Dim recAccount As Recordset
    
   
    If mblnIsEditAdd = False Then
'       lngID = lstTxtItemTax(Index).ID  'TextMatrix(lstMethod(index).ReferRow, 1)
'       If lngID > 0 Then
'          strSql = "select * from Account where lngAccountID=" & lngID & " and blnIsDetail=true"
'          Set recAccount = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenForwardOnly)
'          If recAccount.EOF Then
'             ShowMsg 0, "“" & lstTxtItemTax(Index).Text & "“会计科目不是末级科目，请重新选择会计科目！", _
'                      vbExclamation + MB_TASKMODAL, Me.Caption
'             lstTxtItemTax(Index).SelStart = 0
'             lstTxtItemTax(Index).SelLength = strLen(lstTxtItemTax(0).Text)
'             lstTxtItemTax(Index).SetFocus
'             Exit Sub
'          End If
'          recAccount.Close
'