frmtaxpersonlist.frm

金算盘软件代码

            ShowList = False
            Exit Function
        End If
        strofFrom = .FromOfSql
        strofWhere = .WhereOfSql
    End With
    '根据lngID得到排序字段值
    strSql = "Select " & strSortField & " As " & strSortDec
    Select Case intTab
        Case 0
            If strofWhere <> "" Then
                strofWhere = " where " & strofWhere & "and Tax.lngTaxID=" & lngID
            Else
                strofWhere = " where Tax.lngTaxID=" & lngID
            End If
        Case 1
            If strofWhere <> "" Then
                strofWhere = " where " & strofWhere & "and PersonTax.lngPersonTaxID=" & lngID
            Else
                strofWhere = " where PersonTax.lngPersonTaxID=" & lngID
            End If
    End Select
    strSql = strSql & strofFrom & strofWhere
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    With recTemp
        If .RowCount > 0 Then
            txtFind.Text = recTemp(strSortDec)   '查找
            With mclsList(intTab).FlexGrid
                If .TextMatrix(.Row, 0) = lngID Then      '是否找到
                    ShowList = True
                Else
                    ShowList = False
                End If
            End With
        Else
            ShowList = False
        End If
        .Close
    End With
End Function
'卡片
Public Property Let IsShowCard(ByVal Index As Integer, ByVal vNewValue As Boolean)
   mIsShowCard(Index) = vNewValue
End Property
Public Property Get IsShowCard(ByVal Index As Integer) As Boolean
   IsShowCard(Index) = mIsShowCard(Index)
End Property
'按照部门职员ID提取记录
Public Function GetByListID(ByVal intTab As Integer, ByVal lngID As Long) As rdoResultset
    Dim recRecordset As rdoResultset
    Dim strSql As String
    
    Select Case intTab
        Case 0
            strSql = "Select * From Tax Where lngTaxID = " & lngID
        Case 1
            strSql = "Select * From PersonTax Where lngPersonTaxID = " & lngID
    End Select
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Set GetByListID = recRecordset
End Function

'按照部门职员ID更新停用标志
Private Function UpdateListInActive(ByVal intTab As Integer, ByVal lngID As Long, ByVal blnIsInActive As Boolean) As Boolean
    Dim strSql As String
    
    Select Case intTab
        Case 0
            strSql = "UPDATE Tax SET blnIsInActive = " & blnIsInActive & " WHERE lngTaxID = " & lngID
        Case 1
            strSql = "UPDATE PersonTax SET blnIsInActive = " & blnIsInActive & " WHERE lngPersonTaxID = " & lngID
    End Select
    UpdateListInActive = gclsBase.ExecSQL(strSql)
End Function

'删除部门职员ID指定记录
Private Function DelByPaymentMethodID(ByVal lngID As Long, ByVal intTab As Integer) As Boolean
    Dim strSql As String
    
    Select Case intTab
        Case 0
            strSql = "Delete * From Tax WHERE lngTaxID = " & lngID
        Case 1
            strSql = "Delete * From PersonTax WHERE lngPersonTaxID = " & lngID
    End Select
    DelByPaymentMethodID = gclsBase.ExecSQL(strSql)
End Function

'判断部门职员ID是否使用
Private Function IsUsePaymentMethodID(ByVal lngID As Long) As Boolean
    Dim recRecordset As rdoResultset
    Dim strSql As String
    
    Select Case sstTypAct.Tab
           Case 0
                strSql = "SELECT lngTaxID FROM Tax" _
                & " WHERE EXISTS (SELECT Ap.lngTaxID FROM ARAPInit AS Ap WHERE Ap.lngTaxID=" & lngID & ")" _
                & " OR EXISTS (SELECT IM.lngTaxID FROM ItemNature AS IM WHERE IM.lngTaxID=" & lngID & ")" _
                & " OR EXISTS (SELECT It.lngTaxID FROM ItemActivityDetail AS It WHERE It.lngTaxID=" & lngID & ")" _
                & " OR EXISTS (SELECT Pc.lngTaxID FROM PurchaseorderDetail AS Pc WHERE Pc.lngTaxID=" & lngID & ")" _
                & " OR EXISTS (SELECT So.lngTaxID FROM SaleOrderDetail AS So WHERE So.lngTaxID=" & lngID & ")" _

                'strSQL = "Select lngTaxID From PersonTax Where lngTaxID = " & lngID
           Case 1
                strSql = "Select lngPersonTaxID From Salary Where lngPersonTaxID = " & lngID
    End Select
    
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    IsUsePaymentMethodID = (recRecordset.RowCount >= 1)
    recRecordset.Close
End Function

' 部门职员ID
Public Property Get ListID(ByVal intTab As Integer) As Long
    With mclsList(intTab).FlexGrid
    If .TextArray(.Row * .Cols) <> "" And .Row > 0 Then
        ListID = CLng(.TextArray(.Row * .Cols))
    Else
        ListID = 0
    End If
    End With
