form1.frm

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

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   Appearance      =   0  'Flat
   BackColor       =   &H80000004&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Advantech Diver Demo:DMA Data Transfer"
   ClientHeight    =   4155
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   4725
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4155
   ScaleWidth      =   4725
   StartUpPosition =   2  'CenterScreen
   Begin VB.Timer tmrChkStatus 
      Enabled         =   0   'False
      Left            =   3000
      Top             =   0
   End
   Begin MSComctlLib.ProgressBar prgbConv 
      Height          =   3375
      Left            =   3960
      TabIndex        =   3
      Top             =   600
      Width           =   495
      _ExtentX        =   873
      _ExtentY        =   5953
      _Version        =   393216
      Appearance      =   1
   End
   Begin VB.ListBox lstDataStatus 
      Height          =   3375
      Left            =   240
      TabIndex        =   2
      Top             =   600
      Width           =   3495
   End
   Begin VB.CommandButton cmdStatus 
      Caption         =   "Status"
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1815
      TabIndex        =   1
      Top             =   0
      Visible         =   0   'False
      Width           =   960
   End
   Begin VB.CommandButton cmdStop 
      Caption         =   "Stop"
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   840
      TabIndex        =   0
      Top             =   0
      Width           =   970
   End
   Begin VB.Label Label1 
      Caption         =   "0%"
      Height          =   255
      Left            =   3960
      TabIndex        =   4
      Top             =   240
      Width           =   615
   End
   Begin VB.Menu mnuSetting 
      Caption         =   "&Setting"
   End
   Begin VB.Menu mnuDisplay 
      Caption         =   "&Display"
   End
   Begin VB.Menu mnuRun 
      Caption         =   "&Run"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdStop_Click()
    Dim i As Long, lOverRun As Long
    Dim sTmp As String
    
    cmdStop.Enabled = False
    cmdStatus.Enabled = False
    tmrChkStatus.Enabled = False
    
    ErrCde = DRV_FAIStop(DeviceHandle)
    If ChkErr(ErrCde) <> 0 Then
        bThreadLoop = False
        Exit Sub
    End If
    gFAITransfer.ActiveBuf = 0
    gFAITransfer.DataType = gDevPar.iDataType
    gFAITransfer.start = 0
    gFAITransfer.Count = gDevPar.lConvNum
    gFAITransfer.Overrun = DRV_GetAddress(lOverRun)
    ErrCde = DRV_FAITransfer(DeviceHandle, gFAITransfer)
    If ChkErr(ErrCde) <> 0 Then
        bThreadLoop = False
        Exit Sub
    End If
    prgbConv.Enabled = False
    lstDataStatus.Enabled = True
    lstDataStatus.Clear
    For i = gDevPar.lStartPoint To gDevPar.lStopPoint
        If (gDevPar.iDataType = 1) Then         'voltage data
            sTmp = "Buffer[" & i & "] = " & Format(gTmpVolBuf(i), "#,###0.0000000")
        Else
            sTmp = "Buffer[" & i & "] = " & Hex(gTmpBuf(0))
        End If
        lstDataStatus.AddItem sTmp
    Next i
    DRV_FreeDMABuffer DeviceHandle, DRV_GetAddress(gDMABuffer)
    DRV_DeviceClose (DeviceHandle)
'    CloseHandle (ThreadHandle)
    mnuRun.Enabled = True
End Sub

Private Sub Form_Load()
    'initialize the parameter to default value
    gDevPar.bEvenEnable = 0         'disable event
    gDevPar.iCyclicMode = 0         'NonCyclicMode
    gDevPar.iDataType = 1           'Votage Data
    gDevPar.iTrigger = 0            'internal trigger
    gDevPar.lConvNum = 4000
    gDevPar.lDeviceNum = 0
    gDevPar.lPacerRate = 4000
    gDevPar.lScanChannel = 0
    gDevPar.lStartPoint = 0
    gDevPar.lStopPoint = 99
    gDevPar.lGainCode = 0
End Sub

Private Sub mnuDisplay_Click()
    frmDisp.Show vbModal
End Sub

