⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.frm

📁 Inventory control system
💻 FRM
📖 第 1 页 / 共 4 页
字号:
Private Sub mnu_ProductGroupings_Click()
    LoadForm frmProductGroupings
End Sub

Private Sub mnu_Purchase_Return_Click()
    frmRptPurchaseReturns.show 1
End Sub

Private Sub mnu_PurchaseOrder_Click()
    LoadForm frmPurchaseOrder
End Sub

Private Sub mnu_PurchaseOrderReturn_Click()
    LoadForm frmPOReturn
End Sub

Private Sub mnu_Purchases_Click()
    frmRptPurchasesReport.show 1
End Sub

Private Sub mnu_QtyAdjustment_Click()
    LoadForm frmQtyAdjustment
End Sub

Private Sub mnu_Receipts_Click()
    frmRptReceiptsbyBatch.show 1
End Sub

Private Sub mnu_ReceiveItem_Click()
    LoadForm frmPOReceiveLocal
End Sub

Private Sub mnu_Reorder_Click()
    LoadForm frmReorder
End Sub

Private Sub mnu_Sales_Report_Click()
    frmRptSales.show 1
End Sub

Private Sub mnu_Sales_Return_Click()
    frmRptSalesReturn.show 1
End Sub

Private Sub mnu_SalesReceiptsBatch_Click()
    LoadForm frmSalesReceiptsBatch
End Sub

Private Sub mnu_SalesReturn_Click()
    LoadForm frmSalesReturn
End Sub

Private Sub mnu_Stocks_Category_Click()
    LoadForm frmProductsCategory
End Sub

Private Sub mnu_Stocks_Click()
    LoadForm frmProducts
End Sub

Private Sub mnu_Stocks_OUM_Click()
    LoadForm frmProductsUOM
End Sub

'Private Sub mnu_Vendors_Category_Click()
'    LoadForm frmVendorsCategory
'End Sub

'Private Sub mnu_Vendors_Click()
'    LoadForm frmVendors
'End Sub

Private Sub mnu_Suppliers_Click()
    LoadForm frmSuppliers
End Sub

Private Sub mnu_Suppliers_Report_Click()
    frmRptSuppliers.show 1
End Sub

Private Sub mnu_SuppliersLocation_Click()
    LoadForm frmSuppliersLocation
End Sub

Private Sub mnuAgents_Click()
    LoadForm frmAgents
End Sub

Private Sub mnuBanks_Click()
    LoadForm frmBanks
End Sub

Private Sub mnuCargoClass_Click()
    LoadForm frmCargos
End Sub

Private Sub mnuFE_Click()
    Unload Me
End Sub

Private Sub mnuFLO_Click()
    If MsgBox("Are you sure you want to log out?", vbQuestion + vbYesNo) = vbNo Then Exit Sub

    
    'SendMessage frmShortcuts.hwnd, WM_CLOSE, 0, 0
    UnloadChilds
    SendMessage frmShortcuts.hwnd, WM_ACTIVATE, 0, 0
    
    'ClearInfoMsg
    StatusBar1.Panels(3).Text = ""
    StatusBar1.Panels(4).Text = ""
    
    CurrUser.USER_NAME = ""
    CurrUser.USER_PK = 0
    
    frmLogin.show vbModal: If CloseMe = True Then Unload Me: Exit Sub: Exit Sub
    DisplayUserInfo
    'UpdateInfoMsg
End Sub

Private Sub mnuHUG_Click()
    '
End Sub

Private Sub mnuLedger_Click()
    frmLedger.show
End Sub

Private Sub mnuLocalForwarder_Click()
    LoadForm frmLocalForwarder
End Sub

Private Sub mnuRoutes_Click()
    LoadForm frmRoutes
End Sub

Private Sub mnuRAC_Click()
    On Error Resume Next
    ActiveForm.CommandPass "Close"
End Sub

Private Sub mnuRACN_Click()
    On Error Resume Next
    ActiveForm.CommandPass "New"
End Sub

Private Sub mnuRADS_Click()
    On Error Resume Next
    ActiveForm.CommandPass "Delete"
End Sub

Private Sub mnuRAES_Click()
    On Error Resume Next
    ActiveForm.CommandPass "Edit"
End Sub

Private Sub mnuRAP_Click()
    On Error Resume Next
    ActiveForm.CommandPass "Print"
End Sub

Private Sub mnuRARR_Click()
    On Error Resume Next
    ActiveForm.CommandPass "Refresh"
End Sub

Private Sub mnuRAS_Click()
    On Error Resume Next
    ActiveForm.CommandPass "Search"
End Sub

Private Sub mnuRASSM_Click()
    frmShortcuts.show
    frmShortcuts.WindowState = vbMaximized
    frmShortcuts.SetFocus
End Sub

Private Sub mnuShippingCompany_Click()
    LoadForm frmShippingCompany
End Sub

Private Sub mnuShippingGuide_Click()
    LoadForm frmForwardersGuide
End Sub

Private Sub mnuSMMU_Click()
    If CurrUser.USER_ISADMIN = False Then
        MsgBox "Only admin users can access this record.", vbCritical, "Access Denied"
    Else
        frmUserRec.show vbModal
    End If
End Sub

Private Sub mnuSOAD_Click()
    frmShortcuts.lvMenu.View = lvwIcon
End Sub

Private Sub mnuSOAHL_Click()
    frmShortcuts.lvMenu.View = lvwSmallIcon
End Sub

Private Sub mnuSOAVL_Click()
    frmShortcuts.lvMenu.View = lvwList
End Sub


Private Sub mnuSSS_Click()
    frmSplash.DisableLoader = True
    frmSplash.show vbModal
End Sub

Private Sub mnuUBI_Click()
    frmBusinessInfo.show vbModal
End Sub

Private Sub mnuUC_Click()
    On Error Resume Next
    Shell "calc.exe", vbNormalFocus
End Sub

Private Sub mnuUN_Click()
    On Error Resume Next
    Shell "notepad.exe", vbNormalFocus
End Sub

Private Sub mnuUWE_Click()
    On Error Resume Next
    Shell "Explorer.exe", vbNormalFocus
End Sub

Private Sub mnuWarehouses_Click()
    LoadForm frmWarehouses
End Sub

Private Sub StyleButton2_Click()
    show_mnu = Not show_mnu
    show_menu (show_mnu)
End Sub

Private Sub show_menu(ByVal show As Boolean)
    Dim img As Image
    If show = True Then
        Set img = Image2
    Else
        Set img = Image5
    End If
    'Set the style button graphics
    With StyleButton2
        Set .PictureDown = img.Picture
        Set .PictureFocus = img.Picture
        Set .PictureHover = img.Picture
        Set .PictureUp = img.Picture
    End With
    'Set picture visibility
    picLeft.Visible = show
    
    If show = True Then StyleButton2.ToolTipText = "Hide": picSeparator.MousePointer = vbSizeWE Else picSeparator.MousePointer = vbArrow: StyleButton2.ToolTipText = "Expand"
    
    Set img = Nothing
End Sub

Private Sub picSeparator_Resize()
    Call center_obj_vertical(picSeparator, StyleButton2)
End Sub

Public Sub HideTBButton(ByVal srcPatern As String, Optional srcAllButton As Boolean)
    If srcAllButton = True Then srcPatern = "ttttttt"
    If Mid$(srcPatern, 1, 1) = "t" Then tbMenu.Buttons(3).Visible = False: mnuRACN.Visible = False
    If Mid$(srcPatern, 2, 1) = "t" Then tbMenu.Buttons(4).Visible = False: mnuRAES.Visible = False
    If Mid$(srcPatern, 3, 1) = "t" Then tbMenu.Buttons(5).Visible = False: mnuRAS.Visible = False
    If Mid$(srcPatern, 4, 1) = "t" Then tbMenu.Buttons(6).Visible = False: mnuRADS.Visible = False
    If Mid$(srcPatern, 5, 1) = "t" Then tbMenu.Buttons(7).Visible = False: mnuRARR.Visible = False
    If Mid$(srcPatern, 6, 1) = "t" Then tbMenu.Buttons(8).Visible = False: mnuRAP.Visible = False
    If Mid$(srcPatern, 7, 1) = "t" Then tbMenu.Buttons(9).Visible = False: mnuRAC.Visible = False
    If mnuRAC.Visible = False Then mnuRASep2.Visible = False
End Sub

Public Sub ShowTBButton(ByVal srcPatern As String, Optional srcAllButton As Boolean)
    'Highligh active form in opened form list
    If srcAllButton = True Then srcPatern = "ttttttt"
    If Mid$(srcPatern, 1, 1) = "t" Then tbMenu.Buttons(3).Visible = True: mnuRACN.Visible = True
    If Mid$(srcPatern, 2, 1) = "t" Then tbMenu.Buttons(4).Visible = True: mnuRAES.Visible = True
    If Mid$(srcPatern, 3, 1) = "t" Then tbMenu.Buttons(5).Visible = True: mnuRAS.Visible = True
    If Mid$(srcPatern, 4, 1) = "t" Then tbMenu.Buttons(6).Visible = True: mnuRADS.Visible = True
    If Mid$(srcPatern, 5, 1) = "t" Then tbMenu.Buttons(7).Visible = True: mnuRARR.Visible = True
    If Mid$(srcPatern, 6, 1) = "t" Then tbMenu.Buttons(8).Visible = True: mnuRAP.Visible = True
    If Mid$(srcPatern, 7, 1) = "t" Then tbMenu.Buttons(9).Visible = True: mnuRAC.Visible = True
    If mnuRAC.Visible = True Then mnuRASep2.Visible = True
