frmtpjob.frm

金算盘软件代码

        ElseIf vntMessage = Message.msgJob 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
    'Set datItem(.Tab).Resultset = Nothing
    mclsList(.Tab).SetFlexGrid
    UpdateMenuStatus
    '初始化查找复合列表框
    mclsList(.Tab).InitcboFindKind
    If chkShowAll.Value = 0 Then mclsList(.Tab).DoShowAll False
End With
End Sub

Private Sub mclsMainControl_EditNotepad()
  '记事簿
    Dim strCode As String
    Dim strName As String
    Dim recCurre As rdoResultset
    Dim i As Integer
    Dim strResult As String
    Dim strSql As String
    Set recCurre = GetByListID(sstTypAct.Tab, ListID(sstTypAct.Tab))
    With mclsList(sstTypAct.Tab).FlexGrid
       If .Row > 0 Then
            For i = 0 To mclsList(sstTypAct.Tab).ListSet.FixColumns - 1
                If .TextMatrix(0, i + 2) = "工程编码" Then
                    strCode = .TextMatrix(.Row, i + 2)
                ElseIf .TextMatrix(0, i + 2) = "工程名称" Then
                    strName = .TextMatrix(.Row, i + 2)
                End If
            Next i
        End If
        If sstTypAct.Tab = 1 Then strResult = frmNotePad.EditCard("工程", strCode, strName, IIf(IsNull(recCurre!strNotes), "", recCurre!strNotes))
    End With
    If strResult = "" Then Exit Sub
    strSql = "Update Job Set strNotes='" & strResult & "' Where lngJobID=" & ListID(sstTypAct.Tab)
    gclsBase.ExecSQL (strSql)
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, , , , 21, " " & "," & gclsBase.BaseName & "," & gclsBase.OperatorName
            Case 1
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 64, " " & "," & gclsBase.BaseName & "," & gclsBase.OperatorName
        End Select
    End With
End Sub

Private Sub mclsMainControl_ListReportMenu(ByVal intIndex As Integer)
   Select Case intIndex
          Case 0
             '   mclsMainControl_ReportQuick
          ' Case 1
           '     DepartTable
          ' Case 2
                'JobTable
                Report.ShowListReport 305, 325
           Case 1
                Report.ShowListReport 79, 133
                '    ItemTable
    End Select
    
End Sub

'工程核算一览表
Private Sub JobTable()
    Report.ShowListReport 79, 133
End Sub

'部门一览表
Private Sub ItemTable()

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 msgItemType_DblClick()
       With msgItemType
            If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 Then
               mclsMainControl_EditEdit
            End If
       End With
       
End Sub

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

Private Sub msgItem_DblClick()
   With msgItem
        If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 Then
           mclsMainControl_EditEdit
        End If
   End With
   
End Sub

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

Private Sub msgItem_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgItem
        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
        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).Refresh
            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 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()
    Me.Enabled = False
    Select Case sstTypAct.Tab
        Case 0
            If ListID(sstTypAct.Tab) > 0 Then frmJobTypeListCard.EditCard ListID(sstTypAct.Tab)
        Case 1
            If ListID(sstTypAct.Tab) > 0 Then frmJobListCard.EditCard ListID(sstTypAct.Tab)
    End Select
    Me.Enabled = True
End Sub

'新增卡片
Private Sub mclsMainControl_EditNew()
    Select Case sstTypAct.Tab
        Case 0
            frmJobTypeListCard.AddCard
        Case 1
            frmJobListCard.AddCard
    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 = frmJobTypelistCard.getID Then
'                    MsgBox "", vbExclamation
'                    frmJobTypelistCard.SetFocus
'                    Exit Sub
'                End If
            End If
            If frmJobTypeListCard.DelCard(ListID(sstTypAct.Tab)) Then
                UpDatePreFlage
                blnSucess = True
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgJobType
            End If
            'If Not frmJobTypeListCard.Visible Then
            Unload frmJobTypeListCard
        Case 1
            If mIsShowCard(1) Then
'                If lngID = frmJoblistCard.getID Then
'                    MsgBox "", vbExclamation
'                    frmJoblistCard.SetFocus
'                    Exit Sub
'                End If
            End If
            If frmJobListCard.DelCard(ListID(sstTypAct.Tab)) Then
                blnSucess = True
                gclsSys.SendMessage CStr(Me.hwnd), Message.msgJob
            End If
            'If Not frmJobListCard.Visible Then
            Unload frmJobListCard
    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
                    gclsSys.SendMessage CStr(Me.hwnd), Message.msgJob
                End If
            End Select
            UpdateMenuStatus
    End With
End Sub

'全部显示/显示未停用记录
Private Sub mclsMainControl_EditShowAll()
    frmMain.mnuEditShowAll.Checked = Not frmMain.mnuEditShowAll.Checked