frmadditem.frm

地方税务局税控开票系统

         Top             =   690
         Width           =   1245
      End
      Begin VB.Label lblPlace 
         Caption         =   "工程地址"
         Height          =   255
         Index           =   0
         Left            =   3240
         TabIndex        =   17
         Top             =   810
         Width           =   855
      End
      Begin VB.Label lblDateS 
         Caption         =   "始建日期"
         Height          =   255
         Index           =   0
         Left            =   3240
         TabIndex        =   16
         Top             =   1290
         Width           =   855
      End
      Begin VB.Label lblDateE 
         Caption         =   "完工日期"
         Height          =   255
         Index           =   0
         Left            =   5280
         TabIndex        =   15
         Top             =   1290
         Width           =   855
      End
      Begin VB.Label lbl 
         Caption         =   "建筑面积（平方）"
         Height          =   375
         Index           =   0
         Left            =   3240
         TabIndex        =   14
         Top             =   1680
         Width           =   855
      End
      Begin VB.Label lblValue 
         Caption         =   "总造价（元）"
         Height          =   375
         Index           =   0
         Left            =   5340
         TabIndex        =   13
         Top             =   1710
         Width           =   615
      End
      Begin VB.Label Label1 
         Caption         =   " 承建单位   (乙方电话)      法人"
         Height          =   615
         Index           =   0
         Left            =   120
         TabIndex        =   12
         Top             =   1530
         Width           =   1245
      End
      Begin VB.Label Label3 
         Caption         =   "备     注"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   11
         Top             =   2400
         Width           =   855
      End
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消(&C)"
      Height          =   375
      Left            =   6330
      TabIndex        =   52
      Top             =   3180
      Width           =   1125
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定(&O)"
      Default         =   -1  'True
      Height          =   375
      Left            =   4950
      TabIndex        =   51
      Top             =   3180
      Width           =   1095
   End