End Sub

Public Sub ShowMe()
    Me.Visible = True
End Sub

Private Sub MDIForm_Load()
    show
    Me.BackColor = &H80000005
    HideTBButton "", True
    frmShortcuts.show
    
    DBPath = GetINI("VT Settings", "Path")      'get path from file
    If Trim(DBPath) = "" Or IsNull(DBPath) Then
JumpHere:
      frmLocate.show 1                            'browse database
    End If
    
    If OpenDB = vbRetry Then GoTo JumpHere
    
    'create DSN for reports
    createDSN
    
    frmLogin.show vbModal: If CloseMe = True Then Unload Me: Exit Sub: Exit Sub
    
    'Set the control properties
    Set lvWin.SmallIcons = i16x16
    Set lvWin.Icons = i16x16
    
    DisplayUserInfo
    
    lvWin.ListItems.Add(, "frmShortcuts", "@Shortcuts", 1, 1).Bold = True
    
    show_mnu = True
    show_menu (show_mnu)
End Sub

Private Sub DisplayUserInfo()
    'Display the current user info
    If CurrUser.USER_ISADMIN = True Then
        StatusBar1.Panels(4).Text = "Admin"
    Else
        StatusBar1.Panels(4).Text = "Operator"
    End If
    StatusBar1.Panels(3).Text = CurrUser.USER_NAME
    
    Dim RS As New Recordset
    
    RS.Open "SELECT * FROM TBL_BUSINESS_INFO", CN, adOpenStatic, adLockReadOnly
    
    CurrBiz.BUSINESS_NAME = RS.Fields(0)
    CurrBiz.BUSINESS_ADDRESS = RS.Fields(1)
    CurrBiz.BUSINESS_CONTACT_INFO = RS.Fields(2)
    
    Set RS = Nothing
    
    
End Sub

Public Sub AddToWin(ByVal srcDName As String, ByVal srcFormName As String)
    On Error Resume Next
    Dim xItem As ListItem
    
    Set xItem = lvWin.ListItems.Add(, srcFormName, srcDName, 1, 1)
    xItem.ToolTipText = srcDName
    xItem.SubItems(1) = "***" & srcDName & "***"
    xItem.Selected = True
    
    Set xItem = Nothing
End Sub

Public Sub RemToWin(ByVal srcDName As String)
    On Error Resume Next
    search_in_listview lvWin, "***" & srcDName & "***"
    lvWin.ListItems.Remove (lvWin.SelectedItem.Index)
End Sub


Private Sub MDIForm_Unload(Cancel As Integer)
    Set MAIN = Nothing
End Sub

Private Sub mnuA_Click()
    frmAbout.show vbModal
End Sub

Private Sub mnuHKS_Click()
    'AddTest
End Sub

Private Sub picLeft_Resize()
    On Error Resume Next
    Frame1.Width = picLeft.ScaleWidth
    lvWin.Width = picLeft.ScaleWidth
    lvWin.Height = picLeft.ScaleHeight - lvWin.Top - 20
End Sub

Private Sub picSeparator_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If show_mnu = False Then Exit Sub
    If Button = vbLeftButton Then
        tmrResize.Enabled = True
        resize_down = True
    End If
End Sub

Private Sub picSeparator_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If show_mnu = False Then Exit Sub
    If Button = vbLeftButton Then
        tmrResize.Enabled = False
        resize_down = False
    End If
End Sub

Private Sub tbMenu_ButtonClick(ByVal Button As MSComctlLib.Button)
    If Button.Key = "Shortcuts" Then
        frmShortcuts.show
        frmShortcuts.WindowState = vbMaximized
        frmShortcuts.SetFocus
    Else
        On Error Resume Next
        ActiveForm.CommandPass Button.Key
    End If
End Sub

Private Sub tmrResize_Timer()
    On Error Resume Next
    GetCursorPos cursor_pos
    picLeft.Width = (Me.Width - ((cursor_pos.X * Screen.TwipsPerPixelX) - Me.Left)) - 90
End Sub

Private Sub tmrMemStatus_Timer()
    Call GlobalMemoryStatus(MEM_STAT)
    lblPMem.Caption = Format((MEM_STAT.dwAvailPhys / 1024) / 1024, "#,##0.0") & " MB"
    lblVMem.Caption = Format((MEM_STAT.dwAvailVirtual / 1024) / 1024, "#,##0.0") & " MB"
End Sub

Public Sub UnloadChilds()
''Unload all active forms
    Dim Form As Form
    
    For Each Form In Forms
       ''Unload all active childs
       If Form.Name <> Me.Name And Form.Name <> "frmShortcuts" Then Unload Form
    Next Form
   
    Set Form = Nothing
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -