frmmain.frm

企业ERP系统 采用VB+SQL2000实现。 有客户合约

VERSION 5.00
Object = "{4932CEF1-2CAA-11D2-A165-0060081C43D9}#2.0#0"; "Actbar2.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.MDIForm frmMain 
   BackColor       =   &H8000000C&
   Caption         =   "聯威泰紡織有限公司信息系統"
   ClientHeight    =   8745
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   12135
   StartUpPosition =   3  'Windows Default
   WindowState     =   2  'Maximized
   Begin ActiveBar2LibraryCtl.ActiveBar2 ActiveBar21 
      Align           =   1  'Align Top
      Height          =   8745
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   12135
      _LayoutVersion  =   1
      _ExtentX        =   21405
      _ExtentY        =   15425
      _DataPath       =   ""
      Bands           =   "frmMain.frx":0000
      Begin MSComDlg.CommonDialog CDFile 
         Left            =   2160
         Top             =   1920
         _ExtentX        =   847
         _ExtentY        =   847
         _Version        =   393216
         Filter          =   "*.xls|*.*"
      End
      Begin MSComDlg.CommonDialog comDlg 
         Left            =   600
         Top             =   2100
         _ExtentX        =   847
         _ExtentY        =   847
         _Version        =   393216
      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

Private Sub ActiveBar21_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
Select Case Tool.Name
        '系统设置
        Case "menuSystemDatabase"   '数据库
            frmSystemDatabase.Show vbModal
        Case "menuSystemOperator" '操作员
            frmSystemOperator.Show
        Case "menuCustomerInfo"   '数据库设置
            frmClientMan.Show
        Case "menuLabel"
            frmBasicLabel.Show
        Case "menuFactory" '加工廠信息
            frmBasicFactory.Show
        Case "menuStock"
            frmBasicStock.Show
        Case "menuClientOrder"
            frmBasicClientOrder.Show
        Case "menuSuppliers":  '供應商信息
            frmBasicFabricSuppliers.Show
        Case "menuBaseinfoProduct"  '布種布樣
            frmBasicFabric.Show: viewFlag = False
        Case "menuBaseinfoUnit" '單位信息
             frmBasicUnit.Show
        Case "menuBaseinfoPayment" '付款方式設置
            frmBasicPayment.Show
        Case "menuBaseinfoPort"  '港口信息設置
            frmBasicPort.Show
        Case "menuBaseinfoState" '國家信息
            frmBasicCountries.Show
        Case "menuBaseinfoColorLayout" '顏色花型
            frmBasicColorLayout.Show
        Case "menuBaseinfoColor" '色位信息
            frmBasicColor.Show
        Case "menuBaseinfoWeave" '組織信息
            frmBasicWeave.Show
        Case "menuBaseinfoFabricType" '組織信息
            frmBasicFabricType.Show
        Case "menuBaseinfoProcess" '工藝信息
            frmBasicProcess.Show
        Case "menuBaseinfoComposition" '成份信息
            frmBasicComposition.Show
        Case "menuBaseinfoCompositionType" '成份類型信息
            frmBasicCompositionType.Show
        Case "menuBaseinfoStretch" '拉伸信息
            frmBasicStretch.Show
        Case "menuBaseinfoYarnType"
            frmBasicYarnType.Show
        Case "menuBaseinfoOrigin" '原產地信息
            frmBasicOrigin.Show
        Case "menuBaseinfoPrice"  '價格條款信息設置
            frmBasicPrice.Show
        Case "menuBaseInfoTransport" '運輸公司信息
            FrmBasicTransport.Show
        Case "menuBaseInfoCurrency" '幣種信息
            FrmBasicCurrencyInfo.Show
        Case "menuContract"
            frmContractMan.Show
        Case "menuHelpInfo" '帮助信息
            Call OpenHelp
        Case "menuSystemExit"   '退出系统
            Unload Me
        Case "menuOrder"
            frmOrderMan.Show
        Case "menuOperationContractOrder" '合約跟單表
            frmOperationContractOrder.Show
        Case "menuClaim" '索賠表
            frmClaim.Show
        '預備工序
        Case "menuBeforeMain"
            frmBeforeMain.Show
        Case "menuClientInfo"
            frmBasicClientInfo.Show
        '生產中記
        Case "menuProductionEmbryoContract" '合約
            frmProductionEmbryoContractMain.Show
        Case "menuProductionEmbryoIn"   '進坯
            frmProductionEmbryoIn.Show
        Case "menuProductionEmbryoOut"  '用坯
            frmProductionEmbryoOut.Show
        Case "menuProductionFollowOrder" '加工單跟貨表
            frmProductionFollowOrder.Show
        Case "menuProductionFollowCustomer" '客戶跟貨表
            frmProductionFollow.Show
        Case "menuProductionSummary" '生產匯總表
            frmProductionSummary.Show
        Case "menuProductionProgress"   '生產進度表
            frmProductionProgress.Show
        '出貨
        Case "menuShipments" '出貨通知書表
            frmShipments.Show
        Case "menuShipmentsTodo" '出辦通知書表
            frmShipmentsTodo.Show
        Case "menuShipmentsInvoice"
            frmShipmentsInvoice.Show
        Case "menuStockpileReport" '庫存表
             frmStock.Show
        Case "tHorizontal"  '横向平铺子窗口
            Me.Arrange vbTileHorizontal
        Case "tVertical"    '纵向平铺子窗口
            Me.Arrange vbTileVertical
        Case "tCascade"     '层叠子窗口
            Me.Arrange vbCascade
        Case "tCloseAllWindow"  '关闭所有窗口
            CloaseAllWindow
        '帮助
        Case "menuHelpAbout" '关于
            'frmAbout.Show vbModal
        Case Else
            Debug.Print Tool.Name
End Select
End Sub

Private Sub MDIForm_Load()
App.HelpFile = App.Path & "\使用指南.chm"
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
    If MsgBox("是否退出本系统？", vbQuestion + vbOKCancel, "退出") = vbOK Then
        Cancel = 0
        '记录退出日志
       ' QuitLog
        '删除数据库对象
        'Set objDatabase = Nothing
        '删除显示对象
        'Set objDispalyIni = Nothing
        'XP风格
        'classXP 0, 0
        End
    Else
        Cancel = 1
    End If
End Sub
Private Sub CloaseAllWindow()
    On Error GoTo SaveErr:
    Dim i As Integer
        For i = Forms.Count - 1 To 1 Step -1
            If Forms(i).Name <> Me.Name Then
                Unload Forms(i) '关闭到倒数第二个窗体
            End If
        Next
    Exit Sub
SaveErr:
    'MsgBox Err.Description
End Sub
Private Sub ActiveBar21_ToolDblClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
    Select Case Tool.Name
        Case "miChildWindow" '关闭当前窗口
        On Error Resume Next
            Unload Me.ActiveForm
        Case Else
            Debug.Print Tool.Name
    End Select
End Sub
Private Sub OpenHelp()
  Dim a     As Long
  Dim b     As String
  b = App.Path & "\使用指南.chm"
  a = ShellExecute(0, "open", b, "", "", SW_MAXIMIZE)
End Sub