formqxss.frm

This is a boiler test system,has been use in factory

VERSION 5.00
Begin VB.Form FormQxss 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "实时曲线:"
   ClientHeight    =   5220
   ClientLeft      =   2895
   ClientTop       =   3135
   ClientWidth     =   9765
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5220
   ScaleWidth      =   9765
   Begin VB.Timer Timer1 
      Interval        =   1000
      Left            =   720
      Top             =   2400
   End
   Begin VB.ListBox Listzm 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   5100
      Left            =   7680
      MultiSelect     =   2  'Extended
      TabIndex        =   1
      Top             =   0
      Width           =   1995
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000005&
      Height          =   5100
      Left            =   120
      ScaleHeight     =   5040
      ScaleWidth      =   7395
      TabIndex        =   0
      Top             =   0
      Width           =   7455
      Begin VB.PictureBox Picture2 
         Height          =   1680
         Left            =   1200
         ScaleHeight     =   1620
         ScaleWidth      =   2760
         TabIndex        =   2
         Top             =   600
         Visible         =   0   'False
         Width           =   2820
         Begin VB.TextBox Textzb 
            Height          =   285
            Index           =   0
            Left            =   480
            TabIndex        =   6
            Text            =   "0"
            Top             =   548
            Width           =   615
         End
         Begin VB.TextBox Textzb 
            Height          =   285
            Index           =   1
            Left            =   1680
            TabIndex        =   5
            Text            =   "100"
            Top             =   548
            Width           =   615
         End
         Begin VB.CommandButton Command4 
            Caption         =   "确定"
            Height          =   350
            Left            =   360
            TabIndex        =   4
            Top             =   1080
            Width           =   720
         End
         Begin VB.CommandButton Command5 
            Caption         =   "取消"
            Height          =   350
            Left            =   1440
            TabIndex        =   3
            Top             =   1080
            Width           =   720
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Caption         =   "纵坐标范围"
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   14.25
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            ForeColor       =   &H00FF0000&
            Height          =   285
            Index           =   0
            Left            =   600
            TabIndex        =   9
            Top             =   120
            Width           =   1425
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Caption         =   "从"
            Height          =   180
            Index           =   2
            Left            =   195
            TabIndex        =   8
            Top             =   600
            Width           =   180
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Caption         =   "至"
            Height          =   180
            Index           =   3
            Left            =   1320
            TabIndex        =   7
            Top             =   600
            Width           =   180
         End
      End
      Begin VB.Label lablexy 
         AutoSize        =   -1  'True
         Caption         =   "Label1"
         Height          =   180
         Left            =   360
         TabIndex        =   10
         Top             =   480
         Visible         =   0   'False
         Width           =   540
      End
   End
   Begin VB.Menu exit1 
      Caption         =   "关闭(&X)"
   End
   Begin VB.Menu printqx1 
      Caption         =   "打印(&P)"
   End
   Begin VB.Menu xsfw 
      Caption         =   "显示范围"
   End
   Begin VB.Menu bangt 
      Caption         =   "棒图(&T)"
   End
End
Attribute VB_Name = "FormQxss"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim zbx1, zbx2, stx As Integer
Dim zby2, zby1, sty As Single
Dim MaxY, MinY As Integer
Dim blxuhao(7), topnum, FlagBT
Dim SetupDgls(26), dispdgof, biaoti(1)

Private Sub hzbx1()
''''On Error Resume Next
 sty = Format((zby2 - zby1) / 10, "000.0")
 If sty <= 0 Then sty = 0.05
 stx = (zbx2 - zbx1) \ 10
 Picture1.Cls
 Picture1.Scale (zbx1 - stx * 1.2, zby1 - sty)-(zbx2 + stx * 0.9, zby2 + sty * 1) '设定标尺
'---------------------------------------------------------------------------------
 For p = zby1 To zby2 Step sty
   Picture1.Line (zbx1, p)-(zbx2, p), &HE0E0E0    '画横坐标线
   Picture1.PSet (zbx1 - stx, p - sty / 6), &HFFFFFF
   If zby2 > 100 Then
     Picture1.Print Format$(zby2 + zby1 - p, "#000") '纵坐标
   Else
     Picture1.Print Format$(zby2 + zby1 - p, "#0.0#") '纵坐标
   End If
 Next p
  If blxuhao(1) = 99 Then
    Picture1.PSet (zbx1 - 0.5 * stx, zby1 - sty * 0.8), &HFFFFFF
    Picture1.Print DanWei(SsQxsx(blxuhao(0)))
 End If
 
   If SetupDgls(blxuhao(qx%)) <> "" Then
     y2 = zby2 + zby1 - SetupDgls(blxuhao(qx%))
     Picture1.Line (zbx1, y2)-(zbx2, y2), colorqx(qx%)
     Picture1.PSet (zbx2 + 0.02 * stx, y2 - 0.25 * sty), &HFFFFFF '横坐标值位置
     Picture1.Print SetupDgls(blxuhao(qx%))
   End If
'================================
miao2$ = Time$
miao1$ = DateAdd("s", -2 * zbx2, Time$)
If FlagBT = 0 Then
 For q% = zbx1 To zbx2 Step stx
     Picture1.Line (q%, zby1)-(q%, zby2), &HC0C0C0
  Next
   Picture1.PSet (zbx2 - 0.9 * stx, zby2 + 0.3 * sty), &HFFFFFF  '横坐标值位置
   Picture1.Print miao2$
   Picture1.PSet (zbx1 - 0.8 * stx, zby2 + 0.3 * sty), &HFFFFFF  '横坐标值位置
   Picture1.Print miao1$
End If
  Picture1.Line (zbx1, zby2)-(zbx2, zby2), &H80000003
  Picture1.Line (zbx1, zby1)-(zbx2, zby1), &H80000003
  Picture1.Line (zbx1, zby2)-(zbx1, zby1), &H80000003
  Picture1.Line (zbx2, zby2)-(zbx2, zby1), &H80000003
 End Sub

Private Sub Datacl() '确定坐标上下限
''''On Error Resume Next
For i% = 0 To 5      '变量序号
    blxuhao(i%) = 99
Next
For i% = 0 To Listzm.ListCount - 1
  If Listzm.Selected(i%) Then
      blxuhao(coun%) = i%
      coun% = coun% + 1
      If coun% >= 6 Then Exit For
  End If
Next
If coun% = 0 Then blxuhao(coun%) = 0
'----------------------------------------
 Dim lcs, lcx
 MaxY = -1000: MinY = 1000
 For j% = 0 To 5
   If Val(blxuhao(j%)) = 99 Then Exit For
   abc1% = SsQxsx(blxuhao(j%))
   lcx = Val(LiangC(0, abc1%))
   lcs = Val(LiangC(1, abc1%))
   If MaxY < lcs Then MaxY = lcs
   If MinY > lcx Then MinY = lcx

 Next
'========================
 zby2 = MaxY: zby1 = MinY
 If zby2 < zby1 Then
  aa = zby1
  zby1 = zby2
  zby2 = aa
 End If
 zbx2 = 10 * 30: zbx1 = 0
 hzbx1
 disp1
End Sub