formc1.frm

用VB编写的家庭理财程序

                Combo3(2).AddItem " " & Ddp:  Combo3(5).AddItem " " & Ddp
             End If
             MyRs1.MoveNext
          Loop
          MyRs1.Close
       Else
          Text3(2) = " ":                     Text3(5) = " "
       End If
End Sub

Private Sub Combo2_Click()
    If bytFs = 1 Or bytFs = 2 Then
       StrLb = arrLb(Combo2.ListIndex, 1)
          Lb = arrLb(Combo2.ListIndex, 2)
    End If
    If bytFs = 3 Or bytFs = 4 Then
       strXm = Trim(Combo2.Text)
    End If
End Sub

Private Sub Combo3_Click(Index As Integer)
    Text3(Index) = Combo3(Index).Text
End Sub

Private Sub Command1_Click()                                     ' 确认 & 重选
    If Command1.Caption Like "*确*" Then
       For i = 1 To 7
           Option2(i).Value = False
           Option2(i).Enabled = True
       Next
       Option2(bytFs).Enabled = False
       If bytFs = 6 Then                                         ' 按月
          Frame3.Visible = False
          Call P_grd2
          Exit Sub
       End If
       Frame1.Visible = False
       MSFlexGrid3.Visible = False
       Command2.Visible = False
       Check3.Visible = False
       If bytFs = 7 Then                                         ' 全部
          Frame3.Visible = False
          Call P_grd1
          Exit Sub
       End If
       blnSp = True
       Frame3.Visible = True
          For i = 0 To 5: Text3(i) = "": Next
          Label13 = arrTm(bytFs, 1)
          Call P_cmb3
       Select Case bytFs
              Case 0                                             ' 日期
                   Combo2.Visible = False
                   Label12 = ""
              Case 1                                             ' 收入
                   Sz = "s": Call P_grd4
              Case 2                                             ' 支出
                   Sz = "z": Call P_grd4
              Case 3                                             ' 医药费
                   Call P_cmb2
              Case 4                                             ' 工资奖金
                   Call P_cmb2
              Case 5                                             ' 其它
                   Combo2.Visible = False
                   Label12 = ""
       End Select
       blnSp = False
    Else
       Frame3.Visible = True
       Command1.Caption = "重 选"
    End If
End Sub

