frmmodi.frm

来自「一个资金管理系统的成品 开发环境：VB」· FRM 代码 · 共 893 行 · 第 1/2 页

      BackStyle       =   0  'Transparent
      Caption         =   "预算科目代码"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   960
      TabIndex        =   22
      Top             =   1680
      Width           =   1095
   End
   Begin VB.Label Label6 
      BackStyle       =   0  'Transparent
      Caption         =   "业务金额"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   960
      TabIndex        =   21
      Top             =   2400
      Width           =   1095
   End
   Begin VB.Label Label7 
      BackStyle       =   0  'Transparent
      Caption         =   "管理部门"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3480
      TabIndex        =   20
      Top             =   960
      Width           =   1095
   End
   Begin VB.Label Label8 
      BackStyle       =   0  'Transparent
      Caption         =   "预算类别"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   8640
      TabIndex        =   19
      Top             =   960
      Width           =   1455
   End
   Begin VB.Label Label9 
      BackStyle       =   0  'Transparent
      Caption         =   "预算科目"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3480
      TabIndex        =   18
      Top             =   1680
      Width           =   1095
   End
   Begin VB.Label Label10 
      BackStyle       =   0  'Transparent
      Caption         =   "归属部门代码"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   6240
      TabIndex        =   17
      Top             =   1680
      Width           =   1095
   End
End
Attribute VB_Name = "frmmodi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim conn As New ADODB.Connection
Dim rskjyw As New ADODB.Recordset
Dim rsgkglbm As New ADODB.Recordset
Dim rsyskmlb As New ADODB.Recordset
Dim rsyskm As New ADODB.Recordset
Dim rsfygsbm As New ADODB.Recordset
Dim rs As New ADODB.Recordset
Dim addrecord As Boolean

Private Sub setbuttons(bval As Boolean)
  Dim setcontrol As Control
  For Each setcontrol In Me.Controls
    If TypeName(setcontrol) = "DataCombo" Or TypeName(setcontrol) = "TextBox" Or TypeName(setcontrol) = "CheckBox" Then
       setcontrol.Enabled = bval
    End If
  Next
  cmdkjyw(0).Enabled = Not bval
  cmdkjyw(1).Enabled = bval
  cmdkjyw(2).Enabled = bval
  cmdkjyw(3).Enabled = Not bval
  DTfsrq.Enabled = bval
  Exit Sub
End Sub
'保存会计业务纪录
Private Function storekjyw() As Boolean
  Dim note(8) As String
  Dim str As String
  note(0) = "凭证号码不能为空！"
  note(1) = "发生日期不能为空！"
  note(2) = "归口管理部门代码和名称不能同时为空！"
  note(3) = "预算科目类别代码和名称不能同时为空！"
  note(4) = "预算科目代码和名称不能同时为空！"
  note(5) = "费用归属部门代码和名称不能同时为空！"
  note(6) = "业务金额不能为空！"
  note(7) = "该凭证号码已经存在！"
  storekjyw = False
  If Dacompzhm.Text = "" Then
     MsgBox note(0)
     Dacompzhm.SetFocus
     Exit Function
  End If
  
  If DTfsrq.Value = "" Then
     MsgBox note(1)
     DTfsrq.SetFocus
     Exit Function
  End If
  
  If Dacomglbmdm.Text = "" And Dacomglbmmc.Text = "" Then
     MsgBox note(2)
     Dacomglbmdm.SetFocus
     Exit Function
  End If
  
  If Dacomyslbdm.Text = "" And Dacomyslbmc.Text = "" Then
     MsgBox note(3)
     Dacomyslbdm.SetFocus
     Exit Function
  End If
  
  If Dacomyskmdm.Text = "" And Dacomyskmmc.Text = "" Then
     MsgBox note(4)
     Dacomyskmdm.SetFocus
     Exit Function
  End If
  
   
  If Dacomgsbmdm.Text = "" And Dacomgsbmmc.Text = "" Then
     MsgBox note(5)
     Dacomgsbmdm.SetFocus
     Exit Function
  End If
  
  If Dacomywje.Text = "" Then
     MsgBox note(6)
     Dacomywje.SetFocus
     Exit Function
  End If
 
  
  If addrecord = True Then
     Set rs = conn.Execute("select * from kjyw where pzhm=" & Val(Dacompzhm.Text))
  Else
     Set rs = conn.Execute("select * from kjyw where pzhm=" & Val(Dacompzhm.Text) & " and xuhao =" & rskjyw.Fields("a.xuhao"))
  End If
  If Not rs.EOF Then
     MsgBox note(7)
     Dacompzhm.SetFocus
     Exit Function
  End If
  storekjyw = True
  Exit Function
