frmlistjobitem.frm

金算盘软件代码

    UpdateEditMenuStatus
    Debug.Print "Chk4:" & Timer
End Sub

Private Sub cmdAgain_Click()
    With mclsList.DbTabCtrl
        If .CellValue(.Row + 1, mclsList.SortCol + 1) Like txtFind.Text & "*" Or Trim(.CellValue(.Row + 1, mclsList.SortCol + 1)) = "" Then
            If .Row < .Rows Then
                .Row = .Row + 1
            Else
                cmdAgain.Enabled = False
            End If
        Else
            cmdAgain.Enabled = False
        End If
    End With
End Sub

Private Sub cmdEAR_Click(index As Integer)
    Select Case index
        Case 0
            MakeListEditMenu
            UpdateEditMenuStatus
            mblnEdit = False
            mblnNewProject = False
            mblnNewProjectOrder = False
            PopupMenu frmMain.mnuListEdit, , cmdEAR(0).Left, cmdEAR(0).top + cmdEAR(0).Height
            If mblnEdit Then mclsMainControl_EditEdit
            If mblnNewProject Then
                frmProjectCard.AddCard
                Set frmProjectCard = Nothing
                mclsList.DbTabCtrl.Refresh
            End If
            If mblnNewProjectOrder Then
                frmProjOrderCard.AddCard ListID, GetProjectName
                Set frmProjOrderCard = Nothing
                mclsList.DbTabCtrl.Refresh
            End If
        Case 1
            frmEnterPriceCard.ShowCard ListID, GetProjectName
            Set frmEnterPriceCard = Nothing
            
        Case 3
            frmProDataCard.ShowCard ListID, GetProjectName
            Set frmProDataCard = Nothing
        Case 2
            Dim strName As String
            strName = GetProjectName
            frmBalCKCard.Project = IIf(Trim(strName) <> "", strName, "所有的工程")
            frmBalCKCard.Show vbModal
            Set frmProDataCard = Nothing
    End Select
    
End Sub

Private Sub Form_Activate()
     On Error Resume Next
    SetHelpID Me.HelpContextID
    mclsMainControl_ChildActive
    gclsSys.CurrFormName = Me.hWnd
    If ComPleteLoad > 1 Then ToolRefresh
    ComPleteLoad = ComPleteLoad + 1
    pctDataGrid.SetFocus
    UpdateEditMenuStatus
    If Me.WindowState = 1 Then Me.WindowState = 0
End Sub

Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
    If ComPleteLoad > 3 Then
        ComPleteLoad = ComPleteLoad - 1
    Else
        ComPleteLoad = ComPleteLoad + 1
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    On Error Resume Next
    If KeyAscii = vbKeyEscape Then
        Unload Me
    ElseIf KeyAscii = vbKeyReturn Then
        BKKEY Me.ActiveControl.hWnd, vbKeyTab
    End If
End Sub

Private Sub Form_Load()
    Dim i As Integer
    On Error GoTo ErrHandle
Debug.Print "LoadS:" & Timer
    MsgForm.PleaseWait
    ComPleteLoad = 0
    Me.HelpContextID = 60014
    blnEdit = IsCanDo(13, gclsBase.OperatorID) '391判断有无编辑权
    Me.Caption = "在建工程合同列表"
    Set pctDataGrid.MouseIcon = GetFormResPicture(101, vbResCursor)
    Set mclsList = New ListGrid
    'Set mclsList.Find = txtFind
    'Set mclsList.DataGrid = pctDataGrid
    mclsList.Thwnd = pctDataGrid.hWnd
    Debug.Print "1:" & Timer
    mclsList.ListSet.ViewId = mintViewId
    Debug.Print "2:" & Timer
    mIsFind = False
    intcboFindKind
    mIsFind = True
    Debug.Print "3:" & Timer
    mclsList.intTabs = 1
    mclsList.DbTabCtrl.Clear
    MakeListSql 0
    Debug.Print "3-1:" & Timer
    mclsList.SetGridFormate
    Debug.Print "4:" & Timer
    'SetFormation
    Debug.Print "5:" & Timer
    UpdateEditMenuStatus
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    Unload MsgForm
    ComPleteLoad = ComPleteLoad + 1
    Debug.Print "LoadE:" & Timer
     Exit Sub
     Dim edtErrReturn As ErrDealType
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload MsgForm
         Unload Me
    End If
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton And frmMain.ActiveForm Is Me Then
        MakeListEditMenu
        UpdateEditMenuStatus
        mblnEdit = False
        mblnNewProject = False
        mblnNewProjectOrder = False
        PopupMenu frmMain.mnuListEdit
        If mblnEdit Then mclsMainControl_EditEdit
        If mblnNewProject Then
            frmProjectCard.AddCard
            Set frmProjectCard = Nothing
            mclsList.DbTabCtrl.Refresh
        End If
        If mblnNewProjectOrder Then
            frmProjOrderCard.AddCard ListID, GetProjectName
            Set frmProjOrderCard = Nothing
            mclsList.DbTabCtrl.Refresh
        End If
    End If
End Sub
Private Sub Form_Resize()
    If Me.WindowState = 1 Then Exit Sub
    If Me.WindowState = vbNormal Then
        If Me.width <= 6300 Then Me.width = 6300
        If Me.Height <= 3500 Then Me.Height = 3500
    End If
    RedrawForm
End Sub
Private Sub Form_Unload(Cancel As Integer)
    If mclsList.ListSet.ListID < 1 Then
       mclsList.SaveListSet
    End If
    Set mclsList = Nothing
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
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.msgProject Or vntMessage = Message.msgProjectOrder Then
            ToolRefresh
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除消息
        End If
    Next
    UpdateEditMenuStatus
End Sub

Private Sub mclsMainControl_EditColumn()
    Dim strOld As String
    Dim lngSortCol As Long
    
    strOld = txtFind.Text
    With mclsList
        lngSortCol = .SortCol
        If mclsList.ListSet.ShowListSet(mintViewId) Then
            ReMakeData
        End If
        If .SortCol = lngSortCol Then txtFind.Text = strOld
    End With
End Sub

Private Sub mclsMainControl_EditDel()
    Dim lngID As Long
    Dim strCode As String
    Dim blnSuccess As Boolean
    With mclsList
        If .DbTabCtrl.Row > .TotalRow(.intTab) Then .DbTabCtrl.Row = .TotalRow(.intTab)
        .Resultset(.intTab).AbsolutePosition = .DbTabCtrl.Row
        strCode = .Resultset(mclsList.intTab).rdoColumns("在建工程编码").Value
    End With
    lngID = ListID
    If Trim(strCode) <> "" Then
        blnSuccess = frmProjectCard.DelCard(lngID)
    Else
        blnSuccess = frmProjOrderCard.DelCard(GetlngProjectOrderID)
    End If
    mclsList.Resultset(mclsList.intTab).Requery
    If blnSuccess Then
        ToolRefresh
    End If
End Sub

Private Sub mclsMainControl_EditEdit()
    Dim lngID As Long
    Dim strCode As String
    Me.Enabled = False
    
    With mclsList
        If .DbTabCtrl.Row > .TotalRow(.intTab) Then .DbTabCtrl.Row = .TotalRow(.intTab)
        .Resultset(.intTab).AbsolutePosition = .DbTabCtrl.Row
        strCode = .Resultset(mclsList.intTab).rdoColumns("在建工程编码").Value
    End With
    lngID = ListID
    If Trim(strCode) <> "" Then
        frmProjectCard.EditCard lngID
    Else
        frmProjOrderCard.EditCard GetlngProjectOrderID
    End If
    mclsList.Resultset(mclsList.intTab).Requery
    Me.Enabled = True
End Sub

Private Sub mclsMainControl_EditFilter()
      '筛选
    Dim blnFlage As Boolean
    Dim strOld As String
    strOld = txtFind.Text
    With mclsList
        If .ListSet.ListID < 1 Then
           .ListSet.SaveList
        End If
        Filter.ShowFilter .ListSet.ListID, 1, , , , , blnFlage
        If Not blnFlage Then Exit Sub
        .ListSet.RefreshWhere
        .SaveListSet
        ToolRefresh
        UpdateEditMenuStatus
        '初始化查找复合列表框
        txtFind.Text = strOld
    End With
End Sub

Private Sub mclsMainControl_EditInActive()
    Dim lngID As Long
    Dim strCode
    Dim blnRemark  As Boolean
    Dim intResponse As Integer
    Dim blnYes As Boolean
    With mclsList
        If .TotalRow(.intTab) < 1 Then Exit Sub
        If .DbTabCtrl.Row > .TotalRow(.intTab) Then .DbTabCtrl.Row = .TotalRow(.intTab)
        .Resultset(.intTab).AbsolutePosition = .DbTabCtrl.Row
        strCode = .Resultset(mclsList.intTab).rdoColumns("在建工程编码").Value
        blnRemark = IIf(Trim(.Resultset(mclsList.intTab).rdoColumns(1).Value) <> "", True, False)
    End With
    'lngID = ListID
    If Trim(strCode) = "" Then Exit Sub
    If blnRemark And IsLowerCode(strCode) Then
        intResponse = ShowMsg(Me.hWnd, "是否取消所有下级的停用标记", vbYesNo, Me.Caption)
        blnYes = IIf(intResponse = 6, True, False)
    End If
    If UpdateIsActive(strCode, Not blnRemark, blnYes) Then
        ToolRefresh
    End If
End Sub

