frmmain.frm

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

                frmR.Show 1
            End If
            Unload frmYH_DjwhSelect
        End With
   '-------------------------------------------
   m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuBankBillcode", iID
End If
End Sub

Private Sub mnuBankCheckBill_Click()
    frmYH_Yhdzcxtjlr.HelpContextID = 4
    frmYH_Yhdzcxtjlr.Show 1
    If frmYH_Yhdzcxtjlr.Ok Then
        frmYH_Yhdzwd.uJzRq = frmYH_Yhdzcxtjlr.DTP1.value
        frmYH_Yhdzwd.uCgts = frmYH_Yhdzcxtjlr.Text1.text
        Unload frmYH_Yhdzcxtjlr
        frmYH_Yhdzwd.HelpContextID = 4
        frmYH_Yhdzwd.Show 1
    Else
        Unload frmYH_Yhdzcxtjlr
    End If
End Sub

Private Sub mnuCarryForwordData_Click()
Dim iID As Integer
If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuCarryForwordData") = False Then
    iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuCarryForwordData", glo.sAccountID, glo.sUserID)
    frmLastYearCarryForward.uMutexID = iID
    frmLastYearCarryForward.HelpContextID = 511
    frmLastYearCarryForward.Show
    'm_Mutex.DeleteMutexID gloSys.sSubSysID, glo.sAccountID, "mnuCarryForwordData", iID
End If
End Sub

Private Sub mnuInitAssistant_Click()
'frmIN_YsyfQcyetz.uiFlag = 4
'frmIN_YsyfQcyetz.Show 1, Me
End Sub

Private Sub mnuOpinionSet_Click()
    Dim iID As Integer
    If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuOpinionSet") = False Then
       iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuOpinionSet", glo.sAccountID, glo.sUserID)
       '-----------------------------------------
       frmIn_OpinionSet.HelpContextID = 1
        frmIn_OpinionSet.Show 1
       '-------------------------------------------
       m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuOpinionSet", iID
    End If
End Sub

Private Sub mnuPopupMenuSetHeadHigh_Click()
Dim frm As New frmSetHigh
Dim o As New clsRowType
On Error Resume Next
o.Clone ActiveForm.PrintHeadType
frm.txtValue = o.High
frm.Show 1, Me
With frm
    If .Ok Then
        o.High = .txtValue
        ActiveForm.PrintHeadType = o
    End If
End With
Unload frm
End Sub

Private Sub mnuPopupMenuSetTitleHigh_Click()
Dim frm As New frmSetHigh
Dim o As New clsRowType
On Error Resume Next
o.Clone ActiveForm.PrintTitleType
frm.txtValue = o.High
frm.Show 1, Me
With frm
    If .Ok Then
        o.High = .txtValue
        ActiveForm.PrintTitleType = o
    End If
End With
Unload frm
End Sub

Private Sub mnuPopupSetDataFont_Click()
Dim o As New clsRowType
On Error GoTo Err:
With Me.dLg
    .CancelError = True
    o.Clone ActiveForm.PrintDataType
    .FontName = o.FontName
    .FontSize = o.FontSize
    .ShowFont
    o.FontName = .FontName
    o.FontSize = .FontSize
    ActiveForm.PrintDataType = o
End With
Err:
End Sub

Private Sub mnuPopupSetDataHigh_Click()
Dim frm As New frmSetHigh
Dim o As New clsRowType
On Error Resume Next
o.Clone ActiveForm.PrintDataType
frm.txtValue = o.High
frm.Show 1, Me
With frm
    If .Ok Then
        o.High = .txtValue
        ActiveForm.PrintDataType = o
    End If
End With
Unload frm
End Sub

Private Sub mnuPopupSetHeadFont_Click()
Dim o As New clsRowType
On Error GoTo Err:
With Me.dLg
    o.Clone ActiveForm.PrintHeadType
    .CancelError = True
    .FontName = o.FontName
    .FontSize = o.FontSize
    .ShowFont
    o.FontName = .FontName
    o.FontSize = .FontSize
    ActiveForm.PrintHeadType = o
End With
Err:
End Sub

