frmprodatacard.frm

金算盘软件代码

        If Me.ActiveControl.Name <> "msgData" Then
            BKKEY Me.ActiveControl.hwnd, vbKeyTab
        End If
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If Shift <> 2 Then Exit Sub
    If KeyCode = vbKeyReturn Then
        cmdOK(0).Value = True
    ElseIf KeyCode = vbKeyA Then
        mnuAdd_Click
    ElseIf KeyCode = vbKeyD And mnuDel.Enabled Then
        mnuDel_Click
    End If
End Sub

Private Sub Form_Load()
    Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
    #If conVersionType = 1 Then
        mstrTitle = "在建工程"
    #Else
        mstrTitle = "工程项目"
    #End If
    Utility.LoadFormResPicture Me
    Set mclsGrid = New Grid
    Set mclsGrid.Grid = msgData
    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(Index As Integer)
    If lstPaste(Index).Text = "" Then
        msgData.Text = ""
        msgData.TextMatrix(msgData.Row, Index + 2) = 0
        msgData.TextMatrix(msgData.Row, 1) = "3"
        If Not mblnIsInit Then mblnIsChanged = True
    End If
End Sub

Private Sub lstPaste_Choose(Index As Integer)
    Dim lngCustomerID As Long
    
    If Index = 0 Then
        msgData.TextMatrix(msgData.Row, 5) = lstPaste(Index).Text
        msgData.TextMatrix(msgData.Row, 2) = lstPaste(Index).ID
        lngCustomerID = TxtToDouble(lstPaste(0).TextMatrix(lstPaste(0).ReferRow, 4))
        lstPaste(1).SeekId lngCustomerID
        msgData.TextMatrix(msgData.Row, 6) = lstPaste(1).Text
        msgData.TextMatrix(msgData.Row, 3) = lstPaste(1).ID
    Else
        msgData.TextMatrix(msgData.Row, 6) = lstPaste(Index).Text
        msgData.TextMatrix(msgData.Row, 3) = lstPaste(Index).ID
    End If
    msgData.TextMatrix(msgData.Row, 1) = "3"
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub lstpaste_ItemNotExist(Index As Integer)
'    msgData.TextMatrix(msgData.Row, Index + 5) = ""
'    msgData.TextMatrix(msgData.Row, Index + 2) = 0
'    msgData.TextMatrix(msgData.Row, 1) = "3"
'    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub lstPaste_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        BKKEY msgData.hwnd, vbKeyRight
    End If
End Sub

Private Sub lstPaste_LostFocus(Index As Integer)
    lstPaste(Index).Visible = False
End Sub

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

Private Sub mnuAdd_Click()
    msgData.Rows = msgData.Rows + 1
    msgData.Row = msgData.Rows - 1
    msgData.TextMatrix(msgData.Row, 0) = "0"
    msgData.col = 4
    mblnIsChanged = True
End Sub

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

Private Sub msgData_Click()
    msgData_EnterCell
End Sub

Private Sub msgData_DblClick()
    If msgData.Row = 0 Then Exit Sub
    If msgData.col > 6 Then
        EditGrid 0
    Else
        Paste
    End If
End Sub

Private Sub msgData_EnterCell()
'    If msgData.Row = 0 Then Exit Sub
'    If msgData.col > 3 And msgData.col < 7 Then Paste
End Sub

Private Sub msgData_KeyPress(KeyAscii As Integer)
    With msgData
        Select Case msgData.col
        Case 4, 5, 6
            Paste
        Case 7
            txtPaste.MaxLength = 40
            If InStr("'""|`~", Chr(KeyAscii)) <> 0 Then
                EditGrid 0
            Else
                EditGrid KeyAscii
            End If
        Case 8
            txtPaste.MaxLength = 10
            If Not IsNum(txtPaste.Text, 2, True) Then
                EditGrid 0
            Else
                EditGrid KeyAscii
            End If
        End Select
    End With
End Sub

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

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

Private Sub msgData_Scroll()
    dtePaste.Visible = False
    lstPaste(0).Visible = False
    lstPaste(1).Visible = False
    txtPaste.Visible = False
End Sub

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

Private Sub txtPaste_KeyPress(KeyAscii As Integer)
    Dim l As Long
    
    If KeyAscii = vbKeyReturn Then
        If msgData.col = 7 Then
            BKKEY msgData.hwnd, vbKeyRight
        Else
            For l = msgData.Row + 1 To msgData.Rows - 1
                If msgData.RowHeight(l) > 0 Then Exit For
            Next l
            If l < msgData.Rows Then
                msgData.col = 4
                msgData.Row = l
            Else
                mnuAdd_Click
            End If
        End If
    Else
        If msgData.col = 8 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 msgData
    If .RowHeight(.Row) = 0 Or .col = 0 Then Exit Sub
    txtPaste.Move .Left + .CellLeft - 10, .top + .CellTop - 10, .CellWidth, .CellHeight
    If .col = 8 Then
        txtPaste.MaxLength = 10
        strV = Format(.Text)
    Else
        txtPaste.MaxLength = 40
        strV = .Text
    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
    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, strNote As String, dblV As Double
    
    On Error GoTo ErrHandle
    SaveCard = False
    gclsBase.BaseWorkSpace.BeginTrans
    With msgData
    For i = 1 To .Rows - 1
        If .TextMatrix(i, 1) = "-5" Then
            If .TextMatrix(i, 0) <> "0" Then
                strSql = "DELETE ProjectInvoice WHERE lngInvoiceDetailID=" & .TextMatrix(i, 0)
            Else
                strSql = ""
            End If
        Else
            strNote = IIf(.TextMatrix(i, 7) = "", " ", .TextMatrix(i, 7))
            dblV = TxtToDouble(.TextMatrix(i, 8))
            If .TextMatrix(i, 4) <> "" And TxtToDouble(.TextMatrix(i, 3)) <> 0 Then
                If .TextMatrix(i, 0) = "0" Then
                    If dblV <> 0 Then
                        strSql = "INSERT INTO ProjectInvoice(lngInvoiceDetailID,lngProjectID,lngOrderID," _
                            & "lngCustomerID,strDate,dblAmount,strNote) VALUES(" & GetNewID("ProjectInvoice") _
                            & "," & mlngProjID & "," & TxtToDouble(.TextMatrix(i, 2)) & "," & TxtToDouble(.TextMatrix(i, 3)) _
                            & ",'" & .TextMatrix(i, 4) & "'," & TxtToDouble(.TextMatrix(i, 8)) & ",'" & strNote & "')"
                    Else
                        strSql = ""
                    End If
                Else
                    If .TextMatrix(i, 1) = "3" Then
                        If dblV <> 0 Then
                            strSql = "UPDATE ProjectInvoice SET strDate='" & .TextMatrix(i, 4) & "',strNote='" _
                                & strNote & "',dblAmount=" & TxtToDouble(.TextMatrix(i, 8)) _
                                & ",lngOrderID=" & TxtToDouble(.TextMatrix(i, 2)) & ",lngCustomerID=" _
                                & TxtToDouble(.TextMatrix(i, 3)) & " WHERE lngInvoiceDetailID=" & .TextMatrix(i, 0)
                        Else
                            strSql = "DELETE ProjectInvoice WHERE lngInvoiceDetailID=" & .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 = 8 Then
        msgData.TextMatrix(mlngRow, mlngCol) = FormatShow(msgData.TextMatrix(mlngRow, mlngCol), gclsBase.NaturalCurDec)
        WriteTotal
    End If
    txtPaste.Visible = False
End Sub