frm_main.frm

商品进销存管理系统 采用VB和SQL2000开发 具有很强的实用性

Attribute VB_Name = "frm_main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*************************************************************************
'**模 块 名：frm_main
'**版权说明：吉林省明日科技有限公司享有本软件的所有版权，如果本软件用于商
'**          业用途，必须经过吉林省明日科技有限公司授权。如果提供网上免费
'**          下载，必须经过吉林省明日科技有限公司授权，并保证程序的完整，
'**          不得修改代码、注释和相关内容，否则，我公司将追究其法律责任
'**网    址：www.mingrisoft.com  价值无限，服务无限
'**电    话：[phone],84978982
'**创 建 人：明日科技
'**日    期：2007-10-31
'**修 改 人：MRLBB
'**日    期：2007-10-31
'**描    述：
'*************************************************************************
Dim mytag As String
Dim rs1 As New ADODB.Recordset
Public picTag As Integer
Const SW_SHOWNORMAL As Long = 1
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub Flash1_FSCommand(ByVal command As String, ByVal args As String)
    Select Case command
    Case "jsq"   '计算器
        Dim reval
        reval = Shell("CALC.EXE", 1)
    Case "jsb"   '记事本
        m22_Click
    Case "mmxg"   '密码修改
        mm = 1
        bFlag = False
        Load main_xtgl_mm
        main_xtgl_mm.Show 1
    Case "cxdl"   '重新登录
        Load frm_login
        frm_login.Show
        frm_main.Enabled = False

    Case "zxbz"   '在线帮助
        Dim Temp As String
        Temp = "www.mingrisoft.com"                                         '所要连接的网站名称
        ShellExecute 0&, vbNullString, Temp, vbNullString, vbNullString, 0  '调用IE
    Case "tu"   '退出
        End
    End Select

End Sub

Private Sub Flash2_FSCommand(ByVal command As String, ByVal args As String)
    Select Case command
            '基础信息管理
        Case "data"   '商品资料管理
            m12_Click
        Case "accommodate"   '供应商管理
            m13_Click
        Case "client"        '客户管理
            m14_Click
        Case "personnel"     '人员管理
            m15_Click
        Case "unit"         '本单位信息
            m16_Click
            '库存商品管理
        Case "demand"       '库存查询
            m5_Click
        Case "check"        '库存盘点
            m6_Click
        Case "price"       '价格管理
            m7_Click
    
            '日常业务管理
        Case "xsth"    '销售退货
            m3_Click
        Case "yprk"    '商品入库
            m1_Click
        Case "distribution"   '商品销售
            m2_Click
        Case "rkth"    '入库退货
            m4_Click
    
            ' 商品查询统计
        Case "ykcx"     '入库查询
            m8_Click
        Case "ykthcx"   '入库退货查询
            m9_Click
        Case "xscx"     '销售查询
            m10_Click
        Case "xsthcx"   '销售退货查询
            m11_Click
    
            '系统管理
    
        Case "popedom"   '操作权限
            m17_Click
        Case "prepare"   '数据备份与恢复
            m18_Click
        Case "initialization"   '数据初始化
            m19_Click
        Case "log"   '系统日志
            m20_Click
    
            '辅助工具
        Case "calculator"   '计算器
            m21_Click
        Case "WORDPAD"      '记事本
            m22_Click
        Case "address"      '通讯录
            m23_Click
        Case "yhzh"         '银行账号
            m24_Click
    End Select
End Sub

Private Sub Form_Load()
    RegInfo Me
    Flash1.Movie = App.Path & "\image\flash\主界面中的横长条flash.swf"
    Flash2.Movie = App.Path & "\image\flash\3.swf"
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim i As Integer
    For i = 0 To Label1.UBound
        Label1(i).ForeColor = &HC00000
    Next i
End Sub

Private Sub Label1_Click(Index As Integer)
    If Index = 6 Then Unload Me
End Sub

Private Sub Label1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    '当鼠标移到左侧图形菜单上时，将Picture1移到该菜单上以产生不同的菜单效果
    Label1(Index).ForeColor = RGB(255, 0, 0)
    Flash2.Movie = App.Path & "\image\flash\" & Index & ".swf"
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim Msg As String   ' 声明变量。
    ' 如果正在退出应用。
    Msg = "是否退出〖" & Me.Caption & "〗应用程序？"
    ' 如果用户单击No按钮，则停止QueryUnload。
    If MsgBox(Msg, vbQuestion + vbYesNo, Me.Caption) = vbNo Then Cancel = True
End Sub
Private Sub lbl1_Click()
    '单击左侧图形菜单
    Select Case Lbl1.Caption
    Case "日常业务管理"
        Picture3.Picture = LoadPicture(App.Path & "\image\1.jpg")
        picTag = 1
    Case "库存商品管理"
        Picture3.Picture = LoadPicture(App.Path & "\image\2.jpg")
        picTag = 2
    Case "商品查询统计"
        Picture3.Picture = LoadPicture(App.Path & "\image\3.jpg")
        picTag = 3
    Case "基本资料管理"
        Picture3.Picture = LoadPicture(App.Path & "\image\4.jpg")
        picTag = 4
    Case "系统管理"
        Picture3.Picture = LoadPicture(App.Path & "\image\5.jpg")
        picTag = 5
    Case "辅助工具"
        Picture3.Picture = LoadPicture(App.Path & "\image\6.jpg")
        picTag = 6
    Case "帮助"
        m25_Click
    Case "关于"
        m26_Click
    Case "退出"
        Unload Me
    End Select
