main.frm

个人财务管理系统 可以记录你每一天的详细支出 让你很方便了解你这个月的支出 对于我们这些刚毕业的大学生节约用钱很有好处 大家有什么意见很问题可以发到我邮箱 [e-mail]

                If (g_nYear Mod 4 = 0 And g_nYear Mod 100 <> 0) Or (g_nYear Mod 400 = 0) Then
                    dayMax = 29
                Else
                    dayMax = 28
                End If
        End Select
        
        GetMaxDay = dayMax
    ElseIf nMon = g_nMon Then
        GetMaxDay = g_nDay
    End If
End Function

Private Sub UpdateInfo()
    Dim i, j As Integer
    Dim fin As Double
    Dim remark As String
    Dim maxFin, minFin As Double
    Dim maxDay, minDay As Integer
    Dim SumOut As Double
    Dim loopMax As Integer
    
    '获取今天支出
    fin = GetDayFinance(g_nMon, g_nDay)
    
    lblOutPut.Caption = CStr(fin) & "元"
    
    If Not g_bAmend Then
        cmdLoginData.Caption = "录入数据"
    Else
        cmdLoginData.Caption = "查看详细"
    End If
    
    maxFin = GetDayFinance(g_nMon, 1)
    minFin = GetDayFinance(g_nMon, 1)
    maxDay = 1
    minDay = 1
    
    SumOut = maxFin
    
    '获取本月支出情况(直到当日)
    For i = 2 To g_nDay
        g_DaysInfo(i) = GetDayFinance(g_nMon, i)
        SumOut = SumOut + g_DaysInfo(i)
        
        If g_DaysInfo(i) > maxFin Then
            maxFin = g_DaysInfo(i)
            maxDay = i
        ElseIf g_DaysInfo(i) < minFin Then
            minFin = g_DaysInfo(i)
            minDay = i
        End If
    Next i
    
    If maxFin <= 0 Then
        lblMaxOut.Caption = "本月最大支出: 还未录入数据"
        lblMinOut.Caption = "本月最小支出: 还未录入数据"
    Else
        lblMaxOut.Caption = "本月最大支出: " & maxFin & "元 (" & g_nMon & "月" & maxDay & "日)"
        lblMinOut.Caption = "本月最小支出: " & minFin & "元 (" & g_nMon & "月" & minDay & "日)"
    End If
    
    If SumOut <= 0 Then
        lblSumOut.Caption = "本月支出总额: 还未录入数据"
    Else
        lblSumOut.Caption = "本月支出总额: " & SumOut & "元"
    End If
    
    
    '获取今年所有支出信息
    For i = 1 To g_nMonth
        loopMax = GetMaxDay(i)
        
        For j = 1 To loopMax
            g_YearInfo(i, j) = GetDayFinance(i, j)
        Next j
    Next i
End Sub


Private Sub ScaleMonthInfo(ByVal nMon)
    Dim i As Integer
    Dim loopMax As Integer
    Dim lastPtx, lastPty As Integer
    Dim curPtx, curPty As Integer
    
    '重画frame
    
    Line (rx1, ry1)-(rx2, ry2), vbWhite
    Line (rx2, ry2)-(rx3, ry3), vbWhite
    Line (rx3, ry3)-(rx4, ry4), vbWhite
    Line (rx1, ry1)-(cmbMonth.Left - 1, ry1), vbWhite
    Line (rx4, ry4)-(lblOutputPic.Left + lblOutputPic.Width, ry4), vbWhite
    'Line (rx4, ry4)-(rx1, ry1), vbWhite
    
    
    '绘制分析图
    
    '画X,Y轴
    Line (sx, sy)-(sx, sy - nLen), vbGreen
    Line (sx, sy)-(sx + nLen + 10, sy), vbGreen
    
    '画X轴箭头
    Line (sx + nLen + 10 - 8, sy - 2)-(sx + nLen + 10, sy), vbGreen
    Line (sx + nLen + 10 - 8, sy + 2)-(sx + nLen + 10, sy), vbGreen
    
    '画Y轴箭头
    Line (sx - 2, sy - nLen + 8)-(sx, sy - nLen), vbGreen
    Line (sx + 2, sy - nLen + 8)-(sx, sy - nLen), vbGreen
    
    '画X轴的刻度
    For i = 1 To 31
        Line (sx + i * nSecX, sy)-(sx + i * nSecX, sy - 3), vbGreen
        
        lblSection(i).Left = (sx + i * nSecX) - lblSection(i).Width \ 2
        lblSection(i).Top = (sy + 2)
        lblSection(i).Visible = True
    Next i
    
    '画Y轴的刻度
    For i = 1 To 20
        Line (sx, sy - i * nSecY)-(sx + 3, sy - i * nSecY), vbGreen
        
        lblSection(31 + i).Left = sx - lblSection(31 + i).Width
        lblSection(31 + i).Top = sy - i * nSecY - lblSection(31 + i).Height \ 2
        lblSection(31 + i).Visible = True
    Next i
    
    lblSection(0).Left = sx - 2
    lblSection(0).Top = sy + 2
    
    '画最大警戒线
    Line (rx1 + nGrap, ry1 + 10 + nGrap)-(rx4 - nGrap, ry4 + 10 + nGrap), vbRed
    lblMaxOutput.Left = rx4 - nGrap - lblMaxOutput.Width
    lblMaxOutput.Top = ry4 + 10 + nGrap - lblMaxOutput.Height
    lblMaxOutput.Visible = True
    
    loopMax = GetMaxDay(nMon)
    
    If loopMax >= 1 Then
        lastPtx = 1
        lastPty = CInt(GetDayFinance(nMon, 1) * nSecY \ 10)
        
        If sy - lastPty < ry1 + 10 + nGrap Then
            lastPty = sy - (ry1 + 10 + nGrap)
        End If
        
        Me.DrawWidth = 3
        PSet (sx + lastPtx * nSecX, sy - lastPty), vbBlue
        Me.DrawWidth = 1
    End If
    
    '画每日支出图
    For i = 2 To loopMax
        curPtx = i
        curPty = CInt(GetDayFinance(nMon, i) * 2 * nSecY \ 10)
        
        If sy - curPty < ry1 + 10 + nGrap Then
            curPty = sy - (ry1 + 10 + nGrap)
        End If
        
        Me.DrawWidth = 3
        PSet (sx + curPtx * nSecX, sy - curPty), vbBlue
        Me.DrawWidth = 1
        
        Line (sx + lastPtx * nSecX, sy - lastPty)-(sx + curPtx * nSecX, sy - curPty), RGB(100, 100, 0)
        
        lastPtx = curPtx
        lastPty = curPty
    Next i
