frmmain.frm

利用VB+ACCESS开发的专用布料管理系统

      Begin VB.Menu MnuXtSjHy 
         Caption         =   "数据还原(&R)"
      End
      Begin VB.Menu MnuLine6 
         Caption         =   "-"
      End
      Begin VB.Menu MnuGgDlYh 
         Caption         =   "更改登陆用户(&C)"
      End
      Begin VB.Menu MnuGgYhMm 
         Caption         =   "更改用户密码(&P)"
      End
      Begin VB.Menu MnuDlYhGlQ 
         Caption         =   "登录用户管理(&U)."
      End
      Begin VB.Menu MnuLine18 
         Caption         =   "-"
      End
      Begin VB.Menu MnuExit 
         Caption         =   "退出系统(&X)"
      End
   End
   Begin VB.Menu MnuM 
      Caption         =   "出货验货(&M)"
      Begin VB.Menu MnuM_Out 
         Caption         =   "出货验货记录(&O)"
      End
      Begin VB.Menu MnuLine2 
         Caption         =   "-"
      End
      Begin VB.Menu MnuM_Tj 
         Caption         =   "出货验货汇总(&T)."
      End
   End
   Begin VB.Menu MnuLabel 
      Caption         =   "标签打印(&L)"
   End
   Begin VB.Menu MnuDataT 
      Caption         =   "数据处理(&T)"
      Begin VB.Menu MnuDataDel 
         Caption         =   "删除数据(&D)"
      End
      Begin VB.Menu MnuDataOut 
         Caption         =   "导出EXCEL(&U)"
      End
      Begin VB.Menu MnuLine3 
         Caption         =   "-"
      End
      Begin VB.Menu MnuDataOpen 
         Caption         =   "打开MDB(&O)"
      End
      Begin VB.Menu MnuDataRestore 
         Caption         =   "恢复为系统MDB(&R)."
         Enabled         =   0   'False
      End
      Begin VB.Menu MnuDataSaveAs 
         Caption         =   "保存为MDB(&A)..."
      End
   End
   Begin VB.Menu MnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu MnuGyBXt 
         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
Option Explicit

Public WithEvents m_Menu As EnhancedMenu
Attribute m_Menu.VB_VarHelpID = -1
Dim hbmoving As Boolean
Const sglSplitLimit = 500

Dim HelpPath As String
Dim i As Integer

Private Sub Form_Load()
    Set m_Menu = New EnhancedMenu
    m_Menu.Subclass Me.hWnd
    
    Set m_Menu(2).SubMenu(1).Picture = LoadPicture(SysDbPath + "\COMMIT.ICO")
    Set m_Menu(2).SubMenu(2).Picture = LoadPicture(SysDbPath + "\open.ICO")
    Set m_Menu(2).SubMenu(4).Picture = LoadPicture(SysDbPath + "\index.ICO")
    Set m_Menu(2).SubMenu(6).Picture = LoadPicture(SysDbPath + "\userpower.ICO")
    Set m_Menu(2).SubMenu(7).Picture = LoadPicture(SysDbPath + "\grid.ICO")
    Set m_Menu(2).SubMenu(8).Picture = LoadPicture(SysDbPath + "\close.ICO")
    Set m_Menu(6).SubMenu(1).Picture = LoadPicture(SysDbPath + "\preview.ICO")
    m_Menu(6).RightJustify = True
    
    HelpPath = App.Path & "\help\default.HTM"
    Me.Show
    Me.Caption = "布料管理系统（当前用户：" & MdlMain.LoginUser & "）"
    StatusBar1.Panels("panel3").Text = "登陆日期：" & MdlMain.LoginTime.LgTime
    DoEvents
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If MsgBox("你真的要退出本系统吗？", vbOKCancel + vbInformation, "请确认...") = vbCancel Then
        Cancel = True
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    m_Menu.Destroy
    Set m_Menu = Nothing
End Sub

Public Sub PrintReport(PntStyle As String)
    On Error GoTo ErrorHandle
    CrystalReport1.DataFiles(0) = ""
    CrystalReport1.ReportFileName = ""
    With CrystalReport1
        Select Case PntStyle
            Case "Pnt1"
                .DataFiles(0) = SysDbPath & "\report97.mdb"
                .ReportFileName = SysDbPath & "\pnt1.rpt"
                .WindowTitle = "成品出货验货记录"
            Case "Pnt2"
                .DataFiles(0) = SysDbPath & "\report97.mdb"
                .ReportFileName = SysDbPath & "\pnt2.rpt"
                .WindowTitle = "成品出货验货汇总表"
            Case "Pnt3"
                .DataFiles(0) = SysDbPath & "\report97.mdb"
                .ReportFileName = SysDbPath & "\pnt3.rpt"
                .WindowTitle = "不干胶纸标签打印"
            Case "Pnt4"
                .DataFiles(0) = SysDbPath & "\report97.mdb"
                .ReportFileName = SysDbPath & "\pnt4.rpt"
                .WindowTitle = "不干胶纸标签打印"
        End Select
        .Destination = crptToWindow
        .WindowState = crptMaximized
        .Action = 1
    End With
    Exit Sub
ErrorHandle:
    If Err.Number = 20526 Then
        MsgBox "系统没有安装打印机，请安装打印机后再试试看！", vbOKOnly + vbInformation, "找不到打印机..."
    Else
        MsgBox Err.Number & " : " & Err.Description, vbOKOnly + vbCritical, "打印出错"
    End If
End Sub

Private Sub m_Menu_ItemSelect(MenuObject As MenuItem)
    Select Case MenuObject.Caption
        Case "数据备份(&B)"
            Call MdlMain.CloseWindows("CloseAll")
            DoEvents
            FrmBackUp.Show vbModal
        Case "数据还原(&R)"
            Call MdlMain.CloseWindows("CloseAll")
            DoEvents
            FrmRestore.Show vbModal
        Case "更改登陆用户(&C)"
            FrmLoginChange.Show vbModal
        Case "更改用户密码(&P)"
            FrmPwdGl.Show vbModal
        Case "登录用户管理(&U)."
            FrmLoginUser.Show vbModal
        Case "退出系统(&X)"
            Unload Me
        
        Case "出货验货记录(&O)"
            Call Toolbar1_ButtonClick(Toolbar1.Buttons("TbrMOut"))
        Case "出货验货汇总(&T)."
            Call Toolbar1_ButtonClick(Toolbar1.Buttons("TbrHz"))
        Case "标签打印(&L)"
            Call Toolbar1_ButtonClick(Toolbar1.Buttons("TbrLabel"))
            
        Case "删除数据(&D)"
            FrmM_Del.Show vbModal
        Case "导出EXCEL(&U)"
            FrmM_2xls.Show vbModal
        Case "打开MDB(&O)"
            FrmM_UseMdb.Show vbModal
        Case "恢复为系统MDB(&R)."
            DbConnectSql = "provider=microsoft.jet.oledb.4.0;data source=" & _
                SysDbPath & "\maindb.mdb;jet oledb:database password=;"
            FrmMain.m_Menu(2).SubMenu(1).Enabled = True
            FrmMain.m_Menu(2).SubMenu(2).Enabled = True
            
            FrmMain.m_Menu(5).SubMenu(1).Enabled = True
            FrmMain.m_Menu(5).SubMenu(2).Enabled = True
            FrmMain.m_Menu(5).SubMenu(4).Enabled = True
            FrmMain.m_Menu(5).SubMenu(5).Enabled = False
            FrmMain.m_Menu(5).SubMenu(6).Enabled = True
            
            FrmMain.Toolbar1.Buttons("TbrOut").Enabled = True
            FrmMain.Toolbar1.Buttons("TbrHuanYuan").Enabled = True
            FrmMain.Toolbar1.Buttons("TbrBeiFen").Enabled = True
        Case "保存为MDB(&A)..."
            FrmM_2Mdb.Show vbModal
        
        Case "关于本系统(&A)."
            Flash = True
            FrmFlash.Show vbModal
    End Select
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "TbrExit"
            Unload Me
            
        Case "TbrBeiFen"
            Call MdlMain.CloseWindows("CloseAll")
            DoEvents
            FrmBackUp.Show vbModal
        Case "TbrHuanYuan"
            Call MdlMain.CloseWindows("CloseAll")
            DoEvents
            FrmRestore.Show vbModal
        Case "TbrPassword"
            FrmPwdGl.Show vbModal
            
        Case "TbrMOut"
            Me.Hide
            DoEvents
            FrmM_Out.Show
        Case "TbrHz"
            Me.Hide
            DoEvents
            FrmM_Tj.Show
        Case "TbrLabel"
            FrmM_Label.Show vbModal
        Case "TbrOut"
            FrmM_2xls.Show vbModal
    End Select
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyF6
            Call Toolbar1_ButtonClick(Toolbar1.Buttons("TbrMOut"))
        Case vbKeyF7
            Call Toolbar1_ButtonClick(Toolbar1.Buttons("TbrHz"))
        Case vbKeyF8
            Call Toolbar1_ButtonClick(Toolbar1.Buttons("TbrLabel"))
        Case vbKeyF9
            If Toolbar1.Buttons("TbrOut").Enabled = True Then Call Toolbar1_ButtonClick(Toolbar1.Buttons("TbrOut"))
    End Select
End Sub