frmfi_zzpzadd.frm

一个用VB写的财务软件源码

VERSION 5.00
Begin VB.Form frmFI_ZzpzAdd 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "转账凭证添加（编辑）"
   ClientHeight    =   3315
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4785
   Icon            =   "frmFI_ZzpzAdd.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3315
   ScaleWidth      =   4785
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdUndo 
      Caption         =   "取消(&U)"
      Height          =   345
      Left            =   2760
      TabIndex        =   5
      Top             =   2760
      Width           =   1065
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定(&O)"
      Height          =   345
      Left            =   1080
      TabIndex        =   4
      Top             =   2760
      Width           =   1065
   End
   Begin VB.Frame Frame1 
      Height          =   2175
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   4215
      Begin VB.CommandButton cmdHelp 
         Height          =   300
         Left            =   3150
         Picture         =   "frmFI_ZzpzAdd.frx":0442
         Style           =   1  'Graphical
         TabIndex        =   9
         Top             =   960
         Width           =   375
      End
      Begin VB.ComboBox cboPzzl 
         Height          =   300
         Left            =   1680
         TabIndex        =   3
         Text            =   "cboPzzl"
         Top             =   1440
         Width           =   1575
      End
      Begin VB.TextBox txtZzSm 
         Height          =   300
         Left            =   1680
         MaxLength       =   40
         TabIndex        =   2
         Top             =   960
         Width           =   1455
      End
      Begin VB.TextBox txtZzXh 
         Height          =   300
         Left            =   1680
         MaxLength       =   4
         TabIndex        =   1
         Top             =   480
         Width           =   1095
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "凭证类别："
         Height          =   180
         Left            =   480
         TabIndex        =   8
         Top             =   1500
         Width           =   900
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "转账说明："
         Height          =   180
         Left            =   480
         TabIndex        =   7
         Top             =   1020
         Width           =   900
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "转账序号："
         Height          =   180
         Left            =   480
         TabIndex        =   6
         Top             =   540
         Width           =   900
      End
   End
End
Attribute VB_Name = "frmFI_ZzpzAdd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'------------------yang       2000-12-14
Public sFlag As String      'add :添加        edit:编辑
Public IsOk As Boolean
Public sOldxh As String

Dim frmH_Summ As frmIN_Summary

Private Sub cboPZZL_KeyPress(KeyAscii As Integer)

        If KeyAscii = 13 Then
          SendKeys "{tab}"
        End If
        
End Sub

Private Sub cmdHelp_Click()
    Set frmH_Summ = New frmIN_Summary          '摘要
    frmH_Summ.ubSelectStatus = True
    frmH_Summ.Show 1
    
    If frmH_Summ.usName <> "" Then
        txtZzSm.text = frmH_Summ.usName
    End If
    txtZzSm.SetFocus
End Sub

Private Sub cmdOk_Click()
        Dim iTmp As Integer
        
        If Trim(txtZzXh.text) = "" Then
           MsgBox "转账凭证序号不能为空！", vbExclamation, "提示"
           txtZzXh.SetFocus
           Exit Sub
        End If
        
        If UCase(sFlag) = "ADD" Or sOldxh <> Trim(txtZzXh.text) Then
            If iTmp >= 0 Then
            
                For iTmp = 0 To frmFI_ZzpzSet.cboZzXh.ListCount - 1
                    If Trim(frmFI_ZzpzSet.cboZzXh.List(iTmp)) = Trim(txtZzXh.text) Then
                       Exit For
                    End If
                Next iTmp
                
                
                If iTmp <= frmFI_ZzpzSet.cboZzXh.ListCount - 1 Then
                    MsgBox "转账凭证序号不能重复！", vbExclamation, "提示"
                    txtZzXh.SetFocus
                    Exit Sub
                End If
                
            End If
        End If
        
        If Trim(txtZzSm.text) = "" Then
          MsgBox "转账说明不能为空！", vbExclamation, "提示"
          txtZzSm.SetFocus
          Exit Sub
        End If
        
        If Trim(cboPZZL.text) = "" Then
           MsgBox "凭证类别不能不空！", vbExclamation, "提示"
           cboPZZL.SetFocus
           Exit Sub
        End If
        
        If checkSetSgn(cboPZZL.text) = False Then
           MsgBox "凭证类别不存在！", vbExclamation, "提示"
           cboPZZL.SetFocus
           Exit Sub
           
        End If
                
        frmFI_ZzpzSet.newZzxh = Trim(txtZzXh.text)
        frmFI_ZzpzSet.newZzsm = Trim(txtZzSm.text)
        frmFI_ZzpzSet.newZzlb = Trim(cboPZZL.text)
        IsOk = True
        Unload Me
        