End
Attribute VB_Name = "frmAddItem"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private mbChangeFlag As Boolean        '''在修改状态时，标识数据是否改变
Private mbUpdate As Boolean

'退出时提示
Private Sub cmdCancel_Click()
    Dim iNum As Integer
    
    If gsEditStatus = "E" And mbChangeFlag = True Then
        iNum = MsgBox("您已经更改了数据，是否要退出？", _
                       vbYesNo + vbQuestion, "提示信息")
        If iNum = 7 Then
            Exit Sub
        Else
            mbChangeFlag = False
        End If
    End If
    Unload Me
    
End Sub

'对数据进行保存或修改
Private Sub cmdOK_Click()
'    If txtCode.Text = "" Then
'        MsgBox "请先输入项目代码！", vbOKOnly + vbInformation, "提示信息"
'    End If
    
    mbUpdate = False
    
    If bCheckCharacter = False Then
        MsgBox "符号(')是本系统的特殊符号，请您选择别的符号代替它!", vbOKOnly + vbInformation, "提示信息"
        Exit Sub
    End If
    
    If gsChequeType = "B" Then
        AddBuildInfo                                '''添加建筑项目信息
    ElseIf gsChequeType = "E" Then
        AddEstateInfo
    Else
        AddCommonInfo                               '''添加通用发票的信息
    End If
    
    If mbUpdate Then
        SaveFileInfo                                    '''保存日期
        Unload Me                                       '''新添项目完毕，退出
    End If
End Sub

'检查是有符号(')的录入
Private Function bCheckCharacter() As Boolean
    Dim oText As Object
    Dim oCbo As Object
    
    bCheckCharacter = False
    
    If gsChequeType = "B" Then
        If Len(txtName.Text) > 0 Then
            If InStr(txtName.Text, "'") > 0 Then
                txtName.SetFocus
                Exit Function
            End If
        End If
        If Len(txtBuild.Text) > 0 Then
            If InStr(txtBuild.Text, "'") > 0 Then
                txtBuild.SetFocus
                Exit Function
            End If
        End If
        If Len(txtAddress.Text) > 0 Then
            If InStr(txtAddress.Text, "'") > 0 Then
                txtAddress.SetFocus
                Exit Function
            End If
        End If
        If Len(txtUndertake.Text) > 0 Then
            If InStr(txtUndertake.Text, "'") > 0 Then
                txtUndertake.SetFocus
                Exit Function
            End If
        End If
        If Len(txtDateStart.Text) > 0 Then
            If InStr(txtDateStart.Text, "'") > 0 Then
                txtDateStart.SetFocus
                Exit Function
            End If
        End If
        If Len(txtDateEnd.Text) > 0 Then
            If InStr(txtDateEnd.Text, "'") > 0 Then
                txtDateEnd.SetFocus
                Exit Function
            End If
        End If
        If Len(txtArea.Text) > 0 Then
            If InStr(txtArea.Text, "'") > 0 Then
                txtArea.SetFocus
                Exit Function
            End If
        End If
        If Len(txtValue.Text) > 0 Then
            If InStr(txtValue.Text, "'") > 0 Then
                txtValue.SetFocus
                Exit Function
            End If
        End If
        If Len(txtNote.Text) > 0 Then
            If InStr(txtNote.Text, "'") > 0 Then
                txtNote.SetFocus
                Exit Function
            End If
        End If
        
        
    ElseIf gsChequeType = "E" Then
        For Each oText In txtEstate
            If Len(oText.Text) > 0 Then
                If InStr(oText.Text, "'") > 0 Then
                    oText.SetFocus
                    Exit Function
                End If
            End If
        Next
    Else
        For Each oText In txtCommon
            If Len(oText.Text) > 0 Then
                If InStr(oText.Text, "'") > 0 Then
                    oText.SetFocus
                    Exit Function
                End If
                
            End If
        Next
    End If
    
    bCheckCharacter = True
End Function

'添加通用发票的信息
Private Sub AddCommonInfo()
    Dim iNum As Integer
    
    If Trim(txtCommon(0).Text) = "" Then
        MsgBox "请先输入收款单位(人)的名称！", vbOKOnly + vbInformation, "提示信息"
        txtCommon(0).SetFocus
        Exit Sub
    End If
    
    If gsEditStatus = "A" Then
        If gbAddItem = False Then
            If Trim(txtCommon(2).Text) = "" Then
                MsgBox "请先输入项目名称！", vbOKOnly + vbInformation, "提示信息"
                txtCommon(2).SetFocus
                Exit Sub
            End If
            
'            If bCheckBargain = False Then Exit Sub     '''检查是否有相同的合同号
            iNum = MsgBox("是否要建立项目'" + Trim(txtCommon(2).Text) + "'？", vbYesNo + vbInformation, "提示信息")
        Else
            iNum = MsgBox("是否要建立收款单位(人)'" + Trim(txtCommon(0).Text) + "'？", vbYesNo + vbInformation, "提示信息")
        End If
        
        If iNum = vbNo Then Exit Sub
        
        SaveCommon                                     '''保存通用发票信息
        MsgBox "您的项目信息已经建立，请确认", vbOKOnly + vbInformation, "提示信息"
    Else
        iNum = MsgBox("是否要修改项目'" + Trim(txtCommon(2).Text) + "'的信息？", vbYesNo + vbInformation, "提示信息")
        
        If iNum = vbNo Then Exit Sub
        UpdateCommon                                   '''更新通用发票信息
        MsgBox "您的项目信息已经修改成功，请确认", vbOKOnly + vbInformation, "提示信息"
    End If

    
    mbChangeFlag = False
    
    mbUpdate = True
End Sub

'保存通用信息
Private Sub SaveCommon()
On Error GoTo err
    Dim StrSQL As String
    Dim sEncry As String
    
    If Trim(txtCommon(0).Text) <> "" Then
        sEncry = sGetEncry
    End If
    
    Set recItem = New ADODB.Recordset
    StrSQL = "insert into " + gsconTabel + "commoncheque (receiveunit,outunit,itemname," + _
             "workaddress,totalmoney,unitname,unitcode) values ('" + _
            Trim(txtCommon(0).Text) + "','" + Trim(txtCommon(1).Text) + "','" + _
            Trim(txtCommon(2).Text) + "','" + Trim(txtCommon(3).Text) + _
            "','" + sEncry + "','" + gsUnitCode + "-" + gsUnitName + "','" + gsUnitCode + "')"
    
    gConn.Execute (StrSQL)
    Exit Sub
err:
    MsgBox "添加信息失败，请先退出系统，再重新添加！", vbOKOnly + vbInformation, "提示信息"
End Sub

'修改通用发票信息
Private Sub UpdateCommon()
On Error GoTo err
    Dim StrSQL As String
    Dim sWhere As String
    
