frmmain.frm

一个用VB写的财务软件源码

    
'    Unload fLogin
    Exit Sub
'HandleErr:
'    MsgBox Err.Description, vbInformation, "提示"
End Sub
' Usual relogin code == END
'----------------------------------------------------------

'----------------------------------------------------------
' Usual quit code == BEGIN
Private Sub mnuSystemExit_Click()
    '通过卸载主窗体以结束工程，切忌使用 End 语句
    On Error Resume Next
    If Forms.Count <= 2 Or (TypeOf ActiveForm Is frmNavigate) Then
        If MsgBox("是否退出系统？", vbQuestion + vbDefaultButton1 + vbYesNo) = vbYes Then
            Unload Me
        End If
    Else
        Unload ActiveForm
    End If
End Sub
' Usual quit code == END
'----------------------------------------------------------

'一级菜单：设置(&I)
'设置－－期初余额
Private Sub mnuInitBeginBalance_Click()
    Dim iID As Integer
    If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuInitBeginBalance") = False Then
       iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuInitBeginBalance", glo.sAccountID, glo.sUserID)
       frmIN_Kmyetz.HelpContextID = 103
      
       'frmIN_Kmyetz.Show 1
       frmIN_Kmyetz.Show
       m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuInitBeginBalance", iID
    End If
End Sub

'设置－－结算方式
Private Sub mnuInitCountMode_Click()
    Dim iID As Integer
    If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuInitCountMode") = False Then
       iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuInitCountMode", glo.sAccountID, glo.sUserID)
       frmIN_Jsfs.HelpContextID = 107
       frmIN_Jsfs.Show 1
       m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuInitCountMode", iID
    End If
End Sub

'设置－－外币汇率
Private Sub mnuInitExchangeRate_Click()
    Dim iID As Integer
    If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuInitExchangeRate") = False Then
       iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuInitExchangeRate", glo.sAccountID, glo.sUserID)
       Load frmIN_HL
       frmIN_HL.HelpContextID = 105
       frmIN_HL.Show 1
       m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuInitExchangeRate", iID
    End If
End Sub

'设置－－非法对应科目
Private Sub mnuInitInvalidKM_Click()
'    Dim iID As Integer
'    If m_Mutex.QueryNotEnter(gloSys.sSubSysID, glo.sAccountID, "mnuInitInvalidKM") = False Then
'       iID = m_Mutex.InsertMutexID(gloSys.sSubSysID, "mnuInitInvalidKM", glo.sAccountID, glo.sUserID)
'       frmIN_Ffdykm.Show 1
'       m_Mutex.DeleteMutexID gloSys.sSubSysID, glo.sAccountID, "mnuInitInvalidKM", iID
'    End If
End Sub

'设置－－会计科目
Private Sub mnuInitKM_Click()

    Dim iID As Integer
    If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuInitKM") = False Then
        iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuInitKM", glo.sAccountID, glo.sUserID)
        Me.MousePointer = vbHourglass
        Load frmIN_Kjkmwh
        Me.MousePointer = vbDefault
        frmIN_Kjkmwh.HelpContextID = 101
        'frmIN_Kjkmwh.Show 1, Me
        frmIN_Kjkmwh.Show
        m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuInitKM", iID
    End If
End Sub

'设置－－凭证摘要
Private Sub mnuInitPZabstract_Click()
    Dim iID As Integer
    If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuInitPZabstract") = False Then
       iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuInitPZabstract", glo.sAccountID, glo.sUserID)
       glo.zy_wh_xr = True
       frmIN_Summary.usKmdm = ""
       frmIN_Summary.ubSelectStatus = False
       Load frmIN_Summary
       frmIN_Summary.HelpContextID = 108
       frmIN_Summary.Show 1, Me
       m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuInitPZabstract", iID
    End If
End Sub

'设置－－凭证设置
Private Sub mnuInitVoucherSet_Click()
    Dim iID As Integer
    If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuInitVoucherSet") = False Then
       iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuInitVoucherSet", glo.sAccountID, glo.sUserID)
       '-----------------------------------------
       frmIN_VoucherSet.HelpContextID = 109
       frmIN_VoucherSet.Show 1, Me
       '-------------------------------------------
       m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuInitVoucherSet", iID
    End If
End Sub

