addma1.frm

来自「16 relay output channels and 16 isolated」· FRM 代码 · 共 692 行 · 第 1/2 页

      Height          =   495
      Left            =   7560
      TabIndex        =   3
      Top             =   3360
      Width           =   1335
   End
   Begin VB.CommandButton ComConvert 
      Caption         =   "&Convert"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   6120
      TabIndex        =   2
      Top             =   3360
      Width           =   1335
   End
   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          =   1260
      Left            =   120
      TabIndex        =   1
      Top             =   240
      Width           =   3015
   End
   Begin VB.Label Label6 
      Caption         =   "NOTE : Data Counts must be multiple of                     Channel count"
      Height          =   375
      Left            =   6120
      TabIndex        =   24
      Top             =   1680
      Width           =   3015
   End
   Begin VB.Label Label5 
      Caption         =   "Data Counts:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   6360
      TabIndex        =   22
      Top             =   2400
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "Device:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   0
      Width           =   1095
   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 ChkGainCde_Click()

  ErrCde = GainCodeFilling()
  If (ChkGainCde) Then
    ComGainList.Enabled = False
    ListGain.Enabled = True
  Else
    ComGainList.Enabled = True
    ListGain.Enabled = False
  End If
  
End Sub


Private Sub CombChCount_Click()
  ErrCde = GainCodeFilling()
End Sub

Private Sub CombChCount_GotFocus()
  frmSelDev.Refresh
End Sub


Private Sub CombChCount_LostFocus()
  frmSelDev.Refresh
End Sub


Private Sub CombStartCh_Click()
Dim tempNum As Integer
Dim i As Integer
Dim temp As String
Dim OldChCount As Integer
     
  ' Add analog input channel item
  OldChCount = Val(CombChCount.Text)
  CombChCount.Clear
     
  If (lpDEVCONFIG_AI.ulChanConfig = 0) Then
    tempNum = lpDevFeatures.usMaxAISiglChl
  Else
    tempNum = lpDevFeatures.usMaxAIDiffChl
  End If
     
  'If (tempNum > 0) Then
  For i = 1 To tempNum - Val(CombStartCh.Text)
    CombChCount.AddItem Str(i)
  Next i
  
  CombChCount.Text = CombChCount.List(0)
  CombChCount.Enabled = True
End Sub



Private Sub ComConvert_Click()
Dim ptEnableEvent As PT_EnableEvent
Dim i As Integer, j As Integer
Dim DataSize As Long

  '1. Open device
  ErrCde = DRV_DeviceOpen(devicelist(ListDevice.ListIndex).dwDeviceNum, DeviceHandle)
  If (ChkErr(ErrCde)) Then
    Exit Sub
  End If
    
  '2. Allocate DMA buffer
  ptDmaBuffer.CyclicMode = chkCyclic.value
  If (Val(DataCounts.Text) * 2 < 4096) Then
    ptDmaBuffer.RequestBufSize = 4096
  Else
    ptDmaBuffer.RequestBufSize = Val(DataCounts.Text) * 2
  End If
  ptDmaBuffer.ActualBufSize = DRV_GetAddress(lActualBufSize)
  ptDmaBuffer.buffer = DRV_GetAddress(lDmaBufPtr)
    
  ErrCde = DRV_AllocateDMABuffer(DeviceHandle, ptDmaBuffer)
  If (ChkErr(ErrCde)) Then
    DRV_DeviceClose (DeviceHandle)
    Exit Sub
  End If

  '3. Disable event
  ptEnableEvent.EventType = 0
  ptEnableEvent.Count = 512
  ptEnableEvent.Enabled = False
  ErrCde = DRV_EnableEvent(DeviceHandle, ptEnableEvent)
  If (ChkErr(ErrCde)) Then
    ErrCde = DRV_FreeDMABuffer(DeviceHandle, DRV_GetAddress(lDmaBufPtr))
    DRV_DeviceClose (DeviceHandle)
    Exit Sub
  End If
  
  '4. Set gain list
  j = Val(CombStartCh.Text)
  For i = 0 To Val(CombChCount.Text) - 1
    wGainCode(i) = lpDevFeatures.glGainList(iGainIndex(j)).usGainCde
    j = j + 1
  Next i
    
  '5. Start AI interrupt funciton
  '5.1 Fill element of PT_FAIIntScanStart
  ptAiStart.TrigSrc = TrigMode(1).value                'Ext trig mode
  ptAiStart.SampleRate = Val(SpeedRate.Text)
  ptAiStart.NumChans = Val(CombChCount.Text)
  ptAiStart.StartChan = Val(CombStartCh.Text)
  ptAiStart.GainList = DRV_GetAddress(wGainCode(0))
  ptAiStart.Count = Val(DataCounts.Text)
  ptAiStart.buffer = lDmaBufPtr

  '5.2 Call advantech API function DRV_FAIIntScanStart
  ErrCde = DRV_FAIDmaScanStart(DeviceHandle, ptAiStart)
  If (ChkErr(ErrCde)) Then
    ErrCde = DRV_FreeDMABuffer(DeviceHandle, DRV_GetAddress(lDmaBufPtr))
    ErrCde = DRV_DeviceClose(DeviceHandle)
    Exit Sub
  End If
    
  'Enter getting conversion stauts
  frmRun.Show
  frmSelDev.Hide
