frmselllist.frm

用vb写的饮食管理系统功能全面

VERSION 5.00
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 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          =   61997057
      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          =   61997057
      CurrentDate     =   36855
   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        =   5
      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