lsqx.frm

这是一个用来查询历史数据的小程序

' 画笔程序延时=400                                                              ->画笔程序打开延
' 分组数量=8                                                                    ->棒图、柄图显示
' 分组范围=0-400,401-500,501-600,601-750,751-800,801-1000,1001-1200,1201-3000   ->棒图、柄图显示

' 数据库为slqx.mdb， 其中有31个表，分别对应1-31天，每天有1440个记录,每分钟保存一个记录，以编辑方式更新每次记录
' 每表存在RQ，Sj，Tag，b1，b2,....bn个字段，新数据库可用CreatQxk.exe文件生成。
'******************************************************************************************************************
Dim Sqlstr As String '连接字符串
Dim ChengNo As Integer '记录仪表秤号
Dim ChengNum As Integer  '记录仪表数量
Dim Zoom_Hor As Integer '水平放大倍数
Dim Zoom_Ver As Integer '垂直放大倍数
Dim YbNum_Str As String '连接字符串
Dim Yb_Name() As String '仪表别名
Dim WinWnd '获取画笔程序句柄
Dim Cx_Tag As String '线图、棒图、柄图查询标识
Dim RecNum As Integer '棒图、柄图显示时记录符合条件的记录数
Public Function Qx_Initialize() '初始化
  Dim Ii As Integer, Zz As Integer
  Dim Aa As String
  On Error GoTo Err1
  '取仪表数量
  ChengNum = GetPrivateProfileInt("历史流量曲线", "仪表数量", "0", App.Path & "\config.ini")
  '取仪表名称
  Aa = Space$(255)
  Ii = GetPrivateProfileString("历史流量曲线", "仪表名称", "0", Aa, Len(Aa), App.Path & "\config.ini")
  Aa = Trim(Aa)
  '清除每行字符串的最后一个特殊字符(当返回值中存在汉字时，最后会返回一个ASC()=0的特殊字符)
  If Asc(Right(Aa, 1)) = 0 Then
     Aa = Left(Aa, Len(Aa) - 1)
  End If
  Yb_Name = Split(Aa, ",")
  If ChengNum <> UBound(Yb_Name) + 1 Then
     Call MsgBox("仪表数量与仪表名称不对应!", 48, "系统提示")
  End If
  
  YbNum_Str = ""
  For Ii = 0 To UBound(Yb_Name)
      Combo1.AddItem Yb_Name(Ii)
      YbNum_Str = YbNum_Str & ",b" & CStr(Ii + 1) & " as " & Yb_Name(Ii)
  Next Ii
  
  Exit Function
Err1:
  Call MsgBox("仪表传递数据设置有误!", 48, "系统提示")
  End
End Function
Private Sub Combo1_Click()
  ChengNo = Combo1.ListIndex + 1
  Call DTPicker1_Change '初始化MSChart控件
  Call Command1_Click '查询显示
