frmmain.frm

针对农资系统的管理模式而开发的业务部门与财务部门的转账模式和过程

      End
      Begin VB.Menu mnuRollBackMonthEnd 
         Caption         =   "退回月结"
      End
      Begin VB.Menu mnuTiaoHu 
         Caption         =   "调户"
      End
      Begin VB.Menu mnuEditPrice 
         Caption         =   "修改结存"
      End
      Begin VB.Menu mnuMixiAccount 
         Caption         =   "商品明细分类帐"
      End
   End
   Begin VB.Menu mnuWindow 
      Caption         =   "窗口(&W)"
      WindowList      =   -1  'True
      Begin VB.Menu mnuWindowCascade 
         Caption         =   "层叠(&C)"
      End
      Begin VB.Menu mnuWindowTileHorizontal 
         Caption         =   "横向平铺(&H)"
      End
      Begin VB.Menu mnuWindowTileVertical 
         Caption         =   "纵向平铺(&V)"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnuHelpContents 
         Caption         =   "目录(&C)"
      End
      Begin VB.Menu mnuHelpSearchForHelpOn 
         Caption         =   "搜索帮助主题(&S)..."
      End
      Begin VB.Menu mnuHelpBar0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "关于(&A) "
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)

'/////////////////////////////////////////////////////
'//单据处理
Dim frmStockUpInvoice As frmStockUp     '购进单
Dim frmInformalInvoice As frmStockUp    '估进单
Dim frmStockUpReturn As frmStockUp      '进货退还单
'//
Dim frmWaresIn As frmIn                 '验收入库单
Dim frmWaresSurrogate As frmIn          '代管入库单
Dim frmWaresWastage As frmIn            '盘点单
Dim frmWaresBack As frmIn               '商品退还单
'//
Dim frmWaresSellBill As frmWaresSell    '销售单
Dim frmWaresSelfUse As frmWaresSell     '领用单
Dim frmWaresRedSell As frmWaresSell     '销售退货单

Dim frmWaresOut As frmOut               '出库单
Dim frmwaresOutRed  As frmOut           '退库单
Dim frmWaresOutOther As frmOut          '代管出库单

'//////////////////////////////////////////////////////
'//查询统计
Dim fStockUpCost As frmStockUpCost      '商品采购成本分析
Dim fUnderway As frmStockUpCost         '在途商品分析
'//
Dim frmStockListing As frmStockWares    '库存商品清单
Dim frmLackWares As frmStockWares       '库房短缺商品分析
Dim frmOverstock As frmStockWares       '库房超储商品分析
'//
Dim frmProfitAnalyze As frmAnalyze      '商品毛利分析
Dim frmNotPickUp As frmAnalyze          '成交待发商品
Dim frmIncomeAnalyze As frmAnalyze      '商品收入汇总分析

'//////////////////////////////////////////////////////
'//模块权限变量
Dim m_bEdit As Boolean                  '编辑权
Dim m_bAuditer As Boolean               '审核权
Dim m_bKeeper As Boolean                '记帐权

'//////////////////////////////////////////////////////
'//设置功能表
Private Sub SetFunction()
    Dim mnuObj As Object, nAffected As Integer
    
    For Each mnuObj In Me.Controls
        If TypeOf mnuObj Is Menu Then
            If InStr(1, mnuObj.Name, "mnuWindow") + InStr(1, mnuObj.Name, "mnuHelp") = 0 Then
                On Error Resume Next
                m_gDBCnn.Execute "Insert Into Function (FMenuName, FMenuDescribe) Values ('" & mnuObj.Name & "','" & mnuObj.Caption & "')", nAffected
                On Error GoTo 0
                If nAffected = 0 Then
                    m_gDBCnn.Execute "Update Function Set FMenuDescribe = '" & mnuObj.Caption & "' Where FMenuName = '" & mnuObj.Name & "'"
                End If
            End If
        End If
    Next
End Sub

'//////////////////////////////////////////////////////
'//
Private Sub InitToolBarAttribute()
    Dim mnuObj As Object, i As Integer
    Dim sMnuName As String
    
    For i = 1 To imlToolbarIcons.ListImages.Count
        imlToolbarIcons.ListImages(i).Key = UCase(imlToolbarIcons.ListImages(i).Key)
    Next
    
    tbToolBar.Buttons.Clear
    For Each mnuObj In Me.Controls
        If TypeOf mnuObj Is Menu Then
            If InStr(1, mnuObj.Name, "mnuWindow") + InStr(1, mnuObj.Name, "mnuHelp") = 0 Then
                sMnuName = UCase(mnuObj.Name)
                If sMnuName = "MNUACCOUNT" Or sMnuName = "MNUMONTHEND" Or sMnuName = "MNUMIXIACCOUNT" Then
                    Exit For
                End If
                tbToolBar.Buttons.Add , sMnuName
                
                If sMnuName = UCase("mnuSystem") Or sMnuName = UCase("mnuStockUpVoucher") _
                    Or sMnuName = UCase("mnuHouseVoucher") Or sMnuName = UCase("mnuSellVoucher") _
                    Or sMnuName = UCase("mnuStockUpAnalyze") Or sMnuName = UCase("mnuStockQuery") _
                    Or sMnuName = UCase("mnuSellAnalyze") Or mnuObj.Caption = "-" Then
                    
                    tbToolBar.Buttons(sMnuName).Style = tbrSeparator
                Else
                    tbToolBar.Buttons(sMnuName).ToolTipText = mnuObj.Caption
                    tbToolBar.Buttons(sMnuName).Style = tbrDefault
                    tbToolBar.Buttons(sMnuName).Image = sMnuName
                End If
            End If
        End If
    Next
End Sub

'//////////////////////////////////////////////////////
'//设置操作权限
Public Sub SetOperatorRights()
    Dim sSqlStr As String, sField As String
    Dim FunctionRs As ADODB.Recordset
    Dim PowerRs As ADODB.Recordset
    Dim mnuObj As Object, sKey As String
    
    sField = GetDepartFunctionField()
    sSqlStr = "Select FMenuName From Function Where Not " & sField
    Set FunctionRs = New ADODB.Recordset
    FunctionRs.Open sSqlStr, m_gDBCnn
    
    sSqlStr = "SELECT FMenuName FROM Function Where " & sField & " And FMenuAttrib <> 0 " & _
        " And FMenuName Not In (Select FMenuName From OperatorPower " & _
        " Where FDepartCode = '" & m_gsDepartCode & "' And FOperatorName = '" & m_gsOperator & "')"
    Set PowerRs = New ADODB.Recordset
    PowerRs.Open sSqlStr, m_gDBCnn
    
    On Error Resume Next
    '对父菜单上的最后一个保持可视的子菜单，试图设置 Visible 属性为 False 时会出错！
    '工具条不含“窗口”及“帮助”菜单，若设置其 Visible 及 Enabled 属性时会出错！
    For Each mnuObj In Me.Controls
        If TypeOf mnuObj Is Menu Then
            sKey = UCase(mnuObj.Name)
            FunctionRs.Filter = "FMenuName = '" & mnuObj.Name & "'"
            mnuObj.Visible = (FunctionRs.EOF And FunctionRs.BOF)
            tbToolBar.Buttons(sKey).Visible = (FunctionRs.EOF And FunctionRs.BOF)
            
            If m_gnLevel = GENERAL_OPERATOR Then
                PowerRs.Filter = "FMenuName = '" & mnuObj.Name & "'"
                If mnuObj Is mnuRights Or mnuObj Is mnuChangeManager Then
                    mnuObj.Enabled = False
                    tbToolBar.Buttons(sKey).Enabled = False
                Else
                    mnuObj.Enabled = (PowerRs.EOF And PowerRs.BOF)
                    tbToolBar.Buttons(sKey).Enabled = (PowerRs.EOF And PowerRs.BOF)
                End If
            Else
                mnuObj.Enabled = True
                tbToolBar.Buttons(sKey).Enabled = True
            End If
        End If
    Next
    Set FunctionRs = Nothing
    Set PowerRs = Nothing
