main.bas

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

Attribute VB_Name = "Main"
Option Explicit

'API函数
Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

'写INI文件
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _
    (ByVal lpApplicationName As String, _
    ByVal lpKeyName As Any, _
    ByVal lpString As Any, _
    ByVal lpFileName As String) As Long

'获取INI文件信息
Private Declare Function GetPrivateProfileString _
    Lib "kernel32" Alias "GetPrivateProfileStringA" _
    (ByVal lpApplicationName As String, _
    ByVal lpKeyName As Any, _
    ByVal lpDefault As String, _
    ByVal lpReturnedString As String, _
    ByVal nSize As Long, _
    ByVal lpFileName As String) As Long


Type YearFinance
    MaxOut As Double        '每个月最大支出
    MinOut As Double        '每个月最少支出
    SumOut As Double        '每个月总支出
    MonthIn As Double       '每个月收入
End Type


'每日细节
Type DayDetail
    ZaoCan As Double
    WuCan As Double
    WanCan As Double
    GouWu As Double
    GongJiao As Double
    Other As Double
End Type


Public Const debugFlag As Boolean = True        '调试开关

Public Const g_Rtn As String = "\r\n"
Public Const g_dbFileName As String = "grcwzl102178.ini"
Public Const g_userFileName As String = "grcwzl_users.ini"


Public g_szUser As String                       '当前用户名称
Public g_nUserID As Integer                     '当前用户编号

Public g_dbPath As String                       '数据库文件路径
Public g_userPath As String                     '用户数据文件路径
Public g_MonthsInfo(1 To 12) As YearFinance     '今年的每个月支出情况
Public g_YearInfo(1 To 12, 1 To 31) As Double   '今年每一天的支出情况
Public g_DaysInfo(1 To 31) As Double            '本月每天支出情况
Public g_DayOut As Double                       '今天的支出情况

Public g_bAmend As Boolean                      '是否修改

Public g_nYear As Integer
Public g_nMon As Integer
Public g_nDay As Integer

Public g_MonIt As Integer                       '记录当前查看的是哪个月的分析图

Public rgbt(1 To 12) As Long                   '颜色索引表

Public g_nLoginType As Integer                  '录入类型(1为录今天, 2为补录)


'分析图区域
Public rx1, ry1 As Integer
Public rx2, ry2 As Integer
Public rx3, ry3 As Integer
Public rx4, ry4 As Integer

Public sx, sy As Integer           '原点
Public nLen As Integer             '长度
Public nGrap As Integer            '缝隙
Public nSecX, nSecY As Integer     '段宽度


Public g_downFlag As Boolean


'**********************************************数据库相关函数**************************************************

'创建系统数据库
Public Function CreateDB()
    Dim i As Integer
    Dim j As Integer
    
    For i = 1 To 12
        WritePrivateProfileString "Mon" & i, "sum", "0", g_dbPath       '总收入
        For j = 1 To 31
            WritePrivateProfileString "Mon" & i, "rec" & j, "0", g_dbPath       '是否记录(1是 0否)
            WritePrivateProfileString "Mon" & i, "day" & j, "0", g_dbPath       '每天支出
            
            '每天支出详细
            WritePrivateProfileString "Mon" & i, "zaoc" & j, "0", g_dbPath        '早餐
            WritePrivateProfileString "Mon" & i, "zhongc" & j, "0", g_dbPath      '中餐
            WritePrivateProfileString "Mon" & i, "wanc" & j, "0", g_dbPath        '晚餐
            WritePrivateProfileString "Mon" & i, "gw" & j, "0", g_dbPath          '购物
            WritePrivateProfileString "Mon" & i, "gj" & j, "0", g_dbPath          '公交
            WritePrivateProfileString "Mon" & i, "qt" & j, "0", g_dbPath          '其他
            
            WritePrivateProfileString "Mon" & i, "rem" & j, "", g_dbPath      '每天备注
        Next j
    Next
End Function