End Sub
Private Sub lbl2_Click()
    '单击picture3中移动的图形按钮
    Select Case mytag
    Case "m1"
        m1_Click
    Case "m2"
        m2_Click
    Case "m3"
        m3_Click
    Case "m4"
        m4_Click
    Case "m5"
        m5_Click
    Case "m6"
        m6_Click
    Case "m7"
        m7_Click
    Case "m8"
        m8_Click
    Case "m9"
        m9_Click
    Case "m10"
        m10_Click
    Case "m11"
        m11_Click
    Case "m12"
        m12_Click
    Case "m13"
        m13_Click
    Case "m14"
        m14_Click
    Case "m15"
        m15_Click
    Case "m16"
        m16_Click
    Case "m17"
        m17_Click
    Case "m18"
        m18_Click
    Case "m19"
        m19_Click
    Case "m20"
        m20_Click
    Case "m21"
        m21_Click
    Case "m22"
        m22_Click
    Case "m23"
        m23_Click
    Case "m24"
        m24_Click
    End Select
End Sub
Private Sub menu5_Click(Index As Integer)
    Select Case Index
    Case 0     '操作权限
        Load main_xtgl_czqx
        main_xtgl_czqx.Show
        frm_main.Enabled = False
    Case 1     '数据备份与恢复
        Load main_xtgl_sjbfhf
        main_xtgl_sjbfhf.Show
        frm_main.Enabled = False
    End Select
End Sub
Private Sub exit_Click()
    Unload Me
End Sub
Private Sub m1_Click()     '入库
    rs1.Open "select * from tb_power where 操作员='" & OP & "'", Cnn, adOpenStatic
    If rs1.RecordCount > 0 Then
        If rs1.Fields(0) = False Then
            MsgBox "对不起，您没有使用此项功能的权限！", vbInformation, "提示"
        Else
            Load main_rcyw_rk
            main_rcyw_rk.Show 1
        End If
    End If
    rs1.Close
End Sub

Private Sub m13_Click()
    rs1.Open "select * from tb_power where 操作员='" & OP & "'", Cnn, adOpenStatic
    If rs1.RecordCount > 0 Then
        If rs1.Fields(12) = False Then
            MsgBox "对不起，您没有使用此项功能的权限！", vbInformation, "提示"
        Else
            Load main_jbzl_gys
            main_jbzl_gys.Show 1
        End If
    End If
    rs1.Close
End Sub

Private Sub m2_Click()     '商品销售
    rs1.Open "select * from tb_power where 操作员='" & OP & "'", Cnn, adOpenStatic
    If rs1.RecordCount > 0 Then
        If rs1.Fields(1) = False Then
            MsgBox "对不起，您没有使用此项功能的权限！", vbInformation, "提示"
        Else
            Load main_rcyw_xs
            main_rcyw_xs.Show 1
        End If
    End If
    rs1.Close
End Sub

Private Sub m25_Click()    '帮助
    Call ShellExecute(Me.hwnd, "Open", App.Path & "\说明文件.doc", vbNullString, App.Path, SW_SHOWNORMAL)
End Sub

Private Sub m3_Click()     '销售退货
    rs1.Open "select * from tb_power where 操作员='" & OP & "'", Cnn, adOpenStatic
    If rs1.RecordCount > 0 Then
        If rs1.Fields(2) = False Then
            MsgBox "对不起，您没有使用此项功能的权限！", vbInformation, "提示"
        Else
            Load main_rcyw_xsth
            main_rcyw_xsth.Show 1
        End If
    End If
    rs1.Close
End Sub
Private Sub m4_Click()     '入库退货
    rs1.Open "select * from tb_power where 操作员='" & OP & "'", Cnn, adOpenStatic
    If rs1.RecordCount > 0 Then
        If rs1.Fields(3) = False Then
            MsgBox "对不起，您没有使用此项功能的权限！", vbInformation, "提示"
        Else
            Load main_rcyw_rkth
            main_rcyw_rkth.Show 1
        End If
    End If
    rs1.Close
End Sub
Private Sub m5_Click()
    rs1.Open "select * from tb_power where 操作员='" & OP & "'", Cnn, adOpenStatic
    If rs1.RecordCount > 0 Then
        If rs1.Fields(4) = False Then
            MsgBox "对不起，您没有使用此项功能的权限！", vbInformation, "提示"
        Else
            Load main_kcgl_cx
            main_kcgl_cx.Show 1
        End If
    End If
    rs1.Close
End Sub
Private Sub m6_Click()
    rs1.Open "select * from tb_power where 操作员='" & OP & "'", Cnn, adOpenStatic
    If rs1.RecordCount > 0 Then
        If rs1.Fields(5) = False Then
            MsgBox "对不起，您没有使用此项功能的权限！", vbInformation, "提示"
        Else
            Load main_kcgl_kcpd
            main_kcgl_kcpd.Show 1
        End If
    End If
    rs1.Close
End Sub
Private Sub m7_Click()
    rs1.Open "select * from tb_power where 操作员='" & OP & "'", Cnn, adOpenStatic
    If rs1.RecordCount > 0 Then