fixedtypelist.frm

金算盘软件代码

                    End If
                End If
        End Select
        UpdateMenuStatus
    End With
End Sub

'全部显示/显示未停用记录
Private Sub mclsMainControl_EditShowAll()
    frmMain.mnuEditShowAll.Checked = Not frmMain.mnuEditShowAll.Checked
    If chkShowAll.Value = 0 Then
        chkShowAll.Value = 1
    Else
        chkShowAll.Value = 0
    End If
End Sub

'引用编码
Private Sub mclsMainControl_EditUse()
     Select Case sstTypAct.Tab
        Case 0
            UseCode Message.msgFixed, ListID(0)
        Case 1
            UseCode Message.msgFixedMethod, ListID(1)
     End Select
     Me.ZOrder 1
End Sub

'搜索
Private Sub mclsMainControl_EditSearch()
    frmTreeFind.ShowFind
End Sub

'刷新
Private Sub mclsMainControl_ToolRefresh()
    Me.MousePointer = vbHourglass
    ToolRefresh sstTypAct.Tab
    Me.MousePointer = vbDefault
End Sub

Private Sub mclsMainControl_FilePrint()
    Dim myPrintclass As PrintClass
    
    Set myPrintclass = New PrintClass
    mclsList(sstTypAct.Tab).ReGetColCaption
    Select Case sstTypAct.Tab
        Case 0
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstTypAct.Tab).FlexGrid, 27, "固资类型列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
        Case 1
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstTypAct.Tab).FlexGrid, 28, "变动方式列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    End Select
    mclsList(sstTypAct.Tab).AddReGetColCaption
    Set myPrintclass = Nothing
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Select Case intIndex
    Case 0:
        mclsMainControl_EditEdit
    Case 1:
        mclsMainControl_EditNew
    Case 2:
        mclsMainControl_EditDel
    Case 4:
        mclsMainControl_EditInActive
    Case 5:
        mclsMainControl_EditShowAll
    Case 7:
        mclsMainControl_EditUse
    Case 8:
        mclsMainControl_EditSearch
    Case 10:
        mclsMainControl_EditFilter
    Case 11:
        mclsMainControl_EditColumn
    Case 13:
        mclsMainControl_ToolRefresh
    Case 14:
        mclsMainControl_FilePrint
    End Select
End Sub

'
' 编辑菜单
'
Private Sub MakeListEditMenu()
    Dim intCnt As Integer
    
    With frmMain
        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCnt)
        Next
        
        Utility.CloneMenu .mnuEditEdit, .mnuListEditMenu(0)
        
        Load .mnuListEditMenu(1)
        Utility.CloneMenu .mnuEditNew, .mnuListEditMenu(1)
        
        Load .mnuListEditMenu(2)
        Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(2)
        .mnuListEditMenu(2).Caption = "删除(&D)"
        Load .mnuListEditMenu(3)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(3)
        
        Load .mnuListEditMenu(4)
        Utility.CloneMenu .mnuEditInActive, .mnuListEditMenu(4)
        .mnuListEditMenu(4).Caption = "停用(&H)"
        .mnuListEditMenu(4).Visible = True
        
        Load .mnuListEditMenu(5)
        Utility.CloneMenu .mnuEditShowAll, .mnuListEditMenu(5)
        .mnuListEditMenu(5).Caption = "全部显示(&W)"
        .mnuListEditMenu(5).Visible = True
        
        Load .mnuListEditMenu(6)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(6)
        .mnuListEditMenu(6).Visible = True
        
        Load .mnuListEditMenu(7)
        Utility.CloneMenu .mnuEditUse, .mnuListEditMenu(7)
        Load .mnuListEditMenu(8)
        Utility.CloneMenu .mnuEditSearch, .mnuListEditMenu(8)
        .mnuListEditMenu(8).Visible = False
        
        Load .mnuListEditMenu(9)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(9)
        .mnuListEditMenu(9).Visible = False
        
        Load .mnuListEditMenu(10)
        Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(10)
        Load .mnuListEditMenu(11)
        Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(11)
        
        Load .mnuListEditMenu(12)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(12)
        
        Load .mnuListEditMenu(13)
        Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(13)
        Load .mnuListEditMenu(14)
        Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(14)
    End With
End Sub

'
' 报表菜单
'
Private Sub MakeListReportMenu(Optional ByVal EditObject As String = "")
    Dim intCnt As Integer
    
    With frmMain
        For intCnt = .mnuListReportMenu.Count - 1 To 1 Step -1
            Unload .mnuListReportMenu(intCnt)
        Next
        .mnuListReportMenu(0).Caption = "固资类型一览表"
        .mnuListReportMenu(0).Enabled = False
        .mnuListReportMenu(0).Visible = True
            
        Load .mnuListReportMenu(1)
        .mnuListReportMenu(1).Caption = "变动方式一览表"
        .mnuListReportMenu(1).Enabled = False
        .mnuListReportMenu(1).Visible = True
        If sstTypAct.Tab = 0 Then
           .mnuListReportMenu(0).Enabled = True
           .mnuListReportMenu(1).Enabled = False
        Else
           .mnuListReportMenu(0).Enabled = False
           .mnuListReportMenu(1).Enabled = True
        End If
    End With
