frmprojordercard.frm

金算盘软件代码

   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   0
      Left            =   5550
      Style           =   1  'Graphical
      TabIndex        =   19
      Tag             =   "1001"
      Top             =   510
      Width           =   1215
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "Edit"
      Visible         =   0   'False
      Begin VB.Menu mnuAdd 
         Caption         =   "新增付款计划(&A)"
      End
      Begin VB.Menu mnuDel 
         Caption         =   "删除付款计划(&D)"
      End
   End
End
Attribute VB_Name = "frmProjOrderCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mblnIsInit As Boolean
Private mblnIsList As Boolean
Private mblnIsChanged As Boolean
Private mblnIsFirst(0 To 1) As Boolean
Private mblnIsClose As Boolean
Private mblnIsNew As Boolean
Private mlngRow As Long
Private mlngOrderID As Long
Private mlngDOrderID As Long
Private mlngLstID(0 To 1) As Long

Private Sub RefreshSum()
    Dim i As Integer, dblV As Double
    
    For i = 1 To msgOrder.Rows - 1
        If msgOrder.RowHeight(i) > 0 Then
            dblV = dblV + TxtToDouble(msgOrder.TextMatrix(i, 1))
        End If
    Next i
    lblSum.Caption = FormatShow(dblV, gclsBase.NaturalCurDec)
End Sub

Private Sub InitGrid()
    Dim i As Integer, recX As rdoResultset, strSql As String
    Dim iRows As Integer
    
    If mblnIsNew Then
'        msgOrder.Rows = 8
'        For i = 1 To 7
'            msgOrder.TextMatrix(i, 0) = ""
'            msgOrder.TextMatrix(i, 1) = ""
'            msgOrder.RowData(i) = 0
'        Next i
    Else
        strSql = "SELECT lngPlanID,strDate,dblAmount FROM ProjectOrderPlan " _
            & "WHERE lngOrderID=" & mlngOrderID
        Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recX.EOF Then
            recX.MoveLast
'            iRows = IIf(recX.RowCount < 4, 4, recX.RowCount)
            iRows = 1
            recX.MoveFirst
            i = 1
            While Not recX.EOF
                If i < msgOrder.Rows Then
                    msgOrder.TextMatrix(i, 0) = recX("strDate")
                    msgOrder.TextMatrix(i, 1) = FormatShow(recX("dblAmount"), gclsBase.NaturalCurDec)
                    msgOrder.RowData(i) = recX("lngPlanID")
                Else
                    msgOrder.AddItem recX("strDate") & vbTab & FormatShow(recX("dblAmount"), gclsBase.NaturalCurDec)
                    msgOrder.RowData(msgOrder.Rows - 1) = recX("lngPlanID")
                End If
                recX.MoveNext
                i = i + 1
            Wend
            msgOrder.Rows = msgOrder.Rows + 1
'            While i < iRows
'                msgOrder.RowData(i) = "0"
'                i = i + 1
'            Wend
        End If
        recX.Close
    End If
    msgOrder.FixedAlignment(1) = flexAlignCenterCenter
    If msgOrder.Rows > 4 Then
        msgOrder.ColWidth(0) = 1500
        msgOrder.ColWidth(1) = 2000
    Else
        msgOrder.ColWidth(0) = 1500
        msgOrder.ColWidth(1) = 2250
    End If
    msgOrder.ColWidth(2) = 0
    RefreshSum
End Sub

Private Sub chkClose_Click()
    If chkClose.Value = vbChecked Then
        lblOrder(3).Enabled = True
        dteClose.Enabled = True
        dteClose.Value = gclsBase.BaseDate
'        dteClose.BackColor = &H80000005
    Else
        lblOrder(3).Enabled = False
        dteClose.Enabled = False
        dteClose.Text = ""
'        dteClose.BackColor = &H80000004
    End If
    mblnIsChanged = True
End Sub

Private Sub cmdOK_Click(Index As Integer)
    Dim strNextCode As String
    
'    If mblnIsExist Then Exit Sub
    If Index = 0 Then
        If mblnIsChanged Then
            If Not SaveCard Then
               Exit Sub
            End If
        End If
        Unload Me
    ElseIf Index = 2 Then
        If mblnIsChanged Then
            If SaveCard Then
                mblnIsNew = True
                If Len(txtOrder(0).Text) > 28 Then
                    strNextCode = Left(txtOrder(0).Text, 28) & GetNextCode(Mid(txtOrder(0).Text, 28))
                Else
                    strNextCode = GetNextCode(txtOrder(0).Text)
                End If
                InitCard
                txtOrder(0).Text = strNextCode
                txtOrder(0).SetFocus
                txtOrder(0).SelStart = 0
                txtOrder(0).SelLength = Len(txtOrder(0).Text)
                txtOrder(2).Text = ""
            End If
        End If
    ElseIf Index = 1 Then
        Unload Me
    Else
        If gclsBase.AccountSys = "1" And gclsBase.Trade = "邮电通信" Then
            If mlngOrderID = 0 Then
                If Not SaveCard Then Exit Sub
            End If
            frmScan.ScanOrder mlngOrderID
        End If
    End If
End Sub

Private Sub dtePaste_Change()
    msgOrder.Text = dtePaste.Text
    msgOrder.TextMatrix(msgOrder.Row, 2) = "3"
    mblnIsChanged = True