End Function
Private Sub cmdkjyw_Click(Index As Integer)
  Select Case Index
     Case 0 '添加、修改或删除
        If cmdkjyw(Index).Caption = "添加" Then
           addrecord = True
           Dacomglbmdm.Text = ""
           Dacomyslbdm.Text = ""
           Dacomyskmdm.Text = ""
           Dacomgsbmdm.Text = ""
           setbuttons True
           rskjyw.AddNew
           DTfsrq.Value = Date
           txtbz.Text = " "
        Else
           If cmdkjyw(Index).Caption = "修改" Then
              addrecord = False
              setbuttons True
           Else '删除
              conn.Execute ("delete from kjyw where xuhao=" & rskjyw.Fields("xuhao"))
              rskjyw.Requery
              Exit Sub
           End If
        End If
        Dacompzhm.SetFocus
        Exit Sub
     Case 1 '保存
        If storekjyw = True Then
           'If addrecord = True Then
              rskjyw.UpdateBatch adAffectCurrent
              setbuttons False
              rskjyw.Requery
              MsgBox "保存成功！"
           'Else
              
           'End If
           'setbuttons False
           'storehistory
           'adorefresh
           'conn.Execute ("insert into hthistory (username,act,content,date) values('" & yhmc & "','增加','','" & Date & "')")
        End If
        Exit Sub
     Case 2 '取消
        rskjyw.CancelUpdate
        setbuttons False
        Exit Sub
     Case 3 '退出
        Unload Me
  End Select
End Sub
Private Sub Dacomglbmdm_Change()
 'Set rs = conn.Execute("select * from yskmlb where dm='" & Left(Dacomdm.Text, 1) & "'")
If Trim(Dacomglbmdm.Text) <> "" Then
  rsgkglbm.Filter = "dm ='" & Trim(Dacomglbmdm.Text) & "'"
  If Not rsgkglbm.EOF Then
    Dacomglbmmc.Text = rsgkglbm.Fields("glbmmc").Value
  End If
'  Dacomlbdm.Refresh
End If
End Sub

Private Sub Dacomglbmmc_Change()
If Trim(Dacomglbmmc.Text) <> "" Then
  rsgkglbm.Filter = "glbmmc ='" & Trim(Dacomglbmmc.Text) & "'"
  If Not rsgkglbm.EOF Then
    Dacomglbmdm.Text = rsgkglbm.Fields("dm").Value
  End If
'  Dacomlbdm.Refresh
End If
End Sub
Private Sub Dacomyslbdm_Change()
 'Set rs = conn.Execute("select * from yskmlb where dm='" & Left(Dacomdm.Text, 1) & "'")
If Trim(Dacomyslbdm.Text) <> "" Then
  rsyskmlb.Filter = "dm ='" & Trim(Dacomyslbdm.Text) & "'"
  If Not rsyskmlb.EOF Then
    Dacomyslbmc.Text = rsyskmlb.Fields("yslbmc").Value
  End If
'  Dacomlbdm.Refresh
End If
End Sub

