frmlistjobitem.frm

金算盘软件代码

        mclsMainControl_EditEdit
     ElseIf lngX = 0 Then
'        If .CellFormula(0, lngY) <> cboFindKind.Text Then '双击排序
'            cboFindKind.Text = .CellFormula(0, lngY)
'        End If
        If lngY < 2 Then Exit Sub
        If .CellFormula(0, lngY) <> "" Then
                mclsList.SaveListSet
                If lngY > cboFindKind.ListCount + 1 Then Exit Sub
                If lngY - 1 <> mclsList.SortCol Then
                    .CellFormula(0, mclsList.SortCol + 1) = Left(.CellFormula(0, mclsList.SortCol + 1), Len(.CellFormula(0, mclsList.SortCol + 1)) - 1)
                    On Error Resume Next
                    cboFindKind.Text = .CellFormula(0, lngY)
                    On Error GoTo 0
                Else
                    On Error Resume Next
                    cboFindKind.Text = Left(.CellFormula(0, mclsList.SortCol + 1), Len(.CellFormula(0, mclsList.SortCol + 1)) - 1)
                    On Error GoTo 0
                End If
        End If
    End If
    End With
End Sub

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

Private Sub pctDataGrid_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim lngX As Long
    Dim lngY As Integer
    
    With mclsList.DbTabCtrl
        .MouseCell lngX, lngY
    If lngY = 1 Then
           pctDataGrid.MousePointer = vbCustom
    Else
         pctDataGrid.MousePointer = vbDefault
    End If
    End With
End Sub

Private Sub pctDataGrid_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim lngX As Long
    Dim lngY As Integer
    With mclsList.DbTabCtrl
        If Button = vbLeftButton Then
            If chkShowall.Value = 1 And .Row < .Rows And .Row > 0 Then
                .MouseCell lngX, lngY
                If lngX <> 0 And lngY = 1 Then
                    pctDataGrid.MousePointer = flexHourglass
                    mclsMainControl_EditInActive
                    pctDataGrid.MousePointer = flexDefault
                End If
            End If
            UpdateEditMenuStatus
        ElseIf Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
  End With
End Sub


'根新编辑菜单
Private Sub UpdateEditMenuStatus()
    Dim i As Integer
    Dim lngVoucherID As Long
    Dim blnIsnotEmpty As Boolean
    Dim blnFindNoChange As Boolean
    Dim blnHaveRows As Boolean
    Dim blnHaveInActive As Boolean
On Error Resume Next
    If mclsList.DbTabCtrl.Rows = 1 Then
        blnHaveRows = False
    Else
        blnHaveRows = True
    End If
    If mclsList.DbTabCtrl.Row > 0 And mclsList.DbTabCtrl.Row <= mclsList.TotalRow(mclsList.intTab) Then
        blnIsnotEmpty = True
        mclsList.Resultset(mclsList.intTab).AbsolutePosition = mclsList.DbTabCtrl.Row
        If Trim(mclsList.Resultset(mclsList.intTab).rdoColumns("在建工程编码").Value) <> "" Then
            blnHaveInActive = True
        Else
            blnHaveInActive = False
        End If
    Else
        blnIsnotEmpty = False
    End If
    
    
    
        
    With frmMain
                        
        '注意：《修改》《删除》《作废》永远可见
        
        .mnuEditEdit.Enabled = blnIsnotEmpty And blnEdit
        .mnuEditNew.Enabled = blnEdit And False
        .mnuEditDel.Enabled = blnIsnotEmpty And blnEdit ' And blnEdit
        
        .mnuEditInActive.Checked = False
        .mnuEditInActive.Enabled = blnIsnotEmpty And blnEdit And blnHaveInActive  'And Trim(grdList.TextMatrix(grdList.Row, 1)) = ""
        If chkShowall.Value = 1 Then
            .mnuEditShowAll.Checked = True
        Else
            .mnuEditShowAll.Checked = False
        End If
        If chkShowall.Enabled = True Then
            .mnuEditShowAll.Enabled = True
        Else
            .mnuEditShowAll.Enabled = False
        End If
        .mnuEditColumn.Enabled = True
        .mnuEditFilter.Enabled = True
        .mnuFilePrint.Enabled = True
        .mnuToolRefresh.Enabled = True
        
        .mnuEditEdit.Caption = "修改(&E)"
        .mnuEditNew.Caption = "新增(&N)"
        .mnuEditDel.Caption = "删除(&D)"
        
        .mnuEditInActive.Caption = "作废(&H)"
        .mnuEditShowAll.Caption = "全部显示(&W)"
        .mnuEditInActive.Visible = False
        .mnuFilePrintSetup.Enabled = True
    End With
    cmdEAR(1).Enabled = blnIsnotEmpty And blnIsDetailPro
    cmdEAR(3).Enabled = blnIsnotEmpty And blnIsDetailPro
    mblnIsFindTextChange = False
    With mclsList
    If mclsList.DbTabCtrl.Row = 0 Then  '无当前选定行
        txtFind.Text = ""
        cmdAgain.Enabled = False
    Else
        If .DbTabCtrl.Row < .TotalRow(.intTab) + 1 Then
            '.Resultset(.intTab).Move .DbTabCtrl.Row - 1, 1
            On Error Resume Next
            .Resultset(.intTab).AbsolutePosition = .DbTabCtrl.Row
            txtFind.Text = .Resultset(.intTab).rdoColumns(.SortCol + 1)
        End If
    End If
    End With
    mblnIsFindTextChange = True
    frmMain.SetToolBar
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    If mclsList.ListSet.ListID < 1 Then
       mclsList.ListSet.SaveList
       DefaultCurrentDate mclsList.ListSet.ListID, 9975
    End If
    Select Case intIndex
    Case 0: '修改
        'mclsMainControl_EditEdit
        mblnEdit = True
    Case 1: '新增工程
        'mclsMainControl_EditNew
        mblnNewProject = True