End Property

' 部门职员停用标志
Public Property Get ListIsInActive(ByVal intTab As Integer) As Boolean
    If chkShowAll.Value Then
        With mclsList(intTab).FlexGrid
            ListIsInActive = Not (.TextArray(.Row * .Cols + 1) = "")
        End With
    Else
        ListIsInActive = False
    End If
End Property

'根据列表中记录数，设置菜单可用属性
Private Sub UpdateMenuStatus()
    Dim blnIsnotEmpty As Boolean
    Dim blnFindNoChange As Boolean
    With mclsList(sstTypAct.Tab).FlexGrid
        If .Rows > 1 And .ColSel <> 0 And .RowHeight(.Row) > 0 Then
            blnIsnotEmpty = True
        Else
            blnIsnotEmpty = False
        End If
    End With
    With frmMain
        .mnuEditEdit.Caption = "修改(&N)"
        .mnuEditNew.Caption = "新增(&E)"
        .mnuEditDel.Caption = "删除(&D)"
        .mnuEditCopy.Enabled = blnIsnotEmpty
        .mnuEditEdit.Enabled = blnIsnotEmpty
        .mnuEditNew.Enabled = True
        .mnuEditDel.Enabled = blnIsnotEmpty
        If sstTypAct.Tab = 0 Then
            .mnuEditInActive.Enabled = blnIsnotEmpty
            .mnuEditShowAll.Checked = chkShowAll.Value
            .mnuEditShowAll.Enabled = True
        Else
            .mnuEditInActive.Enabled = False
            .mnuEditShowAll.Checked = chkShowAll.Value
            .mnuEditShowAll.Enabled = False
        End If
        .mnuEditUse.Enabled = blnIsnotEmpty
        .mnuEditSearch.Enabled = True
        .mnuEditColumn.Enabled = True
        .mnuEditFilter.Enabled = True
        .mnuFilePrint.Enabled = True
        .mnuFilePrintSetup.Enabled = True
        .mnuReportQuick.Enabled = blnIsnotEmpty
        .mnuToolRefresh.Enabled = True
    End With
    
    If mclsList(sstTypAct.Tab).FlexGrid.ColSel = 0 Then  '无当前选定行
        blnFindNoChange = mclsList(sstTypAct.Tab).FindNoChange
        mclsList(sstTypAct.Tab).FindNoChange = True
        txtFind.Text = ""
        mclsList(sstTypAct.Tab).FindNoChange = blnFindNoChange
        cmdAgain.Enabled = False
    End If
End Sub

'重画Form
Private Sub RedrawForm()
    On Error Resume Next
    #If conVersionType = 8 Then
        With sstTypAct
            .top = 500 ' Me.top + txtFind.Height + 100
            .Left = ListFormLeft - 50
            .Width = Me.ScaleWidth - ListFormLeft - ListFormRight + 150
            .Height = Me.ScaleHeight - ListUpAreaHeight - ListDownAreaHeight + 100
        End With
        
            '重画MS FlexGrid 控件
            With mclsList(sstTypAct.Tab).FlexGrid
                .top = sstTypAct.top - sstTypAct.TabHeight - 200
                .Left = ListGridLeft - 100
                .Width = sstTypAct.Width - ListGridLeft - ListGridRight + 150
                .Height = sstTypAct.Height - ListGridTop - ListGridBottom + 250 '- sstTypAct.TabHeight '- ListGridTop - ListGridBottom '+ 250
                
    '        .Left = ListFormLeft
    '        .Width = Me.ScaleWidth - ListFormLeft - ListFormRight
    '        .Height = Me.ScaleHeight - ListUpAreaHeight - ListDownAreaHeight
            End With
            txtFind.Width = Me.ScaleWidth - txtFind.Left - ListFormBottom - cmdAgain.Width - 15
            cmdAgain.Left = txtFind.Left + txtFind.Width
            cmdTypact(0).top = Me.ScaleHeight - cmdTypact(0).Height - ListFormBottom
            cmdTypact(1).top = cmdTypact(0).top
            chkShowAll.top = cmdTypact(0).top
            chkShowAll.Left = Me.ScaleWidth - chkShowAll.Width - ListFormBottom
    #Else
        With sstTypAct
            .Left = ListFormLeft
            .Width = Me.ScaleWidth - ListFormLeft - ListFormRight
            .Height = Me.ScaleHeight - ssTabUpAreaHeight - ListDownAreaHeight
        End With
        '重画MS FlexGrid 控件
        With mclsList(sstTypAct.Tab).FlexGrid
            .Left = ListGridLeft
            .Width = sstTypAct.Width - ListGridLeft - ListGridRight
            .Height = sstTypAct.Height - sstTypAct.TabHeight - ListGridTop - ListGridBottom
        End With
    
    
    '重画其余控件
    txtFind.Width = Me.ScaleWidth - txtFind.Left - ListFormBottom - cmdAgain.Width - 15
    cmdAgain.Left = txtFind.Left + txtFind.Width
    cmdTypact(0).top = Me.ScaleHeight - cmdTypact(0).Height - ListFormBottom
    cmdTypact(1).top = cmdTypact(0).top
    
    chkShowAll.top = cmdTypact(0).top
    chkShowAll.Left = Me.ScaleWidth - chkShowAll.Width - ListFormBottom