End Sub
Private Sub Command1_Click() '查询记录
  'On Error Resume Next
  Dim Aa As String
  If Cx_Tag = "线图" Then
     MSChart1.chartType = VtChChartType2dLine
     If ChengNo <= ChengNum Then
        Aa = "b" & CStr(ChengNo) & " as " & Yb_Name(ChengNo - 1)
        Sqlstr = "select cstr(sj), " & Aa & " from " & CStr(Day(DTPicker1.Value)) & _
                 " where rq=#" & Format(DTPicker1.Value, "YYYY-MM-DD") & "# and sj>=#" & DTPicker2.Value & _
                 "# and sj<=#" & DTPicker3.Value & "#"
     Else
        Sqlstr = "select cstr(sj)" & YbNum_Str & " from " & CStr(Day(DTPicker1.Value)) & _
                 " where rq=#" & Format(DTPicker1.Value, "YYYY-MM-DD") & "# and sj>=#" & DTPicker2.Value & _
                 "# and sj<=#" & DTPicker3.Value & "#"
     End If
  ElseIf Cx_Tag = "棒图" Or Cx_Tag = "柄图" Then
     Call BtPtCx   '棒图、柄图查询
     If Cx_Tag = "棒图" Then
        MSChart1.chartType = VtChChartType2dBar
     ElseIf Cx_Tag = "柄图" Then
        MSChart1.chartType = VtChChartType2dPie
     End If
  End If
  Adodc1.RecordSource = Sqlstr
  Adodc1.Refresh
  If Adodc1.Recordset.EOF Then
     StatusBar1.Panels(2).Text = "没有搜寻到所要查询的数据!                     江苏赛摩技术拉姆齐公司 版本 1.0"
     MSChart1.ColumnCount = 0 '请除保存的棒图、柄图
     MSChart1.ShowLegend = False
  Else
     StatusBar1.Panels(2).Text = "搜寻到所要查询的数据共" & CStr(Adodc1.Recordset.RecordCount) & "条                 江苏赛摩技术拉姆齐公司 版本 1.0"
     MSChart1.ShowLegend = True
  End If
  Set MSChart1.DataSource = Adodc1.Recordset
  MSChart1.Refresh
  On Error Resume Next
  If Cx_Tag = "柄图" Then
     MSChart1.RowLabel = ""
  End If
  Command3.Enabled = True
  Command4.Enabled = True
  Command5.Enabled = True
End Sub
Private Sub Command2_Click()
   Unload Me
End Sub
Private Sub Command3_Click()
  Select Case Zoom_Hor
    Case 1
      MSChart1.Width = MSChart1.Width * 2
      Zoom_Hor = 2
    Case 2
      MSChart1.Width = MSChart1.Width * 2
      Zoom_Hor = 3
    Case 3
      MSChart1.Width = MSChart1.Width / 2
      Zoom_Hor = 4
    Case 4
      MSChart1.Width = MSChart1.Width / 2
      Zoom_Hor = 1
  End Select
  HScroll1.Value = 0
End Sub
Private Sub Command4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  PopupMenu Ms_Prn '弹出打印菜单
End Sub
Private Sub Command5_Click()
  Select Case Zoom_Ver
    Case 1
      MSChart1.Height = MSChart1.Height * 2
      Zoom_Ver = 2
    Case 2
      MSChart1.Height = MSChart1.Height * 2
      Zoom_Ver = 3
    Case 3
      MSChart1.Height = MSChart1.Height / 2
      Zoom_Ver = 4
    Case 4
      MSChart1.Height = MSChart1.Height / 2
      Zoom_Ver = 1
  End Select
 VScroll1.Value = 0
End Sub
Private Sub DTPicker1_Change()
  Dim Ii As Integer
  Command3.Enabled = False
  Command4.Enabled = False
  Command5.Enabled = False
  If Cx_Tag = "线图" Then
     ChengNo = Combo1.ListIndex + 1
     If ChengNo = ChengNum + 1 Then
        MSChart1.ColumnCount = ChengNum
        For Ii = 1 To ChengNum
           MSChart1.Column = Ii
           MSChart1.Plot.SeriesCollection(Ii).Pen.Width = 1
   '       MSChart1.Plot.SeriesCollection(Ii).Pen.VtColor.Red = (Ii - 1) * 15
   '       MSChart1.Plot.SeriesCollection(Ii).Pen.VtColor.Green = (Ii - 1) * 15
   '       MSChart1.Plot.SeriesCollection(Ii).Pen.VtColor.Blue = (Ii - 1) * 15
           MSChart1.SeriesType = VtChSeriesType2dLine
        Next Ii
     Else
        MSChart1.ColumnCount = 1
        MSChart1.Plot.SeriesCollection(1).Pen.Width = 1
     End If
  End If
End Sub
Private Sub DTPicker2_Change()
  Command3.Enabled = False
  Command4.Enabled = False
  Command5.Enabled = False
End Sub
Private Sub DTPicker3_Change()
  Command3.Enabled = False
  Command4.Enabled = False
  Command5.Enabled = False
End Sub

