📄 main.frm
字号:
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 + -