'    If gbAddItem = True Then
        sWhere = " itemname ='" + Trim(txtCommon(2).Text) + "'"
'    End If
    
    Set recItem = New ADODB.Recordset
    StrSQL = "update " + gsconTabel + "commoncheque set " + _
                                      "receiveunit ='" + Trim(txtCommon(0).Text) + "'," + _
                                      "outunit = '" + Trim(txtCommon(1).Text) + "'," + _
                                      "itemname ='" + Trim(txtCommon(2).Text) + "'," + _
                                      "workaddress = '" + Trim(txtCommon(3).Text) + "'" + _
                                      " where " + sWhere
    
    gConn.Execute (StrSQL)
    Exit Sub
err:
    MsgBox "修改项目失败，请确认！", vbOKOnly + vbInformation, "提示信息"
End Sub

'添加不动产项目信息
Private Sub AddEstateInfo()
    Dim iNum As Integer

    If Trim(txtEstate(1).Text) = "" Then
        MsgBox "请先输入项目名称！", vbOKOnly + vbInformation, "提示信息"
        txtEstate(1).SetFocus
        Exit Sub
    End If
    
    If Trim(txtEstate(3).Text) = "" Then
        MsgBox "请先输入项目地址！", vbOKOnly + vbInformation, "提示信息"
        txtEstate(3).SetFocus
        Exit Sub
    End If
    
    If gsEditStatus = "A" Then
        If gbAddItem = False Then
            If Trim(txtEstate(0).Text) = "" Then
                MsgBox "请先输入合同号！", vbOKOnly + vbInformation, "提示信息"
                txtEstate(0).SetFocus
                Exit Sub
            End If
            
            If Trim(txtEstate(4).Text) = "" Then
                MsgBox "请先输入顾客名称！", vbOKOnly + vbInformation, "提示信息"
                txtEstate(4).SetFocus
                Exit Sub
            End If
            
            If bCheckBargain = False Then Exit Sub     '''检查是否有相同的合同号
            
            iNum = MsgBox("是否要建立合同号'" + Trim(txtEstate(0).Text) + "'？", vbYesNo + vbInformation, "提示信息")
        Else
            iNum = MsgBox("是否要建立项目'" + Trim(txtEstate(1).Text) + "'？", vbYesNo + vbInformation, "提示信息")
        End If
    
        If iNum = vbNo Then Exit Sub
        
        SaveEstate                                     '''保存不动产信息
        gsEstateCode = txtEstate(0).Text
        
        MsgBox "您的项目信息已经建立，请确认", vbOKOnly + vbInformation, "提示信息"
    Else
        iNum = MsgBox("是否要修改项目'" + Trim(txtEstate(1).Text) + "'的信息？", vbYesNo + vbInformation, "提示信息")
        
        If iNum = vbNo Then Exit Sub
        UpdateEstate                                   '''更新不动产信息
        
        MsgBox "您的项目信息已经修改成功，请确认", vbOKOnly + vbInformation, "提示信息"
    End If
    
    mbChangeFlag = False
    mbUpdate = True
    
End Sub

'检查合同号
Private Function bCheckBargain() As Boolean
On Error GoTo err
    Dim StrSQL As String
    Dim recCheck As ADODB.Recordset
    
    bCheckBargain = False
    Set recCheck = New ADODB.Recordset
    StrSQL = "select * from " + gsconTabel + "estatecheque where estatecode ='" + Trim(txtEstate(0).Text) + "'"
    If recCheck.State = 1 Then recCheck.Close
    recCheck.CursorLocation = adUseClient
    recCheck.Open StrSQL, gConn, adOpenStatic, adLockBatchOptimistic
    
    If recCheck.RecordCount > 0 Then
        bCheckBargain = False
        MsgBox "所要添加的合同号已存在，请确认", vbOKOnly + vbInformation, "提示信息"
        Exit Function
    End If
    
    bCheckBargain = True
    Exit Function
err:
    MsgBox "不能添加的合同号，请确认", vbOKOnly + vbInformation, "提示信息"
End Function

'保存不动产信息
Private Sub SaveEstate()
On Error GoTo err
    Dim StrSQL As String
    Dim sEncry As String
    
    If Trim(txtEstate(0).Text) <> "" Then             '''只有在添加项目时，才写上信息
        sEncry = sGetEncry
    End If