'        frmProjectCard.AddCard
'        Set frmProjectCard = Nothing
        
    Case 2 '新增合同
        mblnNewProjectOrder = True
'        frmProjOrderCard.AddCard
'        Set frmProjOrderCard = Nothing
    Case 3: '删除
        mclsMainControl_EditDel
    Case 5 '停用
        mclsMainControl_EditInActive
    Case 6: '全部显示
        mclsMainControl_EditShowAll
    Case 8: '引用
    
    Case 9: '筛选
        mclsMainControl_EditFilter
    Case 10: '栏目设置
         mclsMainControl_EditColumn
    Case 12: '刷新
        mclsMainControl_ToolRefresh
    Case 13: '打印
        mclsMainControl_FilePrint
    End Select
    mclsList.Resultset(mclsList.intTab).Requery
    'Me.Refresh
    mclsList.DbTabCtrl.Refresh
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)
        .mnuListEditMenu(1).Caption = "新增工程(&J)"
        .mnuListEditMenu(1).Enabled = blnEdit
        
        Load .mnuListEditMenu(2)
        .mnuListEditMenu(2).Caption = "新增合同(&K)"
        .mnuListEditMenu(2).Enabled = blnEdit
        
        Load .mnuListEditMenu(3)
        Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(3)
        .mnuListEditMenu(3).Caption = "删除(&D)"
        
        Load .mnuListEditMenu(4)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(4)
        
        Load .mnuListEditMenu(5)
        Utility.CloneMenu .mnuEditInActive, .mnuListEditMenu(5)
        .mnuListEditMenu(5).Caption = "停用(&H)"
        .mnuListEditMenu(5).Visible = True
        
        Load .mnuListEditMenu(6)
        Utility.CloneMenu .mnuEditShowAll, .mnuListEditMenu(6)
        .mnuListEditMenu(6).Caption = "全部显示(&W)"
        .mnuListEditMenu(6).Visible = True
        
        Load .mnuListEditMenu(7)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(7)
        .mnuListEditMenu(7).Visible = True
        
        Load .mnuListEditMenu(8)
        Utility.CloneMenu .mnuEditUse, .mnuListEditMenu(8)
        
        Load .mnuListEditMenu(9)
        Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(9)
        Load .mnuListEditMenu(10)
        Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(10)
        
        Load .mnuListEditMenu(11)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(11)
        
        Load .mnuListEditMenu(12)
        Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(12)
        Load .mnuListEditMenu(13)
        Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(13)
    End With
End Sub

Private Sub txtFind_Change()
    cmdAgain.Enabled = True
    If mblnIsFindTextChange Then mclsList.FindText txtFind.Text
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 cMsgBox(strMsg As String, Optional strTitle As String)
    If Trim(strTitle) = "" Then
        strTitle = "提示信息"
    End If

    ShowMsg Me.hWnd, strMsg, MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, strTitle