Private Sub Command8_Click()                                     ' 继续
        
    If Text3(4) = "" Then Text3(3) = ""
    
    Frame1.Visible = False
    
    Sj1 = "": Sj2 = ""
    yyp = Trim(Text3(0))
    Mmp = Trim(Text3(1))
    Ddp = Trim(Text3(2))
       If yyp <> "" Then
          Sj1 = yyp
          If Mmp <> "" Then
             If Ddp = "" Then
                Sj1 = Sj1 & "." & Mmp
             Else
                Sj1 = Sj1 & "." & Mmp & "." & Ddp
             End If
          End If
       End If
    strTj = " Rq Like '" & Sj1 & "%'": StrMsg = Sj1
          
    If Trim(Text3(3)) <> "" Then                                 ' 时间区间
       yyp = Trim(Text3(3))
       Mmp = Trim(Text3(4))
       Ddp = Trim(Text3(5))
             Sj2 = yyp
             If Mmp <> "" Then
                If Ddp = "" Then
                   Sj2 = Sj2 & "." & Mmp       ' & ".31"
                Else
                   Sj2 = Sj2 & "." & Mmp & "." & Ddp
                End If
             End If
       If Sj1 <= Sj2 Then
          If Len(Sj2) < 5 Then
             Sj2 = Sj2 & ".12.31"
          Else
             If Len(Sj2) < 8 Then Sj2 = Sj2 & ".31"
          End If
          strTj = " Rq >= '" & Sj1 & "' And Rq <= '" & Sj2 & "'"
          StrMsg = Sj1 & " ～ " & Sj2
       Else
          If Len(Sj1) < 5 Then
             Sj1 = Sj1 & ".12.31"
          Else
             If Len(Sj1) < 8 Then Sj1 = Sj1 & ".31"
          End If
          strTj = " Rq >= '" & Sj2 & "' And Rq <= '" & Sj1 & "'"
          StrMsg = Sj2 & " ～ " & Sj1
       End If
    End If

    Label13 = arrTm(bytFs, 1) & "  " & StrMsg:   StrMsg = ""
               
    If bytFs = 1 Or bytFs = 2 Then                               ' 项目选择
       If Frame2.Visible Then
          strLtj = ""
          With MSFlexGrid2
               For i = 1 To N1
                   If .TextMatrix(i, 2) Like "*√*" Then
                      'StrLb = arrLb(Combo2.ListIndex, 1)
                       Lb = arrLb(i, 2)
                       strLtj = strLtj & IIf(strLtj = "", "", "Or") & " Lb='" & Lb & "' "
                   End If
               Next
          End With
       Else
          strLtj = ""
       End If
       strLtj = " And (" & strLtj & ")"
    Else
       strLtj = IIf(Lb = "", "", " And Lb='" & Lb & "'")
    End If
           
    Select Case bytFs
           Case 0
                 
           Case 1
                strTj = strTj & " And Sz='s' " & strLtj: StrMsg = StrLb
           Case 2
                strTj = strTj & " And Sz='z' " & strLtj: StrMsg = StrLb
           Case 3
                StrMsg = " And ("
                For i = 1 To N5
                    If arrSl(i, 0) Like "*医药*" Then
                       If StrMsg = " And (" Then
                          StrMsg = StrMsg & "Sz='" & arrSl(i, 1) & "' And Lb='" & arrSl(i, 2) & "'"
                       Else
                          StrMsg = StrMsg & " Or Sz='" & arrSl(i, 1) & "' And Lb='" & arrSl(i, 2) & "'"
                       End If
                    End If
                Next
                strTj = strTj & StrMsg & ")"
                Mcp = Trim(Combo2.Text)
                   If Mcp <> "" Then
                      strTj = strTj & " And Mc Like '%" & Mcp & "%'": StrMsg = Mcp
                   Else
                      StrMsg = ""
                   End If
           Case 4
                StrMsg = " And ("
                For i = 1 To N5
                    If arrSl(i, 0) Like "*工资*" Or arrSl(i, 0) Like "*奖金*" Or arrSl(i, 0) Like "*津贴*" Or arrSl(i, 0) Like "*补*" Then
                       If StrMsg = " And (" Then
                          StrMsg = StrMsg & "Sz='" & arrSl(i, 1) & "' And Lb='" & arrSl(i, 2) & "'"
                       Else
                          StrMsg = StrMsg & " Or Sz='" & arrSl(i, 1) & "' And Lb='" & arrSl(i, 2) & "'"
                       End If
                    End If
                Next
                strTj = strTj & StrMsg & ")"
                Mcp = Trim(Combo2.Text)
                   If Mcp <> "" Then
                      strTj = strTj & " And Mc Like '%" & Mcp & "%'": StrMsg = Mcp
                   Else
                      StrMsg = ""
                   End If
           Case 5
                strTj = strTj & " And Sz='z' And Lb='D'"
    End Select
    Label13 = Label13 & "  " & StrMsg
'MsgBox strTj
    Call P_grd0                                                  ' 显示

End Sub

