frmitemlist.frm

金算盘软件代码

                End If
        Case 4
            strSelectOfSql = "Select Position.lngPositionID As id,decode(Position.blnIsInActive,1,'√','') As ""停用""," & strSelectOfSql
                If Trim(strWhereOfSql) <> "" Then
                   strWhereOfSql = " Where " & strWhereOfSql
                End If
        Case 5
            strSelectOfSql = "Select Item.lngItemID As id,decode(Item.blnIsInActive,1,'√','') As ""停用""," & strSelectOfSql
                If Trim(strWhereOfSql) <> "" Then
                   strWhereOfSql = " Where " & strWhereOfSql
                End If
        End Select
    strSql = strSelectOfSql & strFromOfSql & strWhereOfSql
    'Debug.Print strSql
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    
    '列表是否为空
    If recRecordset.RowCount = 0 Then
        mclsList(intTab).FlexGrid.HighLight = flexHighlightNever
        cmdAgain.Enabled = False
    Else
        If intTab <> 5 Then
            mclsList(intTab).FlexGrid.HighLight = flexHighlightAlways
        Else
            mclsList(intTab).FlexGrid.HighLight = flexHighlightNever
        End If
        cmdAgain.Enabled = True
    End If
    mclsList(intTab).ShowAll = True
    Set GetList = recRecordset
End Function
Public Function ShowList(ByVal lngID As Long, Optional intTab As Integer = 0) As Boolean
    Dim intCount As Integer
    Dim strSortField As String
    Dim strSortDec As String
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim strofFrom As String
    Dim strofWhere As String
'    Me.Show
'    Me.ZOrder 0
    With frmMain.mnuListItem
        If IsNumeric(.Tag) Then
            If CLng(.Tag) > 0 Then
                BringWindowToTop .Tag
            Else
                Me.BindingResultSet
            End If
        Else
            Me.BindingResultSet
        End If
    End With
    Me.sstTypAct.Tab = intTab
    With mclsList(intTab).ListSet
        '得到排序字段
        For intCount = 1 To .Columns
            If .ColumnOrderType(intCount) <> 0 Then
                strSortField = .ColumnFieldName(intCount)
                strSortDec = .ColumnDesc(intCount)
                Exit For
            End If
        Next
        If intCount > .Columns Then
            ShowList = False
            Exit Function
        End If
        strofFrom = .FromOfSql
        strofWhere = .WhereOfSql
    End With
    '根据lngID得到排序字段值
    strSql = "Select " & strSortField & " As " & strSortDec
    Select Case intTab
        Case 0
            Me.msgItemType.SetFocus
            If strofWhere <> "" Then
                strofWhere = " where " & strofWhere & " and ItemType.lngItemTypeID=" & lngID
            Else
                strofWhere = " where ItemType.lngItemTypeID=" & lngID
            End If
        Case 1
            Me.msgItemNature.SetFocus
            If strofWhere <> "" Then
                strofWhere = " where " & strofWhere & " and ItemNature.lngItemNatureID=" & lngID
            Else
                strofWhere = " where ItemType.lngItemTypeID=" & lngID
            End If
        Case 2
            Me.msgItem.SetFocus
            If strofWhere <> "" Then
                strofWhere = " where " & strofWhere & " and Item.lngItemID=" & lngID
            Else
                strofWhere = " where Item.lngItemID=" & lngID
            End If
        Case 3
            Me.msgTax.SetFocus
            If strofWhere <> "" Then
                strofWhere = " where " & strofWhere & " and Tax.lngTaxID=" & lngID
            Else
                strofWhere = " where Tax.lngTaxID=" & lngID
            End If
        Case 4
            Me.msgPostion.SetFocus
            If strofWhere <> "" Then
                strofWhere = " where " & strofWhere & " and Position.lngPositionID=" & lngID
            Else
                strofWhere = " where Position.lngPositionID=" & lngID
            End If
        Case 5
            Me.msgStock.SetFocus
            If strofWhere <> "" Then
                strofWhere = " where " & strofWhere & " and Item.lngItemID=" & lngID
            Else
                strofWhere = " where Item.lngItemID=" & lngID
            End If
    End Select
    strSql = strSql & strofFrom & strofWhere
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    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 = 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 ItemType Where lngItemTypeID = " & lngID
        Case 1
            strSql = "Select * From ItemNature Where lngItemNatureID = " & lngID
        Case 2
            strSql = "Select * From Item Where lngItemID = " & lngID
        Case 3
            strSql = "Select * From Tax Where lngTaxID = " & lngID
        Case 4
            strSql = "Select * From Position Where lngPositionID = " & lngID
        Case 5
        
    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 ItemType SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE lngItemTypeID = " & lngID
       
        Case 2
            strSql = "UPDATE Item SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE lngItemID = " & lngID
        Case 3
            strSql = "UPDATE Tax SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE lngTaxID = " & lngID
        Case 4
            strSql = "UPDATE Position SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE lngPositionID = " & lngID
        Case 5
        
    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 ItemType WHERE lngItemTypeID = " & lngID
        Case 1
            strSql = "Delete  From Item WHERE lngItemID = " & lngID
        Case 2
        
        Case 3
        
        Case 4
            strSql = "Delete  From Position WHERE lngPositionID = " & lngID
        Case 5
        
    End Select
    DelByPaymentMethodID = gclsBase.ExecSQL(strSql)
End Function

