控制台编程

开发平台：
Visual Basic

frmAnalysis.frm：源码内容
							VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{65E121D4-0C60-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCHRT20.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmAnalysis 
   Caption         =   "物料信息的分析"
   ClientHeight    =   5430
   ClientLeft      =   45
   ClientTop       =   390
   ClientWidth     =   8685
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5430
   ScaleWidth      =   8685
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton comQuery 
      Caption         =   "查询"
      Height          =   372
      Left            =   1800
      Style           =   1  'Graphical
      TabIndex        =   21
      Top             =   240
      Width           =   852
   End
   Begin VB.Frame Frame4 
      Caption         =   "查询全部物料信息"
      Height          =   735
      Left            =   6840
      TabIndex        =   19
      Top             =   120
      Width           =   1695
      Begin VB.CommandButton Command4 
         Caption         =   "查询"
         Height          =   375
         Left            =   360
         TabIndex        =   20
         Top             =   240
         Width           =   975
      End
   End
   Begin VB.Frame Frame3 
      Caption         =   "查询单一物料信息"
      Height          =   735
      Left            =   3000
      TabIndex        =   15
      Top             =   120
      Width           =   3735
      Begin VB.CommandButton Command3 
         Caption         =   "查询"
         Height          =   375
         Left            =   2760
         TabIndex        =   18
         Top             =   240
         Width           =   855
      End
      Begin VB.TextBox Text2 
         Height          =   270
         Left            =   1440
         TabIndex        =   17
         Top             =   360
         Width           =   1215
      End
      Begin VB.Label Label5 
         Caption         =   "填写物料代号："
         Height          =   255
         Left            =   120
         TabIndex        =   16
         Top             =   360
         Width           =   1335
      End
   End
   Begin MSComCtl2.MonthView MonthView1 
      Height          =   2220
      Left            =   0
      TabIndex        =   0
      Top             =   1560
      Width           =   4065
      _ExtentX        =   7170
      _ExtentY        =   3916
      _Version        =   393216
      ForeColor       =   -2147483630
      BackColor       =   -2147483633
      Appearance      =   1
      StartOfWeek     =   25559041
      CurrentDate     =   39125
   End
   Begin VB.Frame Frame1 
      Caption         =   "分析"
      Height          =   735
      Left            =   3000
      TabIndex        =   6
      Top             =   960
      Width           =   5535
      Begin VB.ComboBox ComboPrice 
         Height          =   300
         Left            =   840
         Style           =   2  'Dropdown List
         TabIndex        =   8
         Top             =   360
         Width           =   1695
      End
      Begin VB.ComboBox ComboChange 
         Height          =   300
         Left            =   3600
         Style           =   2  'Dropdown List
         TabIndex        =   7
         Top             =   360
         Width           =   1815
      End
      Begin VB.Label Label1 
         Caption         =   "价格："
         Height          =   255
         Left            =   120
         TabIndex        =   10
         Top             =   360
         Width           =   615
      End
      Begin VB.Label Label2 
         Caption         =   "消耗率："
         Height          =   255
         Left            =   2760
         TabIndex        =   9
         Top             =   360
         Width           =   735
      End
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定"
      Height          =   372
      Left            =   720
      MaskColor       =   &H0080C0FF&
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   4920
      Width           =   1452
   End
   Begin VB.Data d2 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   372
      Left            =   5880
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   3480
      Visible         =   0   'False
      Width           =   1332
   End
   Begin VB.CommandButton Command2 
      Height          =   615
      Left            =   1080
      Picture         =   "frmAnalysis.frx":0000
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   120
      Width           =   615
   End
   Begin VB.TextBox Text1 
      Height          =   340
      Left            =   120
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   360
      Width           =   972
   End
   Begin MSChart20Lib.MSChart MSChartPrice 
      Height          =   1812
      Left            =   120
      OleObjectBlob   =   "frmAnalysis.frx":08CA
      TabIndex        =   1
      Top             =   720
      Width           =   2772
   End
   Begin MSFlexGridLib.MSFlexGrid grid 
      Bindings        =   "frmAnalysis.frx":2ABB
      Height          =   2775
      Left            =   3120
      TabIndex        =   5
      Top             =   2040
      Width           =   5295
      _ExtentX        =   9340
      _ExtentY        =   4895
      _Version        =   393216
      Cols            =   1
      FixedCols       =   0
      BackColor       =   16777215
      ForeColor       =   16711680
      BackColorFixed  =   -2147483624
      BackColorSel    =   16744576
      ForeColorSel    =   16777215
      BackColorBkg    =   16777215
      GridColor       =   0
      FillStyle       =   1
      GridLinesFixed  =   1
      SelectionMode   =   1
      AllowUserResizing=   3
   End
   Begin MSChart20Lib.MSChart MSChartChange 
      Height          =   1935
      Left            =   120
      OleObjectBlob   =   "frmAnalysis.frx":2ACC
      TabIndex        =   11
      Top             =   2640
      Width           =   2775
   End
   Begin VB.Frame Frame2 
      Caption         =   "分析结果"
      Height          =   3495
      Left            =   3000
      TabIndex        =   13
      Top             =   1800
      Width           =   5535
      Begin VB.Label Label4 
         Caption         =   "Label4"
         Height          =   255
         Left            =   120
         TabIndex        =   14
         Top             =   3120
         Width           =   1215
      End
   End
   Begin VB.Label Label3 
      Caption         =   "请选择日期"
      Height          =   255
      Left            =   120
      TabIndex        =   12
      Top             =   120
      Width           =   1095
   End
End
Attribute VB_Name = "frmAnalysis"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public dbs  As Database
Public rec As Recordset
Public filename As String
Dim TotalCount As Integer
Dim MaxDate  As Date
Dim MinDate  As Date
Dim SearchDate As Date
Dim AverageSel(3) As Integer
Dim ChangeRateSel(5) As Single
Private Sub ComboPrice_Click()
    If ComboPrice.ListIndex = 3 Then
        D2.RecordSource = "SELECT 物料信息变化表.Code as 物料代码,Name as 物料名称,Change as 涨跌,CVar([Volume Price] / Volume) as 价格,TypeName as 物料类型 FROM 物料信息变化表,物料信息表,物料类型信息表  WHERE 物料信息变化表.Day=# " & SearchDate & "# and CVar([Volume Price] / Volume) >30 and 物料信息变化表.Code=物料信息表.Code and 物料信息表.TypeId=物料类型信息表.ID"
        D2.Refresh
    Else
        D2.RecordSource = "SELECT 物料信息变化表.Code as 物料代码,Name as 物料名称,Change as 涨跌,CVar([Volume Price] / Volume) as 价格,TypeName as 物料类型 FROM 物料信息变化表,物料信息表,物料类型信息表  WHERE 物料信息变化表.Day=# " & SearchDate & "# and CVar([Volume Price] / Volume) > " & AverageSel(ComboPrice.ListIndex) & " and CVar([Volume Price] / Volume) <= " & AverageSel(ComboPrice.ListIndex + 1) & " and 物料信息变化表.Code=物料信息表.Code and 物料信息表.TypeId=物料类型信息表.ID"
        D2.Refresh
    End If
    TotalCount = D2.Recordset.RecordCount
    ComboChange.Enabled = True
    Label4.Caption = "共 " & TotalCount & " 条记录。"
End Sub
Private Sub ComboChange_Click()
    If ComboChange.ListIndex = 0 Then
        D2.RecordSource = "SELECT 物料信息变化表.Code as 物料代码,Name as 物料名称,Change as 涨跌,CVar([Volume Price] / Volume) as 价格,TypeName as 类型 FROM 物料信息变化表,物料信息表,物料类型信息表  WHERE 物料信息变化表.Day=# " & SearchDate & "# and 物料信息变化表.Change >0.1 and 物料信息变化表.Code=物料信息表.Code and 物料信息表.TypeId=物料类型信息表.ID"
        D2.Refresh
    ElseIf ComboChange.ListIndex = 5 Then
        D2.RecordSource = "SELECT 物料信息变化表.Code as 物料代码,Name as 物料名称,Change as 涨跌,CVar([Volume Price] / Volume) as 价格,TypeName as 类型 FROM 物料信息变化表,物料信息表,物料类型信息表  WHERE 物料信息变化表.Day=# " & SearchDate & "# and 物料信息变化表.Change <= -0.1 and 物料信息变化表.Code=物料信息表.Code and 物料信息表.TypeId=物料类型信息表.ID"
        D2.Refresh
    Else
        D2.RecordSource = "SELECT 物料信息变化表.Code as 物料代码,Name as 物料名称,Change as 涨跌,CVar([Volume Price] / Volume) as 价格,TypeName as 类型 FROM 物料信息变化表,物料信息表,物料类型信息表  WHERE 物料信息变化表.Day=# " & SearchDate & "# and 物料信息变化表.Change >" & ChangeRateSel(ComboChange.ListIndex + 1) & " and 物料信息变化表.Change <= " & ChangeRateSel(ComboChange.ListIndex) & " and 物料信息变化表.Code=物料信息表.Code and 物料信息表.TypeId=物料类型信息表.ID"
        D2.Refresh
    End If
    TotalCount = D2.Recordset.RecordCount
    ComboChange.Enabled = True
    Label4.Caption = "共 " & TotalCount & " 条记录。"
 End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Command2_Click()
  MonthView1.Visible = True
  comQuery.Enabled = False
End Sub
Private Sub Command3_Click()
 filename = App.Path & "dbmaterialinfo2007.mdb"
Set dbs = OpenDatabase(filename)
Set rec = dbs.OpenRecordset("物料信息变化表")
If Text2.Text = "" Then
  r = MsgBox("没有输入物料代号！", 0 + 16, "提示")
  Exit Sub
  
Else
  rec.MoveFirst
 If rec.Fields("Code") <> Text2.Text Then
  r = MsgBox("数据库中没有这条记录！", 0 + 16, "提示")
  Exit Sub
  End If
  Do While Not rec.EOF
  
 If rec.Fields("Code") = Text2.Text Then
    frmAnalySingle.Show
  End If
  rec.MoveNext
  Loop
  
End If
End Sub
Private Sub Command4_Click()
frmAnalyAll.Show
End Sub
Private Sub comQuery_Click()
    Dim arrMovAverage(3) As Integer
    Dim arrChange(5) As Integer
    Dim RecordStatics As Recordset
    Dim i As Integer
If Text1.Text = "" Then
  r = MsgBox("日期不能为空！", 0 + 16, "提示")
  Exit Sub
End If
    SearchDate = Trim(Text1.Text)
    If SearchDate < MinDate Or SearchDate > MaxDate Then
        r = MsgBox("输入日期必须介于" & MinDate & " 和" & MaxDate & "之间！", 0 + 16, "提示")
        Text1.Text = ""
        ComboPrice.Enabled = False
        ComboChange.Enabled = False
    Else
      
      D2.RecordSource = "SELECT 物料信息变化表.Code as 物料代码,Name as 物料名称,Change as 涨跌,CVar([Volume Price] / Volume) as 价格,TypeName as 物料类型 FROM 物料信息变化表,物料信息表,物料类型信息表  WHERE 物料信息变化表.Day=# " & SearchDate & "# and 物料信息变化表.Code=物料信息表.Code and 物料信息表.TypeId=物料类型信息表.ID"
      D2.Refresh
      
      On Error Resume Next
    
    For i = 0 To 2
      Set RecordStatics = dbs.OpenRecordset("select * from 物料信息变化表 WHERE 物料信息变化表.Day=# " & SearchDate & "#  And CVar(物料信息变化表.[Volume Price] / 物料信息变化表.Volume) > " & AverageSel(i) & " And CVar(物料信息变化表.[Volume Price] / 物料信息变化表.Volume) <= " & AverageSel(i + 1) & "")
      x = RecordStatics.RecordCount
      If Not RecordStatics.EOF Then
        RecordStatics.MoveLast
      End If
      arrMovAverage(i) = RecordStatics.RecordCount
    Next i
    Set RecordStatics = dbs.OpenRecordset("select * from 物料信息变化表 WHERE 物料信息变化表.Day=# " & SearchDate & "#  And CVar(物料信息变化表.[Volume Price] / 物料信息变化表.Volume)>30")
    If Not RecordStatics.EOF Then
        RecordStatics.MoveLast
      End If
    arrMovAverage(3) = RecordStatics.RecordCount
    
    MSChartPrice.ChartData = arrMovAverage
    MSChartPrice.Legend.VtFont.size = 7
    MSChartPrice.Legend.VtFont.Name = "宋体"
    MSChartPrice.Title.VtFont.size = 7
    MSChartPrice.ShowLegend = True
    MSChartPrice.Plot.SeriesCollection(1).LegendText = "0-10"
    MSChartPrice.Plot.SeriesCollection(2).LegendText = "10-20"
    MSChartPrice.Plot.SeriesCollection(3).LegendText = "20-30"
    MSChartPrice.Plot.SeriesCollection(4).LegendText = "高于30"
    
    For i = 1 To 4
      Set RecordStatics = dbs.OpenRecordset("select * from 物料信息变化表 WHERE 物料信息变化表.Day=# " & SearchDate & "# and 物料信息变化表.Change >" & ChangeRateSel(i + 1) & " and 物料信息变化表.Change <= " & ChangeRateSel(i) & " ")
      If Not RecordStatics.EOF Then
        RecordStatics.MoveLast
      End If
      arrChange(i) = RecordStatics.RecordCount
    Next i
    Set RecordStatics = dbs.OpenRecordset("select * from 物料信息变化表 WHERE 物料信息变化表.Day=# " & SearchDate & "# and 物料信息变化表.Change >0.1 ")
    If Not RecordStatics.EOF Then
        RecordStatics.MoveLast
    End If
    arrChange(0) = RecordStatics.RecordCount
    Set RecordStatics = dbs.OpenRecordset("select * from 物料信息变化表 WHERE 物料信息变化表.Day=# " & SearchDate & "# and 物料信息变化表.Change <-0.1 ")
    If Not RecordStatics.EOF Then
        RecordStatics.MoveLast
    End If
    arrChange(5) = RecordStatics.RecordCount
    
    MSChartChange.ChartData = arrChange
    MSChartChange.ShowLegend = True
    MSChartChange.Legend.VtFont.size = 7
   
    MSChartChange.Plot.SeriesCollection(1).LegendText = "涨过10%"
    MSChartChange.Plot.SeriesCollection(2).LegendText = "涨5%-10%"
    MSChartChange.Plot.SeriesCollection(3).LegendText = "涨0%-5%"
    MSChartChange.Plot.SeriesCollection(4).LegendText = "跌0%-5%"
    MSChartChange.Plot.SeriesCollection(5).LegendText = "跌5%-10%"
    MSChartChange.Plot.SeriesCollection(6).LegendText = "跌过10%"
    
    ComboPrice.Enabled = True
    ComboChange.Enabled = True
    D2.Recordset.MoveLast
    TotalCount = D2.Recordset.RecordCount
    ComboChange.Enabled = False
    Label4.Caption = "共 " & TotalCount & " 条记录。"
    End If
End Sub
Private Sub Form_Load()
    Dim MovAverage As Variant
    Dim ChangeRate As Variant
    Dim RecordDate As Recordset
    For i = 1 To 5
      ChangeRateSel(i) = 0.15 - 0.05 * i
    Next i
    For i = 0 To 3
       AverageSel(i) = i * 10
    Next i
    
    MovAverage = Array("0-10", "10-20", "20-30", "高于 30")
    ChangeRate = Array("涨过 10%", "涨 5%-10%", "涨 0%-5%", "跌  0%-5%", "跌  5%-10%", "跌过 10%")
   
    For i = 0 To 3
        ComboPrice.AddItem MovAverage(i)
    Next i
    For i = 0 To 5
       ComboChange.AddItem ChangeRate(i)
    Next i
    
    MonthView1.Visible = False
    filename = App.Path & "dbmaterialinfo2007.mdb"
    Set dbs = OpenDatabase(filename)
    D2.DatabaseName = filename
    Set rec = dbs.OpenRecordset("物料信息表")
    Text1.Text = ""
    
    Set RecordDate = dbs.OpenRecordset("select max(Day) as Max,min(Day) as Min from 物料信息变化表")
    If Not RecordDate.BOF And Not RecordDate.EOF Then
       MaxDate = RecordDate.Fields("Max")
       MinDate = RecordDate.Fields("Min")
    End If
    grid.Cols = 5
    GridInit
    D2.RecordSource = "SELECT 物料信息变化表.Code as 物料代码,Name as 物料名称, Change as 涨跌,CVar([Volume Price] / Volume) as 价格,Day as 日期 FROM 物料信息变化表,物料信息表,物料类型信息表  WHERE 物料信息变化表.Code=物料信息表.Code and 物料信息表.TypeId=物料类型信息表.ID"
    D2.Refresh
    D2.Recordset.MoveLast
    TotalCount = D2.Recordset.RecordCount
    Label4.Caption = "共 " & TotalCount & " 条记录。"
End Sub
Private Sub GridInit()
    Dim GridInfo   As Variant
    GridInfo = Array("物料名称", "日耗量", "日均额", "涨跌", "平均价格")
    grid.Clear
    grid.Row = 0
    For i = 0 To 4
        grid.Col = i
        grid.Text = GridInfo(i)
        grid.ColAlignment(i) = 3
        grid.ColWidth(i) = 800
    Next i
    grid.ColWidth(3) = 1000
    grid.ColAlignment(2) = 8
    grid.ColAlignment(3) = 6
    grid.ColAlignment(4) = 6
End Sub
Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
  Text1.Text = MonthView1.Value
  MonthView1.Visible = False
  comQuery.Enabled = True
  comQuery_Click
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
        Select Case KeyAscii
        Case Asc("0") To Asc("9"), vbKeyBack
                'text Change
        Case Else
                KeyAscii = 0
        End Select
End Sub

						