frmvisitclientcard.frm

金算盘软件代码

        End If
    Else
        If cboClient(1).Text <> mintYear Then
            If mblnIsChanged Then SaveData
            mintYear = cboClient(1).Text
            InitGrid
        End If
    End If
End Sub

Private Sub cmdOK_Click(index As Integer)
    Select Case index
    Case 0:
        If Not SaveData Then
            Exit Sub
        Else
            Unload Me
        End If
    Case 1: Unload Me
    Case 2: PrintData
    End Select
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If mblnIsRefer Then Exit Sub
    If KeyAscii = vbKeyReturn Then
        Select Case Me.ActiveControl.Name
        Case "txtInput", "msgClient"
        Case Else
            BKKEY Me.ActiveControl.hwnd, vbKeyTab
        End Select
    ElseIf KeyAscii = vbKeyEscape Then
        cmdOk(1).Value = True
    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
    End If
End Sub

Private Sub Form_Load()
    Dim edtErrReturn As ErrDealType, b As Byte
    
    On Error GoTo ErrHandle
    Utility.LoadFormResPicture Me
    Set mclsGrid = New Grid
    Set mclsGrid.Grid = msgClient
    InitCbo
    If cboClient(0).ListCount = 0 Then
        ShowMsg 0, "没有具有销售权限的职员，不能编辑拜访客户资料！", vbExclamation + MB_TASKMODAL, Caption
        Unload Me
        Exit Sub
    End If
    For b = 1 To 12
        msgClient.TextMatrix(b, 0) = "0"
        msgClient.TextMatrix(b, 1) = Right("0" & b, 2)
    Next b
    InitGrid
    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 SaveData
        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
End Sub

Private Sub msgClient_DblClick()
    If msgClient.Row = 0 Or msgClient.col < 2 Then Exit Sub
    EditGrid 0
End Sub

Private Sub msgClient_KeyPress(KeyAscii As Integer)
    If msgClient.Row = 0 Or msgClient.RowHeight(msgClient.Row) = 0 Then Exit Sub
    If KeyAscii = vbKeySpace Then
        msgClient_DblClick
    ElseIf KeyAscii = vbKeyReturn Then
        BKKEY msgClient.hwnd, vbKeyRight
    Else
        Select Case msgClient.col
        Case 2, 3, 4
            If InStr("0123456789", Chr(KeyAscii)) = 0 And KeyAscii <> 8 Then
                EditGrid 0
            Else
                EditGrid KeyAscii
            End If
        Case 5, 6
            If InStr("'""|", Chr(KeyAscii)) > 0 And KeyAscii <> 8 Then
                EditGrid 0
            Else
                EditGrid KeyAscii
            End If
        End Select
    End If
End Sub

Private Sub msgClient_Scroll()
    txtInput.Visible = False
End Sub

Private Sub txtInput_Change()
    Select Case msgClient.col
    Case 2, 3, 4
        If Not ContainSpecifyChar(txtInput.Text) Then BKKEY txtInput.hwnd
    Case Else
        If ContainErrorChar(txtInput.Text, "'""|") Then BKKEY txtInput.hwnd
    End Select
    msgClient.TextMatrix(mlngRow, mlngCol) = txtInput.Text
    msgClient.TextMatrix(mlngRow, 0) = "1"
    mblnIsChanged = True
End Sub

Private Sub txtInput_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then txtInput_LostFocus
End Sub

Private Sub txtInput_LostFocus()
    txtInput.Visible = False
End Sub

Private Sub EditGrid(ByVal KeyCode As Integer)
    On Error Resume Next
    With msgClient
    mlngCol = .col
    mlngRow = .Row
    Select Case .col
    Case 2, 3, 4:
        txtInput.MaxLength = 3
'        txtInput.MultiLine = False
    Case 5:
        txtInput.MaxLength = 10000
'        txtInput.MultiLine = True
    Case 6:
        txtInput.MaxLength = 20
'        txtInput.MultiLine = False
    End Select
    txtInput.Move .Left + .CellLeft - 10, .top + .CellTop - 10, .CellWidth, .CellHeight
    If KeyCode = 8 Then
        txtInput.Text = Mid(.Text, 1, Len(.Text) - 1)
    Else
        txtInput.Text = .Text & Chr(KeyCode)
    End If
    txtInput.Visible = True
    txtInput.SetFocus
    txtInput.SelStart = Len(txtInput.Text)
    .Text = txtInput.Text
    mblnIsChanged = True
    End With
End Sub

Private Sub PrintData()
    Dim myPrintclass As PrintClass
    
    Set myPrintclass = New PrintClass
    myPrintclass.PrintList gclsBase.BaseDB, msgClient, 3385, Caption & Chr(1) _
        & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName & Chr(1) & "职员:" _
        & cboClient(0).Text & Chr(1) & "年度:" & cboClient(1).Text
End Sub

Private Function SaveData(Optional blnByAdd As Boolean = False) As Boolean
    Dim intWorkDays As Integer, lngPlanTimes As Long, dblTimes As Double
    Dim l As Long, strSql As String, strNote As String, strContactName As String
    
    If Not mblnIsChanged Then
        SaveData = True
        Exit Function
    End If
    
    On Error GoTo ErrHandle
    SaveData = False
    gclsBase.BaseWorkSpace.BeginTrans
    With msgClient
        For l = 1 To .Rows - 1
            If .TextMatrix(l, 0) <> "0" Then
                intWorkDays = TxtToDouble(.TextMatrix(l, 2))
                lngPlanTimes = TxtToDouble(.TextMatrix(l, 3))
                dblTimes = TxtToDouble(.TextMatrix(l, 4))
                strNote = IIf(.TextMatrix(l, 5) = "", " ", .TextMatrix(l, 5))
                strContactName = IIf(.TextMatrix(l, 6) = "", " ", .TextMatrix(l, 6))
                If intWorkDays + lngPlanTimes + dblTimes <> 0 Then
                    strSql = "INSERT INTO CustomerVisit(intYear,bytPeriod,lngEmployeeID," _
                        & "intWorkDays,lngPlanTimes,dblTimes,strNote,strContactName) " _
                        & "VALUES(" & mintYear & "," & l & "," & mlngEmployeeID & "," _
                        & intWorkDays & "," & lngPlanTimes & "," & dblTimes & ",'" _
                        & strNote & "','" & strContactName & "')"
                Else
                    strSql = "DELETE FROM CustomerVisit WHERE intYear=" & mintYear & " AND " _
                        & "bytPeriod=" & l & " AND lngEmployeeID=" & mlngEmployeeID
                End If
                If Not gclsBase.ExecSQL(strSql) Then
                    strSql = "UPDATE CustomerVisit SET intWorkDays=" & intWorkDays _
                        & ",lngPlanTimes=" & lngPlanTimes & ",dblTimes=" & dblTimes _
                        & ",strNote='" & strNote _
                        & "',strContactName='" & strContactName & "' WHERE " _
                        & "intYear=" & mintYear & " AND bytPeriod=" & l _
                        & " AND lngEmployeeID=" & mlngEmployeeID
                    If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
                End If
            End If
        Next l
    End With
    gclsBase.BaseWorkSpace.CommitTrans
    SaveData = True
    mblnIsChanged = False
    Exit Function
ErrHandle:
    gclsBase.BaseWorkSpace.RollBacktrans
End Function