End Sub

Private Sub ToolRefresh(intTab As Integer)
      Dim i As Integer
      Dim strOldText As String
      Dim strOldSort As String
   
      '保存当前排序列
      strOldSort = cboFindKind.Text
      strOldText = mclsList(intTab).FlexGrid.TextMatrix(mclsList(intTab).FlexGrid.Row, mclsList(intTab).SortCol)
      mclsList(intTab).FlexGrid.Redraw = False
      mclsList(intTab).SaveListColWidth
      '刷新列表记录
      mclsList(intTab).FlexGrid.Cols = 0
      mclsList(intTab).ListSet.ViewId = intViewID(intTab)
      Set datItem(intTab).Resultset = GetList(intTab)
      If Not datItem(intTab).Resultset.EOF Then datItem(intTab).Resultset.MoveLast
      datItem(intTab).Resultset.Close
      Set datItem(intTab).Resultset = Nothing
    
      '设置FlexGrid列表
      mclsList(intTab).SetFlexGrid
      
      '恢复以前排序列
      cboFindKind.Text = strOldSort
      cboFindKind.Text = strOldSort
      mclsList(intTab).FlexGrid.Redraw = False
      If mclsList(intTab).FlexGrid.Rows > 1 Then
          txtfind.Text = strOldText
      End If
      If chkShowAll.Value = 0 Then mclsList(intTab).DoShowAll False
      '更新菜单状态
      UpdateMenuStatus
      mclsList(intTab).FlexGrid.Redraw = True
End Sub

Private Sub txtFind_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim intSelLen As Integer
    
    If KeyCode = 8 Then
        intSelLen = txtfind.SelLength
        If txtfind.SelStart > 0 Then txtfind.SelStart = txtfind.SelStart - 1
        txtfind.SelLength = intSelLen + 1
    End If
End Sub
Private Sub CeaseLower()
    Dim Flage As String
    Dim Code As String
    Dim strOldSortCol As String
    Dim strOldSortText As String
    Dim strSql As String
    Dim intSortCol As Integer
    Dim blnreStore As Boolean
    Dim intResponse As String
    Dim blnRemark As Boolean
    Dim intOldRow As Integer
    blnreStore = False
    
    With mclsList(0).FlexGrid
        strOldSortCol = cboFindKind.Text
        strOldSortText = .TextMatrix(.Row, mclsList(0).SortCol)
        intOldRow = .Row
        blnRemark = ListIsInActive(0)
        For intSortCol = 2 To .FixedCols - 1
            If .TextMatrix(0, intSortCol) = "固定资产类别编码" Or .TextMatrix(0, intSortCol) = "固定资产类别编码↑" Or .TextMatrix(0, intSortCol) = "固定资产类别编码↓" Then
                Code = .TextMatrix(.Row, intSortCol)
                Exit For
            End If
        Next intSortCol
        If mclsList(0).ListSet.ColumnOrderType(intSortCol - 1) <> 1 Then
            cboFindKind.Text = "固定资产类别编码" '排序
            txtfind.Text = Code
            blnreStore = True
        End If
        
        Dim intNewRow As Integer
   
        If UpdateIsActive(Code, Not blnRemark) Then
            If chkShowAll.Value Then
                If .TextMatrix(.Row, 1) = "" Then
                    .TextMatrix(.Row, 1) = "√"
                Else
                    .TextMatrix(.Row, 1) = ""
                End If
            Else
                .TextMatrix(.Row, 1) = "√"
                .RowHeight(.Row) = 0
              '  mclsList.SetFlexRow
            End If
            Flage = .TextMatrix(.Row, 1)
            If Flage <> "" Then
                intNewRow = .Row + 1
                Code = Code & "-"
                Do
                    If intNewRow > .Rows - 1 Then Exit Do
                    If InStr(1, .TextMatrix(intNewRow, intSortCol), Code, 1) = 0 Then
                         Exit Do
                     Else
                        .TextMatrix(intNewRow, 1) = Flage
                        If chkShowAll.Value <> 1 Then .RowHeight(intNewRow) = 0
                         intNewRow = intNewRow + 1
                     End If
                Loop
            Else
                Dim i As Integer
                .TextMatrix(.Row, 1) = Flage
                i = 1
                If .Row < .Rows - 1 Then
                    If UCase(.TextMatrix(.Row + 1, intSortCol)) Like UCase(.TextMatrix(.Row, intSortCol)) & "-*" Then
                        intResponse = ShowMsg(Me.hwnd, "是否取消所有下级的停用标记", vbYesNo, Me.Caption)
                        If intResponse = vbYes Then
                            strSql = "UPDATE FixedType SET blnIsInActive =  0 WHERE  strFixedTypeCode like '" & .TextMatrix(.Row, intSortCol) & "-*'"
                            If gclsBase.ExecSQL(strSql) Then
                                Do Until Not UCase(.TextMatrix(.Row + i, intSortCol)) Like UCase(.TextMatrix(.Row, intSortCol)) & "-*"
                                    .TextMatrix(.Row + i, 1) = Flage
                                    If .Row + i = .Rows - 1 Then
                                        Exit Do
                                    Else
                                        i = i + 1
                                    End If
                                Loop
                            End If
                        End If
                    End If
                End If
                Dim strOldText As String
                If CodePrefix(.TextMatrix(.Row, intSortCol)) <> "" Then
                   Do Until CodePrefix(.TextMatrix(.Row, intSortCol)) = ""
                           ' If .RowHeight(.Row) > 0 Then
                           strOldText = txtfind.Text
                            txtfind.Text = CodePrefix(.TextMatrix(.Row, intSortCol))
                            If txtfind.Text <> CodePrefix(strOldText) Then Exit Do
                            .TextMatrix(.Row, 1) = Flage
                    Loop
                End If
            End If
            If chkShowAll.Value <> 1 Then mclsList(0).SetFlexRow
            gclsSys.SendMessage CStr(Me.hwnd), Message.msgFixed
        End If
      
        '恢复旧的排序
        If blnreStore Then
            cboFindKind.Text = strOldSortCol
            txtfind.Text = strOldSortText
        End If
     End With
End Sub
'更新停用标志
Private Function UpdateIsActive(ByVal strCode As String, ByVal blnIsInActive As Boolean) As Boolean
    Dim strSql As String
    If blnIsInActive Then
        strSql = "UPDATE FixedType SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strFixedTypecode='" & strCode & "' Or strFixedTypecode like '" & strCode & "-*'"
    Else
        strSql = "UPDATE FixedType SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strFixedTypecode  in  ('" & strCode
        Do Until CodePrefix(strCode) = ""
            strCode = CodePrefix(strCode)
            strSql = strSql & "','" & strCode
        Loop
        strSql = strSql & "')"
    End If
    UpdateIsActive = gclsBase.ExecSQL(strSql)
End Function
Private Function UpDatePreFlage(ByVal intTab As Integer) As Boolean
    Dim i As Integer
    Dim intCol
    Dim strOldSort As String
    Dim strOldCol As String
    Dim strSql As String
    Dim recTemplete As rdoResultset
    Dim strOldCode As String
    With mclsList(intTab).FlexGrid
        '.Redraw = False
        Select Case intTab
            Case 0
                strOldCol = cboFindKind.Text
                strOldSort = txtfind.Text
                strOldCode = CodePrefix(.TextMatrix(.Row, GetCol("固定资产类别编码")))
                intCol = GetCol("末级标志")
                If intCol > 0 Then
                    strSql = "select blnIsDetail from FixedType where strFixedTypecode='" & strOldCode & "'"
                    Set recTemplete = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    If Not recTemplete.EOF Then
                        If recTemplete!blnIsDetail Then
                            If mclsList(intTab).ListSet.ColumnOrderType(GetCol("固定资产类别编码") - 1) <> 1 Then cboFindKind.Text = "统计编码"
                            txtfind.Text = strOldCode 'CodePrefix(.TextMatrix(.Row, GetCol("科目编码",0)))
                            .TextMatrix(.Row, intCol) = "是"
                        End If
                    End If
                    recTemplete.Close
                End If
                cboFindKind.Text = strOldCol
                cboFindKind.Text = strOldCol
                txtfind.Text = strOldSort
        End Select
       ' .Redraw = True
    End With
End Function
Private Function GetCol(ByVal strColName As String) As Integer
    Dim i As Integer
    With mclsList(0).FlexGrid
         For i = 1 To .Cols - 1
             If .TextMatrix(0, i) = strColName Or .TextMatrix(0, i) = strColName & "↑" Or .TextMatrix(0, i) = strColName & "↓" Then
                GetCol = i
                Exit For
             End If
         Next
    End With
End Function
Public Function BindingResultSet()
    Me.Hide
    If sstTypAct.Tab = 0 Then
        sstTypAct_Click 0
    Else
        sstTypAct.Tab = 0
    End If
    Me.Show
    Me.ZOrder 0
End Function