End Sub

Private Sub dtePaste_KeyDown(KeyCode As Integer, Shift As Integer, bCancel As Long)
    Dim i As Integer
    Static blnFir As Boolean
    
    Select Case KeyCode
    Case vbKeyUp
        For i = msgOrder.Row - 1 To 1 Step -1
            If msgOrder.RowHeight(i) > 0 Then Exit For
        Next i
        dtePaste.Visible = False
        msgOrder.SetFocus
        If i > 0 Then msgOrder.Row = i
    Case vbKeyDown
        For i = msgOrder.Row + 1 To msgOrder.Rows - 1
            If msgOrder.RowHeight(i) > 0 Then Exit For
        Next i
        dtePaste.Visible = False
        msgOrder.SetFocus
        If i < msgOrder.Rows Then msgOrder.Row = i
    Case vbKeyLeft
        If txtPaste.SelStart = 0 Then
            dtePaste.Visible = False
            msgOrder.SetFocus
        End If
    Case vbKeyRight
        If dtePaste.SelStart = Len(dtePaste.Text) Then
            If Not blnFir Then
                blnFir = True
            Else
                dtePaste.Visible = False
                msgOrder.SetFocus
                BKKEY msgOrder.hwnd, vbKeyRight
                blnFir = False
            End If
        End If
    End Select
End Sub

Private Sub dtePaste_KeyPress(KeyAscii As Integer, bCancel As Long)
    If KeyAscii = vbKeyReturn Then
        BKKEY msgOrder.hwnd, vbKeyRight
    End If
End Sub

Private Sub dtePaste_LostFocus()
    On Error Resume Next
    If Me.ActiveControl.Name = "msgOrder" And msgOrder.col = 0 Then
        If dtePaste.Visible Then dtePaste.SetFocus
    Else
        dtePaste.Visible = False
    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 Me.ActiveControl.Name = "txtOrder" Then
            If Me.ActiveControl.Index = 1 Then Exit Sub
        End If
        BKKEY Me.ActiveControl.hwnd, vbKeyTab
    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
    ElseIf KeyCode = vbKeyEscape Then
        cmdOK(1).Value = True
    End If
End Sub

Private Sub Form_Load()
    
    On Error GoTo ErrHandle
    mblnIsChanged = False
    mblnIsFirst(0) = True
    mblnIsFirst(1) = True
    Utility.LoadFormResPicture Me
    Exit Sub
    
    Dim edtErrReturn As ErrDealType
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Sub

Private Sub Form_Paint()
'    FrameBox hwnd, 90, 90, 90 + 4635, 90 + 5895
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(txtOrder(0).Text & txtOrder(2).Text) = "" Then Exit Sub
    If mblnIsChanged Then
        If mblnIsNew Then
            strMess = "您要保存新增的工程合同"
            If txtOrder(0).Text <> "" Then
                strMess = strMess & "“" & txtOrder(0).Text & "”"
            End If
            If txtOrder(2).Text <> "" Then
                strMess = strMess & "“" & txtOrder(2).Text & "”"
            End If
            strMess = strMess & "吗？"
        Else
            strMess = "“" & txtOrder(0).Text & "”" & " " _
                & "“" & txtOrder(2).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
     Utility.UnLoadFormResPicture Me
End Sub

Public Function DelCard(ByVal lngID As Long, Optional lnghWnd As Long = 0) As Boolean
    Dim strSql As String, strEmp As String
    Dim recTemp As rdoResultset
    
    DelCard = False
    strSql = "SELECT * FROM ProjectOrder WHERE lngOrderID=" & lngID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.EOF Then
        recTemp.Close
        Exit Function
    Else
        strEmp = recTemp!strOrderCode
    End If
    recTemp.Close
    
    If Not IsCanDel(lngID) Then
        ShowMsg lnghWnd, "合同“" & strEmp & "”已经发生业务,不能删除！", vbExclamation + MB_TASKMODAL, "删除合同"
        Exit Function
    End If
    If ShowMsg(lnghWnd, "你确实要删除合同“" & strEmp & "”吗？", vbQuestion + vbYesNo + MB_TASKMODAL + vbDefaultButton2, _
        "删除合同") = vbNo Then Exit Function
    strSql = "DELETE FROM ProjectOrder WHERE lngOrderID=" & lngID
    DelCard = gclsBase.ExecSQL(strSql)
    strSql = "DELETE FROM ProjectOrderPlan WHERE lngOrderID=" & lngID
    DelCard = gclsBase.ExecSQL(strSql)
    gclsSys.SendMessage CStr(Me.hwnd), Message.msgProjectOrder
End Function

Public Function AddCard(ByVal lngProjID As Long, ByVal strProj As String, _
    Optional strName As String = "", Optional intModal As Integer = 0, _
    Optional ByVal IsList As Boolean = False) As Long
    
    mlngOrderID = 0
    mlngLstID(1) = lngProjID
'    RefreshLst 1
'    mblnIsFirst(1) = False
    lstOrder(1).Text = strProj
    mblnIsChanged = True
    mblnIsNew = True
    mblnIsList = IsList
    InitCard strName
    Show vbModal
    AddCard = mlngOrderID
End Function