'判断部门职员ID是否使用
Private Function IsUsePaymentMethodID(ByVal lngID As Long) As Boolean
'    Dim recRecordset As Recordset
'    Dim strSql As String
'
'    Select Case sstTypAct.Tab
'           Case 0
'                strSql = "Select lngItemTypeID From Item Where lngItemTypeID = " & lngID
'           Case 1
'                 strSql = "SELECT lngItemID FROM Class1" _
'                       & " WHERE EXISTS(SELECT Ab.lngItemID FROM PositionItemDaily AS Ab WHERE Ab.lngItemID=" & lngID & ")" _
'                       & " OR EXISTS (SELECT Ap.lngItemID FROM ARAPInit AS Ap WHERE Ap.lngItemID=" & lngID & ")" _
'                       & " OR EXISTS (SELECT Bg.lngItemID FROM BudgetBalance AS Bg WHERE Bg.lngItemID=" & lngID & ")" _
'                       & " OR EXISTS (SELECT Cp.lngItemID FROM LendItemDetail AS Cp WHERE Cp.lngItemID=" & lngID & ")" _
'                       & " OR EXISTS (SELECT It.lngItemID FROM ItemActivityDetail AS It WHERE It.lngItemID=" & lngID & ")" _
'                       & " OR EXISTS (SELECT Pc.lngItemID FROM PurchaseorderDetail AS Pc WHERE Pc.lngItemID=" & lngID & ")" _
'                       & " OR EXISTS (SELECT So.lngItemID FROM SaleOrderDetail AS So WHERE So.lngItemID=" & lngID & ")" _
'                       & " OR EXISTS (SELECT St.lngItemID FROM StockTakingDetail AS St WHERE St.lngItemID=" & lngID & ")" _
'                       & " OR EXISTS (SELECT TV.lngItemID FROM  TransVoucherDetail AS TV WHERE TV.lngItemID=" & lngID & ")" _
'
'                'strSQL = "Select lngItemID From ItemActivityDetail Where lngItemID = " & lngID
'    End Select
'
'    Set recRecordset = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
'    IsUsePaymentMethodID = (recRecordset.RecordCount >= 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
    Dim IsHaveRight As Boolean
    Select Case sstTypAct.Tab
        Case 0, 1, 2
            IsHaveRight = IsCanDo(16, gclsBase.OperatorID)
        Case 3
            IsHaveRight = IsCanDo(19, gclsBase.OperatorID)
        Case 4
            IsHaveRight = IsCanDo(18, gclsBase.OperatorID)
    End Select
    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 = "修改(&E)"
        .mnuEditNew.Caption = "新增(&N)"
        .mnuEditDel.Caption = "删除(&D)"
        .mnuEditCopy.Enabled = blnIsnotEmpty
        .mnuEditEdit.Enabled = blnIsnotEmpty And IsHaveRight
        .mnuEditNew.Enabled = True And IsHaveRight
        .mnuEditDel.Enabled = blnIsnotEmpty And IsHaveRight
        .mnuEditInActive.Checked = False
        .mnuEditInActive.Visible = False
        If sstTypAct.Tab = 0 Or sstTypAct.Tab = 2 Or sstTypAct.Tab = 3 Or sstTypAct.Tab = 4 Then
            .mnuEditInActive.Enabled = blnIsnotEmpty And IsHaveRight
            .mnuEditShowAll.Checked = chkShowAll.Value
            .mnuEditShowAll.Enabled = True
        Else
            .mnuEditInActive.Enabled = False And IsHaveRight
            '.mnuEditShowAll.Checked = chkShowall.Value
            .mnuEditShowAll.Enabled = False
            
        End If
        .mnuEditUse.Enabled = blnIsnotEmpty
        If sstTypAct.Tab = 2 Or sstTypAct.Tab = 4 Then
            .mnuEditNotepad.Enabled = blnIsnotEmpty
        Else
            .mnuEditNotepad.Enabled = False
        End If
        .mnuEditSearch.Enabled = True
        .mnuEditColumn.Enabled = True
        .mnuEditFilter.Enabled = True
        .mnuFilePrint.Enabled = True
        .mnuFilePrintSetup.Enabled = True
        .mnuReportQuick.Enabled = blnIsnotEmpty
        .mnuToolRefresh.Enabled = True
        If sstTypAct.Tab = 5 Then
            .mnuEditNew.Enabled = False
            .mnuEditEdit.Enabled = False
            .mnuEditDel.Enabled = False
            .mnuEditShowAll.Enabled = False
            .mnuEditInActive.Enabled = False
            .mnuEditUse.Enabled = False
            .mnuEditNotepad.Enabled = False
            .mnuEditSearch.Enabled = False
            .mnuEditSearch.Enabled = False
            .mnuEditColumn.Enabled = False
        End If
    End With
    
    #If conVersionType <> 16 Then
        If sstTypAct.Tab = 2 Then
            If mclsList(2).FlexGrid.Rows > 1 Then
                cmdTypact(4).Enabled = True
            Else
                cmdTypact(4).Enabled = False
            End If
        Else
            cmdTypact(4).Enabled = False
        End If
    #End If
    
    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
    frmMain.SetToolBar
End Sub

'重画Form
Private Sub RedrawForm()
    On Error Resume Next
    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
    cmdTypact(2).top = cmdTypact(0).top
    cmdTypact(3).top = cmdTypact(0).top