frm单品综合分析.frm

服装销售系统,VB开发.没有解压密码

            Picture         =   "frm单品综合分析.frx":23DB
            Key             =   "Refresh"
         EndProperty
         BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frm单品综合分析.frx":26F5
            Key             =   "Stop"
         EndProperty
         BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frm单品综合分析.frx":2A0F
            Key             =   "Help"
         EndProperty
         BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frm单品综合分析.frx":2D29
            Key             =   "拉下"
         EndProperty
         BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frm单品综合分析.frx":3043
            Key             =   "拉上"
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "frm单品综合分析"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


'""""""""""""""""""""""""""""""""""""""""""""""""""""""
'           图表分析
'""""""""""""""""""""""""""""""""""""""""""""""""""""""

Option Explicit

Dim I, j As Integer

Private constChartType(0 To 11) As Integer  '定义图表常数

Private Sub InitChartType()
    constChartType(0) = VtChChartType3dBar              '3D 条形图
    constChartType(1) = VtChChartType2dBar              '2D 条形图
    constChartType(2) = VtChChartType3dLine             '3D 折线图
    constChartType(3) = VtChChartType2dLine             '2D 折线图
    constChartType(4) = VtChChartType3dArea             '3D 面积图
    constChartType(5) = VtChChartType2dArea             '2D 面积图
    constChartType(6) = VtChChartType3dStep             '3D 阶梯图
    constChartType(7) = VtChChartType2dStep             '2D 阶梯图
    constChartType(8) = VtChChartType3dCombination      '3D 组合图
    constChartType(9) = VtChChartType2dCombination      '2D 组合图
    constChartType(10) = VtChChartType2dPie             '2D 饼图
    constChartType(11) = VtChChartType2dXY              '2D XY 散点图
End Sub

Private Sub ShowChartAll()
    On Error Resume Next
    Dim iCol, iRow, CurrentContent As String
    Dim I, ColNum As Integer
    Dim StockArry(1 To 1, 1 To 5)
    Dim MyTemp1, MyTemp2, MyTemp3, MyTemp4, MyTemp5
    
    If optNum.Value Then
        Temp = "数量"
    ElseIf optRamt.Value Then
        Temp = "金额"
    End If
    
    If cmbBigType.Text <> "" Then
        If cmbMidType.Text <> "" Then
           MyTemp1 = " WHERE LEFT(A.商品编码,2)='" & _
                Trim(cmbBigType.Text) & Trim(cmbMidType.Text) & "'"
           MyTemp2 = ",LEFT(A.商品编码,2) "
        Else
           MyTemp1 = " WHERE LEFT(A.商品编码,1)='" & Trim(cmbBigType.Text) & "'"
           MyTemp2 = ",LEFT(A.商品编码,1)"
        End If
    End If
    
    For I = 0 To lstDestination.ListCount - 1
        MyTemp4 = MyTemp4 & " B.品名='" & Trim(lstDestination.List(I)) & "' OR "
    Next I
    If MyTemp4 <> "" Then
        MyTemp4 = " WHERE " & Mid(MyTemp4, 1, Len(MyTemp4) - 3)
    End If
      
    sSQL = "SELECT B.品名,SUM(A." & Temp & ") AS 总值 " & _
        " FROM POS销售明细 AS A INNER JOIN 商品主档 AS B" & _
        " ON A.商品编码=B.商品编码 " & _
        MyTemp1 & MyTemp4 & _
        " GROUP BY B.品名"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    If RsTemp.EOF Then
        MsgBox "未发现相应销售信息!!", vbInformation, "提示窗口"
        Exit Sub
    End If
    ColNum = RsTemp.RecordCount
    With chtStock
        .ColumnCount = ColNum
        .RowCount = 1
        For j = 1 To ColNum
            .Column = j
            .ColumnLabel = RsTemp("品名")
            .Row = 1
            .Data = RsTemp("总值")
            RsTemp.MoveNext
        Next j
    End With

End Sub

Private Sub ShowChartType(strType As String)
    On Error Resume Next
    Dim iCol, iRow, CurrentContent As String
    Dim I, ColNum As Integer
    Dim StockArry(1 To 1, 1 To 5)
    Dim MyTemp1, MyTemp2, MyTemp3, MyTemp4, MyTemp5
    Dim Date1 As Date, Date2 As Date, DateTemp As Date
    
    Date1 = dtpDateBegin.Value
    Date2 = dtpDateEnd.Value
    DateTemp = Date1
    
    iRow = DateDiff(strType, Date1, Date2)
    
    If optNum.Value Then
        Temp = "数量"
    ElseIf optRamt.Value Then
        Temp = "金额"
    End If
    
    If cmbBigType.Text <> "" Then
        If cmbMidType.Text <> "" Then
           MyTemp1 = " WHERE LEFT(A.商品编码,2)='" & _
                Trim(cmbBigType.Columns(0).Text) & Trim(cmbMidType.Columns(0).Text) & "'"
           MyTemp2 = ",LEFT(A.商品编码,2) "
        Else
           MyTemp1 = " WHERE LEFT(A.商品编码,1)='" & Trim(cmbBigType.Columns(0).Text) & "'"
           MyTemp2 = ",LEFT(A.商品编码,1)"
        End If
    End If
            
    If lstDestination.ListCount <> 0 Then
        ColNum = lstDestination.ListCount
    Else
        MsgBox "请选择商品!", vbInformation, "提示窗口"
        Exit Sub
    End If
    With chtStock
        .ColumnCount = ColNum
        .RowCount = iRow
        For I = 1 To iRow
            For j = 1 To ColNum
                MyTemp4 = " WHERE B.品名='" & Trim(lstDestination.List(j)) & "'" & _
                    " AND 日期 BETWEEN '" & Format(DateTemp, "YYYY-MM-DD") & "' AND '" & _
                    Format(DateAdd(strType, 1, DateTemp), "YYYY-MM-DD") & "'"
            
                sSQL = "SELECT ISNULL(SUM(A." & Temp & "),0) AS 总值 " & _
                    " FROM POS销售明细 AS A INNER JOIN 商品主档 AS B" & _
                    " ON A.商品编码=B.商品编码 " & _
                    MyTemp1 & MyTemp4 & MyTemp2
                Set RsTemp = Nothing
                RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
                .Column = j
                .ColumnLabel = lstDestination.List(j)
                .Row = I
                .Data = RsTemp("总值")
                RsTemp.MoveNext
            Next j
            DateTemp = DateAdd(strType, 1, DateTemp)
        Next I
    End With

