main.frm

金算盘软件代码

                    Me.mnuAccountPurchase.Visible = True        '商品采购(财务版)
                    Me.mnuAccountSale.Visible = True            '商品销售(财务版)
                    Me.mnuAccountTaskBar7.Visible = True        '应收计息与采购发票间的分隔符
                    Me.mnuAccountTaskBar0.Visible = True
                #End If
           #End If
        #End If
    #End If
End Sub

Public Sub OpenLast()
  Dim strTitle As String
    PicBrower.Visible = False
    If frmMain.mnuFileMRU(0).Visible Then
        mnuFileMRU_Click (0)
        strTitle = App.title
        If GetSetting(strTitle, "Tips", "ShowWhenStart", True) Then
           frmTip.Show vbModal
           If mnuWindowDiagram.Checked Then frmNavigate.RefreshWeb
        End If
        PicBrower.Visible = GetSetting(App.title, "HelpBar", "MinHelpVisible", True)
        mnuHelpBar.Checked = PicBrower.Visible
    Else
        'Unload frmNavigate
        mnuFileOpen_Click
        '更新菜单
        'UpdateMenuStatus
    End If
    mnuToolArrange.Enabled = IIf(GetSetting(App.title, "Navigate", "WindowNavigateStyle", "1") = "2", True, False)
End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode = 2 Or UnloadMode = 3 Then
        End
    End If
    If ShowMsg(Me.hwnd, "你确定要退出吗?", vbQuestion + vbOKCancel, App.title) = vbCancel Then
       Cancel = True
       Exit Sub
    End If
    If mnuWindowDiagram.Checked Then
        SaveSetting App.title, "Diagram", "ShowWhenStart", True
    Else
        SaveSetting App.title, "Diagram", "ShowWhenStart", False
    End If
    DoEvents
End Sub

Private Sub MDIForm_Resize()
    cmdFlow.Left = Me.width - cmdFlow.width - 300
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
    Set frmOpenAccount = Nothing
    If Me.WindowState <> vbMinimized Then
        '把窗体位置、大小存储到系统注册表
        Utility.SaveFormSetting Me
    End If
    Set gclsEniv = Nothing
    Set gclsSys = Nothing
    Set gclsBase = Nothing
    'Set stbMain.Panels(6).Picture = Nothing
    Utility.RemoveFormResPicture 139
    Filter.DestroyImageList ImageListFilter
    Set Me.Icon = Nothing
End Sub

Private Sub mnuAccountAPVoucher_Click()
    If Not gclsBase.PeriodClosed(gclsBase.BaseDate) Then
        MousePointer = vbHourglass
        Dim intCount As Integer
        For intCount = gclsSys.MainControls.Count To 1 Step -1
            If gclsSys.MainControls(intCount).Form.Name = "frmPurchaseSaleVoucher" Then
                Exit For
            End If
        Next
        If intCount < 1 Then
            Set frmPurchaseSaleVoucher = Nothing
        End If
        With frmPurchaseSaleVoucher
            .SetManner "应付"
            .Show vbModal
        End With
        MousePointer = vbDefault
    Else
        ShowMsg frmMain.hwnd, "本期已结帐，不能再制作凭证！", vbCritical + vbOKOnly, "往来凭证"
    End If
End Sub

Private Sub mnuAccount2Bank_Click()
   mnuAccountReconcile_Click
End Sub

Private Sub mnuAccount2BillAdmin_Click()
    mnuAccountBillAdmin_Click
End Sub

    '预算批复
Public Sub mnuAccount2BudgetRepty_Click()
   Dim frmContract As frmContractReport
     If glngContract = 0 Then
        Set frmContract = New frmContractReport
        Load frmContract
        frmContract.ShowReport gclsBase.BaseDate, gclsBase.BaseDate, , , , rtDudgetDetail
     Else
        If gcolContract.Item(CStr(glngContract)).WindowState = 1 Then
            gcolContract.Item(CStr(glngContract)).WindowState = vbNormal
        End If
        gcolContract.Item(CStr(glngContract)).ZOrder 0
     End If
End Sub

Private Sub mnuAccount2CancelOver_Click()
   mnuAccountUnFinish_Click
End Sub

Private Sub mnuAccount2End_Click()
   mnuAccountCalcExchange_Click
End Sub

Private Sub mnuAccount2Fees_Click()
   mnuAccountFees_Click
End Sub

Private Sub mnuAccount2FixChange_Click()
   mnuAccountFixedAsset_Click
End Sub

Private Sub mnuAccount2FixOld_Click()
   mnuAccountDepreciation_Click
End Sub

Private Sub mnuAccount2FixVoucher_Click()
   mnuAccountFixedAssetVoucher_Click
End Sub

Public Sub mnuAccount2JobProject_Click()
    frmListJobItem.Show
    frmListJobItem.ZOrder 0
End Sub

Private Sub mnuAccount2MoneyRate_Click()
    mnuAccountMoneyRate_Click
End Sub

Private Sub mnuAccount2Over_Click()
   mnuAccountFinish_Click
End Sub

Private Sub mnuAccount2Rest_Click()
   mnuAccountRest_Click
End Sub

Private Sub mnuAccount2Salary_Click()
   mnuAccountSalary_Click
End Sub

Private Sub mnuAccount2SalVoucher_Click()
   mnuAccountSalaryVoucher_Click
End Sub

Private Sub mnuAccount2Trans_Click()
   mnuAccountTemplate_Click
End Sub

Private Sub mnuAccount2TurnTo_Click()
   mnuAccountProfitLoss_Click
End Sub

Private Sub mnuAccount2Voucher_Click()
   mnuAccountVoucher_Click
End Sub

'自动凭证(应收应付、现金银行、工资、固定资产)
Public Sub mnuAccountARAPVoucher_Click()
    If Not gclsBase.PeriodClosed(gclsBase.BaseDate) Then
        MousePointer = vbHourglass
        Dim intCount As Integer
        For intCount = gclsSys.MainControls.Count To 1 Step -1
            If gclsSys.MainControls(intCount).Form.Name = "frmPurchaseSaleVoucher" Then
                Exit For
            End If
        Next
        If intCount < 1 Then
            Set frmPurchaseSaleVoucher = Nothing
        End If
        With frmPurchaseSaleVoucher
            .SetManner "自动凭证"
            .Show vbModal
        End With
        MousePointer = vbDefault
    Else
        ShowMsg frmMain.hwnd, "本期已结帐，不能再制作凭证！", vbCritical + vbOKOnly, "收支凭证"
    End If
End Sub

'票据管理
Public Sub mnuAccountBillAdmin_Click()
    Dim clsAccount As clsListCheck
    If gclsList.Count <> 0 Then
        If Not ColItemExist(gclsList, "check") Then
            Set clsAccount = New clsListCheck
            gclsList.Add clsAccount, "check"
        Else
            Set clsAccount = gclsList("check")
        End If
    Else
        Set clsAccount = New clsListCheck
        gclsList.Add clsAccount, "check"
    End If
    clsAccount.Showlist
    clsAccount.SetListType "check"
End Sub

Public Sub mnuAccountCalcExchange_Click()
    MousePointer = vbHourglass
    If CheckTransLoss Then
        With FrmTransferLoss
            .Show vbModal
        End With
        Set FrmTransferLoss = Nothing
    End If
    MousePointer = vbDefault
End Sub

Public Sub mnuAccountDepreciation_Click()
    Dim blnOK As Boolean
    
    blnOK = False
    If Not BeenInputWork(gclsBase.AccountYear, gclsBase.Period) Then
        If ShowMsg(hwnd, "本期工作量未全部录入，是否继续提折旧？", vbYesNo + vbQuestion + vbDefaultButton2, "计提折旧") = vbYes Then
            blnOK = True
        End If
    Else
        blnOK = True
    End If
    If blnOK Then
        With frmFixedOldWizard
            .ShowMe
        End With
        Set frmFixedOldWizard = Nothing
    End If
