aoint1.frm

来自「16 relay output channels and 16 isolated」· FRM 代码 · 共 348 行

VERSION 5.00
Begin VB.Form frmSelDev 
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Advantech Demo: Device selection  for  AO/INT transfer"
   ClientHeight    =   4080
   ClientLeft      =   2820
   ClientTop       =   1545
   ClientWidth     =   5670
   DrawMode        =   5  'Not Copy Pen
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4080
   ScaleWidth      =   5670
   Begin VB.Frame Frame2 
      Caption         =   "Action methods"
      Height          =   1575
      Left            =   2880
      TabIndex        =   14
      Top             =   1560
      Width           =   2655
      Begin VB.CommandButton Command1 
         Caption         =   "&Change..."
         Height          =   375
         Left            =   1680
         TabIndex        =   18
         Top             =   960
         Width           =   855
      End
      Begin VB.CheckBox chkCyclic 
         Caption         =   "Cyclic output data"
         Height          =   375
         Left            =   120
         TabIndex        =   15
         Top             =   240
         Width           =   2055
      End
      Begin VB.Label labWaveform 
         Caption         =   "Sine,500pt."
         Height          =   255
         Left            =   120
         TabIndex        =   17
         Top             =   1080
         Width           =   1215
      End
      Begin VB.Label Label2 
         Caption         =   "Selected waveform:"
         Height          =   255
         Left            =   120
         TabIndex        =   16
         Top             =   840
         Width           =   1575
      End
   End
   Begin VB.ComboBox CombOutputCh 
      Height          =   315
      ItemData        =   "AoInt1.frx":0000
      Left            =   1440
      List            =   "AoInt1.frx":0007
      Style           =   2  'Dropdown List
      TabIndex        =   12
      Top             =   1080
      Width           =   855
   End
   Begin VB.Frame Frame8 
      Caption         =   "Select Device"
      Height          =   735
      Left            =   120
      TabIndex        =   10
      Top             =   120
      Width           =   5295
      Begin VB.ListBox ListDevice 
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Left            =   120
         TabIndex        =   11
         Top             =   240
         Width           =   3855
      End
   End
   Begin VB.TextBox DataCounts 
      Height          =   285
      Left            =   4440
      TabIndex        =   9
      Text            =   "400"
      Top             =   1080
      Width           =   855
   End
   Begin VB.Frame Frame4 
      Caption         =   "Trigger source"
      Height          =   1575
      Left            =   120
      TabIndex        =   2
      Top             =   1560
      Width           =   2655
      Begin VB.TextBox SpeedRate 
         Height          =   375
         Left            =   1080
         TabIndex        =   5
         Text            =   "200"
         Top             =   960
         Width           =   735
      End
      Begin VB.OptionButton TrigMode 
         Caption         =   "Internal trigger"
         Height          =   375
         Index           =   0
         Left            =   240
         TabIndex        =   4
         Top             =   600
         Value           =   -1  'True
         Width           =   2055
      End
      Begin VB.OptionButton TrigMode 
         Caption         =   "External trigger"
         Height          =   375
         Index           =   1
         Left            =   240
         TabIndex        =   3
         Top             =   240
         Width           =   2055
      End
      Begin VB.Label Hz 
         Caption         =   "Hz"
         Height          =   255
         Left            =   1920
         TabIndex        =   7
         Top             =   1080
         Width           =   375
      End
      Begin VB.Label Speed 
         Caption         =   "Speed:"
         Height          =   255
         Left            =   240
         TabIndex        =   6
         Top             =   1080
         Width           =   855
      End
   End
   Begin VB.CommandButton Command2 
      Caption         =   "E&xit"
      Height          =   495
      Left            =   4200
      TabIndex        =   1
      Top             =   3360
      Width           =   1335
   End
   Begin VB.CommandButton ComConvert 
      Caption         =   "&Convert"
      Height          =   495
      Left            =   2520
      TabIndex        =   0
      Top             =   3360
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "Output channel :"
      Height          =   255
      Left            =   120
      TabIndex        =   13
      Top             =   1200
      Width           =   1215
   End
   Begin VB.Label Label5 
      Caption         =   "Conversion Counts:"
      Height          =   255
      Left            =   3000
      TabIndex        =   8
      Top             =   1200
      Width           =   1455
   End
End
Attribute VB_Name = "frmSelDev"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit



Private Sub ComConvert_Click()
Dim i As Integer, j As Integer
Dim DataSize As Long
Dim ptFAoScale As PT_FAOScale
Dim ptFAOIntStart As PT_FAOIntStart
Dim lActualBufSize As Long
Dim gpBinOutBuf As Long

    '1. Open device
    ErrCde = DRV_DeviceOpen(devicelist(ListDevice.ListIndex).dwDeviceNum, DeviceHandle)
    If (ChkErr(ErrCde)) Then
       Exit Sub
    End If
    
    '2. Make Analog output data
    '   2.1 Make wave form (in floating data format)
    giConvCount = Val(DataCounts.Text)
    ReDim fWaveBuf(giConvCount * 2)
    MakeWaveForm (giConvCount)
    
    '   2.2 Fill Record for transfering voltage to binary data
    ReDim BinOutBuf(giConvCount * 2)
    gpBinOutBuf = DRV_GetAddress(BinOutBuf(0))
   
    ptFAoScale.chan = CombOutputCh.ListIndex
    ptFAoScale.Count = giConvCount
    ptFAoScale.VoltArray = DRV_GetAddress(fWaveBuf(0))
    ptFAoScale.BinArray = gpBinOutBuf
    
    '   2.3 Transfer voltag to binary data
    ErrCde = DRV_FAOScale(DeviceHandle, ptFAoScale)
    ReDim fWaveBuf(0)
    If (ChkErr(ErrCde)) Then
       DRV_DeviceClose (DeviceHandle)
       Exit Sub
    End If
   
    '3. Start Analog output/INT transfer action
    '3.1 Fill action Record
    ptFAOIntStart.TrigSrc = TrigMode(1).value
    ptFAOIntStart.SampleRate = Val(SpeedRate.Text)
    ptFAOIntStart.chan = CombOutputCh.ListIndex
    ptFAOIntStart.Count = giConvCount
    ptFAOIntStart.buffer = gpBinOutBuf
    ptFAOIntStart.cyclic = chkCyclic.value
   
    '{3.2 Call Advantech API function to start conversio
    ErrCde = DRV_FAOIntStart(DeviceHandle, ptFAOIntStart)
    If (ChkErr(ErrCde)) Then
       DRV_DeviceClose (DeviceHandle)
       Exit Sub
    End If
    
    frmRun.Show 1   'Modal show
End Sub

Private Sub Command1_Click()
  frmSelDev.Hide
  SelectWaveform.Show
End Sub

Private Sub Command2_Click()
  End
End Sub

Private Sub Form_Load()
  Dim gnNumOfDevices As Integer
  Dim MaxEntries As Integer
  Dim nOutEntries As Integer
  Dim i, ii As Integer
  Dim tt As Long
  Dim tempStr As String
  Dim Response
  Dim tempNum As Integer
  Dim szDeviceName(0 To 15) As Byte
 
 
  MaxEntries = 9
  CombOutputCh.Clear
  
  '{Give the initialize waveform information}
  gwavOut.iType = 0          '{0: Sine, 1: Triangle, 2: Square}
  gwavOut.fMagnitude = 5
  gwavOut.fOffset = 0
  gwavOut.lPeriod = 500
 
  ' Add type of PC Laboratory Card
  tt = DRV_GetAddress(devicelist(0))
  ErrCde = DRV_DeviceGetList(tt, MaxEntries, nOutEntries)
  If (ErrCde <> 0) Then
    DRV_GetErrorMessage ErrCde, szErrMsg
    Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
    Exit Sub
  End If
  
  'Return the number of devices which you install in the system using
  'Device Installation
  ErrCde = DRV_DeviceGetNumOfList(gnNumOfDevices)
  If (ErrCde <> 0) Then
    DRV_GetErrorMessage ErrCde, szErrMsg
    Response = MsgBox(szErrMsg, vbOKOnly, "Error!!")
    Exit Sub
  End If
    
  For i = 0 To (gnNumOfDevices - 1)
    tempStr = ""
    For ii = 0 To MaxDevNameLen
      tempStr = tempStr + Chr(devicelist(i).szDeviceName(ii))
    Next ii
      ListDevice.AddItem tempStr
  Next i
  
  If gnNumOfDevices <= 0 Then
    Response = MsgBox("No Installed Device!", vbOKOnly, "Error!!")
    Exit Sub
  End If
  ListDevice.Text = ListDevice.List(0)
  ListDevice.Enabled = True
  
End Sub

Private Sub ListDevice_Click()
  Dim i, ii As Integer
  Dim nOutEntries As Integer
  Dim lpSubDeviceList As Long
  Dim dwDeviceNum As Long
        
  CombOutputCh.Clear
     
  'Open device
  dwDeviceNum = devicelist(ListDevice.ListIndex).dwDeviceNum
  ErrCde = DRV_DeviceOpen(dwDeviceNum, DeviceHandle)
  If (ChkErr(ErrCde)) Then
    Exit Sub
  End If
   
  ptDevGetFeatures.buffer = DRV_GetAddress(lpDevFeatures)
  ErrCde = DRV_DeviceGetFeatures(DeviceHandle, ptDevGetFeatures)
  If (ChkErr(ErrCde)) Then
    DRV_DeviceClose (DeviceHandle)
    Exit Sub
  End If
     
  'Add analog output channel items
  If (lpDevFeatures.usMaxAOChl > 0) Then
    For i = 0 To (lpDevFeatures.usMaxAOChl) - 1
      CombOutputCh.AddItem Str(i)
    Next i
    CombOutputCh.ListIndex = 0
  End If
     
  'After all, close selected device
  DRV_DeviceClose (DeviceHandle)
     
End Sub