aodma1.frm
来自「16 relay output channels and 16 isolated」· FRM 代码 · 共 375 行
FRM
375 行
VERSION 5.00
Begin VB.Form frmSelDev
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "Advantech Demo: Device selection for AO/DMA transfer"
ClientHeight = 4080
ClientLeft = 2310
ClientTop = 1560
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 = 15
Top = 1560
Width = 2655
Begin VB.CommandButton Command1
Caption = "&Change..."
Height = 375
Left = 1680
TabIndex = 19
Top = 960
Width = 855
End
Begin VB.CheckBox chkCyclic
Caption = "Cyclic output data"
Height = 375
Left = 120
TabIndex = 16
Top = 240
Width = 2055
End
Begin VB.Label labWaveform
Caption = "Sine,500pt."
Height = 255
Left = 120
TabIndex = 18
Top = 1080
Width = 1215
End
Begin VB.Label Label2
Caption = "Selected waveform:"
Height = 255
Left = 120
TabIndex = 17
Top = 840
Width = 1575
End
End
Begin VB.ComboBox CombOutputCh
Height = 315
ItemData = "AoDma1.frx":0000
Left = 1440
List = "AoDma1.frx":0007
Style = 2 'Dropdown List
TabIndex = 13
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 = 12
Top = 240
Width = 2775
End
Begin VB.CommandButton cmdDevChange
Caption = "&Change"
Height = 375
Left = 3840
TabIndex = 11
Top = 240
Visible = 0 'False
Width = 1095
End
End
Begin VB.TextBox DataCounts
Height = 285
Left = 4440
TabIndex = 9
Text = "4000"
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 = "2000"
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 = 14
Top = 1080
Width = 1215
End
Begin VB.Label Label5
Caption = "Conversion Counts:"
Height = 375
Left = 3000
TabIndex = 8
Top = 1080
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 ptFAODmaStart As PT_FAODmaStart
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.Allocate DMA bnuffer for DMA transfering
' 2.1 Fill paramater for calling DRV_AllocateDMABuffer
giConvCount = Val(DataCounts.Text)
ptDmaBuffer.CyclicMode = chkCyclic.value
ptDmaBuffer.RequestBufSize = giConvCount * 2
ptDmaBuffer.ActualBufSize = DRV_GetAddress(lActualBufSize) '{return acture allocated buffer size}
ptDmaBuffer.buffer = DRV_GetAddress(glDmaBufPtr)
' 2.2 Call API function to allocate DMA buffer.
ErrCde = DRV_AllocateDMABuffer(DeviceHandle, ptDmaBuffer)
If (ChkErr(ErrCde)) Then
DRV_DeviceClose (DeviceHandle)
Exit Sub
End If
'3. Make Analog output data
' 3.1 Make wave form (in floating data format)
ReDim fWaveBuf(giConvCount * 2)
MakeWaveForm (giConvCount)
' 3.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
' 3.3 Transfer voltag to binary data
ErrCde = DRV_FAOScale(DeviceHandle, ptFAoScale)
ReDim fWaveBuf(0)
If (ChkErr(ErrCde) = 1) Then
ErrCde = DRV_FreeDMABuffer(DeviceHandle, DRV_GetAddress(glDmaBufPtr))
DRV_DeviceClose (DeviceHandle)
Exit Sub
End If
'4. Start Analog output/DMA transfer action
'4.1 Fill action Record
ptFAODmaStart.TrigSrc = TrigMode(1).value
ptFAODmaStart.SampleRate = Val(SpeedRate.Text)
ptFAODmaStart.chan = CombOutputCh.ListIndex
ptFAODmaStart.Count = giConvCount
ptFAODmaStart.buffer = gpBinOutBuf
'4.2 Call Advantech API function to start conversion
ErrCde = DRV_FAODmaStart(DeviceHandle, ptFAODmaStart)
If (ChkErr(ErrCde)) Then
ErrCde = DRV_FreeDMABuffer(DeviceHandle, DRV_GetAddress(glDmaBufPtr))
DRV_DeviceClose (DeviceHandle)
Exit Sub
End If
frmRun.Show 1
End Sub
Private Sub Command1_Click()
SelectWaveform.Show 1
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
'Get device features and configurations
ptDevGetFeatures.buffer = DRV_GetAddress(lpDevFeatures)
ErrCde = DRV_DeviceGetFeatures(DeviceHandle, ptDevGetFeatures)
If (ChkErr(ErrCde)) Then
ErrCde = DRV_FAOTerminate(DeviceHandle)
Exit Sub
End If
'Add analog output channel item
If (lpDevFeatures.usMaxAOChl > 0) Then
For i = 0 To (lpDevFeatures.usMaxAOChl) - 1
CombOutputCh.AddItem Str(i)
Next i
CombOutputCh.ListIndex = 0
End If
'Close device
DRV_DeviceClose (DeviceHandle)
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?