'设置－－凭证模板
Private Sub mnuInitPZtemplet_Click()
    Dim iID As Integer
    If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuInitPZtemplet") = False Then
       iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuInitPZtemplet", glo.sAccountID, glo.sUserID)
       frmIN_PzTempletList.HelpContextID = 110
       frmIN_PzTempletList.Show 1, Me
       m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuInitPZtemplet", iID
    End If
End Sub

'设置－－凭证类别
Private Sub mnuInitPZtype_Click()
    Dim iID  As Integer
    If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuInitPZtype") = False Then
       iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuInitPZtype", glo.sAccountID, glo.sUserID)
       '----------------------
        Dim rstCwPz As ADODB.Recordset
        MousePointer = vbHourglass
        Set rstCwPz = New ADODB.Recordset
        rstCwPz.CursorLocation = adUseClient
        If rstCwPz.State = adStateClosed Then
            rstCwPz.Open "select * from tZw_Type" & glo.sOperateYear, glo.cnnMain, adOpenStatic, adLockReadOnly
        End If
        If Not (rstCwPz.BOF Or rstCwPz.EOF) Then        '已进行了科目类型选择,只许维护
            frmIN_PzTypeList.HelpContextID = 106
            frmIN_PzTypeList.Show 1, Me
        Else
            frmIN_Pzlx.HelpContextID = 106
            frmIN_Pzlx.Show 1, Me
        End If
        rstCwPz.Close
        Set rstCwPz = Nothing
        MousePointer = vbDefault
      '-----------------------------------
       m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuInitPZtype", iID
    End If
End Sub

'一级菜单：凭证(&P)
'凭证－－记账
Private Sub mnuPzChalk_Click()
    Dim lID As Integer
    Dim oGlo As New GlobalInterface.clsGlobal
    Dim oGloSys As New GlobalInterface.clsGlobalSys
    Dim cls As New AccountRecord.clsAccountRecord
    If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuPzChalk") = False Then
       lID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuPzChalk", glo.sAccountID, glo.sUserID)
       InitGlo oGlo, oGloSys
       cls.iGlo = oGlo
       cls.iGlosys = oGloSys
       cls.Show
       m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuPzChalk", lID
    End If
End Sub

'凭证－－填制凭证
Private Sub mnuPzInput_Click()
    Dim iID As Integer
    If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuPzInput") = False Then
       iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuPzInput", glo.sAccountID, glo.sUserID)
'       ------------------------------
       Dim rSt As ADODB.Recordset
       Set rSt = New ADODB.Recordset
       With rSt
            .CursorLocation = adUseClient
            .Open "select * from tZW_type" & glo.sOperateYear, glo.cnnMain, adOpenStatic, adLockReadOnly
            If .RecordCount = 0 Then
                MsgBox "请先进行凭证种类设置！", vbInformation
            Else
                frmVoucher.AllowAddinObject = True
                Load frmVoucher
                frmVoucher.uDisplaySubjectName = GetSetting(App.Title, "Settings", "DisplaySubjectName", True)
                frmVoucher.MutexID = iID
                frmVoucher.MutexName = "mnuPzInput"
                frmVoucher.HelpContextID = 201
                frmVoucher.Show
                frmVoucher.ContorlStatus "新增"
            End If
            .Close
       End With
'       ----------------------------
    End If


End Sub

'----------------------------------------------------------
'2001.06.22.
'凭证－－凭证复核
Private Sub mnuPzCheck_Click()
    Dim iID As Integer
    Dim lCount As Long
    If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuPzCheck") = False Then
       iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuPzCheck", glo.sAccountID, glo.sUserID)
       '-----------------------------------
        Dim rSt As ADODB.Recordset
        Dim frmPZs As frmPZ_Search
        Set rSt = New ADODB.Recordset
        With rSt
            .CursorLocation = adUseClient
            .Open "SELECT COUNT(*) FROM tZW_pzsj" & glo.sOperateYear, _
                    glo.cnnMain, adOpenStatic, adLockReadOnly
            If IsNull(.Fields(0).value) Or .Fields(0).value = 0 Then
                MsgBox "还没有任何凭证。", vbInformation
                 m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuPzCheck", iID
            Else
                Set frmPZs = New frmPZ_Search
                With frmPZs
                    .SearchFunction = pzsforCheck
                    .HelpContextID = 203
                    .Show 1, Me
                    If .Ok Then
                        frmPZ_SearchResult.SearchResultFunction = .SearchFunction
                        frmPZ_SearchResult.sQueryDistinct = .usSqlDistinct
                        frmPZ_SearchResult.MutexID = iID
                        frmPZ_SearchResult.MutexName = "mnuPzCheck"
                        frmPZ_SearchResult.FillData lCount
                        Unload frmPZs
                        If lCount = 0 Then
                            m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuPzCheck", iID
                        End If
                    Else
                        m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuPzCheck", iID
                    End If
                End With
            End If
            .Close
        End With
        '-------------------------------------
    End If
