📄 datadisp.frm
字号:
VERSION 5.00
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Begin VB.Form frmDataDisp
Caption = "Advantech Demo: Data display"
ClientHeight = 2490
ClientLeft = 3855
ClientTop = 2400
ClientWidth = 2685
LinkTopic = "Form2"
PaletteMode = 1 'UseZOrder
ScaleHeight = 2490
ScaleWidth = 2685
Begin TabDlg.SSTab SSTab1
Height = 2415
Left = 0
TabIndex = 0
Top = 120
Width = 2775
_ExtentX = 4895
_ExtentY = 4260
_Version = 393216
Style = 1
Tabs = 2
Tab = 1
TabHeight = 520
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
TabCaption(0) = "Buffer &A"
TabPicture(0) = "Datadisp.frx":0000
Tab(0).ControlEnabled= 0 'False
Tab(0).Control(0)= "ListBufferA"
Tab(0).ControlCount= 1
TabCaption(1) = "Buffer &B"
TabPicture(1) = "Datadisp.frx":001C
Tab(1).ControlEnabled= -1 'True
Tab(1).Control(0)= "ListBufferB"
Tab(1).Control(0).Enabled= 0 'False
Tab(1).ControlCount= 1
Begin VB.ListBox ListBufferB
Height = 2010
Left = 0
TabIndex = 2
Top = 360
Width = 2655
End
Begin VB.ListBox ListBufferA
Height = 2010
ItemData = "Datadisp.frx":0038
Left = -75000
List = "Datadisp.frx":003F
TabIndex = 1
Top = 360
Width = 2655
End
End
End
Attribute VB_Name = "frmDataDisp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
Dim i As Integer
Dim ptFAIData As PT_FAITransfer
Dim sDataBuffer() As Single
Dim iDataBuffer() As Integer
Dim lOverrun As Long
Dim ptFAIWatchDogCheck As PT_FAIWatchdogCheck
Dim iWhichBuf As Integer
Dim iTriggered As Integer
Dim iTrigChan As Integer
Dim lTrigIndex As Long
Dim fTrigData As Single
Dim lRawData As Long
'Stop Timer action
frmRun.FAIChkTmr.Enabled = False
'Stop AI conversion
ErrCde = DRV_FAITerminate(DeviceHandle)
If (ChkErr(ErrCde) = 1) Then
DRV_DeviceClose (DeviceHandle)
Exit Sub
End If
'Get the AI conversion data
ptFAIData.ActiveBuf = 0 'only one buffer
ptFAIData.Overrun = DRV_GetAddress(lOverrun)
ptFAIData.Count = Val(frmSelDev.DataCounts.Text)
ptFAIData.start = 0 '{Start from buffer begging}
ptFAIData.DataType = frmSelDev.chkFloatData.value
'If want floating data
If (ptFAIData.DataType) = 1 Then
ReDim sDataBuffer(ptFAIData.Count)
ptFAIData.DataBuffer = DRV_GetAddress(sDataBuffer(0))
'Else need Raw data
Else
ReDim iDataBuffer(ptFAIData.Count)
ptFAIData.DataBuffer = DRV_GetAddress(iDataBuffer(0))
End If
' Read buffer A data
ErrCde = DRV_FAITransfer(DeviceHandle, ptFAIData)
If (ChkErr(ErrCde) = 1) Then
ReDim sDataBuffer(0)
ReDim iDataBuffer(0)
DRV_DeviceClose (DeviceHandle)
Exit Sub
End If
'Save data to data show screen
frmDataDisp.ListBufferA.Clear
frmDataDisp.ListBufferB.Clear
For i = 0 To ptFAIData.Count - 1
If ptFAIData.DataType = 1 Then
'Converting to Floating data
frmDataDisp.ListBufferA.AddItem Str(i) + ":" + Format(sDataBuffer(i), "#,##0.000000000")
Else
'Convert to Hex data
frmDataDisp.ListBufferA.AddItem Str(i) + ":" + Hex(iDataBuffer(i))
End If
Next i
'Read buffer B data
ptFAIData.ActiveBuf = 1 'only one buffer
ErrCde = DRV_FAITransfer(DeviceHandle, ptFAIData)
If (ChkErr(ErrCde) = 1) Then
ReDim sDataBuffer(0)
ReDim iDataBuffer(0)
DRV_DeviceClose (DeviceHandle)
Exit Sub
End If
'Save data to data show screen
For i = 0 To ptFAIData.Count - 1
If ptFAIData.DataType = 1 Then
'Converting to Floating data
frmDataDisp.ListBufferB.AddItem Str(i) + ":" + Format(sDataBuffer(i), "#,##0.000000000")
Else
'Convert to Hex data
frmDataDisp.ListBufferB.AddItem Str(i) + ":" + Hex(iDataBuffer(i))
End If
Next i
'Free data buffer
ReDim sDataBuffer(0)
ReDim iDataBuffer(0)
ErrCde = DRV_FreeDMABuffer(DeviceHandle, DRV_GetAddress(lDmaBufPtr))
ErrCde = ChkErr(ErrCde)
'Close device
DRV_DeviceClose (DeviceHandle)
frmSelDev.Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
frmSelDev.SetFocus
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -