frmlistclass.frm

金算盘软件代码

Private Sub sstTypAct_Click(PreviousTab As Integer)
    With sstTypAct
        Set mclsList(0).Again = Nothing
        Set mclsList(1).Again = Nothing
        mclsList(0).FlexGrid.TabStop = False
        mclsList(1).FlexGrid.TabStop = False
        mclsList(.Tab).FlexGrid.TabStop = True
        Set mclsList(.Tab).Again = cmdAgain
        mclsList(.Tab).FlexNoChange = True
        mclsList(.Tab).FindNoChange = True
         '改变钩子对象的作用窗体
        mclsSubClass.hwnd = mclsList(.Tab).FlexGrid.hwnd
        If Not blnIsLoad(.Tab) Then
            mclsList(.Tab).FlexGrid.Redraw = False
            '得到列表记录集
            mclsList(.Tab).ListSet.ViewId = intViewID(.Tab)
            mclsList(.Tab).InitFlexGrid
            Set datItem(.Tab).Resultset = GetList(.Tab)
            If Not datItem(.Tab).Resultset.EOF Then datItem(.Tab).Resultset.MoveLast
            datItem(.Tab).Resultset.Close
            'Set datItem(.Tab).Recordset = Nothing
            mclsList(.Tab).SetFlexGrid
           
            '初始化查找复合列表框
            mclsList(.Tab).InitcboFindKind
            '重画窗体
            mclsList(.Tab).FlexGrid.Redraw = False
            'RedrawForm
            '定位到第一行
            With mclsList(.Tab).FlexGrid
                If .Rows > 1 Then
                    mclsList(sstTypAct.Tab).FlexNoChange = False
                    .Row = 1
                    mclsList(sstTypAct.Tab).FlexNoChange = True
                End If
                .col = 0
                .ColSel = .Cols - 1
            
            
            End With
            mclsList(.Tab).DoShowAll False
            '重画列表线
           ' mclsList(.Tab).gridLineRefresh
            
            UpdateMenuStatus
            blnIsLoad(.Tab) = True
            mclsList(.Tab).FlexGrid.Redraw = True
        Else
            '恢复查找复合列表项
            mblnComboxNoClick = True
            mclsList(.Tab).InitcboFindKind
            mblnComboxNoClick = False
            '恢复查找内容
            If mclsList(.Tab).FlexGrid.Rows > 1 And mclsList(.Tab).FlexGrid.ColSel > 0 Then
                txtfind.Text = mclsList(.Tab).FlexGrid.TextMatrix(mclsList(.Tab).FlexGrid.Row, mclsList(.Tab).SortCol)
            Else
                txtfind.Text = ""
            End If
            UpdateMenuStatus
        End If
        '恢复“全部显示”复选框
        mblnCheckNoChange = True
        chkShowAll.Value = IIf(mclsList(.Tab).ShowAll, 1, 0)
        mblnCheckNoChange = False
'
        RedrawForm
        mclsList(.Tab).FlexNoChange = False
        mclsList(.Tab).FindNoChange = False
    End With
End Sub

'
'查找内容 TextBox 控件
'
Private Sub txtFind_Change()
    mclsList(sstTypAct.Tab).TextFind txtfind.Text
End Sub


'
' FLEXGRID控件
'

'双击FLEXGRID调用卡片
Private Sub msgPaymentMethod_DblClick()
    With mclsList(sstTypAct.Tab).FlexGrid
    If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 And frmMain.mnuEditEdit.Enabled Then
        mclsMainControl_EditEdit
    End If
    End With
End Sub

'恢复“停用”列光标
Private Sub msgItemType_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
   With msgItemType
        If Button = vbLeftButton Then
            If chkShowAll.Value = 1 And .ColSel > 0 And .MouseRow > 0 And .Row > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    .MousePointer = flexHourglass
                    mclsMainControl_EditInActive
                    .MousePointer = flexDefault
                End If
            End If
            UpdateMenuStatus
        End If
  End With
  
End Sub




'
'响应主控对象事件
'

'编辑卡片
Private Sub mclsMainControl_EditEdit()
    Dim lngID As Long
    lngID = ListID(sstTypAct.Tab)
    Me.Enabled = False
    Select Case sstTypAct.Tab
        Case 0
            If lngID > 0 Then
                If CheckIDUsed("Class1", "lngClassID", lngID) Then
'                    frmClass1ListCard.EditCard lngID
                    frmClass1Card.EditCard lngID, vbModal
                    Set frmClass1Card = Nothing
                Else
                    ShowMsg 0, "统计不存在,不能进行修改！", _
                           vbExclamation + MB_TASKMODAL, "修改统计"
                    ToolRefresh sstTypAct.Tab
                End If
            End If
        Case 1
            If lngID > 0 Then
                If CheckIDUsed("Class2", "lngClassID", lngID) Then
