frmjobcard.frm

金算盘软件代码

    If Not GetString(strJob, strTemp, 6) Then GoTo ErrHandle
    lngEmployeeID = CLng(strTemp)
    If Not GetString(strJob, strTemp, 7) Then GoTo ErrHandle
    lngJobStatusID = CLng(strTemp)
    If Not GetString(strJob, strBeginDate, 8) Then GoTo ErrHandle
    If Not GetString(strJob, strEndDate, 9) Then GoTo ErrHandle
    If Not GetString(strJob, strTemp, 10) Then GoTo ErrHandle
    dblPercent = CDbl(strTemp)
    If Not GetString(strJob, mstrNotes, 11) Then GoTo ErrHandle
    
    If strJobCode = "" Or strJobName = "" Then GoTo ErrHandle
    If ItemIsExist("JobType", "lngJobTypeID", lngJobTypeID) Then
        mlngLstID(3) = lngJobTypeID
    Else
        GoTo ErrHandle
    End If
    If ItemIsExist("Customer", "lngCustomerID", lngCustomerID) Then
        mlngLstID(1) = lngCustomerID
    Else
        GoTo ErrHandle
    End If
    If strEndDate < strBeginDate Then GoTo ErrHandle
    If ItemIsExist("JobStatus", "lngJobStatusID", lngJobStatusID) Then
        mlngLstID(0) = lngJobStatusID
    Else
        mlngLstID(0) = 0
    End If
    If ItemIsExist("Employee", "lngEmployeeID", lngEmployeeID) Then
        mlngLstID(2) = lngEmployeeID
    Else
        mlngLstID(2) = 0
    End If
    
    mblnIsNew = True
    txtJob(0).Text = strJobCode
    txtJob(1).Text = strJobName
    calJob.Text = dblPercent
    dteJob(0).Text = Trim(strBeginDate)
    dteJob(1).Text = Trim(strEndDate)
    chkStop.Value = IIf(blnIsInActive, 1, 0)
    
    If Not SaveCard(True) Then GoTo ErrHandle
    AddJob = 1
ErrHandle:
End Function


'进入新增工程
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = vbModeless, _
    Optional ByVal IsList As Boolean = False) As Long
    mlngJobID = 0
    mblnIsNew = True
    Caption = "新增工程"
    mblnIsList = IsList
    InitCard strName
    Show intModal
    AddCard = mlngJobID
End Function

'进入修改工程
Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = vbModeless, _
    Optional strJob As String = "")
    Dim strMess As String
    
    mstrJob = strJob
    If Not CheckIDUsed("Job", "lngJobID", lngID) Then
        If Trim(strJob) <> "" Then
            strMess = "“" & mstrJob & "”"
        Else
            strMess = "该"
        End If
        ShowMsg 0, strMess & "工程不存在,不能进行修改！", _
            vbExclamation + MB_TASKMODAL, "修改工程"
        Unload Me
    Else
        mlngJobID = lngID
        mblnIsNew = False
        Caption = "修改工程"
        cmdOK(2).Visible = False
        cmdOK(3).top = cmdOK(2).top
        InitCard
        Show intModal
    End If
End Sub


Private Sub InitCard(Optional ByVal strName As String = "")
    Dim i As Integer, recJob As rdoResultset, strSql As String
    
    mblnIsInit = True
    mlngDJobID = 0
    mblnIsChanged = False
    If mblnIsNew Then
        txtJob(1).Text = ""
        txtJob(0).Text = Trim(strName)
        calJob.Text = ""
        mlngLstID(0) = 0
        lstJob(0).Text = ""
        mlngLstID(2) = 0
        lstJob(2).Text = ""
        dteJob(0).Text = ""
        dteJob(1).Text = ""
        mstrNotes = ""
        chkStop.Value = Unchecked
    Else
        strSql = "SELECT * FROM JOBVIEW WHERE lngJobID=" & mlngJobID
        Set recJob = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
        With recJob
        txtJob(0).Text = !strJobCode
        txtJob(1).Text = !strJobName
        mstrJob = !strJobCode & "  " & !strJobName
        If !dblPercent > 0 Then
            calJob.Text = IIf(!dblPercent = 0, "", !dblPercent)
            If (!dblPercent - Int(!dblPercent)) > 0 Then
                calJob.Text = FormatShow(calJob.Text, _
                    Len(Mid(calJob.Text, InStr(1, calJob.Text, ".") + 1)))
            End If
        End If
        mlngLstID(0) = !lngJobStatusID
        lstJob(0).Text = Format(!strJobStatusName, "@;;")
        mlngLstID(1) = !lngCustomerID
        lstJob(1).Text = !strCustomerCode & " " & !strCustomerName
        mlngLstID(2) = !lngEmployeeID
        lstJob(2).Text = Format(!strEmployeeCode, "@;;") & " " _
            & Format(!strEmployeeName, "@;;")
        mlngLstID(3) = !lngJobTypeID
        lstJob(3).Text = !strJobTypeCode & " " & !strJobTypeName
        dteJob(0).Text = Trim(!strBeginDate)
        dteJob(1).Text = Trim(!strEndDate)
        mstrNotes = Trim(!strNotes)
        chkStop.Value = !blnIsInActive
        End With
    End If
    mblnIsInit = False