End Sub

Private Function GetlngProjectOrderID()
    Dim strSql As String
    Dim strCode As String
    Dim recTmp As rdoResultset
    Dim lngOrderID As Long
    With mclsList
        If .DbTabCtrl.Row > .TotalRow(.intTab) Then .DbTabCtrl.Row = .TotalRow(.intTab)
        .Resultset(.intTab).AbsolutePosition = .DbTabCtrl.Row
        strCode = .Resultset(.intTab).rdoColumns("合同号").Value
        If .DbTabCtrl.Row > 0 Then
            lngOrderID = CLng(.DbTabCtrl.CellValue(.DbTabCtrl.Row, 0))
        Else
            lngOrderID = -1
            Exit Function
        End If
    End With
    strSql = "Select lngOrderID as ID from ProjectOrder where ProjectOrder.lngProjectID=" & lngOrderID & " and ProjectOrder.strOrderCode='" & strCode & "'"
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recTmp.EOF Then
    GetlngProjectOrderID = recTmp!ID
    Else
        GetlngProjectOrderID = 0
    End If
    recTmp.Close
    Set recTmp = Nothing
End Function
Private Function GetProjectName() As String
    Dim strSql As String
    Dim recTmp As rdoResultset
    Dim lngProjectID As Long
    With mclsList.DbTabCtrl
        If .Row > 0 Then
            lngProjectID = CLng(.CellValue(.Row, 0))
        Else
            lngProjectID = -1
            Exit Function
        End If
    End With
    strSql = "Select strProjectCode as strcode ,strProjectName as strName from Project where lngProjectID=" & lngProjectID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recTmp.EOF Then
        GetProjectName = recTmp!strCode & " " & recTmp!strName
    Else
        GetProjectName = ""
    End If
    recTmp.Close
    Set recTmp = Nothing
End Function
Private Function IsLowerCode(ByVal strCode As String) As Boolean
    Dim strSql As String
    Dim tmp As rdoResultset
    strSql = "select blnIsInActive from Project where blnIsInActive=1 and strProjectCode like '" & strCode & "-%'"
    Set tmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If tmp.RowCount <> 0 Then
        IsLowerCode = True
    Else
        IsLowerCode = False
    End If
End Function
Private Function UpdateIsActive(ByVal strCode As String, ByVal blnIsInActive As Boolean, ByVal blnYes As Boolean) As Boolean
    Dim strSql As String
    Dim strSuSql As String
   
     If blnIsInActive Then
            strSql = "UPDATE Project SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strProjectCode = '" & strCode & "' Or strProjectCode like '" & strCode & "-%'"
     Else
        If blnYes Then
            strSuSql = "UPDATE Project SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strProjectCode='" & strCode & "' Or strProjectCode like '" & strCode & "-%'"
        End If
        strSql = "UPDATE Project SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strProjectCode  in  ('" & strCode
        Do Until CodePrefix(strCode) = ""
            strCode = CodePrefix(strCode)
            strSql = strSql & "','" & strCode
        Loop
        strSql = strSql & "')"
        
    End If
      
    If blnYes Then
        If Not gclsBase.ExecSQL(strSuSql) Then
            UpdateIsActive = False
            Exit Function
        End If
    End If
    UpdateIsActive = gclsBase.ExecSQL(strSql)
End Function
Private Function RefreshRecList()
     Dim strSql As String
    Debug.Print "Re1: "; Timer
    mclsList.DbTabCtrl.Clear
    mclsList.Resultset(0).Requery
    mclsList.RefreshCurrTab 0
    mclsList.SetGridFormate
    Debug.Print "Re2: "; Timer
    mclsList.DbTabCtrl.Refresh
    UpdateEditMenuStatus
End Function

Private Function blnIsDetailPro() As Boolean
    Dim strSql As String
    Dim recTmp As rdoResultset
    strSql = " Select blnIsDetail  From Project where blnIsDetail=1 and lngProjectID=" & ListID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTmp.RowCount > 0 Then
        blnIsDetailPro = True
    Else
        blnIsDetailPro = False
    End If
    recTmp.Close
    Set recTmp = Nothing
End Function