End Sub

'凭证－－查询凭证
Private Sub mnuPzSearch_Click()
    Dim iID As Integer
    If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuPzSearch") = False Then
       iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuPzSearch", glo.sAccountID, glo.sUserID)
       '------------------------------------------------------
          Dim rSt As ADODB.Recordset
            Dim frmPZs As frmPZ_Search
            Dim lCount As Long
            
            Set rSt = New ADODB.Recordset
            With rSt
                .CursorLocation = adUseClient
                .Open "SELECT COUNT(*) FROM tZW_type" & glo.sOperateYear, _
                        glo.cnnMain, adOpenStatic, adLockReadOnly
                If IsNull(.Fields(0).value) Or .Fields(0).value = 0 Then
                    MsgBox "请先进行凭证种类设置！", vbInformation
                Else
                    Set frmPZs = New frmPZ_Search
                    With frmPZs
                        .SearchFunction = pzsForSearchOnly
                        .HelpContextID = 204
l_Redo:
                        .Show 1, Me
                        If .Ok Then
                            frmPZ_SearchResult.SearchResultFunction = .SearchFunction
                            frmPZ_SearchResult.sQueryDistinct = .usSqlDistinct
                            frmPZ_SearchResult.MutexID = iID
                            frmPZ_SearchResult.MutexName = "mnuPzSearch"

                            frmPZ_SearchResult.FillData lCount

                            If lCount = 0 Then
                                GoTo l_Redo
        '                    Else
        '                        Unload frmPZs
                            End If
                        Else
                            m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuPzSearch", iID
                            
                        End If
                    End With
                End If
                .Close
            End With
       '---------------------------------
    End If
End Sub

'凭证- -凭证汇总
Private Sub mnuPzCollect_Click()
'
'    Dim frmC As frmPZ_CollectResultView
'    Dim frmPZs As frmPZ_Search
'
'    Set frmPZs = New frmPZ_Search
'    With frmPZs
'        .SearchFunction = pzsForCollect
'        .Show 1, Me
'        If .OK Then
'            Set frmC = New frmPZ_CollectResultView
'            frmC.ShowResult .usSQL
'            Unload frmPZs
'        End If
'    End With
'
End Sub

'----------------------------------------------------------
'凭证－－凭证改号与删除
Private Sub mnuPzUpdate_Click()
    Dim iID As Integer
    Dim lCount As Long
    If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuPzUpdate") = False Then
       iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuPzUpdate", glo.sAccountID, glo.sUserID)
        Dim frmPzList As New frmPZ_SearchResult
        Dim sSQL As String
        sSQL = "SELECT kjqj,pzzl,pzbh,pzrq,pzzy,fjzs,zdrm,fhrm,zgrm,xgbz" & _
                   " FROM tZW_pzsj" & glo.sOperateYear & _
                   " WHERE xgbz='0' and jlhm=1 and kjqj>=1 and kjqj<=12" & _
                   " ORDER BY kjqj,pzzl,pzbh"
        With frmPzList
            .SearchResultFunction = pzsrForupdate
            .sQueryDistinct = sSQL
            .MutexName = "mnuPzUpdate"
            .MutexID = iID
            .FillData lCount
            If lCount > 0 Then
                .HelpContextID = 202
            End If
        End With
    End If
End Sub

'一级菜单：账表(&A)
'账表－－日记账
Private Sub mnuAccountBook_Click()
    Dim lID As Integer
    If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuAccountBook") = False Then
       lID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuAccountBook", glo.sAccountID, glo.sUserID)
        Dim frmR As frmAC_BookResult
        Dim iTemp As Integer
        With frmAC_BookSelect
            .Ok = False
            .HelpContextID = 305
            .Sho