Private Sub Dacomyslbmc_Change()
If Trim(Dacomyslbmc.Text) <> "" Then
  rsyskmlb.Filter = "yslbmc ='" & Trim(Dacomyslbmc.Text) & "'"
  If Not rsgkglbm.EOF Then
    Dacomyslbdm.Text = rsyskmlb.Fields("dm").Value
  End If
'  Dacomlbdm.Refresh
End If
End Sub
Private Sub Dacomyskmdm_Change()
 'Set rs = conn.Execute("select * from yskmlb where dm='" & Left(Dacomdm.Text, 1) & "'")
If Trim(Dacomyskmdm.Text) <> "" Then
  rsyskm.Filter = "dm ='" & Trim(Dacomyskmdm.Text) & "'"
  If Not rsyskm.EOF Then
    Dacomyskmmc.Text = rsyskm.Fields("yskmmc").Value
  End If
'  Dacomlbdm.Refresh
End If
End Sub
Private Sub Dacomyskmmc_Change()
If Trim(Dacomyskmmc.Text) <> "" Then
  rsyskm.Filter = "yskmmc ='" & Trim(Dacomyskmmc.Text) & "'"
  If Not rsyskm.EOF Then
    Dacomyskmdm.Text = rsyskm.Fields("dm").Value
  End If
'  Dacomlbdm.Refresh
End If
End Sub
Private Sub Dacomgsbmdm_Change()
 'Set rs = conn.Execute("select * from yskmlb where dm='" & Left(Dacomdm.Text, 1) & "'")
If Trim(Dacomgsbmdm.Text) <> "" Then
  rsfygsbm.Filter = "dm ='" & Trim(Dacomgsbmdm.Text) & "'"
  If Not rsfygsbm.EOF Then
    Dacomgsbmmc.Text = rsfygsbm.Fields("gsbmmc").Value
  End If
'  Dacomlbdm.Refresh
End If
End Sub
Private Sub Dacomgsbmmc_Change()
If Trim(Dacomgsbmmc.Text) <> "" Then
  rsfygsbm.Filter = "gsbmmc ='" & Trim(Dacomgsbmmc.Text) & "'"
  If Not rsgkglbm.EOF Then
    Dacomgsbmdm.Text = rsfygsbm.Fields("dm").Value
  End If
'  Dacomlbdm.Refresh
End If
End Sub

Private Sub Form_Load()
Dim fieldname(13) As Variant
Dim wide(13) As Variant
Dim str As String
fieldname(0) = "序号"
fieldname(1) = "凭证号码"
fieldname(2) = "发生日期"
fieldname(3) = "归口管理部门代码"
fieldname(4) = "归口管理部门"
fieldname(5) = "预算科目类别代码"
fieldname(6) = "预算科目类别"
fieldname(7) = "预算科目代码"
fieldname(8) = "预算科目名称"
fieldname(9) = "费用归属部门代码"
fieldname(10) = "费用归属部门"
fieldname(11) = "业务金额"
fieldname(12) = "备注"
wide(0) = 400
wide(1) = 800
wide(2) = 1000
wide(3) = 1000
wide(4) = 1400
wide(5) = 1000
wide(6) = 1400
wide(7) = 1000
wide(8) = 1400
wide(9) = 1000
wide(10) = 1400
wide(11) = 1000
wide(12) = 1400

'str = "Provider=SQLOLEDB.1;Password=090309;Persist Security Info=True;User ID=cw;Initial Catalog=ysgl2004;Data Source=CWSERVER"
If conn.State <> 1 Then
    conn.CursorLocation = adUseClient
    conn.Open nowconnectstring
