📄 frmselllist.frm
字号:
VERSION 5.00
Object = "{0BA686C6-F7D3-101A-993E-0000C0EF6F5E}#1.0#0"; "THREED32.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{02B5E320-7292-11CF-93D5-0020AF99504A}#1.0#0"; "MSCHART.OCX"
Begin VB.Form frmSellList
Caption = "物品销售排行榜"
ClientHeight = 5745
ClientLeft = 1110
ClientTop = 345
ClientWidth = 8715
Icon = "frmSellList.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MDIChild = -1 'True
ScaleHeight = 5745
ScaleWidth = 8715
WindowState = 2 'Maximized
Begin Threed.SSPanel spBar
Height = 540
Left = 120
TabIndex = 5
Top = 60
Width = 8520
_Version = 65536
_ExtentX = 15028
_ExtentY = 952
_StockProps = 15
Caption = " 统计日期 至"
BackColor = 12632256
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BevelOuter = 1
Font3D = 3
Alignment = 1
Begin VB.CommandButton cmdBrowser
Caption = "浏览(&B)"
Height = 435
Left = 2235
TabIndex = 6
Top = 45
Width = 1335
End
Begin VB.CommandButton cmdTJ
Caption = "重新统计(&T)"
Height = 435
Left = 5670
TabIndex = 2
Top = 45
Width = 1455
End
Begin VB.CommandButton cmdClose
Cancel = -1 'True
Caption = "关闭(&C)"
Height = 435
Left = 7140
TabIndex = 3
Top = 45
Width = 1335
End
Begin MSComCtl2.DTPicker dpStartDate
Height = 300
Left = 1320
TabIndex = 0
ToolTipText = "更换统计日期后,请重新统计。"
Top = 120
Width = 1755
_ExtentX = 3096
_ExtentY = 529
_Version = 393216
Format = 24510465
CurrentDate = 36855
End
Begin MSComCtl2.DTPicker dpEndDate
Height = 300
Left = 3600
TabIndex = 1
ToolTipText = "更换统计日期后,请重新统计。"
Top = 120
Width = 1755
_ExtentX = 3096
_ExtentY = 529
_Version = 393216
Format = 24510465
CurrentDate = 36855
End
End
Begin MSChartLib.MSChart chtReport
Height = 4200
Left = 660
OleObjectBlob = "frmSellList.frx":0E42
TabIndex = 4
Top = 1005
Width = 6150
End
Begin MSFlexGridLib.MSFlexGrid Grid1
Height = 4395
Left = 90
TabIndex = 7
Top = 675
Visible = 0 'False
Width = 7155
_ExtentX = 12621
_ExtentY = 7752
_Version = 393216
Rows = 3
FixedCols = 0
RowHeightMin = 50
BackColorSel = 14737632
ForeColorSel = 12582912
BackColorBkg = 12632256
WordWrap = -1 'True
AllowBigSelection= 0 'False
FocusRect = 0
SelectionMode = 1
AllowUserResizing= 1
End
End
Attribute VB_Name = "frmSellList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Const MARGIN_SIZE = 60 'In Twips
Private Sub cmdBrowser_Click()
If Grid1.Visible = True Then
cmdBrowser.Caption = "浏览(&B)"
chtReport.Visible = True
Grid1.Visible = False
Else
chtReport.Visible = False
Grid1.Visible = True
cmdBrowser.Caption = "图表(&V)"
End If
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
'-------------------------------------------------------------------------
Private Sub DisplayError(oError As ErrObject)
MsgBox oError.Description, vbExclamation, App.Title
End Sub
Private Sub cmdTJ_Click()
LoadData
'安装网格
QueryStr = "Select * From Top30"
QuerySell
'隐藏网格
If cmdBrowser.Caption = "浏览(&B)" Then
Grid1.Visible = False
End If
End Sub
Private Sub dpEndDate_Change()
If dpEndDate.Value < dpStartDate.Value Then
dpStartDate.Value = dpEndDate.Value
End If
End Sub
Private Sub dpStartDate_Change()
If dpEndDate.Value < dpStartDate.Value Then
dpEndDate.Value = dpStartDate.Value
End If
End Sub
Private Sub Form_Load()
Screen.MousePointer = 11
dpStartDate.Value = Date
dpEndDate.Value = Date
'安装
LoadData
'安装网格
SCondStr = ""
QueryStr = "Select * From Top30"
QuerySell
'隐藏网格
Grid1.Visible = False
Screen.MousePointer = 0
Exit Sub
Form_Load_Error:
DisplayError Err
Screen.MousePointer = 0
Exit Sub
End Sub
Private Sub Form_Resize()
Dim sngButtonTop As Single
Dim sngScaleWidth As Single
Dim sngScaleHeight As Single
On Error GoTo Form_Resize_Error
With Me
sngScaleWidth = .ScaleWidth
sngScaleHeight = .ScaleHeight
.chtReport.Move MARGIN_SIZE, _
MARGIN_SIZE + 560, _
sngScaleWidth - (2 * MARGIN_SIZE), _
Me.ScaleHeight - 400 - (2 * MARGIN_SIZE)
.spBar.Width = .Width - 350
'移动“关闭”按钮到右下角
With .cmdClose
.Top = 40
.Left = spBar.Width - .Width - 40
End With
cmdTJ.Top = cmdClose.Top
cmdTJ.Left = cmdClose.Left - cmdTJ.Width - 40
cmdBrowser.Left = cmdTJ.Left - cmdBrowser.Width - 40
cmdBrowser.Top = cmdClose.Top
.Grid1.Left = spBar.Left
.Grid1.Top = spBar.Height + 100
.Grid1.Height = .Height - spBar.Height - 650
.Grid1.Width = .spBar.Width
End With
Exit Sub
Form_Resize_Error:
'如果用户使窗体过小，以至于出现负值高度或宽度，则会出错。
Resume Next
End Sub
Private Sub LoadData()
Dim DB As Database, EF As Recordset
Dim sTmp As String
Set DB = OpenDatabase(ConData, False, False, Constr) '减序
sTmp = "Delete * From Top30"
DB.Execute sTmp
Dim sDate As String
If dpStartDate.Value = dpEndDate.Value Then
sDate = dpStartDate.Value
Else
sDate = "统计日期： " & dpStartDate.Value & " 至 " & dpEndDate.Value
End If
sTmp = "Insert into Top30 Select Top 30 名称,sum(SellList.数量) as 数量 From SellList Where (日期>=#" & dpStartDate.Value & "# And 日期<=#" & dpEndDate.Value & "#) Group By 名称"
DB.Execute sTmp
sTmp = "Update Top30 Set 日期='" & sDate & "'"
DB.Execute sTmp
Set EF = DB.OpenRecordset(" Select * From Top30 Order by 数量 DESC", dbOpenDynaset)
Dim lMax As Long, lMin As Long
Dim lCount As Long
sTmp = ""
On Error Resume Next
If EF.EOF And EF.BOF Then
lMax = 100
lMin = 1
lCount = 1
Else
lMax = EF.Fields("数量")
EF.MoveLast
lCount = EF.RecordCount
lMin = EF.Fields("数量")
EF.MoveFirst
Dim i As Long
i = 1
Dim Values(1 To 31)
Dim Labels(1 To 31)
Do While (Not EF.EOF) Or i > 30
If EF.EOF = True Then Exit Do
If Not IsNull(EF.Fields("数量")) Then
'给出数量
Values(i) = EF.Fields("数量") '行标签
Labels(i) = EF.Fields("名称")
End If
i = i + 1
EF.MoveNext
Loop
End If
EF.Close
DB.Close
With chtReport
.TextLengthType = VtTextLengthTypeDevice
.TitleText = "《 最畅销的 30 种物品排行榜 》"
.ShowLegend = True
.ChartData = Values
.RowLabel = "从 " & dpStartDate.Value & " 至 " & dpEndDate.Value & " 时间内的最畅销产品排名。"
Dim J As Integer
For J = 1 To i - 1
.Column = J
.ColumnLabel = Labels(J) + Str(Values(J))
Next
End With
End Sub
Private Sub QuerySell()
Me.MousePointer = 11
Dim DB As Database, EF As Recordset, HH As Integer
Dim MargeRowBN As String, X As Integer, tmpBNX As String, ZF As String
Dim MargeRow As String, tmpBN As String
'配置网格
Dim StoreQueryString As String
Select Case SCondStr
Case ""
StoreQueryString = QueryStr & " Order By 数量 Desc"
Case Is <> ""
StoreQueryString = QueryStr + " Where " & SCondStr & " Order By 数量 Desc"
End Select
StoreQueryString = StoreQueryString
Grid1.Visible = False
Grid1.Clear
Grid1.Cols = 3
Grid1.FormatString = "^ 物品名称 |^ 数量 |^ 购物日期 "
Grid1.ColWidth(0) = 3200
Grid1.ColWidth(1) = 3800
Grid1.ColWidth(2) = 4300
On Error Resume Next
Set DB = OpenDatabase(ConData, False, False, Constr)
Set EF = DB.OpenRecordset("Select Top 30 From Top30", dbOpenTable)
'增加一个合计
Grid1.Rows = EF.RecordCount + 3
If Grid1.Rows < 29 Then
Grid1.Rows = 29
End If
Set EF = DB.OpenRecordset(StoreQueryString, dbOpenDynaset)
HH = 1
Do While Not EF.EOF()
Grid1.Row = HH
Grid1.Col = 0
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(0).Value) Then '物品类别 |^ 物品名称 |^ 物品代码|^ 单位 |^ 单价 |^ 数量 |^ 金额 |^ 购物日期
Grid1.Text = EF.Fields(0).Value
End If
Grid1.Col = 1
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(1).Value) Then
Grid1.Text = EF.Fields(1).Value
End If
Grid1.Col = 2
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(2).Value) Then
Grid1.Text = EF.Fields(2).Value
End If
EF.MoveNext
HH = HH + 1
Loop
EF.Close
DB.Close
Grid1.Col = 0
Grid1.Row = 1
Grid1.ColSel = 2
Grid1.Visible = True
Me.MousePointer = 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -