form1.frm

工控硬件读写ISA多功能卡823的VB例子程序

      Width           =   8505
      Begin VB.TextBox YScale 
         Alignment       =   1  'Right Justify
         BackColor       =   &H0000FF00&
         BeginProperty Font 
            Name            =   "MS Serif"
            Size            =   9.6
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   330
         Index           =   1
         Left            =   270
         TabIndex        =   5
         Text            =   "-5"
         Top             =   2280
         Width           =   552
      End
      Begin VB.TextBox YScale 
         Alignment       =   1  'Right Justify
         BackColor       =   &H0000FF00&
         BeginProperty Font 
            Name            =   "MS Serif"
            Size            =   9.6
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   330
         Index           =   0
         Left            =   270
         TabIndex        =   4
         Text            =   "5"
         Top             =   480
         Width           =   552
      End
      Begin VB.PictureBox Gph 
         BackColor       =   &H0080FFFF&
         BeginProperty Font 
            Name            =   "MS Serif"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000C0&
         Height          =   2148
         Left            =   960
         ScaleHeight     =   2100
         ScaleWidth      =   7344
         TabIndex        =   3
         Top             =   480
         Width           =   7395
      End
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   7680
      Top             =   4560
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Active"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   372
      Left            =   7080
      TabIndex        =   1
      Top             =   3480
      Width           =   1332
   End
   Begin VB.CommandButton Command1 
      Caption         =   "&Exit"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   10.8
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   372
      Left            =   7080
      TabIndex        =   0
      Top             =   3960
      Width           =   1332
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const DataNo = 100
Dim fBuf(0 To DataNo - 1) As Single
Dim wRtn As Integer, wTotalBoards As Integer
Dim YS(0 To 1) As Single

Dim wCfgCode, wADChNo, wDAChNo, wCardType As Integer
Dim wCount As Long
Dim bProcessing As Boolean



Private Sub cbCardType_Click()
    'While Hi/Lo Gain Selection is changed, reset contents of the Input Range (ComboBox).
    InRange.Clear
    wCardType = cbCardType.ListIndex
    If wCardType = 0 Then ' Low Gain
        InRange.AddItem "    -5~5    "
        InRange.AddItem "  -2.5~2.5  "
        InRange.AddItem " -1.25~1.25 "
        InRange.AddItem "-0.625~0.625"
        InRange.AddItem "     0~10   "
        InRange.AddItem "     0~5    "
        InRange.AddItem "     0~2.5  "
        InRange.AddItem "     0~1.25 "
        InRange.AddItem "   -10~10   "
    Else
        InRange.AddItem "    -5~5    "
        InRange.AddItem "  -0.5~0.5  "
        InRange.AddItem " -0.05~0.05 "
        InRange.AddItem "-0.005~0.005"
        InRange.AddItem "     0~10   "
        InRange.AddItem "     0~1    "
        InRange.AddItem "     0~0.1  "
        InRange.AddItem "     0~0.01 "
        InRange.AddItem "   -10~10   "
        InRange.AddItem "    -1~1    "
        InRange.AddItem "  -0.1~0.1  "
        InRange.AddItem " -0.01~0.01 "
    End If
    
    InRange.ListIndex = 0   'Reset the Input Range
    wCfgCode = 0             'Reset the Gain Code

End Sub


Private Sub cbDAMode_Click()
     eDAVal.Text = "2.5"
     Select Case cbDAMode.ListIndex
        Case 0
            DADesc.Caption = "DA(0~5v)"
        Case 1
            DADesc.Caption = "DA(0~10v)"
        Case 2
            DADesc.Caption = "DA(+/-5v)"
        Case 3
            DADesc.Caption = "DA(+/-10v)"
     End Select
End Sub

Private Sub InRange_Click()
  Dim G As Single
  Dim nG As Single
  
  'While Input Range is changed, reset the Gain Code
  wCfgCode = InRange.ListIndex
  nG = cbCardType.ListIndex
  G = Val(Mid(ATFullVolt, wCfgCode * 4 + nG * 12 * 4 + 1, 4)) / Val(Mid(ATGain, wCfgCode * 4 + nG * 12 * 4 + 1, 4))
    
  YScale(0).Text = G
  If Val(Mid$(ATBiUni, wCfgCode * 4 + nG * 12 * 4 + 1, 4)) = 1 Then 'Unipolar
    YScale(1).Text = "0"
  Else
    YScale(1).Text = G * -1
  End If
  
  YScale_LostFocus (0)
  YScale_LostFocus (1)
End Sub

Private Sub YScale_LostFocus(Index As Integer)
  YScale(Index).Text = Trim(Val(YScale(Index).Text))
  If Val(YScale(Index).Text) > 12 Then YScale(Index).Text = "12"
  If Val(YScale(Index).Text) < -12 Then YScale(Index).Text = "-12"
  YS(Index) = Val(YScale(Index).Text)
  If YS(Index) = YS((Index + 1) Mod 2) Then
    YS(Index) = YS(Index) + IIf(Index = 0, 0.1, -0.1)
  End If
  YScale(Index).Text = Trim(YS(Index))
  Gph.Cls
  Gph.Scale (0, YS(0))-(DataNo, YS(1))
End Sub

Private Sub Command1_Click()
    A823_DriverClose
    Timer1.Enabled = False
    End
End Sub

Private Sub Command2_Click()
    Dim wRetVal As Integer

    If Command2.Caption = "Active" Then
       wADChNo = Val("&h" + cbADChannel.Text)
       wDAChNo = Val("&h" + cbDAChannel.Text)
       If A823_ActiveBoard(Val(eSelect.Text)) <> A823_NoError Then
          MsgBox "Can not Active the Board."
          Exit Sub
       End If
       Command2.Caption = "Stop"
       Command1.Enabled = False
       bProcessing = False
       Timer1.Enabled = True
    Else
       Timer1.Enabled = False
       Command2.Caption = "Active"
       Command1.Enabled = True
    End If
    Select Case cbDAMode.ListIndex
        Case 0
            A823_DA_Uni5 wDAChNo, Val(eDAVal.Text)
        Case 1
            A823_DA_Uni10 wDAChNo, Val(eDAVal.Text)
        Case 2
            A823_DA_Bi5 wDAChNo, Val(eDAVal.Text)
        Case 3
            A823_DA_Bi10 wDAChNo, Val(eDAVal.Text)
    End Select
End Sub

Private Sub Form_Load()
    Dim rtn
    
    Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
    
    '********************************************************************
    '* NOTICE: call A823_DriverInit() to initialize the driver.        *
    '* Initial the device driver, and return the board number in the PC *
    '********************************************************************
    Command2.Caption = "Active"
    Command2.Enabled = False
    
    wRtn = A823_DriverInit(wTotalBoards)
    If wRtn <> A823_NoError Then
        MsgBox "Can not initial Device Driver!!!"
        Exit Sub
    End If
    
    If wTotalBoards < 1 Then
        MsgBox "Card Not Found!!"
        Exit Sub
    End If
    
    eTotal.Text = Str(wTotalBoards)
    Command2.Enabled = True
    
    cbCardType.ListIndex = 0
    'cbCardType_Click
    cbADChannel.ListIndex = 0
    cbDAChannel.ListIndex = 0
    wADChNo = 0
    
    YS(0) = 5: YS(1) = -5
    wCfgCode = InRange.ListIndex
    wCardType = cbCardType.ListIndex
    cbDAMode.ListIndex = 0
    cbDAMode_Click
    
End Sub

Private Sub Timer1_Timer()
    Dim i As Integer
    Dim fVal As Single
    
    If bProcessing = True Then
        Exit Sub
    Else
        bProcessing = True
    End If
    wRtn = A823_AD_Float(wADChNo, wCfgCode, wCardType, fVal)
    AD.Text = Format(fVal, "###,###.000")
        
    wRtn = A823_SetChGain(wADChNo, wCfgCode, wCardType)
    wCount = DataNo
    wRtn = A823_ADs_Float(fBuf(0), wCount)
    If wRtn <> A823_NoError Then
        Command2_Click
        MsgBox "A823_ADs_Float() Error!"
        bProcessing = False
        Exit Sub
    End If
    Gph.Cls
    Gph.PSet (0, fBuf(0))
    For i = 1 To DataNo - 1
        Gph.Line -(i, fBuf(i))
        DoEvents
    Next i
    bProcessing = False
End Sub