📄 frmmain.frm
字号:
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)"
Visible = 0 'False
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
Visible = 0 'False
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)"
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
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
Private Sub mnuAddSale_Click()
frmSale.Show vbModal, Me
End Sub
Private Sub mnuAddSpoilage_Click()
frmSpoilage.Show vbModal, Me
End Sub
Private Sub mnuAddSupplier_Click()
frmSupplier.Show vbModal, Me
End Sub
Private Sub mnuAddType_Click()
frmType.Show vbModal, Me
End Sub
Private Sub mnuAddUser_Click()
frmUser.Show vbModal, Me
End Sub
'============================================================================
'============================================================================
'设置列表视图为大图标显示项目
Private Sub mnuBigIcon_Click()
mnuBigIcon.Checked = True
mnuSmallIcon.Checked = False
mnuList.Checked = False
mnuDetail.Checked = False
ListView.View = lvwIcon
End Sub
'设置列表视图为小图标显示项目
Private Sub mnuSmallIcon_Click()
mnuSmallIcon.Checked = True
mnuBigIcon.Checked = False
mnuList.Checked = False
mnuDetail.Checked = False
ListView.View = lvwSmallIcon
End Sub
'设置列表视图为列表显示项目
Private Sub mnuList_Click()
mnuList.Checked = True
mnuSmallIcon.Checked = False
mnuBigIcon.Checked = False
mnuDetail.Checked = False
ListView.View = lvwList
End Sub
'设置列表视图为详细资料显示项目
Private Sub mnuDetail_Click()
mnuDetail.Checked = True
mnuList.Checked = False
mnuSmallIcon.Checked = False
mnuBigIcon.Checked = False
ListView.View = lvwReport
End Sub
'============================================================================
'============================================================================
'浏览所有进货信息，以下菜单响应代码与之类似
Private Sub mnuBrowseBuy_Click()
Dim AllBuys As New clsBuys
'不带查询条件查询所有进货信息
AllBuys.Query
'设置当前操作状态为浏览进货信息
CurrentOperation = BrowseBuy
'在列表视图显示查询返回的进货信息
AddObjsToLvw AllBuys
End Sub
Private Sub mnuBrowseSale_Click()
Dim AllSales As New clsSales
AllSales.Query
CurrentOperation = BrowseSale
AddObjsToLvw AllSales
End Sub
Private Sub mnuBrowseSpoilage_Click()
Dim AllSpoilages As New clsSpoilages
AllSpoilages.Query
CurrentOperation = BrowseSpoilage
AddObjsToLvw AllSpoilages
End Sub
Private Sub mnuBrowseGoods_Click()
Dim AllGoodses As New clsGoodses
AllGoodses.Query
CurrentOperation = BrowseGoods
AddObjsToLvw AllGoodses
End Sub
Private Sub mnuBrowseSupplier_Click()
Dim AllSuppliers As New clsSuppliers
AllSuppliers.Query
CurrentOperation = BrowseSupplier
AddObjsToLvw AllSuppliers
End Sub
Private Sub mnuBrowseType_Click()
Dim AllTypes As New clsGoodsTypes
AllTypes.Query
CurrentOperation = BrowseType
AddObjsToLvw AllTypes
'与其他项目的浏览相比，浏览商品类型要考虑须同时重新加载树形视图的节点
TreeView.Nodes.Clear
InitTvwEx
End Sub
Private Sub mnuBrowseUser_Click()
Dim AllUsers As New clsUsers
AllUsers.Query
CurrentOperation = BrowseUser
AddObjsToLvw AllUsers
End Sub
'============================================================================
'============================================================================
'删除进货信息，以下菜单响应代码与之类似
Private Sub mnuDelBuy_Click()
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -