form1.frm

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

            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      =   6864
         TabIndex        =   3
         Top             =   480
         Width           =   6912
      End
   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            =   6960
      TabIndex        =   1
      Top             =   3360
      Width           =   1092
   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            =   6960
      TabIndex        =   0
      Top             =   3840
      Width           =   1092
   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 wBuf(0 To DataNo - 1) As Integer
Dim wRtn As Integer, wTotalBoards As Integer
Dim YS(0 To 1) As Single
Dim hEvent As Long

Dim wCfgCode, wADChNo, wCardType As Integer
Dim wCount As Long

Dim wFlag As Integer


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 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
    End
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
    cbTriggerMode.ListIndex = 0
        
    YS(0) = 5: YS(1) = -5
    wCfgCode = InRange.ListIndex
    wADChNo = Val(cbADChannel.Text)
    wCardType = cbCardType.ListIndex
    Gph.Scale (0, YS(0))-(DataNo, YS(1))
End Sub

Private Sub Command2_Click()
    Dim i As Integer
    Dim c2 As Integer
    Dim fTmp As Single
            
    A823_SetTriggerMode cbTriggerMode.ListIndex  '0:Internal Trigger   1:External Trigger

    c2 = 2 * 1024 / Val(eSRate.Text)  'Used in Internal Trigger Mode
    If Command2.Caption = "Active" Then
       wADChNo = Val(cbADChannel.Text)
       If A823_ActiveBoard(Val(eSelect.Text)) <> A823_NoError Then
          MsgBox "Can not Active the Board."
          Exit Sub
       End If
       
       wRtn = A823_SetChGain(wADChNo, wCfgCode, wCardType)
       
       hEvent = CreateEvent(0, False, False, 0)
       If hEvent = 0 Then
            MsgBox "Create Event Error!!"
            Exit Sub
       End If
       
       If A823_Int_Install(hEvent, DataNo) <> A823_NoError Then
             MsgBox "Can not install IRQ."
             Exit Sub
       End If
       
       Command2.Caption = "Stop"
       Command1.Enabled = False
       Do While Command2.Caption = "Stop"
            
            '******* Start Interrup ********
            wRtn = A823_Int_Start(c2)      'Sampling rate 2M/(c1*c2)
            If wRtn <> A823_NoError Then
                A823_Int_Stop
                Exit Do
            End If
            
            Do While Command2.Caption = "Stop"
                If WaitForSingleObject(hEvent, 300) = WAIT_OBJECT_0 Then
                    Exit Do
                End If
                Sleep (100)
                DoEvents
            Loop
            
            A823_Int_Stop
            
            If Command2.Caption <> "Stop" Then
                Exit Do
            End If
            
            wRtn = A823_Int_GetHexBuf(wBuf(0), DataNo)
            
            '******* End Interrup ********
            
            Gph.Cls
            wRtn = A823_Hex2Float(wCfgCode, wCardType, wBuf(0), fTmp)
            Gph.PSet (0, fTmp)
            For i = 1 To DataNo - 1
                wRtn = A823_Hex2Float(wCfgCode, wCardType, wBuf(i), fTmp)
                Gph.Line -(i, fTmp)
            Next i
            DoEvents
            Sleep 100
       Loop
       A823_Int_Remove
       CloseHandle hEvent
       hEvent = 0
       Command2.Caption = "Active"
       Command1.Enabled = True
    Else
       Command2.Caption = "Active"
       Command1.Enabled = True
    End If
End Sub