End Sub


'显示图表

Private Sub ShowChart()
    If optAll.Value Then
        Call ShowChartAll
    ElseIf optDay.Value Then
        Call ShowChartType("D")
    ElseIf optWeek.Value Then
        Call ShowChartType("WW")
    ElseIf optMonth.Value Then
        Call ShowChartType("M")
    End If
End Sub

Private Sub chtStock_PointSelected(Series As Integer, DataPoint As Integer, MouseFlags As Integer, Cancel As Integer)
    stbChart.Panels("SelectNum").Text = "选择的数值是:" & chtStock.ChartData(DataPoint, Series)
End Sub

Private Sub cmbBigType_Click()
    On Error Resume Next
    sSQL = "SELECT 本节点编码,本节点名称 FROM 商品分类表 WHERE 级别=2 AND 父节点名称='" & Trim(cmbBigType.Columns(1).Text) & "'"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    cmbMidType.RemoveAll
    While Not RsTemp.EOF
        cmbMidType.AddItem RsTemp("本节点编码") & vbTab & Trim(RsTemp("本节点名称"))
        RsTemp.MoveNext
    Wend
End Sub

Private Sub cmbBigType_InitColumnProps()
    On Error Resume Next
    sSQL = "SELECT 本节点编码,本节点名称 FROM 商品分类表 WHERE 级别=1"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    While Not RsTemp.EOF
        cmbBigType.AddItem RsTemp("本节点编码") & vbTab & Trim(RsTemp("本节点名称"))
        RsTemp.MoveNext
    Wend
End Sub

Private Sub cmdAddAll_Click()
    Dim I
    While lstSource.ListCount <> 0
        lstDestination.AddItem lstSource.List(I)
        lstSource.RemoveItem I
    Wend
End Sub

Private Sub cmdAddToDes_Click()
    If lstSource.ListIndex = -1 Then Exit Sub
    lstDestination.AddItem lstSource.Text
    lstSource.RemoveItem lstSource.ListIndex
End Sub

Private Sub cmdRemoveAll_Click()
    Dim I
    While lstDestination.ListCount <> 0
        lstSource.AddItem lstDestination.List(I)
        lstDestination.RemoveItem I
    Wend
End Sub

Private Sub cmdRemoveFromDes_Click()
    If lstDestination.ListIndex = -1 Then Exit Sub
    lstSource.AddItem lstDestination.Text
    lstDestination.RemoveItem lstDestination.ListIndex
End Sub

Private Sub Form_Load()
    On Error Resume Next
    
    Dim I
    Call SetFormToCenter(Me)
    Call InitChartType
    sSQL = "SELECT 商品编码,品名 FROM 商品主档"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    While Not RsTemp.EOF
        lstSource.AddItem RsTemp("品名")
        RsTemp.MoveNext
    Wend
    txtHelp.Text = "当选中项目为空时为全部；" & vbCrLf & _
                   "不为空时，比较项目为选中项目；"
    chtStock.Width = Me.ScaleWidth
    dtpDateBegin.Value = Now
    dtpDateEnd.Value = Now
End Sub

Private Sub optChartType_Click(Index As Integer)
    chtStock.chartType = constChartType(Index)
    chtStock.Refresh
End Sub


Private Sub tlbChart_ButtonClick(ByVal Button As ComctlLib.Button)
    Select Case Button.Key
        Case "Refresh"
            Call ShowChart
            chtStock.Refresh
        Case "PullUp"
            DoEvents
            While tabStock.Top + tabStock.Height > tlbChart.Top + tlbChart.Height
                tabStock.Move tabStock.Left, tabStock.Top - 20
                Me.Refresh
            Wend
            chtStock.Height = Me.ScaleHeight - tlbChart.Height - stbChart.Height
            chtStock.Move Me.ScaleLeft, Me.ScaleTop + tlbChart.Height
            tlbChart.Buttons("PullUp").Visible = False
            tlbChart.Buttons("PullDown").Visible = True
        Case "PullDown"
            DoEvents
            While tabStock.Top < tlbChart.Top + tlbChart.Height
                tabStock.Move tabStock.Left, tabStock.Top + 20
                Me.Refresh
            Wend
            chtStock.Height = Me.ScaleHeight - tabStock.Height - tlbChart.Height - stbChart.Height
            chtStock.Move Me.ScaleLeft, tabStock.Top + tabStock.Height
            tlbChart.Buttons("PullUp").Visible = True
            tlbChart.Buttons("PullDown").Visible = False
        Case "Exit"
            Unload Me
    End Select
End Sub