End Sub
'进入删除工程，判断记录是否是末级和被使用，删除记录
Public Function DelCard(ByVal lngID As Long, Optional lnghWnd As Long = 0) As Boolean
    Dim recJob As rdoResultset, strSql As String
    Dim strJob As String
    
'    If lngID = mlngJobID And frmTpJobList.IsShowCard(1) Then
'        ShowMsg lnghWnd, "不能删除正在修改的工程！", vbExclamation + MB_TASKMODAL, "删除工程"
'        Show vbModal
'        Exit Function
'    End If
    DelCard = True
    strSql = "SELECT * FROM Job WHERE lngJobID=" & lngID
    Set recJob = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recJob.EOF Then
        recJob.Close
        Exit Function
    Else
        strJob = Trim(recJob!strJobCode) & " " & Trim(recJob!strJobName)
        recJob.Close
    End If
    If CodeUsed(lngID) Then
        ShowMsg lnghWnd, "工程“" & strJob & "”已经发生业务,不能删除！", _
            vbExclamation + MB_TASKMODAL, "删除工程"
        DelCard = False
        Exit Function
    End If
    
    If ShowMsg(lnghWnd, "你确实要删除工程“" & strJob & "”吗?", _
        vbQuestion + vbYesNo + MB_TASKMODAL + vbDefaultButton2, "删除工程") = vbNo Then
            DelCard = False
            Exit Function
    End If
    strSql = "DELETE FROM Job WHERE lngJobID=" & lngID
    DelCard = gclsBase.ExecSQL(strSql)
    gclsSys.SendMessage CStr(Me.hwnd), Message.msgJob
End Function

'判断记录是否被使用（可能有多张表会使用此编码）
Private Function CodeUsed(lngID As Long) As Boolean
    CodeUsed = True
'    If CheckIDUsed("ActivityDetail", "lngJobID", lngID) Then Exit Function
    If CheckIDUsed("ARAPInit", "lngJobID", lngID) Then Exit Function
    If CheckIDUsed("BudgetBalance", "lngJobID", lngID) Then Exit Function
    If CheckIDUsed("ItemActivityDetail", "lngJobID", lngID) Then Exit Function
    If CheckIDUsed("PurchaseOrderDetail", "lngJobID", lngID) Then Exit Function
    If CheckIDUsed("SaleOrderDetail", "lngJobID", lngID) Then Exit Function
    CodeUsed = False
End Function

Private Sub calJob_Change()
    If mblnIsInit Then Exit Sub
    If calJob.Value > 100 Then calJob.Text = 100
    If calJob.Value < 0 Then calJob.Text = 0
    mblnIsChanged = True
End Sub

Private Sub calJob_KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
    mblnIsDrop = calJob.IsDropDown
End Sub

Private Sub calJob_KeyPress(ByVal KeyAscii As Integer)
    If KeyAscii = vbKeyReturn And Not mblnIsDrop Then
        BKKEY calJob.hwnd, vbKeyTab
    End If
End Sub

Private Sub chkStop_Click()
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub dteJob_KeyPress(Index As Integer, KeyAscii As Integer, bCancel As Long)
    If KeyAscii = vbKeySpace Then
        dteJob(Index).DropDownPanel
    ElseIf KeyAscii = vbKeyReturn Then
        BKKEY dteJob(Index).hwnd, vbKeyTab
    End If
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim i As Integer
    
    mblnIsRefer = False
    If KeyCode = vbKeyEscape Or KeyCode = vbKeyReturn Then
        For i = 0 To 3
            If lstJob(i).ReferVisible Then mblnIsRefer = True
        Next i
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If mblnIsList Then
        mblnIsList = False
        Exit Sub
    End If
    If KeyAscii = vbKeyReturn Then
        If Not mblnIsRefer Then
            BKKEY Me.ActiveControl.hwnd, vbKeyTab
        End If
    ElseIf KeyAscii = vbKeyEscape Then
        cmdOK(1).Value = Not mblnIsRefer
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn And Shift = 2 Then
        cmdOK(0).Value = True
    End If
End Sub

Private Sub Form_Load()
    Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
'    SetHelpID hwnd, 30017
    Utility.LoadFormResPicture Me
'    SendKeys "%{C}"
'    frmTpJobList.IsShowCard(1) = True
    Exit Sub
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intMsgReturn As Integer, strMess As String
    
    If UnloadMode <> vbFormControlMenu Then Exit Sub
'    If Trim(txtJob(0).Text & txtJob(1).Text) = "" Then Exit Sub
    If mblnIsChanged Then
        If mblnIsNew Then
            strMess = "您要保存新增的工程"
            If txtJob(0).Text <> "" Then
                strMess = strMess & "“" & txtJob(0).Text & "”"
            End If
            If txtJob(1).Text <> "" Then
                strMess = strMess & "“" & txtJob(1).Text & "”"
            End If
            strMess = strMess & "吗？"
        Else
            strMess = "“" & txtJob(0).Text & "”" & " " _
                & "“" & txtJob(1).Text & "”工程已被修改，是否保存？"
        End If
        intMsgReturn = ShowMsg(hwnd, strMess, vbQuestion + vbYesNoCancel, Caption)
        If intMsgReturn = vbYes Then
            Cancel = Not SaveCard
        ElseIf intMsgReturn = vbCancel Then
            Cancel = True
        End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Unload frmJobStatusCard
    Unload frmCustomerCard
    Unload frmEmployeeCard
    Unload frmJobTypeCard
    mblnIsChanged = False
    Utility.UnLoadFormResPicture Me
'    frmTpJobList.IsShowCard(1) = False
End Sub

Private Sub Form_Paint()
    FrameBox Me.hwnd, 150, 150, 4930, 2850 '画边框
End Sub

Private Sub dteJob_Change(Index As Integer)
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub lstJob_AddNew(Index As Integer)
    Dim lngID As Long
    
    Select Case Index
        Case 0
            lngID = frmJobStatusCard.AddCard(, 1, True)
        Case 1
            lngID = frmCustomerCard.AddCard(, 1, True)
        Case 2
            lngID = frmEmployeeCard.AddCard(, 1, True)
        Case 3
            lngID = frmJobTypeCard.AddCard(, 1, True)
    End Select
    If lngID > 0 Then mlngLstID(Index) = lngID
    mblnIsChanged = True
    RefreshList lstJob(Index), Index
End Sub

Private Sub lstJob_Change(Index As Integer)
    If ContainErrorChar(lstJob(Index).Text, "`~!@#$%^&*=+'"";:,./?|\") Then BKKEY lstJob(Index).hwnd
End Sub

Private Sub lstJob_Delete(Index As Integer)
    Dim blnSuccess As Long
    Dim lngID As Long
    
    lngID = mlngLstID(Index)
    If lngID > 0 Then
        Select Case Index
            Case 0
                blnSuccess = Card.DelCard(Message.msgJobStatus, lngID, Me.hwnd)
            Case 1
                blnSuccess = Card.DelCard(Message.msgCustomer, lngID, Me.hwnd)
            Case 2
                blnSuccess = Card.DelCard(Message.msgEmployee, lngID, Me.hwnd)
            Case 3
                blnSuccess = Card.DelCard(Message.msgJobType, lngID, Me.hwnd)
        End Select
        If blnSuccess Then mlngLstID(Index) = 0
        mblnIsChanged = True
        RefreshList lstJob(Index), Index
    Else
        ShowMsg Me.hwnd, "请先选择一项，再删除！", vbInformation, Me.Caption
    End If
End Sub

Private Sub lstJob_Edit(Index As Integer)