frmsrzw.frm

家财管理系统实例

         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
         BeginProperty Column02 
            DataField       =   "金额"
            Caption         =   "金额"
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   1
               Format          =   """￥""#,##0.00"
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column03 
            DataField       =   "日期"
            Caption         =   "日期"
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   1
               Format          =   "yyyy-MM-dd"
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column04 
            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
            BeginProperty Column02 
            EndProperty
            BeginProperty Column03 
            EndProperty
            BeginProperty Column04 
               ColumnWidth     =   4004.788
            EndProperty
         EndProperty
      End
   End
End
Attribute VB_Name = "frmSRZW"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim WithEvents rs As ADODB.Recordset
Attribute rs.VB_VarHelpID = -1

Private Sub cmdAdd_Click()
    On Error Resume Next
    '追加新记录
    rs.AddNew
    rs("姓名") = cboName.List(0)
    rs("项目") = cboXm.List(0)
    rs("金额") = 0
    rs("日期") = Date
    Set dtpDjRq.DataSource = rs
    dtpDjRq.DataField = "日期"
    cboName.SetFocus
End Sub

Private Sub cmdDel_Click()
    On Error Resume Next
    '删除记录
    If Not (rs.EOF Or rs.BOF) Then
        rs.Delete
        rs.MoveNext
    End If
End Sub

Private Sub cmdPrint_Click()
    fMain.PrintPage rs, Caption
End Sub

Private Sub dtpDjRq_LostFocus()
    rs.Update "日期", dtpDjRq.Value
End Sub

Private Sub Form_Activate()
    fMain.RsPC Tag
End Sub

Private Sub Form_Load()
    On Error Resume Next
    StateForm
    Set rs = New ADODB.Recordset
    OpenRs "", "", #1/1/9999#, #1/1/9999#
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    On Error Resume Next
    If rs.EditMode = adEditAdd Or rs.EditMode = adEditInProgress Then
        rs.Update
    End If
End Sub

Private Sub Form_Resize()
    ReFrom
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    Set frmSRZW = Nothing
End Sub

Private Sub rs_WillMove(ByVal adReason As ADODB.EventReasonEnum, _
 adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    On Error Resume Next
    rs.Update
End Sub

Private Sub rs_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, _
 ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, _
 ByVal pRecordset As ADODB.Recordset)
    On Error Resume Next
    Dim intRsPos As Integer, intRsCount As Integer
    intRsPos = rs.AbsolutePosition
    intRsCount = rs.RecordCount
    If intRsPos < 1 Then
        cboName.Enabled = False
        cboXm.Enabled = False
        dtpDjRq.Enabled = False
        txtBz.Enabled = False
        txtJe.Enabled = False
        cmdDel.Enabled = False
        cmdPrint.Enabled = False
    Else
        cboName.Enabled = True
        cboXm.Enabled = True
        dtpDjRq.Enabled = True
        txtBz.Enabled = True
        txtJe.Enabled = True
        cmdDel.Enabled = True
        cmdPrint.Enabled = True
    End If
    
    Tag = Caption & Space(3) & "当前位置:" & _
    intRsPos & Space(3) & "记录总数:" & intRsCount
    
    fMain.RsPC Tag
End Sub

Private Sub StateForm()
    On Error Resume Next
    '设置树形查询搜索框的节点
    Dim mNode As Node, strNodeKey As String
    Dim rsNodes As ADODB.Recordset
    
    Set mNode = TreeView1.Nodes.Add(, tvwFirst, "1NODE")
    mNode.Text = "按家庭成员搜索"
    
    '取得成员节点
    DbeJcgl.CYQD gstrName
    Set rsNodes = DbeJcgl.rsCYQD
    Do Until rsNodes.EOF
        strNodeKey = "CY" & rsNodes("姓名")
        Set mNode = TreeView1.Nodes.Add("1NODE", tvwChild, strNodeKey)
        mNode.Text = rsNodes("姓名")
        cboName.AddItem rsNodes("姓名")
        rsNodes.MoveNext
    Loop
    rsNodes.Close

    
    Set mNode = TreeView1.Nodes.Add("1NODE", tvwNext, "2NODE")
    mNode.Text = "按收入项目搜索"
    
    '取得项目节点
    DbeJcgl.rsSRXMQD.Open
    Set rsNodes = DbeJcgl.rsSRXMQD
    Do Until rsNodes.EOF
        strNodeKey = "XM" & rsNodes("项目")
        Set mNode = TreeView1.Nodes.Add("2NODE", tvwChild, strNodeKey)
        mNode.Text = rsNodes("项目")
        cboXm.AddItem rsNodes("项目")
        rsNodes.MoveNext
    Loop
    rsNodes.Close
    Set rsNodes = Nothing
    
    dtpDjRq = Date
    dtpCxRq(0) = DateAdd("M", -1, Date)
    dtpCxRq(1) = Date
End Sub

Private Sub OpenRs(ByVal strName As String, ByVal strXM As String, _
 ByVal dtRq1 As Date, ByVal dtRq2 As Date)
    On Error Resume Next
    '从数据源取得记录集
    If rs.State = 1 Then
        rs.Close
    End If
    
    DbeJcgl.SRZW strName, strXM, dtRq1, dtRq2
    Set rs = DbeJcgl.rsSRZW
    
    Set cboName.DataSource = rs
    cboName.DataField = "姓名"
    Set cboXm.DataSource = rs
    cboXm.DataField = "项目"
    Set dtpDjRq.DataSource = rs
    dtpDjRq.DataField = "日期"
    Set txtJe.DataSource = rs
    txtJe.DataField = "金额"
    Set txtBz.DataSource = rs
    txtBz.DataField = "说明"
    Set DataGrid1.DataSource = rs
End Sub

Public Sub ReFrom()
    '调整控件位置、大小
    On Error Resume Next
    If Width < 6000 Then
        Width = 6000
    End If
    
    If Height < 6000 Then
        Height = 6000
    End If
    
    Frame1.Height = Height - 4500
    TreeView1.Height = Frame1.Height - 1000
    Picture1(1).Move 5085, 0, Width - 5200, Height - 400
    DataGrid1.Move 0, 0, Picture1(1).Width - 60, Picture1(1).Height - 60
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
    Dim strName As String, strXM As String
    Dim dtRq1 As Date, dtRq2 As Date
    
    strName = gstrName
    strXM = "%"
    dtRq1 = dtpCxRq(0)
    dtRq2 = dtpCxRq(1)
    
    If Left(Node.Key, 2) = "CY" Then
        strName = Node.Text
    ElseIf Left(Node.Key, 2) = "XM" Then
        strXM = Node.Text
    End If
    
    OpenRs strName, strXM, dtRq1, dtRq2
End Sub

Private Sub txtJe_GotFocus()
    txtJe.SelStart = 1
    txtJe.SelLength = Len(txtJe)
End Sub