#End If
End Sub


'命令控件数组
Private Sub cmdTypact_Click(Index As Integer)
    Dim PosX, PosY As Integer
    
    PosX = cmdTypact(Index).Left
    PosY = cmdTypact(Index).top + cmdTypact(Index).Height
    With frmMain
        Select Case Index
               Case 0
                    MakeListEditMenu
                    PopupMenu .mnuListEdit, , PosX, PosY
               
               Case 1
                    MakeListReportMenu (getDepEmp())
                    PopupMenu .mnuListReport, , PosX, PosY
        End Select
    End With
End Sub

'取部门职员
Private Function getDepEmp() As String
    Dim strDepEmp As String
    Dim i As Integer
    
    Select Case sstTypAct.Tab
           Case 0
                If msgItemType.Row > 0 And msgItemType.ColSel > 0 Then
                    With msgItemType
                      .Redraw = False
                      For i = 1 To .Cols - 1
                          If .TextMatrix(0, i) = "商品类型名称" Then
                             strDepEmp = .TextMatrix(.Row, i)
                             Exit For
                          End If
                      Next
                      .Redraw = True
                    End With
                Else
                   strDepEmp = ""
                   
                End If
           Case 1
                If msgItem.Row > 0 And msgItem.ColSel > 0 Then
                   With msgItem
                        .Redraw = False
                        For i = 1 To .Cols - 1
                            If .TextMatrix(0, i) = "商品名称" Then
                               strDepEmp = .TextMatrix(.Row, i)
                               Exit For
                            End If
                        Next
                        .Redraw = True
                   End With
                Else
                    strDepEmp = ""
                End If
                
    End Select
    getDepEmp = strDepEmp
    
End Function


'
'窗体 Form 控件
'
Private Sub Form_Load()
    Dim i As Integer
    Dim intSortCol As Integer
    Me.Hide
    Me.Left = -30000
    MsgForm.PleaseWait
    SetHelpID Me.hwnd, 30033
    '部门职员列表窗体初始化
    Debug.Print "Load Start: ", Timer
    intViewID(0) = 61
    intViewID(1) = 60
    For i = 0 To 1
        Set mclsList(i) = New list
        Set mclsList(i).FindKind = cboFindKind
        'Set mclsList(i).Again = cmdAgain
        Set mclsList(i).Find = txtFind
    Next
    Set mclsList(0).FlexGrid = msgItemType
    Set mclsList(1).FlexGrid = msgItem
     
    '设置钩子对象
    Set mclsSubClass = New SubClass32.SubClass

    mclsSubClass.Messages(WM_PAINT) = True
    mclsSubClass.Messages(WM_LBUTTONUP) = True
    mclsSubClass.Messages(WM_LBUTTONDOWN) = True
    mclsSubClass.Messages(WM_MOUSEMOVE) = True
    
    Set mclsSubClassform = New SubClass32.SubClass
    mclsSubClassform.hwnd = Me.hwnd
    mclsSubClassform.Messages(WM_GETMINMAXINFO) = True
    Unload MsgForm
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
'    If sstTypAct.Tab = 0 Then
'        sstTypAct_Click 0
'    Else
'        sstTypAct.Tab = 0
'    End If
    
    Debug.Print "Load End: ", Timer
    #If conVersionType = 8 Then
        sstTypAct.TabEnabled(1) = False
        sstTypAct.TabVisible(1) = False
        sstTypAct.TabVisible(0) = False
        msgItemType.Height = 2500
    #End If
End Sub

'右键菜单
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton And frmMain.ActiveForm Is Me Then
        MakeListEditMenu
        PopupMenu frmMain.mnuListEdit
    End If
End Sub

Private Sub Form_Paint()
   ' DrawInSertLine Me.hwnd, ListFormLeft, 500, Me.Width - 2 * (ListFormLeft + ListFormRight), 500
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode = vbFormControlMenu Then
        Select Case True
            Case mIsShowCard(0)
                MsgBox "请先关闭商品税率卡片！", vbExclamation
                Cancel = True
                frmItemTaxListCard.Show
                frmItemTaxListCard.ZOrder 0
            Case mIsShowCard(1)
                MsgBox "请先关闭个人所得税率卡片！", vbExclamation
                Cancel = True
                frmPersonTaxListCard.Show