frmyskm.frm

一个资金管理系统的成品 开发环境：VB

VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Begin VB.Form frmyskm 
   BackColor       =   &H00FF8080&
   Caption         =   "资金科目管理"
   ClientHeight    =   5865
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6825
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5865
   ScaleWidth      =   6825
   StartUpPosition =   1  'CenterOwner
   Begin MSDataListLib.DataCombo Dacomyslbmc 
      Height          =   330
      Left            =   4440
      TabIndex        =   14
      Top             =   240
      Width           =   1455
      _ExtentX        =   2566
      _ExtentY        =   556
      _Version        =   393216
      Locked          =   -1  'True
      Text            =   "DataCombo1"
   End
   Begin VB.CommandButton cmdyskm 
      Caption         =   "添加科目"
      Height          =   375
      Index           =   0
      Left            =   360
      TabIndex        =   9
      Top             =   1440
      Width           =   1100
   End
   Begin VB.CommandButton cmdyskm 
      Caption         =   "修改科目"
      Height          =   375
      Index           =   1
      Left            =   1800
      TabIndex        =   8
      Top             =   1440
      Width           =   1100
   End
   Begin VB.CommandButton cmdyskm 
      Caption         =   "查询科目"
      Height          =   375
      Index           =   2
      Left            =   3240
      TabIndex        =   7
      Top             =   1440
      Width           =   1100
   End
   Begin VB.CommandButton cmdyskm 
      Caption         =   "删除科目"
      Height          =   375
      Index           =   3
      Left            =   4920
      TabIndex        =   6
      Top             =   1440
      Width           =   1100
   End
   Begin VB.CommandButton cmdyskm 
      Caption         =   "下一个"
      Height          =   375
      Index           =   4
      Left            =   360
      TabIndex        =   5
      Top             =   1920
      Width           =   1100
   End
   Begin VB.CommandButton cmdyskm 
      Caption         =   "上一个"
      Height          =   375
      Index           =   5
      Left            =   1800
      TabIndex        =   4
      Top             =   1920
      Width           =   1100
   End
   Begin VB.CommandButton cmdyskm 
      Caption         =   "保存"
      Enabled         =   0   'False
      Height          =   375
      Index           =   6
      Left            =   3240
      TabIndex        =   3
      Top             =   1920
      Width           =   1100
   End
   Begin VB.CommandButton cmdyskm 
      Caption         =   "退出"
      Height          =   375
      Index           =   7
      Left            =   4920
      TabIndex        =   2
      Top             =   1920
      Width           =   1100
   End
   Begin MSDataGridLib.DataGrid DataGrid1 
      Height          =   3015
      Left            =   360
      TabIndex        =   0
      Top             =   2520
      Width           =   5775
      _ExtentX        =   10186
      _ExtentY        =   5318
      _Version        =   393216
      AllowUpdate     =   0   'False
      HeadLines       =   1
      RowHeight       =   15
      BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ColumnCount     =   2
      BeginProperty Column00 
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column01 
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      SplitCount      =   1
      BeginProperty Split0 
         BeginProperty Column00 
         EndProperty
         BeginProperty Column01 
         EndProperty
      EndProperty
   End
   Begin MSDataListLib.DataCombo Dacomdm 
      Height          =   315
      Left            =   1560
      TabIndex        =   1
      Top             =   240
      Width           =   1575
      _ExtentX        =   2778
      _ExtentY        =   556
      _Version        =   393216
      Enabled         =   0   'False
      Text            =   "DataCombo1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin MSDataListLib.DataCombo Dacomyskmmc 
      Height          =   315
      Left            =   1560
      TabIndex        =   12
      Top             =   720
      Width           =   1575
      _ExtentX        =   2778
      _ExtentY        =   556
      _Version        =   393216
      Enabled         =   0   'False
      Text            =   "DataCombo1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Label Label1 
      BackColor       =   &H00FF8080&
      BackStyle       =   0  'Transparent
      Caption         =   "科目名称"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   240
      TabIndex        =   13
      Top             =   720
      Width           =   1095
   End
   Begin VB.Label Labkhmc 
      BackColor       =   &H00FF8080&
      BackStyle       =   0  'Transparent
      Caption         =   "科目代码"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   240
      TabIndex        =   11
      Top             =   240
      Width           =   1095
   End
   Begin VB.Label Lablxr 
      BackColor       =   &H00FF8080&
      BackStyle       =   0  'Transparent
      Caption         =   "所属类别"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3360
      TabIndex        =   10
      Top             =   240
      Width           =   1095
   End
End
Attribute VB_Name = "frmyskm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim addrecord As Variant
'Dim usercheck As Boolean
Dim conn As New ADODB.Connection
Dim rsyskm As New ADODB.Recordset
Dim rsyskmlb As New ADODB.Recordset
'设置资金科目管理中按钮的状态
Private Sub setbuttonsyskm(bval As Boolean)
    For i = 0 To 5
       cmdyskm(i).Enabled = bval
    Next i
    cmdyskm(6).Enabled = Not bval
    Dacomdm.Enabled = Not bval
    Dacomyskmmc.Enabled = Not bval
    DataGrid1.Enabled = bval
    If bval Then
       cmdyskm(7).Caption = "退出"
    Else
       cmdyskm(7).Caption = "取消"
    End If
    Exit Sub
End Sub

