frmenterpricecard.frm

金算盘软件代码

    Set mclsGrid.Grid = msgEnter
    InitLst
'    mblnIsInit = False
    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
    
    If UnloadMode <> vbFormControlMenu Then Exit Sub
    If mblnIsChanged Then
        intMsgReturn = ShowMsg(hwnd, "您要保存拨入资金吗？", 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
    mblnIsChanged = False
    Utility.UnLoadFormResPicture Me
    Set mclsGrid = Nothing
End Sub

Private Sub lstPaste_Change()
    If lstPaste.Text = "" Then
        msgEnter.Text = ""
        msgEnter.TextMatrix(msgEnter.Row, 2) = 0
        msgEnter.TextMatrix(msgEnter.Row, 1) = "3"
        If Not mblnIsInit Then mblnIsChanged = True
    End If
End Sub

Private Sub lstPaste_Choose()
    msgEnter.Text = lstPaste.Text
    msgEnter.TextMatrix(msgEnter.Row, 2) = lstPaste.ID
    msgEnter.TextMatrix(msgEnter.Row, 1) = "3"
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub lstpaste_ItemNotExist()
'    msgEnter.TextMatrix(msgEnter.Row, 7) = ""
'    msgEnter.TextMatrix(msgEnter.Row, 2) = 0
'    msgEnter.TextMatrix(msgEnter.Row, 1) = "3"
'    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub lstPaste_KeyPress(KeyAscii As Integer)
    Dim l As Long
    
    If KeyAscii = vbKeyReturn Then
        For l = msgEnter.Row + 1 To msgEnter.Rows - 1
            If msgEnter.RowHeight(l) > 0 Then Exit For
        Next l
        If l < msgEnter.Rows Then
            msgEnter.col = 3
            msgEnter.Row = l
        Else
            mnuAdd_Click
        End If
    End If
End Sub

Private Sub lstPaste_LostFocus()
    If Me.ActiveControl.Name <> "lstPaste" Then
        lstPaste.Visible = False
    End If
End Sub

Private Sub mclsGrid_AfterColResize(lngCol As Long)
    dtePaste.Visible = False
    txtPaste.Visible = False
End Sub

Private Sub mnuAdd_Click()
    Dim l As Long
    
    For l = 1 To msgEnter.Rows - 1
        If msgEnter.RowHeight(l) > 0 Then
            If msgEnter.TextMatrix(l, 3) = "" Or TxtToDouble(msgEnter.TextMatrix(l, 6)) = 0 Then Exit For
        End If
    Next l
    If l < msgEnter.Rows Then
        msgEnter.Row = l
        If msgEnter.TextMatrix(l, 3) = "" Then
            msgEnter.col = 3
        Else
            msgEnter.col = 6
        End If
    Else
        msgEnter.Rows = msgEnter.Rows + 1
        msgEnter.Row = msgEnter.Rows - 1
        msgEnter.TextMatrix(msgEnter.Row, 0) = "0"
        msgEnter.col = 3
    End If
    If Not mblnIsInit Then
        mblnIsChanged = True
        msgEnter.SetFocus
    End If
End Sub

Private Sub mnuDel_Click()
    If ShowMsg(hwnd, "你确实要删除该笔拨入资金吗？", vbQuestion + vbYesNo, Caption) = vbYes Then
        msgEnter.TextMatrix(msgEnter.Row, 1) = "-5"
        msgEnter.RowHeight(msgEnter.Row) = 0
        mblnIsChanged = True
    End If
End Sub

Private Sub msgEnter_Click()
    msgEnter_EnterCell
End Sub

Private Sub msgEnter_DblClick()
    If msgEnter.Row = 0 Then Exit Sub
    If msgEnter.col <> 3 And msgEnter.col <> 7 Then
        EditGrid 0
    Else
        Paste
    End If
End Sub

Private Sub msgEnter_EnterCell()
'    If msgEnter.Row = 0 Then Exit Sub
'    If msgEnter.col = 3 Or msgEnter.col = 7 Then Paste
End Sub

Private Sub msgEnter_GotFocus()
    Static blnX As Boolean
    
    If blnX Then
'        If msgEnter.col = 3 Or msgEnter.col = 7 Then Paste
    Else
        blnX = True
        If msgEnter.Rows = 1 Then
            mnuAdd_Click
        Else
            msgEnter.col = 3
        End If
    End If
End Sub

Private Sub msgEnter_KeyPress(KeyAscii As Integer)
    With msgEnter
        Select Case msgEnter.col
        Case 3, 7
            Paste
        Case 4, 5
            If InStr("'""|`~", Chr(KeyAscii)) <> 0 Then
                EditGrid 0
            Else
                EditGrid KeyAscii
            End If
        Case 6
            If Not IsNum(txtPaste.Text, 2, True) Then
                EditGrid 0
            Else
                EditGrid KeyAscii
            End If
        End Select
    End With
End Sub

Private Sub msgEnter_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton Then Exit Sub
    If msgEnter.Row > 0 And msgEnter.RowHeight(msgEnter.Row) > 0 Then
        mnuDel.Enabled = True
    Else
        mnuDel.Enabled = False
    End If
    PopupMenu mnuEdit
End Sub

Private Sub Paste()
    On Error Resume Next
    If msgEnter.RowHeight(msgEnter.Row) = 0 Then
        dtePaste.Visible = False
        lstPaste.Visible = False
        Exit Sub
    End If
    If msgEnter.col = 3 Then
        lstPaste.Visible = False
        dtePaste.Visible = True
        dtePaste.SetFocus
        dtePaste.Text = msgEnter.TextMatrix(msgEnter.Row, 3)
        dtePaste.Move msgEnter.Left + msgEnter.CellLeft - 10, msgEnter.top + msgEnter.CellTop - 10, msgEnter.CellWidth, msgEnter.CellHeight
    Else
        dtePaste.Visible = False
        lstPaste.Visible = True
        lstPaste.SetFocus
        lstPaste.Text = msgEnter.TextMatrix(msgEnter.Row, 7)
        lstPaste.Move msgEnter.Left + msgEnter.CellLeft - 10, msgEnter.top + msgEnter.CellTop - 10, msgEnter.CellWidth, msgEnter.CellHeight
    End If
End Sub

Private Sub msgEnter_Scroll()
    dtePaste.Visible = False
    lstPaste.Visible = False
    txtPaste.Visible = False
End Sub

Private Sub txtPaste_Change()
    If msgEnter.col = 6 Then
        If Not IsNum(txtPaste.Text, 2) Then BKKEY txtPaste.hwnd
    Else
        If ContainErrorChar(txtPaste.Text, "'""|`~") Then BKKEY txtPaste.hwnd
    End If
    msgEnter.Text = txtPaste.Text
    msgEnter.TextMatrix(msgEnter.Row, 1) = "3"
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub txtPaste_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        BKKEY msgEnter.hwnd, vbKeyRight
    Else
        If msgEnter.col = 6 Then
            If InStr("0123456789.-", Chr(KeyAscii)) = 0 And KeyAscii <> 8 Then KeyAscii = 0
        Else
            If InStr("'""|`~", Chr(KeyAscii)) > 0 And KeyAscii <> 8 Then KeyAscii = 0
        End If
    End If
End Sub

Private Sub EditGrid(ByVal KeyCode As Integer)
    Dim strV As String
    On Error Resume Next
    
    With msgEnter
    If .RowHeight(.Row) = 0 Or .col = 0 Then Exit Sub
    txtPaste.Move .Left + .CellLeft - 10, .top + .CellTop - 10, .CellWidth, .CellHeight
    If .col = 4 Then
        txtPaste.MaxLength = 20
        strV = .Text
    ElseIf .col = 5 Then
        txtPaste.MaxLength = 40
        strV = .Text
    Else
        strV = Format(.Text)
        txtPaste.MaxLength = 12
    End If
    If KeyCode = 8 Then
        txtPaste.Text = Mid(strV, 1, Len(strV) - 1)
    ElseIf KeyCode = 0 Then
        txtPaste.Text = strV
    Else
        txtPaste.Text = strV & Chr(KeyCode)
    End If
    mlngCol = .col
    mlngRow = .Row
    lstPaste.Visible = False
    dtePaste.Visible = False
    txtPaste.Visible = True
    txtPaste.SetFocus
    txtPaste.SelStart = Len(txtPaste.Text)
    End With
End Sub

Private Function SaveCard() As Boolean
    Dim i As Integer, strSql As String, dblSum As Double
    Dim strRemark As String, strBookNO As String
    
    On Error GoTo ErrHandle
    SaveCard = False
    gclsBase.BaseWorkSpace.BeginTrans
    With msgEnter
    For i = 1 To .Rows - 1
        If .TextMatrix(i, 1) = "-5" Then
            If .TextMatrix(i, 0) <> "0" Then
                strSql = "DELETE ProjectFundIn WHERE lngDetailID=" & .TextMatrix(i, 0)
            Else
                strSql = ""
            End If
        Else
            If .TextMatrix(i, 3) <> "" Then
                strBookNO = IIf(.TextMatrix(i, 4) = "", " ", .TextMatrix(i, 4))
                strRemark = IIf(.TextMatrix(i, 5) = "", " ", .TextMatrix(i, 5))
                dblSum = TxtToDouble(.TextMatrix(i, 6))
                If .TextMatrix(i, 0) = "0" And dblSum <> 0 Then
                    strSql = "INSERT INTO ProjectFundIn(lngDetailID,lngProjectID,lngOrderID," _
                        & "strDate,dblAmount,strBookNo,strRemark) VALUES(" & GetNewID("ProjectFundIn") _
                        & "," & mlngProjID & "," & TxtToDouble(.TextMatrix(i, 2)) & ",'" & .TextMatrix(i, 3) _
                        & "'," & dblSum & ",'" & strBookNO & "','" & strRemark & "')"
                Else
                    If .TextMatrix(i, 1) = "3" Then
                        If dblSum <> 0 Then
                            strSql = "UPDATE ProjectFundIn SET strDate='" & .TextMatrix(i, 3) & "'," _
                                & "strBookNo='" & strBookNO & "',strRemark='" _
                                & strRemark & "',dblAmount=" & TxtToDouble(.TextMatrix(i, 6)) _
                                & ",lngOrderID=" & TxtToDouble(.TextMatrix(i, 2)) & " WHERE lngDetailID=" _
                                & .TextMatrix(i, 0)
                        Else
                            strSql = "DELETE ProjectFundIn WHERE lngDetailID=" & .TextMatrix(i, 0)
                        End If
                    Else
                        strSql = ""
                    End If
                End If
            Else
                strSql = ""
            End If
        End If
        If strSql <> "" Then
            If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
        End If
    Next i
    End With
    gclsBase.BaseWorkSpace.CommitTrans
    SaveCard = True
    Exit Function
ErrHandle:
    gclsBase.BaseWorkSpace.RollBacktrans
End Function

Private Sub txtPaste_LostFocus()
    If mlngCol = 6 Then
        msgEnter.TextMatrix(mlngRow, mlngCol) = FormatShow(msgEnter.TextMatrix(mlngRow, mlngCol), gclsBase.NaturalCurDec)
        WriteTotal
    End If
    txtPaste.Visible = False
End Sub