End Sub

'费用分摊
Private Sub mnuAccountFees_Click()
    MousePointer = vbHourglass
    If CheckTrans("管理费用分摊") Then
        With frmExpense
            .Show vbModal
        End With
        Set frmExpense = Nothing
    End If
    MousePointer = vbDefault
End Sub

'固定资产
Public Sub mnuAccountFixedAsset_Click()
    MousePointer = vbHourglass
    With frmAccountFixedAsset
        .ShowMe
    End With
    MousePointer = vbDefault
End Sub

Public Sub mnuAccountFixedAssetVoucher_Click()
    If GetSet(10, "特殊科目", "固定资产") > 0 Then
        Dim intCount As Integer
        For intCount = gclsSys.MainControls.Count To 1 Step -1
            If gclsSys.MainControls(intCount).Form.Name = "frmFixedVoucher" Then
                Exit For
            End If
        Next
        If intCount < 1 Then
            Set frmFixedVoucher = Nothing
        End If
        frmFixedVoucher.ShowMe
    Else
        MsgBox "请在帐套属性中选择固定资产科目", vbInformation, "固资凭证"
    End If
End Sub

Public Sub mnuAccountJobCheck_Click()
     '预算批复
    Dim frmContract As frmContractReport
    If glngContract = 0 Then
        Set frmContract = New frmContractReport
        Load frmContract
        frmContract.ShowReport gclsBase.BaseDate, gclsBase.BaseDate, , , , rtDudgetDetail
    Else
        If gcolContract.Item(CStr(glngContract)).WindowState = 1 Then
            gcolContract.Item(CStr(glngContract)).WindowState = vbNormal
        End If
        gcolContract.Item(CStr(glngContract)).ZOrder 0
    End If
End Sub

Public Sub mnuAccountJobProject_Click()
    '工程合同
    frmListJobItem.Show
    frmListJobItem.ZOrder 0
End Sub

'资金计息
Public Sub mnuAccountMoneyRate_Click()
    If Not gclsBase.PeriodClosed(gclsBase.BaseDate) Then
        frmAccountInterest.Show vbModal
    Else
        ShowMsg frmMain.hwnd, "本期已结帐，不能再科目计息！", vbCritical + vbOKOnly, "科目计息"
    End If
End Sub

Public Sub mnuAccountProfitLoss_Click()
    MousePointer = vbHourglass
    If CheckLoss(FrmLoss.Caption) Then
        With FrmLoss
            .Show vbModal
        End With
        Set FrmLoss = Nothing
    Else
        Unload FrmLoss
    End If
    MousePointer = vbDefault
End Sub

'商品采购(财务版)
Public Sub mnuAccountPurchase_Click()
    mnuTaskPurchase_Click
End Sub

'结余分配
Private Sub mnuAccountRest_Click()
    MousePointer = vbHourglass
    If CheckLoss(frmDispart.Caption) Then
        With frmDispart
            .Show vbModal
        End With
        Set frmDispart = Nothing
    Else
        Unload frmDispart
    End If
    MousePointer = vbDefault
End Sub

Public Sub mnuAccountRPVoucher_Click()
    If Not gclsBase.PeriodClosed(gclsBase.BaseDate) Then
        MousePointer = vbHourglass
        Dim intCount As Integer
        For intCount = gclsSys.MainControls.Count To 1 Step -1
            If gclsSys.MainControls(intCount).Form.Name = "frmPurchaseSaleVoucher" Then
                Exit For
            End If
        Next
        If intCount < 1 Then
            Set frmPurchaseSaleVoucher = Nothing
        End If
        With frmPurchaseSaleV