End Sub

'//////////////////////////////////////////////////////
'//
Private Sub GetOperatorPower(sMenuName As String, ByRef bEdit As Boolean, Optional ByRef bAuditer As Boolean, Optional ByRef bKeeper As Boolean)
    If m_gnLevel = SUPPER_MANAGER Or m_gnLevel = DEPART_MANAGER Then
        bEdit = True
        bAuditer = True
        bKeeper = True
        Exit Sub
    End If

    Dim PowerRs As ADODB.Recordset
    Set PowerRs = New ADODB.Recordset
    PowerRs.Open "Select * From OperatorPower Where FDepartCode = '" & m_gsDepartCode & "' And FOperatorName = '" & m_gsOperator & "' And FMenuName = '" & sMenuName & "' Order by FPowerAttrib", m_gDBCnn
    With PowerRs
        If .EOF And .BOF Then
            bEdit = False
            bAuditer = False
            bKeeper = False
        Else
            .Filter = "FPowerAttrib = 1"
            bEdit = Not (.EOF And .BOF)
            .Filter = "FPowerAttrib = 2"
            bAuditer = Not (.EOF And .BOF)
            .Filter = "FPowerAttrib = 3"
            bKeeper = Not (.EOF And .BOF)
        End If
    End With
    Set PowerRs = Nothing
End Sub

'//////////////////////////////////////////////////////
'//
Private Sub MDIForm_Load()
    Dim i As Integer
'///////////////////////////////////
'//    SetFunction      '设置功能表
'///////////////////////////////////
   InitToolBarAttribute
    
    
    With sbStatusBar
        .Panels.Add , "OPERATOR", "操作员：" & m_gsOperator, sbrText
        .Panels.Add , "LOGINDATE", "登录日期：" & Format(m_gLoginDate, "Long Date"), sbrText
        .Panels.Add , "CURRENTTIME", "当前时间：" & Format(Time, "Long Time"), sbrText
        
        For i = .Panels("OPERATOR").Index To .Panels("CURRENTTIME").Index
            .Panels(i).Alignment = sbrCenter
            .Panels(i).AutoSize = sbrContents
            .Panels(i).MinWidth = 1440
        Next
    End With
    
    CurrentTimer.Interval = 1000
    CurrentTimer.Enabled = True
    'SetOperatorRights
End Sub

Private Sub CurrentTimer_Timer()
    sbStatusBar.Panels("CURRENTTIME").Text = "当前时间：" & Format(Time, "Long Time")
End Sub

'//////////////////////////////////////////////////////
'//系统设置
Private Sub mnuCharge_Click()
    GetOperatorPower "mnuCharge", m_bEdit
    frmCharge.OperatorPower = m_bEdit
    frmCharge.Show vbModal
End Sub

Private Sub mnuCustomer_Click()
    GetOperatorPower "mnuCustomer", m_bEdit
    frmCustomer.OperatorPower = m_bEdit
    frmCustomer.Show
    frmCustomer.SetFocus
End Sub

Private Sub mnuEditPrice_Click()
    frmEditPrice.Show
End Sub

Private Sub mnuMixiAccount_Click()
frmStockCondtion.Show vbModal
End Sub

Private Sub mnuMonthEnd_Click()
'月末结账
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "select FCloseAccDate from system", m_gDBCnn, adOpenStatic, adLockOptimistic
If rs!FCloseAccDate < m_gLoginDate Then
    
    If vbOK = MsgBox("月结以后不能再录入本月数据,您确定要月结吗?", vbOKCancel, "月末结帐") Then
        Me.MousePointer = vbHourglass
        If PeriodEndKeepRecord Then
            rs!FCloseAccDate = m_gnYear & "-" & m_gbyMonth & IIf(m_gbyMonth = 12, "-31", "-25") 'm_gLoginDate
            rs.Update
            End  '应该重新登陆
        End If
        Me.MousePointer = 0
        rs!FCloseAccDate = m_gLoginDate
    End If
Else
    MsgBox "本月已经结帐"
End If
rs.Close
End Sub

Private Sub mnuRollBackMonthEnd_Click()
 Dim CloseAccDate As Date
 Dim rs As ADODB.Recordset
 Set rs = New ADODB.Recordset
 rs.Open "select FCloseAccDate from system", m_gDBCnn, adOpenStatic, adLockOptimistic
 CloseAccDate = rs!FCloseAccDate
 rs.Close
 rs.Open "select FYear,Fmonth,FDate from ledger where FDate >#" & CloseAccDate & "#", m_gDBCnn, adOpenStatic, adLockReadOnly
 If rs.EOF And rs.BOF Then
    Dim strSQL As String
    strSQL = "delete from ledger where FYear = " & m_gnYear & " and Fmonth= " & m_gbyMonth & " and ( FFlag <=1 or FFlag>=13)"
    m_gDBCnn.Execute strSQL
    If m_gbyMonth = 1 Then
        strSQL = "update system set FCloseAccDate = #" & (m_gnYear - 1) & "-12-31#"
    Else
        strSQL = "update system set FCloseAccDate = #" & m_gnYear & "-" & m_gbyMonth - 1 & "-25#"
    End If
    m_gDBCnn.Execute strSQL
    MsgBox "成功退回到本月月结前的状态."
    End
 Else
    MsgBox "已经录入下月数据,不能退回!"
 End If
End Sub

Private Sub mnuSetWarehouse_Click()
    GetOperatorPower "mnuSetWarehouse", m_bEdit
    frmSetWarehouse.OperatorPower = m_bEdit
    frmSetWarehouse.Show vbModal
End Sub

Private Sub mnuSetDepart_Click()
    GetOperatorPower "mnuSetDepart", m_bEdit
    frmSetDepart.OperatorPower = m_bEdit
    frmSetDepart.Show vbModal
End Sub

Private Sub mnuSupplier_Click()
    GetOperatorPower "mnuSupplier", m_bEdit
    frmSupplier.OperatorPower = m_bEdit
    frmSupplier.Show
    frmSupplier.SetFocus
End Sub

Private Sub mnuTiaoHu_Click()
 frmTiaohu.Show vbModal
End Sub

Private Sub mnuWaresList_Click()
    GetOperatorPower "mnuWaresList", m_bEdit
    frmWaresList.OperatorPower = m_bEdit
    frmWaresList.Show
    frmWaresList.SetFocus
End Sub

Private Sub mnuInitBalance_Click()
    GetOperatorPower "mnuInitBalance", m_bEdit
    frmInitBalance.OperatorPower = m_bEdit
    frmInitBalance.Show vbModal
End Sub

Private Sub mnuInitStockDetail_Click()
    GetOperatorPower "mnuInitStockDetail", m_bEdit
    frmInitStockDetail.OperatorPower = m_bEdit
    frmInitStockDetail.Show vbModal
End Sub

'////////////////////////////////////////
'//
Private Sub mnuRights_Click()
    frmRights.Show vbModal
End Sub

Private Sub mnuOperatorLogin_Click()
    Dim i As Integer
    
    frmLogin.SetMeCaption = "更换操作员"
    frmLogin.Show vbModal
    If frmLogin.OK Then
        i = 0
        Do While Forms.Count > 2
            If Forms(i) Is m_gMainForm Or Forms(i) Is frmLogin Then
                i = i + 1
            Else
                Unload Forms(i)
            End If
        Loop
        sbStatusBar.Panels("OPERATOR").Text = "操作员：" & m_gsOperator
        sbStatusBar.Panels("LOGINDATE").Text = "登录日期：" & Format(m_gLoginDate, "Long Date")
        SetOperatorRights
    End If
    Unload frmLogin
End Sub