frmjoblistcard.frm

金算盘软件代码

Private mlngLstID(3) As Long
Private mstrJob As String
Private mstrNotes As String
Private WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1

'进入新增工程
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = vbModeless) As Long
    If IsContinue Then Exit Function
    mlngJobID = 0
    mblnIsNew = True
'    mblnIsChanged = True
    Caption = "新增工程"
    cmdOK(2).Default = True
    InitCard strName
    Show intModal
    AddCard = mlngJobID
    Refresh
    ZOrder 0
    Unload MsgForm
End Function

Private Function IsContinue() As Boolean
    Dim lngResult As Long
    
    IsContinue = True
    If mblnIsChanged Then
        Me.ZOrder 0
        lngResult = ShowMsg(Me.hwnd, "上一次编辑的工程还未保存，是否继续编辑它？", _
            vbYesNoCancel + vbQuestion, "工程卡片提示信息")
        If lngResult = vbYes Then       '继续编辑上一次的工程
            SendKeys "%{C}"
            Exit Function
        Else
            lngResult = ShowMsg(Me.hwnd, "是否保存上一次编辑的工程？", _
                vbYesNoCancel + vbQuestion, "工程卡片提示信息")
            If lngResult = vbYes Then       '保存上一次编辑的工程
                If Not SaveCard Then      '保存失败
                    lngResult = ShowMsg(Me.hwnd, "上一次编辑的工程保存失败，是否继续编辑它？", _
                        vbYesNoCancel + vbQuestion, "工程卡片提示信息")
                    If lngResult = vbYes Then
                        SendKeys "%{C}"
                        Exit Function
                    End If
                End If
            End If
        End If
    End If
    IsContinue = False
End Function

'进入修改工程
Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = vbModeless, _
    Optional strJob As String = "")
    Dim strMess As String
    
    If IsContinue Then Exit Sub
    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(0).Default = True
        cmdOK(2).Visible = False
        cmdOK(3).top = cmdOK(2).top
        InitCard
        Show intModal
        Refresh
        ZOrder 0
    End If
    Unload MsgForm
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 = ""
        For i = 0 To 3
            mlngLstID(i) = 0
            lstJob(i).Text = ""
        Next i
        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
        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 = Format(!strBeginDate, "@;;")
        dteJob(1).Text = Format(!strEndDate, "@;;")
        mstrNotes = Trim(!strNotes)
        chkStop.Value = !blnIsInActive
        End With
    End If
    mblnIsInit = False
End Sub
'进入删除工程，判断记录是否是末级和被使用，删除记录
Public Function DelCard(ByVal lngID As Long) As Boolean
    Dim recJob As rdoResultset, Strsql As String
    Dim strJob As String
    
    If lngID = mlngJobID And frmTpJobList.IsShowCard(1) Then
        ShowMsg 0, "不能删除正在修改的工程！", vbExclamation + MB_TASKMODAL, "删除工程"
        Show
        Exit Function
    End If
    DelCard = True
    Strsql = "SELECT * FROM Job WHERE lngJobID=" & lngID
    Set recJob = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenForwardOnly)
    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 0, "工程“" & strJob & "”已经发生业务,不能删除！", _
            vbExclamation + MB_TASKMODAL, "删除工程"
        DelCard = False
        Exit Function
    End If
    
    If ShowMsg(0, "你确实要删除工程“" & strJob & "”吗?", _
        vbQuestion + vbYesNo + MB_TASKMODAL, "删除工程") = 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("AccountBalance", "lngJobID", lngID) Then Exit Function
    If CheckIDUsed("AccountDaily", "lngJobID", lngID) Then Exit Function
    If CheckIDUsed("ActivityDetail", "lngJobID", lngID) Then Exit Function
    If CheckIDUsed("ARAPInit", "lngJobID", lngID) Then Exit Function
    If CheckIDUsed("PurchaseOrderDetail", "lngJobID", lngID) Then Exit Function
    If CheckIDUsed("SaleOrderDetail", "lngJobID", lngID) Then Exit Function
    If CheckIDUsed("TransVoucherDetail", "lngJobID", lngID) Then Exit Function
    If CheckIDUsed("VoucherDetail", "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_GotFocus()
    If mblnIsNew Then
        cmdOK(2).Default = False
    Else
        cmdOK(0).Default = False
    End If
End Sub

Private Sub calJob_LostFocus()
    If mblnIsNew Then
        cmdOK(2).Default = True
    Else
        cmdOK(0).Default = True
    End If
End Sub

Private Sub chkStop_Click()
'    Dim strJob As String
'
'    strJob = txtJob(0).Text & " " & txtJob(1).Text
'    If chkStop.Value = Checked And Not mblnIsNew Then
'        If CodeUsed(mlngJobID) Then
'            ShowMsg hwnd, "工程“" & strJob & "”已经发生业务,不能停用！", _
'                vbExclamation, Caption
'            chkStop.Value = Unchecked
'        End If
'    End If
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub Form_Activate()
    mclsMainControl_ChildActive
    frmMain.mnuEditShowList = True
    gclsSys.CurrFormName = Me.hwnd
End Sub

Private Sub Form_Load()
    Me.Hide
    Me.Left = -30000
    MsgForm.PleaseWait
    SetHelpID hwnd, 30017
    frmTpJobList.IsShowCard(1) = True
    cmdOK(0).Picture = LoadResPicture(1001, vbResBitmap)
    cmdOK(1).Picture = LoadResPicture(1002, vbResBitmap)
    cmdOK(2).Picture = LoadResPicture(1004, vbResBitmap)
    cmdOK(3).Picture = LoadResPicture(1013, vbResBitmap)
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
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)
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
    mblnIsChanged = False
    frmTpJobList.IsShowCard(1) = False
End Sub

Private Sub Form_Paint()
    FrameBox Me.hwnd, 90, 30, 4965, 2895 '画边框
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 = Card.AddCard(Message.msgJobStatus)
        Case 1
            lngID = Card.AddCard(Message.msgCustomer)
        Case 2
            lngID = Card.AddCard(Message.msgEmployee)
        Case 3
            lngID = Card.AddCard(Message.msgJobType)
    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)
    
    If mlngLstID(Index) > 0 Then