End Sub


Private Sub cmbMonth_Click()
    If g_MonIt <> cmbMonth.ListIndex + 1 Then
        g_MonIt = cmbMonth.ListIndex + 1
        
        Me.Refresh      '!!!重绘可绘制区域(触发Paint事件)
    End If
End Sub

Private Sub cmdAmend_Click()
    txtOutput.Enabled = True
    txtRemark.Enabled = True
    
    g_bAmend = True
End Sub

Private Sub cmdLoginData_Click()
    fmDay.Show 1
    
    UpdateInfo
End Sub

Private Sub cmdOk_Click()
    Dim fin As Double
    Dim remark As String
    Dim i As Integer
    
    If g_bAmend Then
        g_bAmend = False
        
        If txtOutput.Text <> "" Then
            fin = CDbl(txtOutput.Text)
        Else
            fin = 0
        End If
        
        remark = txtRemark.Text
        
        remark = Replace(remark, vbCrLf, g_Rtn)    '处理换行
        
        SetDayFinance g_nMon, g_nDay, fin, remark
        
        UpdateInfo
        Me.Refresh
    End If
End Sub



Private Sub cmdQuery_Click()
    fmQuery.Show 1
End Sub


Private Sub Form_Load()
    Dim strPath As String
    Dim nSize As Long
    
    Me.ScaleMode = 3        '设置单位模式
    
    If debugFlag Then
        g_dbPath = App.Path & "\db\" & g_szUser & "_" & g_dbFileName
    Else
        '获取数据库完整路径
        strPath = Space(260)               '!!!设定g_dbPath容器
        nSize = GetSystemDirectory(strPath, 260)
        
        g_dbPath = Mid(strPath, 1, nSize) & "\" & g_szUser & "_" & g_dbFileName
    End If
    
    If Dir(g_dbPath) = vbStringNull Then
        CreateDB
    End If
    
    InitGlobal          '初始化全局变量
        
    InitControl         '初始化控件
    
    UpdateInfo          '更新信息
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    g_downFlag = True
    
    If Button = 1 Then
        If (X > rx1 + nGrap And X < rx4 - nGrap - 10) And (Y > ry1 + 10 + nGrap And Y < ry2 - nGrap) Then
            Me.Refresh
            
            Me.DrawStyle = vbDot
            Line (rx1 + nGrap, Y)-(X, Y), vbGreen
            Line (X, ry2 - nGrap)-(X, Y), vbGreen
            Me.DrawStyle = vbSolid
        End If
    End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If g_downFlag And (X > rx1 + nGrap And X < rx4 - nGrap - 10) And (Y > ry1 + 10 + nGrap And Y < ry2 - nGrap) Then
        Me.Refresh
        
        Me.DrawStyle = vbDot
        Line (rx1 + nGrap, Y)-(X, Y), vbGreen
        Line (X, ry2 - nGrap)-(X, Y), vbGreen
        Me.DrawStyle = vbSolid
    End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    g_downFlag = False
    
    Me.Refresh
End Sub

Private Sub Form_Paint()
    ScaleMonthInfo g_MonIt      '绘制月信息分析图
End Sub