📄 frmmain.frm
字号:
Begin VB.Menu mnuDelType
Caption = "删除类型(&D)"
End
End
Begin VB.Menu mnuGoods
Caption = "商品管理(&R)"
Begin VB.Menu mnuBrowseGoods
Caption = "浏览所有商品(&B)"
End
Begin VB.Menu ln5
Caption = "-"
End
Begin VB.Menu mnuAddGoods
Caption = "添加商品(&A)"
End
Begin VB.Menu mnuQueryGoods
Caption = "查询商品(&Q)"
End
Begin VB.Menu mnuModifyGoods
Caption = "修改商品(&M)"
End
Begin VB.Menu mnuDelGoods
Caption = "删除商品(&D)"
End
End
Begin VB.Menu mnuBuy
Caption = "进货管理(&B)"
Begin VB.Menu mnuBrowseBuy
Caption = "浏览所有进货(&B)"
End
Begin VB.Menu ln6
Caption = "-"
End
Begin VB.Menu mnuAddBuy
Caption = "登记进货(&A)"
End
Begin VB.Menu mnuQueryBuy
Caption = "查询进货(&Q)"
End
Begin VB.Menu mnuModifyBuy
Caption = "修改进货(&M)"
End
Begin VB.Menu mnuDelBuy
Caption = "删除进货(&D)"
End
End
Begin VB.Menu mnuSale
Caption = "销售管理(&S)"
Begin VB.Menu mnuBrowseSale
Caption = "浏览所有销售(&B)"
End
Begin VB.Menu ln7
Caption = "-"
End
Begin VB.Menu mnuAddSale
Caption = "登记销售(&A)"
End
Begin VB.Menu mnuQuerySale
Caption = "查询销售(&Q)"
End
Begin VB.Menu mnuModifySale
Caption = "修改销售(&M)"
End
Begin VB.Menu mnuDelSale
Caption = "删除销售(&D)"
End
End
Begin VB.Menu mnuSpoilage
Caption = "商品报损(&I)"
Begin VB.Menu mnuBrowseSpoilage
Caption = "浏览所有报损(&B)"
End
Begin VB.Menu ln8
Caption = "-"
End
Begin VB.Menu mnuAddSpoilage
Caption = "登记报损(&A)"
End
Begin VB.Menu mnuQuerySpoilage
Caption = "查询报损(&Q)"
End
Begin VB.Menu mnuModifySpoilage
Caption = "修改报损(&M)"
End
Begin VB.Menu mnuDelSpoilage
Caption = "删除报损(&D)"
End
End
Begin VB.Menu mnuStat
Caption = "统计分析(&A)"
Begin VB.Menu mnuStatBuy
Caption = "进货统计(&B)"
End
Begin VB.Menu mnuStatSale
Caption = "销售统计(&S)"
End
Begin VB.Menu mnuStatSpoilage
Caption = "报损统计(&P)"
End
End
Begin VB.Menu mnuView
Caption = "视图(&V)"
Begin VB.Menu mnuShowTBar
Caption = "显示工具栏(&T)"
Checked = -1 'True
End
Begin VB.Menu mnuShowSBar
Caption = "显示状态栏(&B)"
Checked = -1 'True
End
Begin VB.Menu ln9
Caption = "-"
End
Begin VB.Menu mnuBigIcon
Caption = "大图标(&N)"
End
Begin VB.Menu mnuSmallIcon
Caption = "小图标(&M)"
End
Begin VB.Menu mnuList
Caption = "列表(&L)"
End
Begin VB.Menu mnuDetail
Caption = "详细资料(&D)"
Checked = -1 'True
End
Begin VB.Menu ln10
Caption = "-"
End
Begin VB.Menu mnuRefresh
Caption = "刷新(&E)"
Shortcut = {F5}
End
End
Begin VB.Menu mnuHelp
Caption = "帮助(&H)"
Begin VB.Menu mnuHelpFile
Caption = "帮助(&H)"
Shortcut = ^H
End
Begin VB.Menu ln11
Caption = "-"
End
Begin VB.Menu mnuAbout
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
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 Const GWL_WNDPROC = (-4)
Private Sub Form_Load()
'OldWindowProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
'Call SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf FormSize_WndMessage)
'将窗体位置居中
Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
'设置标题标签
lblUser(0) = "当前登录用户:" & Space(1) & TrueName & Space(5) & "用户类型:" & Space(1) & IIf(UserType = 0, "普通用户", "系统管理员")
lblUser(1) = lblUser(0)
'在状态栏显示当前时间
tmrTime_Timer
'初始化树形视图，加载所有商品类型
InitTvwEx
End Sub
Private Sub Form_Resize()
'改变窗体内的控件位置和大小
ResizeForm
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MsgBox("确定要退出特瑞飞商品进销存系统吗？", vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
Call SetWindowLong(Me.hwnd, GWL_WNDPROC, OldWindowProc)
'取消卸载窗体
Else: Cancel = 1
End If
End Sub
'窗体大小改变时对相应控件的大小和位置进行设置
Private Sub ResizeForm()
'为防止出错，在窗体最小化时退出该过程的执行
If Me.WindowState = vbMinimized Then Exit Sub
On Error Resume Next
'设置查询图片框和关于图片框的left属性
picQuery.Left = 30
picAbout.Left = 2750
'按照工具栏TBar的Visible属性设置相关控件的Top值
If TBar.Visible = True Then
picTitle.Top = TBar.Height + 30
Else
picTitle.Top = 0
End If
TreeView.Top = picTitle.Top + picTitle.Height + 15
picQuery.Top = TreeView.Top + 15
picDescribe.Top = TreeView.Top
ListView.Top = picDescribe.Top + picDescribe.Height
picAbout.Top = ListView.Top + 45
'按照状态栏SBar的Visible属性设置相关控件的Height值和Top值
If SBar.Visible = True Then
TreeView.Height = Me.ScaleHeight - (picTitle.Top + picTitle.Height + SBar.Height)
ListView.Height = Me.ScaleHeight - (picDescribe.Top + picDescribe.Height + SBar.Height) + 30
Else
TreeView.Height = Me.ScaleHeight - (picTitle.Top + picTitle.Height) - 15
ListView.Height = Me.ScaleHeight - (picDescribe.Top + picDescribe.Height) + 15
End If
picQuery.Height = TreeView.Height - 30
cmdQuery.Top = picQuery.Height - 800
cmdReturn.Top = cmdQuery.Top
lblQuery(5).Top = cmdQuery.Top - 1000
picAbout.Height = ListView.Height - 90
'设置其他控件的大小和位置
picTitle.Width = Me.ScaleWidth
picDescribe.Width = Me.ScaleWidth - picDescribe.Left
ListView.Width = Me.ScaleWidth - ListView.Left + 15
picAbout.Width = ListView.Width - 90
imgLogo.Top = 6 * (picAbout.ScaleHeight - imgLogo.Height) / 7
imgLogo.Left = 6 * (picAbout.ScaleWidth - imgLogo.Width) / 7
SBar.Panels(1).Width = Me.ScaleWidth - SBar.Panels(2).Width - SBar.Panels(3).Width
End Sub
'单击列表视图的列首进行排序
Private Sub ListView_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Dim i As Long
With ListView
'设置列表视图ListView的排序规则
.Sorted = True
.SortKey = ColumnHeader.Index - 1
.SortOrder = Abs(Not .SortOrder = lvwDescending)
'对当前排序的列的列首文字加上排序标志("▲"或"▼")
For i = 1 To .ColumnHeaders.Count
If Right(.ColumnHeaders(i).Text, 1) = "▲" Then
.ColumnHeaders(i).Text = Replace(.ColumnHeaders(i).Text, "▲", "")
ElseIf Right(ListView.ColumnHeaders(i).Text, 1) = "▼" Then
.ColumnHeaders(i).Text = Replace(.ColumnHeaders(i).Text, "▼", "")
End If
Next
'改变当前排序的列的列首文字的排序标志
If Right(ColumnHeader.Text, 1) = "▲" Then
ColumnHeader.Text = Replace(ColumnHeader.Text, "▲", "▼")
ElseIf Right(ColumnHeader.Text, 1) = "▼" Then
ColumnHeader.Text = Replace(ColumnHeader.Text, "▼", "▲")
Else
ColumnHeader.Text = IIf(.SortOrder = lvwAscending, ColumnHeader.Text & "▲", ColumnHeader.Text & "▼")
End If
End With
End Sub
Private Sub ListView_DblClick()
'如果列表视图没有项目被选中则退出该过程的执行
If ListView.SelectedItem Is Nothing Then Exit Sub
'显示选中项目的修改界面
ShowModifyInterface
End Sub
Private Sub ListView_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'鼠标右键弹起时弹出菜单mnuView
If Button = vbRightButton Then
PopupMenu mnuView
End If
End Sub
Private Sub TreeView_NodeClick(ByVal Node As MSComctlLib.Node)
Dim SomeGoodses As New clsGoodses
Select Case Node.Key
Case "Root": mnuAbout_Click '显示关于信息
Case "AllGoods":
mnuBrowseGoods_Click '浏览所有商品信息
Case Else:
SomeGoodses.Query , GetIDFromTvw '按照树节点的商品类型ID查询商品
CurrentOperation = BrowseGoods '设置当前操作状态为浏览商品信息
AddObjsToLvw SomeGoodses, False '在列表视图显示查询到的商品
lblDescribe = "浏览" & TreeView.SelectedItem.Text & "商品"
End Select
'设置相关提示信息
lblCount.Left = lblDescribe.Left + lblDescribe.Width
SBar.Panels(1) = lblDescribe
End Sub
'进货信息查询（可以根据需求灵活更改）
Private Sub cmdQuery_Click()
On Error GoTo ErrorHandler
'必须输入商品名称
If Trim(txtGoodsName) = "" Then MsgBox "请输入商品名称！", vbInformation: txtGoodsName.SetFocus: Exit Sub
'进货起始日期不能大于终止日期
If dtBegin > dtEnd Then MsgBox "进货起始日期不能大于终止日期，请重新选择！", vbInformation: Exit Sub
cmdQuery.Enabled = False
Dim SomeBuys As New clsBuys
'按照商品名称和进货时间范围查询
SomeBuys.Query , txtGoodsName, dtBegin, dtEnd
'设置当前操作状态为浏览进货信息
CurrentOperation = QueryBuy
'在列表视图显示查询到的进货信息
AddObjsToLvw SomeBuys
lblQuery(5) = "查询完毕！" & Chr(13) & "共找到 " & ListView.ListItems.Count & " 条结果。"
cmdQuery.Enabled = True
Exit Sub
ErrorHandler:
cmdQuery.Enabled = True
MsgBox "查询中出现错误！", vbInformation
End Sub
Private Sub cmdReturn_Click()
TreeView.Visible = True
picQuery.Visible = False
End Sub
'用户点击特瑞飞Web地址或Email联接标签后打开相应页面或发送邮件
Private Sub lblAbout_Click(Index As Integer)
Select Case Index
Case 12: ShellExecute Me.hwnd, "open", "mailto:webmaster@trfsoft.com", vbNullString, vbNullString, vbNormalFocus
Case 14: ShellExecute Me.hwnd, "open", "http://www.trfsoft.com", vbNullString, vbNullString, vbNormalFocus
End Select
End Sub
Private Sub mnuAbout_Click()
lblDescribe = "关于软件"
lblCount = ""
SBar.Panels(1) = lblDescribe
picAbout.Visible = True
End Sub
'============================================================================
'模式显示进货管理窗体frmBuy，以下菜单响应代码与之类似
Private Sub mnuAddBuy_Click()
frmBuy.Show vbModal, Me
End Sub
Private Sub mnuAddGoods_Click()
frmGoods.Show vbModal, Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -