frmprojordercard.frm

金算盘软件代码

Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0, _
    Optional strOrder As String)
    Dim strMess As String
    
    If Not CheckIDUsed("ProjectOrder", "lngOrderID", lngID) Then
        If Trim(strOrder) <> "" Then
            strMess = "“" & strOrder & "”"
        Else
            strMess = "该"
        End If
        ShowMsg 0, strMess & "工程合同不存在,不能进行修改！", vbExclamation + MB_TASKMODAL, "修改工程合同"
        Unload Me
    Else
        mlngOrderID = lngID
        mblnIsChanged = False
        mblnIsNew = False
        cmdOK(2).Visible = False
        cmdOK(3).top = cmdOK(3).top - cmdOK(2).Height
        Caption = "修改工程合同"
        InitCard
'        SendKeys "%{C}"
        Show vbModal
    End If
End Sub

Private Function IsCanDel(ByVal lngID As Long) As Boolean
    
    IsCanDel = False
    
    If CheckIDUsed("ProjectFundIn", "lngOrderID", lngID) Then Exit Function
    If CheckIDUsed("ProjectInvoice", "lngOrderID", lngID) Then Exit Function
    IsCanDel = True
End Function

Private Function InitCard(Optional strName As String = "") As Boolean
    Dim i As Integer
    Dim strSql As String
    Dim recOrder As rdoResultset

    InitCard = True
    mblnIsInit = True
    mlngDOrderID = 0
    mblnIsClose = False
    If Not mblnIsNew Then
        strSql = "SELECT ProjectOrder.*,Project.strProjectCode || ' ' " _
            & "|| Project.strProjectName strProject,Customer.strCustomerCode " _
            & "|| ' ' || Customer.strCustomerName strCustomer FROM ProjectOrder," _
            & "Project,Customer WHERE ProjectOrder.lngOrderID=" & mlngOrderID _
            & " AND ProjectOrder.lngProjectID=Project.lngProjectID AND " _
            & "ProjectOrder.lngCustomerID=Customer.lngCustomerID(+)"
        Set recOrder = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
        If recOrder.EOF Then
            InitCard = False
            recOrder.Close
            Exit Function
        Else
            With recOrder
            lstOrder(0).Text = !strCustomer
            lstOrder(1).Text = !strProject
            mlngLstID(0) = !lngCustomerID
            mlngLstID(1) = !lngProjectID
            dteOrder.Text = Trim(!strDate)
            txtOrder(0).Text = !strOrderCode
'            txtOrder(1).Text = !strNote
            txtOrder(2).Text = !strOrderName
            If !blnIsClosed <> 0 Then
                chkClose.Value = 1
                dteClose.Text = Trim(!strCloseDate)
            Else
                chkClose.Value = 0
            End If
            mblnIsClose = (!blnIsClosed = 1)
            .Close
            End With
            strSql = "SELECT * FROM ProjectOrder WHERE lngOrderID=" & mlngOrderID
            Set recOrder = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recOrder.EOF Then
                txtOrder(1).Text = Format(recOrder!strNote, "@;;")
            End If
        End If
    Else
        Caption = "增加工程合同"
        txtOrder(0).Text = Trim(strName)
        txtOrder(1).Text = ""
        chkClose.Value = Unchecked
'        mlngLstID(0) = 0
'        mlngLstID(1) = 0
'        lstOrder(0).Text = ""
'        lstOrder(1).Text = ""
    End If
    InitGrid
    SetTabIndex
    mblnIsInit = False
End Function

Private Sub RefreshLst(ByVal Index As Integer)
    Select Case Index
        Case 0
            setlistbox lstOrder(Index), 1, mlngLstID(Index)
        Case 1
            setlistbox lstOrder(Index), 35, mlngLstID(Index)
    End Select
End Sub

Private Sub lstOrder_AddNew(Index As Integer)
    Dim lngID As Long
    
    Select Case Index
    Case 0
        lngID = frmCustomerCard.AddCard(, 1, True)
    Case 1
        lngID = frmProjectCard.AddCard(, 1, True)
    End Select
    If lngID <> 0 Then mlngLstID(Index) = lngID
    RefreshLst Index
    mblnIsChanged = True
End Sub

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

Private Sub lstOrder_Choose(Index As Integer)
    If Not mblnIsInit Then mblnIsChanged = True
    mlngLstID(Index) = lstOrder(Index).ID
End Sub

Private Sub lstOrder_Delete(Index As Integer)
    Select Case Index
    Case 0
        If frmCustomerCard.DelCard(mlngLstID(0), Me.hwnd) Then mlngLstID(Index) = 0
    Case 1
        If frmProjectCard.DelCard(mlngLstID(1), Me.hwnd) Then mlngLstID(Index) = 0
    End Select
    RefreshLst Index
    mblnIsChanged = True
End Sub

Private Sub lstOrder_Edit(Index As Integer)
     Select Case Index
     Case 0
        If mlngLstID(Index) = 0 Then
            ShowMsg hwnd, "请先选择单位再进行修改！", vbExclamation, Caption
            Exit Sub
        End If
        frmCustomerCard.EditCard mlngLstID(0), 1, lstOrder(0).Text
     Case 1
        If mlngLstID(Index) = 0 Then
            ShowMsg hwnd, "请先选择工程再进行修改！", vbExclamation, Caption
            Exit Sub
        End If
        frmProjectCard.EditCard mlngLstID(1), 1, lstOrder(1).Text
    End Select
    mblnIsChanged = True
    RefreshLst Index
    If lstOrder(Index).Text = "" Then mlngLstID(Index) = 0
End Sub

Private Sub lstOrder_GotFocus(Index As Integer)
    If mblnIsFirst(Index) Then
        RefreshLst Index
        mblnIsFirst(Index) = False
    End If
End Sub

Private Sub lstOrder_ItemNotExist(Index As Integer)
    Dim lngID As Long
    
    Select Case Index
    Case 0
        If frmMsgAdd.MsgAddShow(Caption, "单位列表中没有" & lstOrder(0).Text) = vbOK Then
            lngID = frmCustomerCard.AddCard(lstOrder(0).Text, 1, True)
        Else
            lstOrder(Index).Text = ""
        End If
    Case 1
        If frmMsgAdd.MsgAddShow(Caption, "工程列表中没有" & lstOrder(1).Text) = vbOK Then
            lngID = frmProjectCard.AddCard(lstOrder(1).Text, 1, True)
        End If
    End Select
    If lngID <> 0 Then mlngLstID(Index) = lngID
    mblnIsChanged = True
    RefreshLst Index
End Sub

Private Sub lstOrder_LostFocus(Index As Integer)
    If Trim(lstOrder(Index).Text) = "" Then mlngLstID(Index) = lstOrder(Index).ID
    lstOrder(Index).MoveFocus
End Sub

Private Sub mnuAdd_Click()
    Dim i As Integer
    
    For i = 1 To msgOrder.Rows - 1
        If msgOrder.RowHeight(i) > 0 Then
            If msgOrder.TextMatrix(i, 0) = "" And msgOrder.TextMatrix(i, 1) = "" And msgOrder.RowData(i) = "0" Then
                Exit For
            End If
        End If
    Next i
    If i < msgOrder.Rows - 1 Then
        msgOrder.Row = i
    Else
        msgOrder.Rows = msgOrder.Rows + 1
        msgOrder.Row = msgOrder.Rows - 1
    End If
    msgOrder.RowData(msgOrder.Row) = "0"
    msgOrder.col = 0
    mblnIsChanged = True
End Sub

Private Sub mnuDel_Click()
    Dim i As Integer, j As Integer
    If ShowMsg(hwnd, "你确实要删除该笔付款计划吗？", vbQuestion + vbYesNo, Caption) = vbYes Then
        msgOrder.RowHeight(msgOrder.Row) = 0
        i = msgOrder.Row
        RefreshSum
        For j = i + 1 To msgOrder.Rows - 1
            If msgOrder.RowHeight(j) > 0 Then Exit For
        Next j
        If j < msgOrder.Rows Then
            msgOrder.Row = j
        Else
            For j = j - 1 To 1 Step -1
                If msgOrder.RowHeight(j) > 0 Then Exit For
            Next j
            If j > 0 Then msgOrder.Row = j
        End If
        If VisableRow > 4 Then
            msgOrder.ColWidth(1) = 2000
        Else
            msgOrder.ColWidth(1) = 2250
        End If
        msgOrder.col = 0
        mblnIsChanged = True
    End If
End Sub

Private Sub msgOrder_DblClick()
    If msgOrder.Row = 0 Or msgOrder.RowHeight(msgOrder.Row) = 0 Then Exit Sub
    If Not RowAllowEdit(msgOrder.Row) Then Exit Sub
    If msgOrder.col = 1 Then
        EditGrid 0
    Else
        Paste
    End If
End Sub

Private Function RowAllowEdit(ByVal lRow As Long) As Boolean
    Dim l As Long
    
    With msgOrder
        If .TextMatrix(lRow, 0) <> "" Or .TextMatrix(lRow, 1) <> "" Or lRow < .Rows - 1 Then
            RowAllowEdit = True
            Exit Function
        End If
        For l = 1 To lRow
            If .RowHeight(l) > 0 Then
                If .TextMatrix(l, 0) = "" Or .TextMatrix(l, 1) = "" Then Exit For
            End If
        Next l
        RowAllowEdit = (l = lRow)
    End With
End Function

'Private Sub msgOrder_EnterCell()
'    If msgOrder.RowHeight(msgOrder.Row) = 0 Then Exit Sub
'    If msgOrder.Row = 0 Or msgOrder.col = 1 Then Exit Sub
'    Paste
'End Sub
'
Private Sub msgOrder_KeyPress(KeyAscii As Integer)
    If msgOrder.Row = 0 Or msgOrder.RowHeight(msgOrder.Row) = 0 Then Exit Sub
    
    If KeyAscii = vbKeyReturn Then
        If msgOrder.Row = msgOrder.Rows - 1 Then
            If msgOrder.TextMatrix(msgOrder.Row, 0) = "" And msgOrder.TextMatrix(msgOrder.Row, 1) = "" Then
                chkClose.SetFocus
                Exit Sub
            End If
        End If
    End If
    If RowAllowEdit(msgOrder.Row) Then
        If msgOrder.col = 0 Then
            Paste
        ElseIf Me.ActiveControl.Name <> "chkClose" Then
            If InStr("0123456789.", Chr(KeyAscii)) > 0 Or KeyAscii = 8 Then
                EditGrid KeyAscii
            Else
                EditGrid 0
            End If
        End If
    End If
End Sub

Private Sub msgOrder_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton Then Exit Sub
    mnuDel.Enabled = (msgOrder.Row <> 0)
    PopupMenu mnuEdit
End Sub

Private Sub msgOrder_Scroll()
    txtPaste.Visible = False
    dtePaste.Visible = False
End Sub

Private Sub sstOrder_DblClick()
    SetTabIndex
End Sub

Private Sub txtOrder_Change(Index As Integer)
    If Index = 0 Or Index = 2 Then
        If ContainErrorChar(txtOrder(Index).Text, "`~!@#$%^&*=+'"";:,/?|\") Then BKKEY txtOrder(Index).hwnd
        If Index = 0 Then
            If LenB(StrConv(txtOrder(0).Text, vbFromUnicode)) > txtOrder(0).MaxLength Then BKKEY txtOrder(Index).hwnd
        End If
    Else
        If ContainErrorChar(txtOrder(1).Text, "'""") Then BKKEY txtOrder(1).hwnd
    End If
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub txtOrder_KeyPress(Index As Integer, KeyAscii As Integer)
    If Index = 0 Or Index = 2 Then
        If InStr("`~!@#$%^&*=+'"";:,/?|\", Chr(KeyAscii)) > 0 Then KeyAscii = 0
    Else
        If InStr("'""", Chr(KeyAscii)) > 0 Then KeyAscii = 0
    End If
End Sub

Private Sub txtPaste_Change()
    If Not IsNum(txtPaste.Text, 2, True) Then BKKEY txtPaste.hwnd
    msgOrder.TextMatrix(msgOrder.Row, 2) = "3"
    msgOrder.Text = txtPaste.Text
    mblnIsChanged = True
End Sub

Private Sub txtPaste_KeyPress(KeyAscii As Integer)
    
    Select Case KeyAscii