'创建用户数据库
Public Function CreateUserDB()
    WritePrivateProfileString "Count", "sum", "0", g_userPath
End Function

'获取用户数量
Public Function GetUsersCount() As Integer
    Dim szRtnValue As String
    Dim nSize As Integer
    
    szRtnValue = Space(8)
    nSize = GetPrivateProfileString("Count", "sum", "0", szRtnValue, 8, g_userPath)
    
    GetUsersCount = CInt(Mid(szRtnValue, 1, nSize))
End Function

'根据用户编号获取用户名
Public Function GetUserName(ByVal uid As Integer) As String
    Dim szRtnValue As String
    Dim nSize As Integer
    
    szRtnValue = Space(64)
    nSize = GetPrivateProfileString("Users", "user" & uid, "", szRtnValue, 64, g_userPath)
    
    GetUserName = Mid(szRtnValue, 1, nSize)
End Function


'检验密码是否正确
Public Function CheckLogin(ByVal uid As Integer, ByVal pwd As String) As Boolean
    Dim szRtnValue As String
    Dim nSize As Integer
    Dim szPwd As String
    
    szRtnValue = Space(32)
    nSize = GetPrivateProfileString("Users", "pwd" & uid, "", szRtnValue, 32, g_userPath)
    
    szPwd = Mid(szRtnValue, 1, nSize)
    
    If szPwd = pwd Then
        CheckLogin = True
    Else
        CheckLogin = False
    End If
End Function

'检查用户名是否存在
Public Function IsExist(ByVal uname As String) As Boolean
    Dim i As Integer
    Dim szRtnValue As String
    Dim nSize As Integer
    Dim sum As Integer
    Dim szName As String
    
    IsExist = False
    
    sum = GetUsersCount()
    
    For i = 1 To sum
        szRtnValue = Space(64)
        nSize = GetPrivateProfileString("Users", "key" & i, "", szRtnValue, 64, g_userPath)
        
        szName = Mid(szRtnValue, 1, nSize)
        
        If szName = uname Then
            IsExist = True
            Exit Function
        End If
    Next
End Function

'添加用户
Public Function AddNewUser(ByVal uname As String, ByVal pwd As String)
    Dim sum As Integer
    Dim uid As Integer
    
    sum = GetUsersCount()
    uid = sum + 1
    
    WritePrivateProfileString "Users", "user" & uid, uname, g_userPath
    WritePrivateProfileString "Users", "pwd" & uid, pwd, g_userPath
    WritePrivateProfileString "Users", "key" & uid, uname, g_userPath
    WritePrivateProfileString "Count", "sum", CStr(uid), g_userPath
End Function


'设置某月的总收入
Public Function SetMonthInput(ByVal nMon As Integer, ByVal fin As Double)
    WritePrivateProfileString "Mon" & nMon, "sum", CStr(fin), g_dbPath
End Function

'设置某一天的支出情况
Public Function SetDayFinance(ByVal nMon As Integer, ByVal nDay As Integer, ByVal fin As Double, ByVal remark As String)
    WritePrivateProfileString "Mon" & nMon, "day" & nDay, CStr(fin), g_dbPath
    WritePrivateProfileString "Mon" & nMon, "rem" & nDay, remark, g_dbPath
    WritePrivateProfileString "Mon" & nMon, "rec" & nDay, "1", g_dbPath
End Function

'获取某一天的支出情况
Public Function GetDayFinance(ByVal nMon As Integer, ByVal nDay As Integer) As Double
    Dim szRtnValue As String
    Dim nSize As Integer
    
    szRtnValue = Space(64)
    nSize = GetPrivateProfileString("Mon" & nMon, "day" & nDay, "0", szRtnValue, 64, g_dbPath)
    
    GetDayFinance = CDbl(Mid(szRtnValue, 1, nSize))
End Function


'设置某一天的支出详细
Public Function SetDayDetail(ByVal nMon As Integer, ByVal nDay As Integer, ByRef tmpDD As DayDetail)
    WritePrivateProfileString "Mon" & nMon, "zaoc" & nDay, CStr(tmpDD.ZaoCan), g_dbPath
    WritePrivateProfileString "Mon" & nMon, "zhongc" & nDay, CStr(tmpDD.WuCan), g_dbPath
    WritePrivateProfileString "Mon" & nMon, "wanc" & nDay, CStr(tmpDD.WanCan), g_dbPath
    WritePrivateProfileString "Mon" & nMon, "gw" & nDay, CStr(tmpDD.GouWu), g_dbPath
    WritePrivateProfileString "Mon" & nMon, "gj" & nDay, CStr(tmpDD.GongJiao), g_dbPath
    WritePrivateProfileString "Mon" & nMon, "qt" & nDay, CStr(tmpDD.Other), g_dbPath
End Function

'获取某一天的支出详细情况
Public Function GetDayDetail(ByVal nMon As Integer, ByVal nDay As Integer) As DayDetail
    Dim tmpDD As DayDetail
    Dim nSize As Integer
    Dim szRtnValue(0 To 5) As String
    
    szRtnValue(0) = Space(64)
    nSize = GetPrivateProfileString("Mon" & nMon, "zaoc" & nDay, "0", szRtnValue(0), 64, g_dbPath)
    tmpDD.ZaoCan = CDbl(Mid(szRtnValue(0), 1, nSize))
    
    szRtnValue(1) = Space(64)
    nSize = GetPrivateProfileString("Mon" & nMon, "zhongc" & nDay, "0", szRtnValue(1), 64, g_dbPath)
    tmpDD.WuCan = CDbl(Mid(szRtnValue(1), 1, nSize))
    
    szRtnValue(2) = Space(64)
    nSize = GetPrivateProfileString("Mon" & nMon, "wanc" & nDay, "0", szRtnValue(2), 64, g_dbPath)
    tmpDD.WanCan = CDbl(Mid(szRtnValue(2), 1, nSize))
    
    szRtnValue(3) = Space(64)
    nSize = GetPrivateProfileString("Mon" & nMon, "gw" & nDay, "0", szRtnValue(3), 64, g_dbPath)
    tmpDD.GouWu = CDbl(Mid(szRtnValue(3), 1, nSize))
    
    szRtnValue(4) = Space(64)
    nSize = GetPrivateProfileString("Mon" & nMon, "gj" & nDay, "0", szRtnValue(4), 64, g_dbPath)
    tmpDD.GongJiao = CDbl(Mid(szRtnValue(4), 1, nSize))
    
    szRtnValue(5) = Space(64)
    nSize = GetPrivateProfileString("Mon" & nMon, "qt" & nDay, "0", szRtnValue(5), 64, g_dbPath)
    tmpDD.Other = CDbl(Mid(szRtnValue(5), 1, nSize))
    
    GetDayDetail = tmpDD
End Function


'获取某一天的支出备注
Public Function GetDayRemark(ByVal nMon As Integer, ByVal nDay As Integer) As String
    Dim szRtnValue As String
    Dim nSize As Integer
    
    szRtnValue = Space(1024)
    nSize = GetPrivateProfileString("Mon" & nMon, "rem" & nDay, " ", szRtnValue, 1024, g_dbPath)
    
    GetDayRemark = Replace(Mid(szRtnValue, 1, nSize), g_Rtn, vbCrLf)
End Function

'判断某一天是否已经记录
Public Function DayIsRecord(ByVal nMon As Integer, ByVal nDay As Integer) As Boolean
    Dim szRtnValue As String
    Dim nSize As Integer
    Dim ret As Integer
    
    szRtnValue = Space(2)
    nSize = GetPrivateProfileString("Mon" & nMon, "rec" & nDay, " ", szRtnValue, 2, g_dbPath)
    ret = CInt(Mid(szRtnValue, 1, nSize))
    
    If ret = 0 Then
        DayIsRecord = False
    Else
        DayIsRecord = True
    End If
End Function

'**********************************************数据库相关函数**************************************************