Private Sub mnuRun_Click()
    Dim lActBufSize As Long
    Dim ptDevGetFeatures As PT_DeviceGetFeatures
    Dim DevFeature As DEVFEATURES
    Dim ptAllocDMABuf As PT_AllocateDMABuffer
    Dim ptEnableEvent As PT_EnableEvent
    Dim ptFAIDMAStart As PT_FAIDmaStart
    
    'open device
    ErrCde = DRV_DeviceOpen(gDevPar.lDeviceNum, DeviceHandle)
    If (ChkErr(ErrCde) <> 0) Then
        Exit Sub
    End If
    
    'get device feature
    ptDevGetFeatures.buffer = DRV_GetAddress(DevFeature)
    ErrCde = DRV_DeviceGetFeatures(DeviceHandle, ptDevGetFeatures)
    If (ChkErr(ErrCde) <> 0) Then
        DRV_DeviceClose DeviceHandle
        Exit Sub
    End If
    
    'Allocate DMA buffer for DMA transfer
    ptAllocDMABuf.CyclicMode = gDevPar.iCyclicMode
    ptAllocDMABuf.RequestBufSize = gDevPar.lConvNum * 2
    ptAllocDMABuf.ActualBufSize = DRV_GetAddress(lActBufSize)
    ptAllocDMABuf.buffer = DRV_GetAddress(gDMABuffer)
    ErrCde = DRV_AllocateDMABuffer(DeviceHandle, ptAllocDMABuf)
    If ChkErr(ErrCde) <> 0 Then
        DRV_DeviceClose DeviceHandle
        Exit Sub
    End If
    
    'Allocate memory for Voltage data or Raw data
    If (gDevPar.iDataType = 1) Then         'is voltage value data
        ReDim gTmpVolBuf(0 To gDevPar.lConvNum)
        gFAITransfer.DataBuffer = DRV_GetAddress(gTmpVolBuf(0))
    Else                                    'raw data
        ReDim gTmpBuf(0 To gDevPar.lConvNum)
        gFAITransfer.DataBuffer = DRV_GetAddress(gTmpBuf(0))
    End If
    
    'Enable event feature
    ptEnableEvent.EventType = ADS_EVT_INTERRUPT Or ADS_EVT_BUFCHANGE Or ADS_EVT_TERMINATED Or ADS_EVT_OVERRUN
    ptEnableEvent.Enabled = gDevPar.bEvenEnable
    ptEnableEvent.Count = 512
    ErrCde = DRV_EnableEvent(DeviceHandle, ptEnableEvent)
    If ChkErr(ErrCde) <> 0 Then
        DRV_FreeDMABuffer DeviceHandle, DRV_GetAddress(gDMABuffer)
        DRV_DeviceClose (DeviceHandle)
        Exit Sub
    End If
    
    'Start DMA transfer
    ptFAIDMAStart.TrigSrc = gDevPar.iTrigger
    ptFAIDMAStart.SampleRate = gDevPar.lPacerRate
    ptFAIDMAStart.chan = gDevPar.lScanChannel
    ptFAIDMAStart.Count = gDevPar.lConvNum
    ptFAIDMAStart.buffer = gDMABuffer
    ptFAIDMAStart.gain = DevFeature.glGainList(gDevPar.lGainCode).usGainCde
    ErrCde = DRV_FAIDmaStart(DeviceHandle, ptFAIDMAStart)
    If ChkErr(ErrCde) <> 0 Then
        DRV_FreeDMABuffer DeviceHandle, DRV_GetAddress(gDMABuffer)
        DRV_DeviceClose (DeviceHandle)
        Exit Sub
    End If
        
    tmrChkStatus.Interval = 50
    tmrChkStatus.Enabled = True
    mnuRun.Enabled = False
    cmdStop.Enabled = True
    'cmdStatus.Enabled = True
    prgbConv.Max = gDevPar.lConvNum
    prgbConv.Enabled = True
End Sub

Private Sub mnuSetting_Click()
    frmSetting.Show vbModal
End Sub

Private Sub tmrChkStatus_Timer()
    Dim lActiveBuf As Long, lStopped As Long, iRetrieved As Integer
    Dim lOverRun As Long, lHalfReady As Long
    Dim ptFAICheck As PT_FAICheck
    
    ptFAICheck.ActiveBuf = DRV_GetAddress(lActiveBuf)
    ptFAICheck.stopped = DRV_GetAddress(lStopped)
    ptFAICheck.retrieved = DRV_GetAddress(iRetrieved)
    ptFAICheck.Overrun = DRV_GetAddress(lOverRun)
    ptFAICheck.HalfReady = DRV_GetAddress(lHalfReady)
    ErrCde = DRV_FAICheck(DeviceHandle, ptFAICheck)
    If ChkErr(ErrCde) <> 0 Then
        Exit Sub
    End If
    
    If (iRetrieved = 0) Then
        iRetrieved = 1
    End If
    prgbConv.value = iRetrieved
    If (iRetrieved = gDevPar.lConvNum) Then
        Label1.Caption = "100%"
        cmdStop_Click
        Exit Sub
    End If
    Label1.Caption = Str(Format((prgbConv.value * 100 / prgbConv.Max), 0)) & "%"
End Sub