form1.frm

自动根据输入数据的最大最小值选择纵向坐标

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   11010
   ScaleWidth      =   15240
   StartUpPosition =   3  '窗口缺省
   Begin VB.PictureBox Pic1 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      Height          =   6135
      Left            =   360
      ScaleHeight     =   6135
      ScaleWidth      =   13215
      TabIndex        =   0
      Top             =   240
      Width           =   13215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()
Dim Y1, Y2, max As Integer
Dim X1, X2 As String
Dim maxP As Single
Dim minN As Single
'MsgBox Now
maxP = 500#
minN = -100#
X1 = maxP
X2 = minN
If InStr(X1, ".") <> 0 Then
  X1 = Left$(X1, (InStr(X1, ".") - 1))
End If
If InStr(X2, ".") <> 0 Then
  X2 = Left$(X2, (InStr(X2, ".") - 1))
End If
X2 = Abs(X2)
If Abs(maxP) - Abs(minN) >= 0 Then
  max = (CInt(Left(X1, 1)) + 2) * 10 ^ (CInt(Len(X1) - 1))
  Y1 = max '+ (10 ^ (Len(max) - 1)) / 2 + 0.5
  Y2 = 0 - (CInt(Left(Abs(X2), 1)) + 2) * 10 ^ (CInt(Len(X2) - 1)) 'X2 - (10 ^ (Len(max) - 1)) / 2 - 0.5
Else
  max = 0 - (CInt(Left(Abs(X2), 1)) + 2) * 10 ^ (CInt(Len(X2) - 1))
  Y1 = (CInt(Left(X1, 1)) + 2) * 10 ^ (CInt(Len(X1) - 1))
  Y2 = 0 - (CInt(Left(Abs(X2), 1)) + 2) * 10 ^ (CInt(Len(X2) - 1))
End If
DrawWidth = 4
Pic1.Scale (-5, Y1)-(125, Y2)
Pic1.Line (0, 0)-(125, 0)
Pic1.Line (0, Y1)-(0, Y2)
Dim i, j, m As Integer
For i = 0 To 125 Step 10
  Pic1.Line (i, 0)-(i, max / 50)
  For j = 1 To 9
    Pic1.Line (i + j, 0)-(i + j, max / 100), QBColor(8)
  Next
Next
If max >= 0 Then
  m = 10 ^ (CInt(Len(X1) - 1))
Else
  m = 10 ^ (CInt(Len(X2) - 1))
End If
DrawWidth = 2
  For i = 0 To Y1 Step m
     Pic1.Line (0, i)-(1, i)
     Pic1.CurrentX = -5
     Pic1.CurrentY = i + m
     Pic1.Print i + m
     For j = 1 To 9
       Pic1.Line (0, i + j * m / 10)-(0.6, i + j * m / 10), QBColor(8)
     Next
  Next
  For i = 0 To Abs(Y2) Step m
     Pic1.Line (0, -i)-(1, -i)
     Pic1.CurrentX = -5
     Pic1.CurrentY = -(i + m) + m / 15
     Pic1.Print -(i + m)
     For j = 1 To 9
       Pic1.Line (0, -(i + j * m / 10))-(0.6, -(i + j * m / 10)), QBColor(8)
     Next
  Next
  
  '填写时间轴坐标
  Dim startT, endT, startT1, endT1 As Date
  Dim str1, str2 As String
  Dim spaceSum, spaceSingle As Single
  Dim axis(0 To 12)
  startT = "2007-10-01 07:31:03"
  endT = "2007-10-01 10:02:03"
  str1 = Right(startT, Len(startT) - InStr(startT, ":"))
  str2 = Left(str1, InStr(str1, ":") - 1)
  If str2 >= 0 And str2 - 30 < 0 Then
    axis(0) = Left(startT, InStr(startT, ":") - 1) & ":00"
  ElseIf str2 - 30 >= 0 And str2 - 31 < 0 Then
     axis(0) = Left(startT1, InStr(startT1, ":") - 1) & ":30"
  Else
    'startT1 = DateAdd("n", -1, startT)
    axis(0) = Left(startT, InStr(startT, ":") - 1) & ":30"
  End If
  str1 = Right(endT, Len(endT) - InStr(endT, ":"))
  str2 = Left(str1, InStr(str1, ":") - 1)
  If str2 >= 0 And str2 - 30 < 0 Then
    axis(12) = Left(endT, InStr(endT, ":") - 1) & ":30"
  Else
    'endT1 = DateAdd("n", 1, endT)
    axis(12) = Left(endT, InStr(endT, ":") - 1) & ":00"
  End If
  endT1 = axis(12)
  startT1 = axis(0)
  'MsgBox startT1
  'MsgBox endT1
  spaceSum = CSng(DateDiff("n", startT1, endT1))
  spaceSingle = spaceSum / 12
  'MsgBox spaceSingle
 ' MsgBox startT1
  For i = 1 To 11
    axis(i) = DateAdd("n", spaceSingle * i, startT1)
  Next
  axis(0) = Right(axis(0), Len(axis(0)) - InStr(axis(0), " "))
  axis(12) = Right(axis(12), Len(axis(12)) - InStr(axis(12), " "))
  For i = 1 To 11
    axis(i) = Right(axis(i), Len(axis(i)) - InStr(axis(i), " "))
    axis(i) = Left(axis(i), Len(axis(i)) - 3)
  Next
 ' MsgBox max
  For i = 0 To 12
    Pic1.CurrentX = 0.2 + 10 * i - 2
    Pic1.CurrentY = 0 - max / 30
    Pic1.Print axis(i)
  Next
  
  '根据时间画曲线
  Dim time(1 To 20) As Date
  Dim data(1 To 20)
  time(1) = "2007-10-01 07:32:59"
  For i = 2 To 20
    time(i) = DateAdd("n", 6, time(i - 1))
    data(i) = i * i
  Next
  MsgBox time(20)
  For i = 1 To 20
    str1 = Right(time(i), 2)
    If str1 >= 0 And str1 - 30 <= 0 Then
      time(i) = Left(time(i), 17) & "00"
    Else
      time(i) = Left(DateAdd("n", 1, time(i)), InStrRev(time(i), ":")) & "00"
    End If
  Next
 '  MsgBox InStrRev(time(1), ":")
  For i = 1 To 19
   Pic1.FillStyle = 0
   ' Pic1.CurrentX = DateDiff("n", time(i), startT1)
   ' Pic1.CurrentY = data(i)
    Pic1.Line (DateDiff("n", startT1, time(i)) / spaceSingle * 10, data(i))-(DateDiff("n", startT1, time(i + 1)) / spaceSingle * 10, data(i + 1))
    'Pic1.Circle (DateDiff("n", startT1, time(i)) / spaceSingle * 10, data(i)), 0.3, QBColor(12)
 Next
'Pic1.Circle (DateDiff("n", startT1, time(20)) / spaceSingle * 10, data(20)), 0.3, QBColor(12)
 
End Sub