Private Sub mnuPopupSetTitleFont_Click()
Dim o As New clsRowType
On Error GoTo Err:
With Me.dLg
    .CancelError = True
    o.Clone ActiveForm.PrintTitleType
    .FontName = o.FontName
    .FontSize = o.FontSize
    .ShowFont
    o.FontName = .FontName
    o.FontSize = .FontSize
    ActiveForm.PrintTitleType = o
End With
Err: End Sub

Private Sub mnusyDefine_Click()
    Dim iID As Integer
    If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuZzpzSet") = False Then
       iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuZzpzSet", glo.sAccountID, glo.sUserID)
       '-----------------------------------------
        Dim rstPZZL As ADODB.Recordset
        Set rstPZZL = New ADODB.Recordset
        With rstPZZL
            .CursorLocation = adUseClient
            .Open "select * from tZW_type" & glo.sOperateYear & " order by signID", _
                        glo.cnnMain, adOpenStatic, adLockReadOnly
            If .RecordCount = 0 Then
                MsgBox "请先设置凭证种类！", vbExclamation, "提示"
                Exit Sub
            End If
        End With
        Set rstPZZL = Nothing
        frmFI_ZzpzSet.usPzType = "损益"
        frmFI_ZzpzSet.HelpContextID = 508
        frmFI_ZzpzSet.Show 1
       '-------------------------------------------
       m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuZzpzSet", iID
    End If
End Sub

Private Sub mnusySc_Click()
    Dim iID As Integer
    If m_Mutex.QueryNotEnter(gloSys.sSubSysId, glo.sAccountID, "mnuZzsc") = False Then
       iID = m_Mutex.InsertMutexID(gloSys.sSubSysId, "mnuZzsc", glo.sAccountID, glo.sUserID)
       '-----------------------------------------
        Dim rstPz As New ADODB.Recordset
        Dim sSQL As String
        '判断是否有未记账凭证，如果有这提示不能进行期末转账
        frmFI_ZzdateSel.Show 1
        If frmFI_ZzdateSel.Ok Then
            frmFI_ZzNew.sKJRQ = Trim(frmFI_ZzdateSel.cboRQ.List(frmFI_ZzdateSel.cboRQ.ListIndex))
            sSQL = "select count(*)  from tzw_pzsj" & glo.sOperateYear & " where xgbz<>2  and kjqj< =" & Month(Trim(frmFI_ZzdateSel.cboRQ.List(frmFI_ZzdateSel.cboRQ.ListIndex)))
            rstPz.CursorLocation = adUseClient
            rstPz.Open sSQL, glo.cnnMain, adOpenKeyset, adLockOptimistic
            If Not IsNull(rstPz.Fields(0).value) Then
                If rstPz.Fields(0).value > 0 Then
                   MsgBox Month(Trim(frmFI_ZzdateSel.cboRQ.List(frmFI_ZzdateSel.cboRQ.ListIndex))) & "月含有未记账凭证，不能进行期末转账！", vbInformation
                   Exit Sub
                   
                End If
            End If
            Set rstPz = Nothing
            Unload frmFI_ZzdateSel
            frmFI_ZzNew.usPzType = "损益"
            frmFI_ZzNew.HelpContextID = 509
            frmFI_ZzNew.Show
        Else
            Unload frmFI_ZzdateSel
        End If

       '-------------------------------------------
       m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuZzsc", iID
    End If
End Sub

Private Sub mnuSystemLock_Click()
LockSystem
End Sub

'页面设置
Private Sub mnuSystemPaperSet_Click()
    On Error Resume Next
    With dLg
        .DialogTitle = "页面设置"
        .Flags = cdlPDHelpButton & cdlPDNoSelection
        If Printers.Count > 0 Then
            .ShowPrinter
        End If
    End With
End Sub

'预览
Private Sub mnuSystemPreview_Click()
    If Not (ActiveForm Is Nothing) Then
        If Printers.Count = 0 Then
           MsgBox "请安置打印机！", vbInformation
           Exit Sub
        End If
        On Error Resume Next
        ActiveForm.uPreview
    End If
End Sub