Private Sub Form_Load()
  'On Error Resume Next
  Dim Open_Delay As Integer
  ChengNo = 1
  DTPicker1.Value = Date
  DTPicker2.Value = "0:00:00"
  Call Qx_Initialize '初始化
  Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & App.Path & "\slqx.mdb"
  Sqlstr = "select cstr(sj)" & YbNum_Str & " from " & CStr(Day(Date)) & " where rq=#" & Format(DTPicker1.Value, "YYYY-MM-DD") & "#"
  Adodc1.RecordSource = Sqlstr
  Adodc1.Refresh
  Set MSChart1.DataSource = Adodc1.Recordset
  MSChart1.Refresh
  '取画笔程序延时
  Open_Delay = GetPrivateProfileInt("历史流量曲线", "画笔程序延时", "0", App.Path & "\config.ini")
  If IsNumeric(Open_Delay) Then
     Timer1.Interval = Open_Delay
  Else
     Call MsgBox("画笔延时数据设置有误!", 48, "系统提示")
  End If
  Combo1.AddItem "全部"
  Combo1.ListIndex = ChengNum
  Zoom_Hor = 1
  Zoom_Ver = 1
  Cx_Tag = "线图"
End Sub
Private Sub HScroll1_Change()
  On Error Resume Next
  MSChart1.Left = -HScroll1.Value * (9930 / HScroll1.Max) _
                  * Switch(MSChart1.Width = 9930, 0, MSChart1.Width = 19860, 1, MSChart1.Width = 39720, 3)
End Sub
Private Sub MSChart1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = 2 Then
     PopupMenu Ms_List
  End If
End Sub
Private Sub MSChart1_PointSelected(Series As Integer, DataPoint As Integer, MouseFlags As Integer, Cancel As Integer)
  If Cx_Tag = "线图" Then
     MSChart1.Row = DataPoint
     MSChart1.Column = Series
     Label2(0) = MSChart1.RowLabel
     Label2(1) = MSChart1.Data
  ElseIf Cx_Tag = "棒图" Then
     MSChart1.Row = DataPoint
     MSChart1.Column = Series
     Label2(0) = MSChart1.ColumnLabel
     Label2(1) = Format(MSChart1.Data / RecNum * 100, "###0.00")
  ElseIf Cx_Tag = "柄图" Then
     MSChart1.Row = DataPoint
     MSChart1.Column = Series
     Label2(0) = MSChart1.ColumnLabel
     Label2(1) = Format(MSChart1.Data / RecNum * 100, "###0.00")
  End If
End Sub
Private Sub ToPbrush_Click() '输出至画笔
  Dim Repo As Integer
  MSChart1.TitleText = Format(DTPicker1.Value, "YYYY-MM-DD") & " 日 " & DTPicker2.Value _
           & " 至 " & DTPicker3.Value & " 仪表流量曲线"
  Clipboard.Clear
  MSChart1.EditCopy
  MSChart1.TitleText = ""
  WinWnd = FindWindow(vbNullString, "未命名 - 画图")
  If WinWnd = 0 Then
     On Error GoTo Err1
     Call Shell("PBRUSH.EXE", 1) 'Windows 98系统
     GoTo Step1
Err1:
     Call Shell("MSPAINT.EXE", 1) 'Windows 2000系统
Step1:
  End If
  Timer1.Enabled = True '延时
End Sub
Private Sub Timer1_Timer() '延时
  Timer1.Enabled = False
  ShowWindow WinWnd, SW_MAXIMIZE
  'AppActivate "未命名 - 画图"
  SendKeys ("^v") '粘贴
End Sub
Private Sub ToPrn_Click() '输出至打印机
  Clipboard.Clear
  MSChart1.EditCopy
  Label4 = Format(DTPicker1.Value, "YYYY-MM-DD") & " 日 " & DTPicker2.Value _
           & " 至 " & DTPicker3.Value & " 仪表流量曲线"
  Printer.CurrentY = 300
  Printer.CurrentX = MSChart1.Width / 2 - Label4.Width / 2 + 800
  Printer.Print Label4
  Printer.PaintPicture Clipboard.GetData(), 0, 540
  Printer.EndDoc
  Clipboard.Clear
