mainwan.frm

金算盘软件代码

Private Sub lbHot_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        Dim po As POINTAPI
        po.x = x / Screen.TwipsPerPixelX
        po.y = y / Screen.TwipsPerPixelY
        ClientToScreen PicBrower.hwnd, po
        ScreenToClient Me.hwnd, po
        Drawline po.x, False
    End If
End Sub

Private Sub lbHot_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
   If Button = 1 Then
     Dim po As POINTAPI
     po.x = x / Screen.TwipsPerPixelX
     po.y = y / Screen.TwipsPerPixelY
     ClientToScreen PicBrower.hwnd, po
     ScreenToClient Me.hwnd, po
     Drawline po.x
   End If
End Sub

Private Sub lbHot_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
   If Button = 1 Then
        Drawline lngPos, False
        If PicBrower.width - x > 200 Then
           PicBrower.width = PicBrower.width - x
        Else
           PicBrower.width = 200
        End If
   End If
End Sub

Private Sub MDIForm_Activate()
    If gExistIndog Then
        frmMain.stbMain.Panels("WorkState").AutoSize = sbrContents
        frmMain.stbMain.Panels("WorkState").Text = "万能软件公司版权所有"
        frmMain.stbMain.Panels("WorkState").Bevel = sbrInset
    Else
        frmMain.stbMain.Panels("WorkState").AutoSize = sbrContents
        If gclsBase.VersionType = 1 Then
            frmMain.stbMain.Panels("WorkState").Text = "[教学版]"
        Else
            frmMain.stbMain.Panels("WorkState").Text = "[演示版]"
        End If
        frmMain.stbMain.Panels("WorkState").Bevel = sbrInset
    End If
    If Not Me.ActiveForm Is Nothing Then
       On Error Resume Next
       gclsSys.MainControls(Trim(str(frmMain.ActiveForm.hwnd))).MDIChildActive
    Else
        Dim strBuffer As String * 128
        Dim strURL As String
         Dim ret As Long
         ret = GetWindowsDirectory(strBuffer, 128)
         strURL = "mk:@MSITStore:" & Left(strBuffer, ret) & "\HELP\" & "Ac98Nav.chm" & "::/bzml01.htm"
         ShowDeskTopHelp strURL
    End If
    tlbMain.Enabled = True
End Sub

Private Sub MDIForm_Deactivate()
    tlbMain.Enabled = False
End Sub

Private Sub MDIForm_Load()
   Dim strBuffer As String * 128
   Dim strURL As String
    Dim ret As Long
    Set Me.Picture = Utility.GetFormResPicture(11531, vbResBitmap)
    ret = GetWindowsDirectory(strBuffer, 128)
    strURL = "mk:@MSITStore:" & Left(strBuffer, ret) & "\HELP\" & "Ac98Nav.chm" & "::/bzml01.htm"
    ShowDeskTopHelp strURL
    
    Me.Caption = App.title
    Me.mnuEnd.Visible = False
'    Me.mnuAccount2.Visible = False
    
    '从系统注册表中加载最近打开文件
    Utility.LoadMRU
    
    '为所有的筛选和搜索初始化ImageList
    Filter.InitImageList ImageListFilter
    '根据版本类型组织菜单
    InitMenu
    
    '从系统注册表中加载窗体位置、大小
    Utility.LoadFormSetting Me
    
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    strURL = "mk:@MSITStore:" & App.HelpFile & "::/welcome.htm"
    ShowDeskTopHelp strURL

End Sub

Private Sub InitMenu()
    '标准版
    #If conVersionType = 1 Then
           Me.mnuAccountPurchase.Visible = False        '商品采购(财务版)
           Me.mnuAccountSale.Visible = False            '商品销售(财务版)
           Me.mnuAccountDtail.Visible = False           '财务版非控制科目的银行对仗
           Me.mnuFileExport.Visible = False             '引出
           Me.mnuFileImport.Visible = False             '引入
'           Me.mnuFileBar6.Visible = False
           Me.mnuReporAudit.Visible = False
           
           
           Me.mnuTask.Visible = True                  '供应链
           Me.mnuAccountBankMoney.Visible = True      '现金银行
           Me.mnuReportBar1.Visible = True
           Me.mnuReportPurchase.Visible = True
           Me.mnuReportStorage.Visible = True
           Me.mnuReportSale.Visible = True
           Me.mnuReportWt.Visible = True
           Me.mnuReportBar2.Visible = True
           Me.mnuReporFareAnalysis.Visible = True
           Me.mnuListItemInit.Visible = True
           Me.mnuListCustom.Visible = True              '自定项目
           Me.mnuListFance.Visible = True
           Me.mnuListBar3.Visible = True
    #Else
                '财务版
           Me.mnuAccountDtail.Visible = False           '财务版非控制科目的银行对仗
           Me.mnuFileExport.Visible = False             '引出
           Me.mnuFileImport.Visible = False             '引入
'           Me.mnuFileBar6.Visible = False
           Me.mnuReporAudit.Visible = False
           Me.mnuTask.Visible = False                    '供应链
           Me.mnuListItemInit.Visible = False
           Me.mnuListCustom.Visible = False     '自定项目
           Me.mnuListFance.Visible = False
           Me.mnuListBar3.Visible = False
           Me.mnuReportWt.Visible = False       '委托加工
           Me.mnuReportPurchase.Visible = False
           Me.mnuReportSale.Visible = False
           Me.mnuReportStorage.Visible = False
           Me.mnuReportBar2.Visible = False
           Me.mnuReporFareAnalysis.Visible = False
           
           Me.mnuAccountPurchase.Visible = True        '商品采购(财务版)
           Me.mnuAccountSale.Visible = True            '商品销售(财务版)
    #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
        End If
        PicBrower.Visible = GetSetting(App.title, "HelpBar", "MinHelpVisible", True)
        mnuHelpBar.Checked = PicBrower.Visible
    Else
        'Unload frmNavigateWan
        mnuFileOpen_Click
        '更新菜单
        'UpdateMenuStatus
    End If
End Sub

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

Private Sub MDIForm_Resize()
    cmdFlow.Left = Me.width - cmdFlow.width - 300
    cmdFlow.top = (tlbMain.Height - cmdFlow.Height) / 2
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 11532
    Utility.RemoveFormResPicture 139
    Filter.DestroyImageList ImageListFilter
    Set Me.Icon = Nothing
    End
End Sub

Public 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
'应付贷项
Public Sub mnuAccountAPCrebit_Click()
    MousePointer = vbHourglass
    ShowBillOfType 34
    MousePointer = vbDefault
End Sub

'应付借项
Public Sub mnuAccountAPDebit_Click()
    MousePointer = vbHourglass
    ShowBillOfType 35
    MousePointer = vbDefault
End Sub

'Private Sub mnuAccount2Bank_Click()
'   mnuAccountReconcile_Click
'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
'
'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 mnuAccountARCrebit_Click()
    MousePointer = vbHourglass
    ShowBillOfType 37
    MousePointer = vbDefault
End Sub
'应收借项
Public Sub mnuAccountARDebit_Click()
    MousePointer = vbHourglass
    ShowBillOfType 36
    MousePointer = vbDefault
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

Private Sub mnuAccountCreatSalary_Click()
    frmSalaryList.SetNewSalarylist
End Sub

Public Sub mnuAccountDepreciation_Click()
    Dim blnOK As Boolean
    
    blnOK = False
    If Not BeenInputWork(gclsBase.AccountYear, gclsBase.P