'                    frmClass2ListCard.EditCard lngID
                    frmClass2Card.EditCard lngID, vbModal
                    Set frmClass2Card = Nothing
                Else
                    ShowMsg 0, "项目不存在,不能进行修改！", _
                            vbExclamation + MB_TASKMODAL, "修改项目"
                    ToolRefresh sstTypAct.Tab
                End If
            End If
    End Select
    Me.Enabled = True
End Sub

'新增卡片
Private Sub mclsMainControl_EditNew()
    Select Case sstTypAct.Tab
        Case 0
'            frmClass1ListCard.AddCard
            frmClass1Card.AddCard , vbModal
            Set frmClass1Card = Nothing
        Case 1
'            frmClass2ListCard.AddCard
            frmClass2Card.AddCard , vbModal
            Set frmClass2Card = Nothing
    End Select
End Sub

'删除记录
Private Sub mclsMainControl_EditDel()
'
'
''    If mIsShowCard Then
''        If lngID = frmPaymentMethodCard.PaymentMethodID Then
''            MsgBox "不能删除当前编辑的付款方式！", vbExclamation
''            frmPaymentMethodCard.SetFocus
''            Exit Sub
''        End If
''    End If

    Dim blnSucess As Boolean
    Dim lngID As Long
    lngID = ListID(sstTypAct.Tab)
    blnSucess = False
    Select Case sstTypAct.Tab
        Case 0
            If mIsShowCard(0) Then
'                If lngID = frmClass1ListCard.ClassID And lngID > 0 Then
                If lngID = frmClass1Card.ClassID And lngID > 0 Then
                    MsgBox "不能删除正在编辑的统计", vbExclamation
                    frmClass1Card.EditCard lngID, vbModal
                    Set frmClass1Card = Nothing
'                    frmClass1ListCard.Show
'                    frmClass1ListCard.ZOrder 0
                    Exit Sub
                End If
            End If
'            If frmClass1ListCard.DelCard(ListID(sstTypAct.Tab)) Then
            If frmClass1Card.DelCard(ListID(sstTypAct.Tab)) Then
                UpDatePreFlage 0
                blnSucess = True
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgClass
            End If
            Unload frmClass1Card
            Set frmClass1Card = Nothing
            'If Not frmJobTypeListCard.Visible Then
'            Unload frmClass1ListCard
        Case 1
            If mIsShowCard(1) Then
'                If lngID = frmClass2ListCard.ClassID And lngID > 0 Then
                If lngID = frmClass2Card.ClassID And lngID > 0 Then
                    MsgBox "不能删除正在编辑的项目", vbExclamation
'                    frmClass2ListCard.Show
'                    frmClass2ListCard.ZOrder 0
                    frmClass2Card.EditCard lngID, vbModal
                    Set frmClass2Card = Nothing
                    Exit Sub
                End If
            End If
'            If frmClass2ListCard.DelCard(ListID(sstTypAct.Tab)) Then
            If frmClass2Card.DelCard(ListID(sstTypAct.Tab)) Then
                UpDatePreFlage 1
                blnSucess = True
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgClass2
            End If
            Unload frmClass2Card
            Set frmClass2Card = Nothing
            'If Not frmJobListCard.Visible Then
'            Unload frmClass2ListCard
    End Select
    If blnSucess Then
        With mclsList(sstTypAct.Tab).FlexGrid
            .RowHeight(.Row) = 0
            .RowData(.Row) = 1
        End With
        mclsList(sstTypAct.Tab).SetFlexRow
    End If
    UpdateMenuStatus
End Sub

'停用/启用记录
Private Sub mclsMainControl_EditInActive()
    With sstTypAct
        Select Case .Tab
            Case 0
                CeaseLower 0
            Case 1
                CeaseLower 1
'                If UpdateListInActive(.Tab, ListID(.Tab), Not ListIsInActive(.Tab)) Then
'                   With mclsList(.Tab).FlexGrid
'                        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(sstTypAct.Tab).SetFlexRow
'                        End If
'                   End With
'                    gclsSys.SendMessage CStr(Me.hwnd), Message.msgClass2
'                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.msgClass, ListID(0)
        Case 1
            UseCode Message.msgClass2, 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, 19, "统计核算列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
        Case 1
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstTypAct.Tab).FlexGrid, 20, "项目核算列表" & 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 9:
        mclsMainControl_EditNotepad
    Case 11:
        mclsMainControl_EditFilter
    Case 12:
        mclsMainControl_EditColumn
    Case 14:
        mclsMainControl_ToolRefresh
    Case 15:
        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)