m.bas

用于家庭收支管理

Attribute VB_Name = "M1"
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal _
nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal _
nIndex As Long) As Long
Const WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const GWL_STYLE = (-16)
Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long

Public Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

Public szlbsz(1, 30) As String '定义自添收支类别


Public ret1 As String
Public mm As String

Public formname As String
Public ret2 As String
Public te As Integer
Public tt As Integer
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal_lpszSoundName As String, ByVal uFlags As Long) As Long
Public Declare Function HtmlHelpA Lib "hhctrl.ocx" (ByVal hwndCaller As Long, ByVal pszFile As String, ByVal uCommand As Long, ByVal dwData As Long) As Long


Public Sub CheckExist(fm As Form)
    Dim title As String
    
    If App.PrevInstance Then
        title = App.title
        
        MsgBox "此程序已打开", vbCritical
        
         End
        App.title = "" '如此才不会Avtivate到自己
        
        fm.Caption = ""
        AppActivate title 'activate先前就已行的程式
       
    End If
End Sub

Public Sub xiesz()
Dim a2, a1 As Integer
a2 = 0
a1 = 0
Open App.Path + "\lenbiezc.szl" For Input As #1
Open App.Path + "\lenbiesr.szl" For Input As #2
'把支出类别赋值数组
Do While Not EOF(1)
   Line Input #1, strline$
   szlbsz(0, a2) = strline$
   a2 = a2 + 1
Loop
'把收入类别赋值数组
Do While Not EOF(2)
   Line Input #2, strline$
   szlbsz(1, a1) = strline$
   a1 = a1 + 1
Loop
Close #1
Close #2
End Sub