Private Sub P_grd0()
    bytGrd = "0"
    Set MyRs2 = New Recordset                                    ' T_zm 表
    StrSQL = "SELECT * FROM " & StrT2 & " WHERE " & strTj
       If Check1 = 0 Then
          StrSQL = StrSQL & " Order By Rq,Xh"
       Else
          StrSQL = StrSQL & " Order By Rq Desc,Xh Desc"
       End If
    MyRs2.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
       intTs = MyRs2.RecordCount                                 ' intTs: 条数
       If intTs < 1 Then
          MsgBox "  很抱歉，没有发现相关数据 ...  ", 48, "  请注意"
          Label13 = arrTm(bytFs, 1): Exit Sub
       End If
    Frame3.Visible = False
    blnSp = True
       Option2(7).Enabled = True             ' ???
    blnSp = False
    ReDim arrZm(intTs, 2)
    With MSFlexGrid1
        .Clear
        .Rows = IIf(intTs + 2 < intRou, intRou, intTs + 2) + 1
        .Cols = 9
        .Height = 225 * (intRou + 1) + 90
        .Row = 0: .Col = 0: .Text = " 序号":    .ColWidth(0) = 600
                  .Col = 1: .Text = " 日 期":   .ColWidth(1) = 1140
                  .Col = 2: .Text = "  名  称": .ColWidth(2) = 1800
                  .Col = 3: .Text = "  单价 ":  .ColWidth(3) = 820
                  .Col = 4: .Text = " 数量 ":   .ColWidth(4) = 620
                  .Col = 5: .Text = "  收 入 ": .ColWidth(5) = 920
                  .Col = 6: .Text = "  支 出 ": .ColWidth(6) = 920
                  .Col = 7: .Text = "  余 额 ": .ColWidth(7) = 920
                  .Col = 8: .Text = "  备 注":  .ColWidth(8) = 1300 - IIf(intTs + 2 < intRou, 0, 270)
                   MyRs2.MoveFirst
                   sigSr = 0
                   sigZc = 0
                      For i = 1 To intTs
                          arrZm(i, 0) = MyRs2![Xh]               ' 暂存记录
                          arrZm(i, 1) = MyRs2![Sz]
                          arrZm(i, 2) = MyRs2![Lb]
                          Rq = MyRs2![Rq]
                          Sz = MyRs2![Sz]
                         .TextMatrix(i, 0) = i & " "
                         .TextMatrix(i, 1) = " " & Rq
                         .TextMatrix(i, 2) = " " & MyRs2![Mc]
                         .TextMatrix(i, 3) = IIf(MyRs2![Dj] > 0, Format(MyRs2![Dj], "0.00 "), "")
                         .TextMatrix(i, 4) = IIf(MyRs2![Sl] > 0, MyRs2![Sl] & " ", "")
                         .TextMatrix(i, 5) = IIf(Sz = "s", Format(MyRs2![Sr], "0.00 "), "")
                         .TextMatrix(i, 6) = IIf(Sz = "z", Format(MyRs2![Zc], "0.00 "), "")
                         .TextMatrix(i, 7) = Format(MyRs2![Ye], "0.00 ")
                         .TextMatrix(i, 8) = " " & MyRs2![Bz]  ' & " " & MyRs2![Lb]
                             sigSr = sigSr + MyRs2![Sr]
                             sigZc = sigZc + MyRs2![Zc]
                          MyRs2.MoveNext
                      Next
                      MyRs2.Close
                     .TextMatrix(i + 1, 2) = " 累计"
                     .TextMatrix(i + 1, 5) = IIf(sigSr = 0, "", Format(sigSr, "0.00 "))
                     .TextMatrix(i + 1, 6) = IIf(sigZc = 0, "", Format(sigZc, "0.00 "))
                      If sigSr > 0 And sigZc > 0 Then
                        .TextMatrix(i + 1, 7) = Format(sigSr - sigZc, "0.00 ")
                      End If
        .MergeCol(1) = True
        .MergeCells = flexMergeRestrictColumns                   ' 单元格合并
        .Visible = True
    End With
    Command1.Caption = "重 选"
End Sub

Private Sub Command7_Click()
    For i = 1 To 7
        Option2(i).Value = False
        Option2(i).Enabled = True
    Next
    Frame3.Visible = False
End Sub

