frmlistright.frm

金算盘软件代码

    
'    Set recRecordset = GetByTermID(lngID)
'    'If recRecordset.RecordCount = 0 Then    '当前付款条件已被其他用户删除
'    '    mclsMainControl_ToolRefresh
''    'Else
'        If IsUseTermID(lngID) Then
'            MsgBox "当前编辑的付款条件正在使用，不能删除！", vbExclamation
'        Else
'            If recRecordset!blnIsDetail Then

'                If mIsShowCard Then
'                    If lngID = frmOperator.getID And lngID > 0 Then
'                        MsgBox "不能删除当前编辑的操作员！", vbExclamation
''                        frmOperator.Show
''                        frmOperator.ZOrder 0
'                        Exit Sub
'                    End If
'                End If
                If frmOperator.DelCard(lngID) Then
                   ' mclsMainControl_ToolRefresh
                   With msgTerm
                    .RowHeight(.Row) = 0
                    .RowData(.Row) = 1
                    mclsList.SetFlexRow
                   End With
                   gclsSys.SendMessage CStr(Me.hwnd), Message.msgright
                End If
                Unload frmOperator
                Set frmOperator = Nothing
                UpdateMenuStatus
                'If Not frmOperator.Visible Then
'                Unload frmOperator
                
                
'            Else
'              ShowMsg "不是末级编码，不能删除！", vbCritical, Me.Caption
'            End If
'        End If
'    'End If
'    recRecordset.Close
End Sub

'停用/启用记录
Private Sub mclsMainControl_EditInActive()
     If TermID = 0 Then Exit Sub
     If TermID = 1 Then
        ShowMsg Me.hwnd, "系统管理员不能停用", vbExclamation, Me.Caption
        Exit Sub
     End If
     If UpdateTermInActive(TermID, Not TermIsInActive) Then
        With msgTerm
            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
        End With
          gclsSys.SendMessage CStr(Me.hwnd), Message.msgClass
    End If
    UpdateMenuStatus
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_EditFilter()
   ' mclsList.Filter intViewID
   Dim blnFlage As Boolean
   'If Not mblnIsSaveListset Then
    If mclsList.ListSet.ListID < 1 Then mclsList.ListSet.SaveList
        'If Not FindlngViewID(intViewID) Then
       
   ' End If
    Filter.ShowFilter mclsList.ListSet.ListID, 1, , , , , blnFlage
    If Not blnFlage Then Exit Sub
    mclsList.SaveListSet
    mclsList.ListSet.ViewId = intViewID
    msgTerm.Cols = 0
    Set datTerm.Resultset = GetList()
    If Not datTerm.Resultset.EOF Then datTerm.Resultset.MoveLast
    datTerm.Resultset.Close
    'Set datTerm.Recordset = Nothing
    mclsList.SetFlexGrid
    UpdateMenuStatus
    '初始化查找复合列表框
    mclsList.InitcboFindKind
    If chkShowall.Value = 0 Then mclsList.DoShowAll False
End Sub

'栏目设置
Private Sub mclsMainControl_EditColumn()

    Dim strFind As String
    Dim strSort As String
    Dim intCount As Integer
    
    With msgTerm
        strFind = .TextMatrix(.Row, mclsList.SortCol)
        strSort = cboFindKind.Text
        If mclsList.ListSet.ShowListSet(intViewID) Then
            .Redraw = False
            msgTerm.Cols = 0
            Set datTerm.Resultset = GetList()
            If Not datTerm.Resultset.EOF Then datTerm.Resultset.MoveLast
            datTerm.Resultset.Close
            'Set datTerm.Recordset = Nothing
            mclsList.SetFlexGrid
            UpdateMenuStatus
            '初始化查找复合列表框
            mclsList.InitcboFindKind
            For intCount = 0 To cboFindKind.ListCount - 1
                If cboFindKind.list(intCount) = strSort Then
                    txtFind.Text = strFind
                    Exit For
                End If
            Next intCount
            If chkShowall.Value = 0 Then mclsList.DoShowAll False
            .Redraw = True
        End If
    End With
End Sub