End If
str = "SELECT a.xuhao, a.pzhm, a.fsrq , e.dm as glbmdm,a.glbmmc,b.dm AS yskmlbdm, a.yslbmc, c.dm AS yskmdm,a.yskmmc, d.dm AS gsbmdm, a.gsbmmc, a.ywje, a.bz FROM kjyw a INNER JOIN  yskmlb b ON a.yslbmc = b.yslbmc INNER JOIN  yskm c ON a.yskmmc = c.yskmmc INNER JOIN  fygsbm d ON a.gsbmmc = d.gsbmmc INNER JOIN  gkglbm e ON a.glbmmc = e.glbmmc WHERE (a.pzhm= " & pzhm & " ) ORDER BY a.pzhm"
rskjyw.Open str, conn, adOpenStatic, adLockBatchOptimistic
rsyskm.Open "select * from yskm order by dm", conn, adOpenStatic, adLockBatchOptimistic
rsyskmlb.Open "select * from yskmlb order by dm", conn, adOpenStatic, adLockBatchOptimistic
rsfygsbm.Open "select * from fygsbm order by dm", conn, adOpenStatic, adLockBatchOptimistic
rsgkglbm.Open "select * from gkglbm order by dm", conn, adOpenStatic, adLockBatchOptimistic
Set DataGrid1.DataSource = rskjyw
For i = 0 To 12
    DataGrid1.Columns(i).Caption = fieldname(i)
    DataGrid1.Columns(i).Width = wide(i)
    DataGrid1.Columns(i).DataField = rskjyw.Fields(i).Name
Next i
Set Dacompzhm.DataSource = rskjyw
Dacompzhm.DataField = rskjyw.Fields("pzhm").Name
'Set Dacompzhm.RowSource = rskjyw
'Dacomyskmdm.ListField = rskjyw.Fields("dm").Name

Set DTfsrq.DataSource = rskjyw
DTfsrq.DataField = rskjyw.Fields("fsrq").Name

Set Dacomglbmdm.RowSource = rsgkglbm
Dacomglbmdm.ListField = rsgkglbm.Fields("dm").Name

Set Dacomglbmmc.DataSource = rskjyw
Dacomglbmmc.DataField = rskjyw.Fields("glbmmc").Name
Set Dacomglbmmc.RowSource = rsgkglbm
Dacomglbmmc.ListField = rsgkglbm.Fields("glbmmc").Name

Set Dacomyslbdm.RowSource = rsyskmlb
Dacomyslbdm.ListField = rsyskmlb.Fields("dm").Name

Set Dacomyslbmc.DataSource = rskjyw
Dacomyslbmc.DataField = rskjyw.Fields("yslbmc").Name
Set Dacomyslbmc.RowSource = rsyskmlb
Dacomyslbmc.ListField = rsyskmlb.Fields("yslbmc").Name

Set Dacomyskmdm.RowSource = rsyskm
Dacomyskmdm.ListField = rsyskm.Fields("dm").Name

Set Dacomyskmmc.DataSource = rskjyw
Dacomyskmmc.DataField = rskjyw.Fields("yskmmc").Name
Set Dacomyskmmc.RowSource = rsyskm
Dacomyskmmc.ListField = rsyskm.Fields("yskmmc").Name

Set Dacomgsbmdm.RowSource = rsfygsbm
Dacomgsbmdm.ListField = rsfygsbm.Fields("dm").Name

Set Dacomgsbmmc.DataSource = rskjyw
Dacomgsbmmc.DataField = rskjyw.Fields("gsbmmc").Name
Set Dacomgsbmmc.RowSource = rsfygsbm
Dacomgsbmmc.ListField = rsfygsbm.Fields("gsbmmc").Name

Set Dacomywje.DataSource = rskjyw
Dacomywje.DataField = rskjyw.Fields("ywje").Name

Set txtbz.DataSource = rskjyw
txtbz.DataField = rskjyw.Fields("bz").Name

If operatetype = Add Then
  cmdkjyw(0).Caption = "添加"
Else
  If operatetype = modi Then
    cmdkjyw(0).Caption = "修改"
  Else
    cmdkjyw(0).Caption = "删除"
  End If
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
 conn.Close
End Sub