datadisp.frm

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

VERSION 5.00
Begin VB.Form frmDataDisp 
   Caption         =   "Advantech Demo: Data display"
   ClientHeight    =   4050
   ClientLeft      =   3195
   ClientTop       =   2025
   ClientWidth     =   3495
   LinkTopic       =   "Form2"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4050
   ScaleWidth      =   3495
   Begin VB.ListBox DataList 
      Height          =   3765
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3255
   End
   Begin VB.Menu file 
      Caption         =   "&File"
      Begin VB.Menu ExitDisp 
         Caption         =   "E&xit"
      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 ExitDisp_Click()
  Unload frmDataDisp
  frmSelDev.Show
End Sub

Private Sub Form_Load()
Dim i As Integer
Dim ptFAIData As PT_FAITransfer
Dim sDataBuffer() As Single
Dim iDataBuffer() As Integer
  
  'Stop Timer action
  frmRun.FAIChkTmr.Enabled = False

 'Stop AI conversion
  ErrCde = DRV_FAIStop(DeviceHandle)
  If (ChkErr(ErrCde) = 1) Then
    ErrCde = DRV_FreeDMABuffer(DeviceHandle, DRV_GetAddress(lDmaBufPtr))
    DRV_DeviceClose (DeviceHandle)
    Exit Sub
  End If

  'Get the AI conversion data
  ptFAIData.Overrun = DRV_GetAddress(wOverrun)
  ptFAIData.Count = ptAiStart.Count
  ptFAIData.start = 0                    'Start from buffer begging
  ptFAIData.DataType = frmSelDev.chkFloatData.value
  ptFAIData.ActiveBuf = 0                'Single buffer

  '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
     
  ErrCde = DRV_FAITransfer(DeviceHandle, ptFAIData)
  If (ChkErr(ErrCde) = 1) Then
    ReDim sDataBuffer(0)
    ReDim iDataBuffer(0)
    ErrCde = DRV_FreeDMABuffer(DeviceHandle, DRV_GetAddress(lDmaBufPtr))
    DRV_DeviceClose (DeviceHandle)
    Exit Sub
  End If

  'Save data to data show screen
  frmDataDisp.DataList.Clear

  For i = 0 To ptFAIData.Count - 1
    If ptFAIData.DataType = 1 Then
      'Converting to Floating data
      frmDataDisp.DataList.AddItem Format(sDataBuffer(i), "#,##0.000000000")
    
    Else
      'Convert to Hex data
      frmDataDisp.DataList.AddItem Hex(iDataBuffer(i))
    End If
  Next i

  '{Free data buffer
  ReDim sDataBuffer(0)
  ReDim iDataBuffer(0)
  ErrCde = DRV_FreeDMABuffer(DeviceHandle, DRV_GetAddress(lDmaBufPtr))
  If (ChkErr(ErrCde) = 1) Then
    DRV_DeviceClose (DeviceHandle)
    End
  End If

  'Close device
  DRV_DeviceClose (DeviceHandle)
    
End Sub
Private Sub Form_Unload(Cancel As Integer)
  Unload frmDataDisp
  frmSelDev.Show
End Sub