Private Sub Text3_Change(Index As Integer)                       ' 检验
    If blnSp Then Exit Sub
    m = 0
       If IsNumeric(Text3(Index)) Then
             k = Val(Text3(Index))
          If k < 0 Then
             m = 8: StrMsg = "大于 0 的"
          Else
             Select Case Index
                    Case 0, 3
                         j = Val(Left(StrCrq, 4))
                         If k > j Then m = 8: StrMsg = "不大于 " & j & " 的"
                    Case 1, 4
                         If k > 12 Then m = 8: StrMsg = " 1 ～ 12 的"
                    Case 2, 5
                         If k > 31 Then m = 8: StrMsg = " 1 ～ 31 的"
             End Select
          End If
       Else
          StrMsg = ""
       End If
    If m > 0 Then
       MsgBox "  应当输入" & StrMsg & "数字 ...  ", 48, "  请注意"
       Text1(Index) = ""
    End If
    Select Case Index
           Case 0
                If bytFs = 0 And Trim(Text3(0)) = "" Then Text3(0) = " " & Left(StrCrq, 4)
           Case 1, 2, 4, 5
                If Trim(Text3(Index - 1)) = "" Then Text3(Index) = ""
    End Select
End Sub

Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)            ' 选中一笔帐目
    If KeyAscii = 13 Then Call MSFlexGrid1_Click
End Sub

Private Sub MSFlexGrid1_Click()                                  ' 选中一笔
    
    If bytFs = 6 Then
       With MSFlexGrid1
            If .Row = 1 Or .TextMatrix(.Row, 4) = "" Then Exit Sub
            Ye = Val(.TextMatrix(.Row - 1, 4))
            Ny = Trim(.TextMatrix(.Row, 1))
            intRo1 = .Row
       End With
       Call P_grd3: Exit Sub
    End If

    With MSFlexGrid1
         If Trim(.TextMatrix(.Row, 6)) = "" And Trim(.TextMatrix(.Row, 7)) = "" Then Exit Sub
    End With
  
    Frame1.Visible = True
  
    With MSFlexGrid1
        .Height = 225 * (intRod + 1) + 90
        .Col = 8: .ColWidth(8) = 1300 - IIf(.Rows > intRod, 270, 0)
         k = .Row
            For j = 1 To .Cols - 1
               .Col = j: .CellBackColor = intCx1                 ' 设置颜色
            Next
        .Row = intRo1
            For j = 1 To .Cols - 1
               .Col = j: .CellBackColor = intCy1                 ' 颜色复原
            Next
         intRo1 = k
        .Row = k
            Xhp = arrZm(k, 0)                                    ' 序号 Xhp
            Szp = arrZm(k, 1)
                  Option1(0).Value = IIf(Szp = "s", True, False)
            Rqp = Trim(.TextMatrix(k, 1)): Text1(1) = " " & Rqp
            Mcp = Trim(.TextMatrix(k, 2)): Text1(3) = " " & Mcp
            Lbp = Trim(arrZm(k, 2))
               For i = 1 To N5
                   If Lbp = arrSl(i, 2) And Szp = arrSl(i, 1) Then
                      Text1(2).Text = " " & arrSl(i, 0)
                      Exit For                                   ' 类别
                   End If
               Next
            Djp = Val(.TextMatrix(k, 3)): Text1(4) = " " & Format(Djp, "0.00")
            Slp = Val(.TextMatrix(k, 4)): Text1(5) = " " & Slp
            Jep = Val(.TextMatrix(k, IIf(Szp = "s", 5, 6)))
                                           Text1(6) = " " & Format(Jep, "0.00")
            Bzp = Trim(.TextMatrix(k, 8)): Text1(7) = " " & Bzp
    End With
End Sub

Private Sub Command4_Click()                                     ' Return
    With MSFlexGrid1
        .Height = 225 * (intRou + 1) + 90
        .ColWidth(8) = 1300 - IIf(intTs > intRou, 270, 0)
         k = .Row
    End With
    For i = 0 To 6: Option2(i).Value = False: Next
    Frame1.Visible = False
End Sub

Private Sub Command5_Click()                                     ' 退出
    Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
 On Error Resume Next                                ' 关闭记录集，释放对象
    MyRs1.Close: Set MyRs1 = Nothing
    MyRs2.Close: Set MyRs2 = Nothing
    MyRs3.Close: Set MyRs3 = Nothing
    MyDb2.Close: Set MyDb2 = Nothing
End Sub