'刷新
Private Sub mclsMainControl_ToolRefresh()
    Dim strOldSort As String
    Dim strOldText As String
    Me.MousePointer = vbHourglass
    With msgTerm
        '保存当前排序列
        strOldSort = cboFindKind.Text
        strOldText = .TextMatrix(.Row, mclsList.SortCol)
        mclsList.SaveListColWidth
        .Redraw = False
        '刷新列表记录
        .Cols = 0
        Set datTerm.Resultset = GetList()
        If Not datTerm.Resultset.EOF Then datTerm.Resultset.MoveLast
        datTerm.Resultset.Close
        'Set datTerm.Recordset = Nothing
        mclsList.SetFlexGrid
        '恢复以前排序列
        cboFindKind.Text = strOldSort
        cboFindKind.Text = strOldSort
        .Redraw = False
        If .Rows > 1 Then
            txtFind.Text = strOldText
        End If
        If chkShowall.Value = 0 Then mclsList.DoShowAll False
        '更新菜单状态
        UpdateMenuStatus
        .Redraw = True
        '发出付款条件消息
      
    End With
    Me.MousePointer = vbDefault
End Sub

'打印
Private Sub mclsMainControl_FilePrint()
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    mclsList.ReGetColCaption
    myPrintclass.PrintList gclsBase.BaseDB, mclsList.FlexGrid, 62, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    mclsList.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
           ' frmAuthorityGrp.EditAutherGrp "as"
        Case 7:
            mclsMainControl_EditFilter
        Case 8:
            mclsMainControl_EditColumn
        Case 10:
            mclsMainControl_ToolRefresh
        Case 11:
            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)
'        .mnuListEditMenu(7).Caption = "编辑权限组"
'
'        Load .mnuListEditMenu(8)
'        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(8)
        
        Load .mnuListEditMenu(7)
        Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(7)
        
        Load .mnuListEditMenu(8)
        Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(8)
        
        Load .mnuListEditMenu(9)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(9)
        
        Load .mnuListEditMenu(10)
        Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(10)
        Load .mnuListEditMenu(11)
        Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(11)
    End With
End Sub


'
' 报表菜单
'
Private Sub MakeListReportMenu()
    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 = True
        .mnuListReportMenu(0).Visible = True
        
        Load .mnuListReportMenu(1)
        .mnuListReportMenu(1).Caption = "权限组表"
        .mnuListReportMenu(1).Enabled = True
        .mnuListReportMenu(1).Visible = False
        
        Load .mnuListReportMenu(2)
        .mnuListReportMenu(2).Caption = "权限表"
        .mnuListReportMenu(2).Enabled = True
        .mnuListReportMenu(2).Visible = False
    End With
End Sub

'“钩子”事件
Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    '“钩子”事件处理
    mclsList.HookProc Msg, wParam, lParam, mclsSubClass
End Sub

'操作员权限表
Private Sub OperatorRightTable()
    
End Sub
'权限组表
Private Sub RightGTable()

End Sub
'权限表
Private Sub RightTable()

End Sub
Private Function CurrCodeName() As String
    Dim strCode As String
    Dim strName As String
    Dim i As Integer
    With mclsList.FlexGrid
        If .Row > 0 Then
            For i = 0 To mclsList.ListSet.FixColumns - 1
                If .TextMatrix(0, i + 2) = "统计名称" Or .TextMatrix(0, i + 2) = "统计名称↑" Or .TextMatrix(0, i + 2) = "统计名称↓" Then
                    strName = .TextMatrix(.Row, 2 + i)
                    Exit For
                End If
            Next
        End If
    End With
    CurrCodeName = Trim(strName)
End Function
Private Function GetCol(ByVal strColName As String) As Integer
    Dim i As Integer
    With mclsList.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
    Set datTerm.Resultset = GetList()
    If Not datTerm.Resultset.EOF Then datTerm.Resultset.MoveLast
    datTerm.Resultset.Close
    'Set datTerm.Recordset = Nothing
    mclsList.SetFlexGrid
    mclsList.InitcboFindKind
    mclsList.FlexNoChange = False
    mclsList.FindNoChange = False
    With msgTerm
        If .Rows > 1 Then msgTerm.Row = 1
        .col = 0
        .ColSel = .Cols - 1
    End With
    Debug.Print "Load End: ", Timer
    mclsList.DoShowAll False
    UpdateMenuStatus
    Me.Show
    Me.ZOrder 0
End Function