'资金科目管理中记录增加或修改后的字段检验
Private Function yskmcheck() As Boolean
   Dim id As Integer
   Dim str As String
   Dim note(3) As String
   note(0) = "资金科目代码不能为空！"
   note(1) = "资金科目名称不能为空！"
   note(2) = "此资金科目代码或者此资金科目名称已经存在！"
   yskmcheck = False
   If Dacomdm.Text = "" Then
       MsgBox note(0)
       Dacomdm.SetFocus
       Exit Function
   End If
   If Dacomyskmmc.Text = "" Then
       MsgBox note(1)
       Dacomkmmc.SetFocus
       Exit Function
   End If
   id = rsyskm.Fields("xuhao")
   If addrecord = True Then
       str = "select * from yskm where dm='" & Dacomdm.Text & "' or yskmmc='" & Dacomyskmmc.Text & "'"
       Set rs = conn.Execute(str)
   Else
      str = "select * from yskm where (dm='" & Dacomdm.Text & "' or yskmmc='" & Dacomyskmmc.Text & "') and xuhao <> '" & id & "'"
      Set rs = conn.Execute(str)
   End If
   If rs.EOF Then
      yskmcheck = True
   Else
     MsgBox note(2)
     'rsyskm.CancelBatch adAffectAllChapters
     Dacomdm.SetFocus
   End If
   Exit Function
End Function
Private Sub cmdyskm_Click(Index As Integer)
  Dim i As Integer
Dim result As Boolean
Dim m_name As String
Dim bookmark As Variant
On Error GoTo adderr
Select Case Index
  Case 0  '添加按钮
       addrecord = True
       rsyskm.AddNew
       setbuttonsyskm False
       Dacomdm.SetFocus
       Exit Sub
  Case 1   '修改按钮
       addrecord = False
       setbuttonsyskm False
       Dacomdm.SetFocus
       Exit Sub
  Case 2   '查询按钮
      bookmark = rsyskm.bookmark
      m_name = InputBox("请输入资金科目代码或资金科目名称", "按资金科目代码或资金科目名称搜索")
      If m_name = "" Then
         Exit Sub
      End If
      rsyskm.MoveFirst
      rsyskm.Find "dm like '%" & m_name & "%'"
      If rsyskm.EOF Then
         rsyskm.MoveFirst
         rsyskm.Find "yskmmc like '%" & m_name & "%'"
         If rsyskm.EOF Then
            MsgBox "没有该资金科目代码或资金科目名称！"
            rsyskm.bookmark = bookmark
         End If
         'rsyskm.MoveFirst
      End If
      Exit Sub
  Case 3   '删除按钮
      If MsgBox("你确认要删除该条记录吗？", vbexclaimation + vbOKCancel, "记录删除") = vbCancel Then
          Exit Sub
      End If
      With rsyskm
         '删除该纪录
          .Delete
          .UpdateBatch adAffectCurrent
          'If .RecordCount <= 0 Then
          '   Adodc1.Enabled = False
          '   Exit Sub
          'End If
          '移到下一条
          .MoveNext
          '如果到文件尾，移到最后一条
          If .EOF Then .MoveLast
      End With
      Exit Sub
   Case 4   '下一条
     rsyskm.MoveNext
     If rsyskm.EOF Then
        MsgBox "这是最后一个记录！"
        rsyskm.MovePrevious
     End If
     Exit Sub
  Case 5   '上一条
     rsyskm.MovePrevious
     If rsyskm.BOF Then
        MsgBox "这是第一个记录！"
        rsyskm.MoveNext
     End If
     Exit Sub
  Case 6  '保存按钮
       result = yskmcheck()
       If result = True Then
           rsyskm.UpdateBatch adAffectCurrent
           setbuttonsyskm True
           MsgBox "保存成功！"
           'Adodc4.Refresh
       End If
       Exit Sub
  Case 7   ' 退出或取消按钮
       If cmdyskm(Index).Caption = "退出" Then
         Unload Me
       Else
         rsyskm.CancelUpdate
         setbuttonsyskm True
         Exit Sub
       End If
End Select
Exit Sub
adderr:
  MsgBox Err.Description
  Unload Me
End Sub


Private Sub Dacomdm_Change()
'Set rs = conn.Execute("select * from yskmlb where dm='" & Left(Dacomdm.Text, 1) & "'")
If Dacomdm.Text <> "" Then
  rsyskmlb.Filter = "dm ='" & Left(Dacomdm.Text, 1) & "'"
  Dacomyslbmc.Text = rsyskmlb.Fields("yslbmc").Value
'  Dacomlbdm.Refresh
End If
End Sub

Private Sub Form_Load()
Dim fieldname(4) As Variant
Dim wide(4) As Variant
Dim str As String
fieldname(0) = "序号"
fieldname(1) = "资金科目代码"
fieldname(2) = "资金科目类别名称"
fieldname(3) = "资金科目名称"
wide(0) = 400
wide(1) = 1400
wide(2) = 1400
wide(3) = 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

rsyskm.Open "select * from yskm order by dm", conn, adOpenStatic, adLockBatchOptimistic
rsyskmlb.Open "select dm,yslbmc from yskmlb order by dm", conn, adOpenStatic, adLockBatchOptimistic
Set DataGrid1.DataSource = rsyskm
For i = 0 To 2
    DataGrid1.Columns(i).Caption = fieldname(i)
    DataGrid1.Columns(i).Width = wide(i)
    DataGrid1.Columns(i).DataField = rsyskm.Fields(i).Name
Next i
Set Dacomdm.DataSource = rsyskm
Dacomdm.DataField = rsyskm.Fields("dm").Name
Set Dacomyskmmc.DataSource = rsyskm
Dacomyskmmc.DataField = rsyskm.Fields("yskmmc").Name
Set Dacomyslbmc.DataSource = rsyskm
Dacomyslbmc.DataField = rsyskm.Fields("yslbmc").Name
Set Dacomyslbmc.RowSource = rsyskmlb
Dacomyslbmc.ListField = rsyskmlb.Fields("yslbmc").Name
End Sub

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