End Sub

Private Sub ComGainList_Click()
  frmGainCdeSet.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 lpDEVCONFIG_AI As DEVCONFIG_AI
 
 
  MaxEntries = 9
 
  ' 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
  ListDevice.Text = ListDevice.List(0)
  ListDevice.Enabled = True
         
End Sub



Private Sub ListDevice_Click()
  Dim i, ii As Integer
  Dim tempNum As Integer
  Dim TestRes As Boolean
  Dim tempStr As String
  Dim nOutEntries As Integer
  Dim lpSubDeviceList As Long
  Dim dwDeviceNum As Long
  Dim temp As String
        
  For i = 0 To 15
    iGainIndex(i) = 0
  Next i
     
  '1. Open Device
  ListGain.Clear
  dwDeviceNum = devicelist(ListDevice.ListIndex).dwDeviceNum
  ErrCde = DRV_DeviceOpen(dwDeviceNum, DeviceHandle)
  If (ChkErr(ErrCde)) Then
    Exit Sub
  End If
    
  '2. Get device's information
  '2.1 Get device features and configurations
  ptDevGetFeatures.buffer = DRV_GetAddress(lpDevFeatures)
  ErrCde = DRV_DeviceGetFeatures(DeviceHandle, ptDevGetFeatures)
  If (ChkErr(ErrCde)) Then
    Exit Sub
  End If
      
  ptAIGetConfig.buffer = DRV_GetAddress(lpDEVCONFIG_AI)
  ErrCde = DRV_AIGetConfig(DeviceHandle, ptAIGetConfig)
  If (ChkErr(ErrCde)) Then
    Exit Sub
  End If
     
  '2.2 Add Gain code selection items
  tempNum = lpDevFeatures.usNumGain
  If (lpDevFeatures.usNumGain > 0) Then
    For i = 0 To (lpDevFeatures.usNumGain - 1)
      tempStr = ""
      For ii = 0 To 15
        tempStr = tempStr + Chr(lpDevFeatures.glGainList(i).szGainStr(ii))
      Next ii
      ListGain.AddItem tempStr
    Next i
  End If
  ListGain.Text = ListGain.List(0)
     
  '2.3 Add analog input channel items
  CombStartCh.Clear
  If (lpDEVCONFIG_AI.ulChanConfig = 0) Then
    tempNum = lpDevFeatures.usMaxAISiglChl
  Else
    tempNum = lpDevFeatures.usMaxAIDiffChl
  End If
     
  If (tempNum > 0) Then
    For i = 0 To (tempNum - 1)
      temp = Str(i)
      CombStartCh.AddItem temp
    Next i
    CombStartCh.Text = CombStartCh.List(0)
    CombStartCh.Enabled = True
  End If
      
  '3. Close device
  DRV_DeviceClose (DeviceHandle)
      
End Sub

Private Sub ListGain_Click()
  ErrCde = GainCodeFilling()
End Sub