mainmodule.bas

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

Attribute VB_Name = "MainModule"
Option Explicit
Public Const SERIES_NUM As Integer = 5             '商品代码总级数
Public Const SERIES_LEN As Integer = 3             '商品代码级长
Public Const SYSTEM_SECTION = "System"

'///////////////////////////////////////////
'//StockUp表中FType定义:
Public Const STOCKUP_INVOICE = 0        '购进单
Public Const INFORMAL_INVOICE = 1       '估进单
Public Const RETURN_INVOICE = 2         '进货退还单

'///////////////////////////////////////////
'//WaresIn表中FType定义:
Public Const INIT_INVOICE = 0           '期初库存
Public Const IN_INVOICE = 1             '验收入库单
Public Const SURROGATE_INVOICE = 2      '代管入库单
Public Const WASTAGE_INVOICE = 3        '盘点单
Public Const BACK_INVOICE = 4           '商品退还单

'///////////////////////////////////////////
'//Warehouse表中FHouseAttrib定义:
Public Const INNER_HOUSE = 0            '内库
Public Const OUTER_HOUSE = 1            '外库

'///////////////////////////////////////////
'//Sell表中FType定义:
Public Const SELL_INVOICE = 0           '销售单
Public Const SELFUSE_INVOICE = 1        '领用单
Public Const REDSELL_INVOICE = 2        '销售退货单

'///////////////////////////////////////////
'//WaresOut表中FType定义:
Public Const OUT_SELL = 0               '出库单
Public Const OUT_OTHER = 1              '代管出库单
Public Const OUT_RED = 2                '退库单

'///////////////////////////////////////////
'//Depart表中FDepartAttrib定义:
Public Const COMPANY_DEPART = 0         '总公司
Public Const STOCKUP_SELL_DEPART = 1    '采购兼销售
Public Const STOCKUP_DEPART = 2         '采购
Public Const SELL_DEPART = 3            '销售
Public Const HOUSE_DEPART = 4           '库房

'///////////////////////////////////////////
'//WaresList表中FPriceMode定义:
Public Const FIFO_MODE = 0              '先进先出
Public Const WEIGHT_AVER_MODE = 1       '加权平均
Public Const MOVE_AVER_MODE = 2         '移动平均
Public Const LIFO_MODE = 3              '后进先出

'///////////////////////////////////////////
'//经营费用一级代码定义:
Public Const CHARGE_CODE As String = "AAA"
Public Const CHARGE_NAME As String = "经营费用"

'///////////////////////////////////////////
'//库存明细帐Ledger表中FFlag定义:
Public Const PREV_YEAR_CLOSE As Integer = 0     '上年结转
Public Const PREV_MONTH_CLOSE As Integer = 1    '上月结转

Public Const IN_HOUSE_DETAIL As Integer = 2     '入库明细
Public Const IN_WASTAGE_DETAIL As Integer = 3   '盘点溢损明细
Public Const IN_BACK_DETAIL As Integer = 4      '入库退还
Public Const OUT_HOUSE_DETAIL As Integer = 5    '出库明细
Public Const OUT_RETURN_DETAIL As Integer = 6   '出库退货
Public Const OUT_DIAO_BO As Integer = 7   '出库调拨
Public Const TIAO_HU As Integer = 8   '调户
Public Const THIS_DAY_SUM As Integer = 13       '本日合计 -
Public Const THIS_MONTH_SUM As Integer = 14     '本月合计+
Public Const THIS_SEASON_TOTAL As Integer = 15  '本季累计-
Public Const THIS_YEAR_TOTAL As Integer = 16    '本年累计+
Public Const THIS_SEASON_SUM As Integer = 17    '本季合计+
Public Const THIS_YEAR_SUM As Integer = 18      '本年合计
Public Const CLOSE_NEXT_YEAR As Integer = 19    '结转下年

'///////////////////////////////////////////
'//当前操作员级别定义:
Public Const SUPPER_MANAGER As Integer = 0      '系统主管
Public Const DEPART_MANAGER As Integer = 1      '部门主管
Public Const GENERAL_OPERATOR As Integer = 2    '普通操作员

'///////////////////////////////////////////
'//
Global m_gMainForm As frmMain
Global m_gsConnection As String
Global m_gDBCnn As ADODB.Connection
Global m_gsDBName As String
Global m_gsIniFile As String

Global m_sUnitName As String
Global m_gLoginDate As Date
Global m_gnYear As Integer
Global m_gbyMonth As Byte

Global m_gsDepartCode As String         '当前操作员所属部门
Global m_gnDepartAttrib As Integer      '当前操作员部门属性
Global m_gsOperator As String           '当前操作员姓名
Global m_gsPassword As String           '当前操作员口令
Global m_gnLevel As Integer             '当前操作员级别

Global m_gSeriesNum As Integer             '商品代码总级数
Global m_gSeriesLen() As Integer             '商品代码级长

Global ShowRate As Single

Sub Main()
    frmSplash.Show
    frmSplash.Refresh
    '"c:\program files\hsnjxc\warehouse.mdb" '
    m_gsDBName = App.Path & "\Warehouse.mdb"
    m_gsConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source= " & m_gsDBName
    m_gsIniFile = App.Path & "\" & App.EXEName & ".INI"
    
    Set m_gDBCnn = New ADODB.Connection
    m_gDBCnn.ConnectionString = m_gsConnection
    m_gDBCnn.CursorLocation = adUseClient
    m_gDBCnn.Open
    
    frmLogin.SetMeCaption = "系统登录"
    frmLogin.Show vbModal, frmSplash
    If Not frmLogin.OK Then
        End
    End If
    Unload frmLogin
    Dim bFirst As String
    bFirst = GetPrivateSetting("SystemInfo", "FirstRun", "")
    If UCase(bFirst) <> UCase("False") Then
        SavePrivateSetting "SystemInfo", "FirstRun", "FALSE"
        frmSeriesDef.Show vbModal
    End If
    
    Set m_gMainForm = New frmMain
    Load m_gMainForm
    m_gMainForm.Show
    Unload frmSplash
    '初始商品代码级数和级长
    InitSeries
    ShowRate = 1#
End Sub
Sub InitSeries()
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
rst.Open "select FseriesNum,FSeriesLength from Seriesdef", m_gDBCnn, adOpenStatic, adLockReadOnly
rst.MoveLast
m_gSeriesNum = rst.RecordCount
rst.MoveFirst
ReDim m_gSeriesLen(m_gSeriesNum)
Dim i As Integer
i = 0
If Not (rst.EOF And rst.BOF) Then
    Do While Not rst.EOF
        m_gSeriesLen(i) = rst!FSeriesLength
        i = i + 1
        rst.MoveNext
    Loop
Else
    MsgBox "级数表有误,请与维护人员联系"
End If
rst.Close
End Sub
'/////////////////////////////////////////////////
'//
Public Function GetDepartFunctionField() As String
    Dim sField As String
    
    Select Case m_gnDepartAttrib
        Case COMPANY_DEPART
            sField = "FCompanyItem"
        Case STOCKUP_SELL_DEPART
            sField = "FStockupSellItem"
        Case STOCKUP_DEPART
            sField = "FStockupItem"
        Case SELL_DEPART
            sField = "FSellItem"
        Case HOUSE_DEPART
            sField = "FHouseItem"
        Case Else       '超级主管登录(部门代码='', 部门属性=-1)
            sField = "FSupperItem"
    End Select
    GetDepartFunctionField = sField
End Function

Public Function GetLastVisibleCol(Grd As DataGrid) As Integer
    Dim i As Integer
    With Grd
        For i = .Columns.Count - 1 To 0 Step -1
            If .Columns(i).Visible And .Columns(i).Width >= 61 And Not .Columns(i).Locked Then
                GetLastVisibleCol = i
                Exit Function
            End If
        Next
    End With
    GetLastVisibleCol = -1
End Function

Public Function RsIsEmpty(sSqlStr As String) As Boolean
    Dim TempRs As ADODB.Recordset
    Set TempRs = New ADODB.Recordset
    TempRs.Open sSqlStr, m_gDBCnn
    
    With TempRs
        If .EOF And .BOF Then
            RsIsEmpty = True
        Else
            RsIsEmpty = False
        End If
    End With
    Set TempRs = Nothing
End Function

'////////////////////////////////////////////////////////////////////
'//FindRs为与DataGrid绑定记录集的复制, 且尚未对当前记录执行Update!
Public Function FieldIsRepeat(FindRs As ADODB.Recordset, sFindStr As String) As Boolean
    With FindRs
        If .RecordCount = 1 Then
            FieldIsRepeat = False
        Else
            ' 新创建副本的当前记录将设置为首记录。
            .Find sFindStr
            If .EOF Then
                FieldIsRepeat = False
            Else
                FieldIsRepeat = True
            End If
        End If
    End With
    Set FindRs = Nothing
End Function

'//////////////////////////////////////////////////////////
'//SQL格式: Select Max(KeyField) From TableName Where ...
'//若返回空串, 则表示数据宽度已超出有效范围
Public Function GetNewInvoiceNo(sSqlStr As String, nKeyIndex As Integer) As String
    Dim TempRs As ADODB.Recordset
    Dim sNo As String, nLen As Integer
    
    Set TempRs = New ADODB.Recordset
    TempRs.Open sSqlStr, m_gDBCnn
    
    With TempRs
        If IsNull(.Fields(nKeyIndex).Value) Then
            sNo = "1"
        Else
            sNo = Trim(Str(Val(.Fields(nKeyIndex).Value) + 1))
        End If
        
        nLen = .Fields(nKeyIndex).DefinedSize - Len(sNo)
        If nLen < 0 Then
            GetNewInvoiceNo = ""
        Else
            GetNewInvoiceNo = String(nLen, "0") & sNo
        End If
    End With
    Set TempRs = Nothing
End Function

'//////////////////////////////////////////////////////////
'//SQL格式: Select Max(KeyField) From TableName Where ...
Public Function GetNewIndex(sSqlStr As String, nKeyIndex As Integer) As Long
    Dim TempRs As ADODB.Recordset
    Dim nIndex As Long
    
    Set TempRs = New ADODB.Recordset
    TempRs.Open sSqlStr, m_gDBCnn
    
    With TempRs
        If IsNull(.Fields(nKeyIndex).Value) Then
            nIndex = 0
        Else
            nIndex = .Fields(nKeyIndex).Value + 1
        End If
        
        GetNewIndex = nIndex
    End With
    Set TempRs = Nothing
End Function

Public Function GetSelectWaresCode(sFilter As String, Optional ByRef bSelectWares As Boolean) As String
    bSelectWares = True
    Dim f As frmSelectWares
    Set f = New frmSelectWares
    f.SqlFilter = sFilter
    f.Show vbModal
    GetSelectWaresCode = f.SelectWaresCode
    Unload f
    bSelectWares = False
End Function