End Sub
Private Sub ToBt_Click()
  Cx_Tag = "棒图"
  Label1(4) = "范围："
  Label1(5) = "    比例："
  Label1(6) = "%"
  Label2(0) = ""
  Label2(1) = ""
  Call Command1_Click '查询显示
End Sub
Private Sub ToLine_Click()
  Cx_Tag = "线图"
  Label1(4) = "时 间："
  Label1(5) = "瞬时流量："
  Label1(6) = "t/h"
  Label2(0) = ""
  Label2(1) = ""
  Call Command1_Click '查询显示
End Sub
Private Sub ToPt_Click()
  Cx_Tag = "柄图"
  Label1(4) = "范围："
  Label1(5) = "    比例："
  Label1(6) = "%"
  Label2(0) = ""
  Label2(1) = ""
  Call Command1_Click '查询显示
End Sub

Private Sub VScroll1_Change()
  On Error Resume Next
  MSChart1.Top = -VScroll1.Value * (4240 / VScroll1.Max) _
              * Switch(MSChart1.Height = 4240, 0, MSChart1.Height = 8480, 1, MSChart1.Height = 16960, 3) + 120
End Sub
Public Function BtPtCx() '棒图、柄图查询
  Dim Ii As Integer, GroupNum As Integer
  Dim Aa As String, GroupRange() As String
  Dim SingleGroupRange() As String
  Dim AiasName(1) As String
  Adodc2.ConnectionString = Adodc1.ConnectionString
  Adodc2.RecordSource = "select * from " & CStr(Day(DTPicker1.Value)) & " where rq=#" & Format(DTPicker1.Value, "YYYY-MM-DD") & "#"
  Adodc2.Refresh
  RecNum = Adodc2.Recordset.RecordCount
  '取分组数量
  GroupNum = GetPrivateProfileInt("历史流量曲线", "分组数量", "0", App.Path & "\config.ini")
  '取分组范围
  Aa = Space$(255)
  Ii = GetPrivateProfileString("历史流量曲线", "分组范围", "0", Aa, Len(Aa), App.Path & "\config.ini")
  Aa = Trim(Aa)
  If Asc(Right(Aa, 1)) = 0 Then
     Aa = Left(Aa, Len(Aa) - 1)
  End If
  GroupRange = Split(Aa, ",")
  If GroupNum <> UBound(GroupRange) + 1 Then
     Call MsgBox("分组数量与分组范围不对应!", 48, "系统提示")
  End If
  If ChengNo = ChengNum + 1 Then '只能对一个仪表进行棒图、柄图操作
     ChengNo = 1
     Combo1.ListIndex = 0
  End If
  Sqlstr = ""
  For Ii = 0 To UBound(GroupRange)
      SingleGroupRange = Split(GroupRange(Ii), "/")
      AiasName(0) = IIf(SingleGroupRange(0) >= 0, SingleGroupRange(0), "－" & Abs(SingleGroupRange(0)))
      AiasName(1) = IIf(SingleGroupRange(1) >= 0, SingleGroupRange(1), "－" & Abs(SingleGroupRange(1)))
      Sqlstr = Sqlstr & "Count(iif(b" & CStr(ChengNo) & " >= " & SingleGroupRange(0) & " And b" & _
               CStr(ChengNo) & " < " & SingleGroupRange(1) & ",b" & CStr(ChengNo) & ")) as " & AiasName(0) & "至" & AiasName(1) & ","
  Next Ii
  
  Sqlstr = Left(Sqlstr, Len(Sqlstr) - 1)
  Sqlstr = "select " & Sqlstr & " from " & CStr(Day(DTPicker1.Value)) & " where rq=#" & Format(DTPicker1.Value, "YYYY-MM-DD") & "#"
End Function