'打印
Private Sub mnuSystemPrint_Click()
    If Not (ActiveForm Is Nothing) Then
       If Printers.Count = 0 Then
           MsgBox "请安置打印机！", vbInformation
           Exit Sub
       Else
          On Error Resume Next
          ActiveForm.uPrint
       End If
    End If
End Sub

''一级菜单：系统(&S)
''----------------------------
Private Sub mnuSystemRelogin_Click()
    Dim rSt As ADODB.Recordset
    Dim ctl As Control
    Dim frm As Object
'   On Error GoTo HandleErr
   Set VoucherTempSave = Nothing
   Set s = CreateObject("encryption.iencryption")
    '进行系统注册
l_Redo:
    With fLogin
        If Not funSystemLogin(False) Then Exit Sub
        
        '关闭所有 MDI 子窗体
        For Each frm In Forms
            If TypeOf frm Is frmMain Then
            Else
                Unload frm
            End If
        Next

        '刷新操作员权限
        If Not SetUserAuth(.usAccountID, .usUserID) Then
            GoTo l_Redo
        End If
        
    '个性环境检测与权限设置通过
        Me.MousePointer = vbHourglass
        '设置权限
        For Each ctl In Me.Controls
            If TypeOf ctl Is Menu Then
                ctl.Enabled = True
            End If
        Next
        Call SetUserAuth(.usAccountID, .usUserID)
        
        '赋全程变量
'        glo.sAccountID = .usAccountID
'        glo.sAccountName = .usAccountName
'        glo.sOperateYear = .uiAccountYear
'        glo.sUserID = .usUserID
'        glo.sUserName = .usUserName
'        glo.sOperateDate = .usOperateDate
'        glo.iOperatePeriod = .uiPeriod
'        glo.sUnEarlierDate = .usUnEarlierDate
'        glo.sBeginYear = .uiAccountBeginYear
'        glo.sBeginMonth = .uiAccountBeginMonth
        glo.cnnMain.Close
        Select Case g_FLAT
            Case "SQL"
                glo.cnnMain.Open GetConnectString(g_FLAT, gloSys.sServer, _
                    gloSys.sUser, s.decrypt(gloSys.sPassword), "cwDB" & glo.sAccountID)
            Case "ORACLE"
                Set glo.cnnMain = Nothing
                Set glo.cnnMain = New ADODB.Connection
                glo.cnnMain.Open GetConnectString(g_FLAT, gloSys.sServer, _
                    "cwDB" & glo.sAccountID, "ykcwDB" & glo.sAccountID)
        End Select
        
        '刷新状态栏
        Call FillStatusBar
        
        '{各个子系统个性环境的重建}
'----------------------------------------------------------

        '取出科目是否用"-"负号分隔的标志
        Set rSt = New ADODB.Recordset
        With rSt
            .CursorLocation = adUseClient
            .Open "SELECT SeparateSubject FROM tSYS_Account" & _
                    " WHERE AccountID = '" & glo.sAccountID & "'", _
                gloSys.cnnSYS, adOpenStatic, adLockReadOnly
            If .EOF = False Then
                If IsNull(.Fields(0).value) Then
                    glo.bSeparateSubject = False
                Else
                    If IsNumeric(.Fields(0).value) Then
                        glo.bSeparateSubject = .Fields(0).value
                    Else
                        glo.bSeparateSubject = False
                    End If
                End If
            End If
            .Close
        End With
        Set rSt = Nothing
        
  '取出科目代码符号分隔的标志
     Set rSt = New ADODB.Recordset
     With rSt
        .CursorLocation = adUseClient
        .Open "SELECT Separatechar FROM tSYS_Account" & _
                " WHERE AccountID = '" & glo.sAccountID & "'", _
            gloSys.cnnSYS, adOpenStatic, adLockReadOnly
    
        If Not IsNull(.Fields("separatechar").value) Then
              glo.sSeparateSubject = .Fields("separatechar").value
        Else
              glo.sSeparateSubject = "0"
        End If
        .Close
    End With
    Set rSt = Nothing
        
        MousePointer = vbDefault
'----------------------------------------------------------
    End With