End Sub
Private Function haveZF() As Boolean
    Dim rstTmp As New ADODB.Recordset
    rstTmp.CursorLocation = adUseClient
    
    haveZF = False
    rstTmp.Open "select * from tzw_zzpzset" & glo.sOperateYear & " where id='" & Trim(txtZzXh.text) & "'", glo.cnnMain, adOpenStatic, adLockReadOnly
    If rstTmp.RecordCount > 0 Then
       haveZF = True
    End If
End Function

Private Function checkSetSgn(sTj As String) As Boolean
Dim rstPZZL As ADODB.Recordset
'On Error GoTo err1
Set rstPZZL = New ADODB.Recordset

    With rstPZZL
        .CursorLocation = adUseClient
        .Open "select * from tZW_type" & glo.sOperateYear & " where sign='" & sTj & "'", _
                    glo.cnnMain, adOpenStatic, adLockReadOnly
        If .RecordCount <> 0 Then
           checkSetSgn = True
           
        Else
           checkSetSgn = False
        End If
          .Close
    End With
    Exit Function
err1:
    MsgBox "ErrNumber:" & Err.Number & "Err:" & Err.Description, vbExclamation, "提示"
    checkSetSgn = False
    
End Function

Private Sub cmdUndo_Click()
        Unload Me
End Sub

Private Sub form_load()
    
 
    Call FillCbo
    
    If UCase(sFlag) = "EDIT" Then
       txtZzXh.text = Trim(frmFI_ZzpzSet.cboZzXh.text)
       txtZzSm.text = Trim(frmFI_ZzpzSet.cboZzsm.text)
       cboPZZL.text = Trim(frmFI_ZzpzSet.lbPzlb.Caption)
''       sOldxh = Trim(txtZzXh.Text)
    End If
    
    If UCase(sFlag) = "ADD" Then
       txtZzXh.text = ""
       txtZzSm.text = ""
       
    End If
    
    
End Sub
Private Sub FillCbo()
    Dim rstPZZL As ADODB.Recordset
    Dim s As String
'    If frmFI_ZzpzAdd.Tag = "" Then Exit Sub
    cboPZZL.Clear
    s = ""
    Set rstPZZL = New ADODB.Recordset
    With rstPZZL
        .CursorLocation = adUseClient
        .Open "select * from tZW_type" & glo.sOperateYear & " order by signID", _
                    glo.cnnMain, adOpenStatic, adLockReadOnly
        If .RecordCount <> 0 Then
            .MoveFirst
            Do Until .EOF
                cboPZZL.AddItem .Fields("sign").Value
                If Left$(.Fields("sign").Value, 1) = "转" And s = "" Then
                    s = .Fields("sign").Value
                End If
                .MoveNext
            Loop
            If s = "" Then
                cboPZZL.ListIndex = 0       '该语句触发 cboPZZL_Click 事件
            Else
                cboPZZL.text = s
            End If
        End If
        .Close
    End With
End Sub

Private Sub txtZzSm_KeyPress(KeyAscii As Integer)
     If KeyAscii = 13 Then
            SendKeys "{tab}"
     End If
End Sub

Private Sub txtZzXh_KeyPress(KeyAscii As Integer)
        If KeyAscii = 13 Then
            SendKeys "{tab}"
        Else
            KeyAscii = IntegerEnabled(KeyAscii)
        End If
        
End Sub