fixedtypelist.frm

金算盘软件代码

       End If
    End If
    mclsList(sstTypAct.Tab).FlexGrid.Redraw = True
End Sub


Private Sub mclsMainControl_ChildActive()

    Dim vntMessage As Variant
    
    SetHelpID Me.HelpContextID
    gclsSys.CurrFormName = Me.hwnd
    '响应消息
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = Message.msgFixed Then   '接收到固资类型改变消息
            ToolRefresh 0
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除固资类型改变消息
        ElseIf vntMessage = Message.msgFixedMethod Then      '接收到变动方式改变消息
            ToolRefresh 1
            mclsMainControl.Messages.Remove CStr(vntMessage)
        End If
    Next
    mclsMainControl.Messages.Clear
    UpdateMenuStatus
End Sub

Private Sub mclsMainControl_EditColumn()
    With sstTypAct
        If mclsList(.Tab).ListSet.ShowListSet(intViewID(.Tab)) Then
            blnIsLoad(.Tab) = False
            sstTypAct_Click .Tab
        End If
    End With
End Sub


'筛选
Private Sub mclsMainControl_EditFilter()
   Dim blnFlage(1) As Boolean
   
   With sstTypAct
        If Not mblnIsSaveListset(.Tab) Then
           If Not FindlngViewID(intViewID(.Tab)) Then mclsList(.Tab).ListSet.SaveList
           mblnIsSaveListset(.Tab) = True
        End If
        
        Filter.ShowFilter mclsList(.Tab).ListSet.ListID, 1, , , , , blnFlage(.Tab)
        
        If Not blnFlage(.Tab) Then Exit Sub
        mclsList(.Tab).SaveListSet
        mclsList(.Tab).ListSet.ViewId = intViewID(.Tab)
        mclsList(.Tab).FlexGrid.Cols = 0
        Set datItem(.Tab).Resultset = GetList(.Tab)
        If Not datItem(.Tab).Resultset.EOF Then datItem(.Tab).Resultset.MoveLast
        datItem(.Tab).Resultset.Close
        
        mclsList(.Tab).SetFlexGrid
        UpdateMenuStatus
        
        '初始化查找复合列表框
        mclsList(.Tab).InitcboFindKind
        If chkShowAll.Value = 0 Then mclsList(.Tab).DoShowAll False
   End With
End Sub

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

Private Sub mclsMainControl_ListReportMenu(ByVal intIndex As Integer)
    Select Case intIndex
           Case 0
                Report.ShowListReport 315, 355
            Case 1
                Report.ShowListReport 316, 356
    End Select
    
End Sub

'快捷报表
Private Sub mclsMainControl_ReportQuick()

End Sub

Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    mclsList(sstTypAct.Tab).HookProc Msg, wParam, lParam, mclsSubClass
End Sub

Private Sub mclsSubClassForm_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    Dim MinMax As MINMAXINFO

    If Msg = WM_GETMINMAXINFO Then
        CopyMemory MinMax, ByVal lParam, Len(MinMax)
        
        MinMax.ptMinTrackSize.x = 430
        MinMax.ptMinTrackSize.y = 250
        
        CopyMemory ByVal lParam, MinMax, Len(MinMax)
        Result = 0
    End If
End Sub

Private Sub msgFixedMethod_DblClick()
       With msgFixedMethod
            If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 And frmMain.mnuEditEdit.Enabled Then
               mclsMainControl_EditEdit
            End If
       End With
End Sub

'单击FLEXGRID停用列,停用或启用当前记录
Private Sub msgFixedMethod_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim blnCancel As Boolean
    
    With msgFixedMethod
        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

Private Sub msgFixedtype_DblClick()
   With msgFixedType
        If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 And frmMain.mnuEditEdit.Enabled Then
           mclsMainControl_EditEdit
        End If
   End With
End Sub

Private Sub msgFixedType_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgFixedType
        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

Private Sub msgFixedType_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgFixedType
        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 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
            
            mclsList(.Tab).SetFlexGrid
            '初始化查找复合列表框
            mclsList(.Tab).InitcboFindKind
            mclsList(.Tab).FlexGrid.Redraw = False
            '定位到第一行
            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
        
            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控件

'恢复“停用”列光标
Private Sub msgFixedMethod_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
   With msgFixedMethod
        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("FixedType", "lngFixedTypeID", lngID) Then
'                    frmFixedTypeListCard.EditCard lngID
                    frmFixedTypeCard.EditCard lngID, vbModal
                    Set frmFixedTypeCard = Nothing
                Else
                    ShowMsg 0, "该固资类型不存在,不能进行修改!", _
                            vbExclamation + MB_TASKMODAL, "修改固资类型"
                    ToolRefresh sstTypAct.Tab
                End If
            End If
        Case 1
            If lngID > 0 Then
                If CheckIDUsed("FixedMethod", "lngFixedMethodID", lngID) Then
'                    frmFixedMethodListCard.EditCard lngID
                    frmFixedMethodCard.EditCard lngID, vbModal
                    Set frmFixedMethodCard = 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
'            frmFixedTypeListCard.AddCard
            frmFixedTypeCard.AddCard , vbModal
            Set frmFixedTypeCard = Nothing
        Case 1
'            frmFixedMethodListCard.AddCard
            frmFixedMethodCard.AddCard , vbModal
            Set frmFixedMethodCard = Nothing
    End Select
End Sub

'删除记录
Private Sub mclsMainControl_EditDel()
    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 = frmFixedTypeListCard.FixedTypeID And lngID > 0 Then
'                    ShowMsg Me.hwnd, "不能删除当前编辑的固资类型", vbExclamation + MB_TASKMODAL, Me.Caption
'                    frmFixedTypeListCard.Show
'                    frmFixedTypeListCard.ZOrder 0
'                    Exit Sub
'                End If
'            End If
'            If frmFixedTypeListCard.DelCard(ListID(sstTypAct.Tab)) Then
            If frmFixedTypeCard.DelCard(ListID(sstTypAct.Tab)) Then
                UpDatePreFlage 0
                blnSucess = True
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgFixed
            End If
            Unload frmFixedTypeCard
            Set frmFixedTypeCard = Nothing
'            Unload frmFixedTypeListCard
        Case 1
            If mIsShowCard(1) Then
'               If lngID = frmFixedMethodListCard.FixedMethodID And lngID > 0 Then
               If lngID = frmFixedMethodCard.FixedMethodID And lngID > 0 Then
                    ShowMsg Me.hwnd, "不能删除当前编辑的变动方式", vbExclamation + MB_TASKMODAL, Me.Caption
'                    frmFixedMethodListCard.Show
'                    frmFixedMethodListCard.ZOrder 0
                    frmFixedMethodCard.EditCard lngID, vbModal
                    Set frmFixedMethodCard = Nothing
                    Exit Sub
                End If
            End If
'            If frmFixedMethodListCard.DelCard(ListID(sstTypAct.Tab)) Then
            If frmFixedMethodCard.DelCard(ListID(sstTypAct.Tab)) Then
                blnSucess = True
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgFixedMethod
            End If
            Unload frmFixedMethodCard
            Set frmFixedMethodCard = Nothing
'            Unload frmFixedMethodListCard
    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
            Case 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
                    If .Tab = 0 Then
        '                gclsSys.SendMessage CStr(Me.hwnd), Message.msgFixed
                    Else
                        gclsSys.SendMessage CStr(Me.hwnd), Message.msgFixedMethod