Private Sub mclsMainControl_EditNew()
    'frmProjectCard.AddCard
    'frmProjOrderCard.AddCard GetlngProjectOrderID
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_FilePrint()
'    Dim myPrintclass As PrintClass
'    Set myPrintclass = New PrintClass
'    'mclsList.ReGetColCaption
'
'    'mclsList(sstCustom.Tab).AddReGetColCaption
'    Set myPrintclass = Nothing
    Dim myPrintclass As PrintClass
    Dim strSortChar As String
    Set myPrintclass = New PrintClass
    With mclsList
        strSortChar = Right(.DbTabCtrl.CellFormula(0, .SortCol + 1), 1)
        .DbTabCtrl.CellFormula(0, .SortCol + 1) = Left(.DbTabCtrl.CellFormula(0, .SortCol + 1), Len(.DbTabCtrl.CellFormula(0, .SortCol + 1)) - 1)
    'myPrintclass.PrintNewList gclsBase.BaseDB, mclsList.Resultset(mclsList.intTab), mclsList.DbTabCtrl, mintPrintID(mclsList.intTab), mstrPrintTitle(mclsList.intTab)
        myPrintclass.PrintNewList gclsBase.BaseDB, mclsList.Resultset(0), mclsList.DbTabCtrl.TableHandle, 99, "在建工程合同列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
     .DbTabCtrl.CellFormula(0, .SortCol + 1) = .DbTabCtrl.CellFormula(0, .SortCol + 1) & strSortChar
    End With
    Set myPrintclass = Nothing
End Sub
Private Sub mclsMainControl_FilePrintSetup()
    Dim MyPrintSet As PrintClass
    Set MyPrintSet = New PrintClass
    MyPrintSet.PrintNewSetUp gclsBase.BaseDB, mclsList.DbTabCtrl.TableHandle, , , , 99, "在建工程合同列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    Set MyPrintSet = Nothing
End Sub

Private Sub mclsMainControl_ToolRefresh()
    Me.MousePointer = vbHourglass
    'ToolRefresh
    RefreshRecList
    Me.MousePointer = vbDefault
End Sub

Private Sub pctDataGrid_Click()
     With mclsList
        If .DbTabCtrl.Row < .DbTabCtrl.Rows Then
            If .TotalRow(.intTab) > 0 Then .Resultset(.intTab).MoveFirst
            If .DbTabCtrl.Row - 1 <> 0 Then .Resultset(.intTab).AbsolutePosition = .DbTabCtrl.Row '- 1 'mResultset(mTab).Move .Row - 1, 1
        Else
            .DbTabCtrl.Row = .DbTabCtrl.Rows - 1
            If .TotalRow(.intTab) > 0 Then .Resultset(.intTab).MoveFirst
            If .DbTabCtrl.Row - 1 <> 0 Then .Resultset(.intTab).AbsolutePosition = .DbTabCtrl.Row '- 1 ' mResultset(mTab).Move .Row - 1, 1
        End If
        '.SetRow
        If Not .Resultset(.intTab).EOF And Not .Resultset(.intTab).BOF Then
        mblnIsFindTextChange = False
        txtFind.Text = IIf(IsNull(.Resultset(.intTab).rdoColumns(.SortCol + 1).Value), "", .Resultset(.intTab).rdoColumns(.SortCol + 1).Value)
        mblnIsFindTextChange = True
        End If
    End With
    Exit Sub
End Sub
Private Sub pctDataGrid_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 37 Or KeyCode = 38 Or KeyCode = 39 Or KeyCode = 40 Then
        With mclsList
        If .DbTabCtrl.Row = 0 Then
            .DbTabCtrl.Row = 1
            mclsList.SetRow
        End If
        If .TotalRow(.intTab) = 0 Then Exit Sub
        If .DbTabCtrl.Row < .DbTabCtrl.Rows Then
                .Resultset(.intTab).AbsolutePosition = .DbTabCtrl.Row '- 1
        Else
            .DbTabCtrl.Row = .DbTabCtrl.Rows - 1
                .Resultset(.intTab).AbsolutePosition = .DbTabCtrl.Row '- 1
        End If
            If Not .Resultset(.intTab).EOF And Not .Resultset(.intTab).BOF Then
                mblnIsFindTextChange = False
                txtFind.Text = IIf(IsNull(.Resultset(.intTab).rdoColumns(.SortCol + 1).Value), _
                                "", .Resultset(.intTab).rdoColumns(.SortCol + 1).Value)
                mblnIsFindTextChange = True
            End If
        End With
    End If
    Exit Sub
End Sub
Private Sub pctDataGrid_DblClick()
    Dim lngX As Long
    Dim lngY As Integer
    
    With mclsList.DbTabCtrl
        .MouseCell lngX, lngY
     If lngX > 0 And lngX < .Rows And frmMain.mnuEditEdit.Enabled Then