util7248.frm

凌华工控控制卡PCI-7248使用例子

      Caption         =   "Ch2"
      ForeColor       =   &H00FF0000&
      Height          =   195
      Index           =   1
      Left            =   180
      TabIndex        =   5
      Top             =   1050
      Width           =   375
   End
   Begin VB.Shape Shape3 
      BackColor       =   &H00C0C0C0&
      FillColor       =   &H00C0C0C0&
      FillStyle       =   0  'Solid
      Height          =   1335
      Left            =   120
      Top             =   230
      Width           =   495
   End
   Begin VB.Image doa_1 
      Appearance      =   0  'Flat
      Height          =   180
      Left            =   780
      Picture         =   "UTIL7248.frx":3B88
      Top             =   4680
      Visible         =   0   'False
      Width           =   180
   End
   Begin VB.Image do_0 
      Appearance      =   0  'Flat
      Height          =   180
      Left            =   480
      Picture         =   "UTIL7248.frx":3C6A
      Top             =   4680
      Visible         =   0   'False
      Width           =   180
   End
   Begin VB.Image dia_1 
      Appearance      =   0  'Flat
      Height          =   180
      Left            =   780
      Picture         =   "UTIL7248.frx":3D4C
      Top             =   4500
      Visible         =   0   'False
      Width           =   180
   End
   Begin VB.Image di_0 
      Appearance      =   0  'Flat
      Height          =   180
      Left            =   480
      Picture         =   "UTIL7248.frx":3E2E
      Top             =   4500
      Visible         =   0   'False
      Width           =   180
   End
   Begin VB.Menu mnuExit 
      Caption         =   "E&xit!"
   End
End
Attribute VB_Name = "uti48dio"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Const INPUT_COLOR = &HFF00FF
Const OUTPUT_COLOR = &HFF0000

Dim value_a(0 To 1) As Long, value_b(0 To 1) As Long, value_cu(0 To 1) As Long, value_cl(0 To 1) As Long
Dim status_a(0 To 1) As Integer, status_b(0 To 1) As Integer, status_cu(0 To 1) As Long, status_cl(0 To 1) As Integer

Private Sub bit_a_Click(Index As Integer)
  Dim Channel As Integer
  Dim bit As Integer
  Dim result As Integer
  Channel = Int(Index / 8)
  bit = Index Mod 8
  If status_a(Channel) = OUTPUT_PORT Then
    If (Int((value_a(Channel) / (2 ^ bit))) Mod 2) = 1 Then
      bit_a(Index) = do_0
      value_a(Channel) = value_a(Channel) - (2 ^ bit)
    Else  'bit is 0
      bit_a(Index) = doa_1
      value_a(Channel) = value_a(Channel) + (2 ^ bit)
    End If
    'result = W_7248_DO(0, Channel * 5 + Channel_P1A, value_a(Channel))
    result = DO_WritePort(card, Channel * 5 + Channel_P1A, value_a(Channel))
  End If
End Sub

Private Sub bit_b_Click(Index As Integer)
  Dim Channel As Integer
  Dim bit As Integer
  Dim result As Integer
  Channel = Int(Index / 8)
  bit = Index Mod 8
  If status_b(Channel) = OUTPUT_PORT Then
    If (Int((value_b(Channel) / (2 ^ bit))) Mod 2) = 1 Then
      bit_b(Index) = do_0
      value_b(Channel) = value_b(Channel) - (2 ^ bit)
    Else  'bit is 0
      bit_b(Index) = dob_1
      value_b(Channel) = value_b(Channel) + (2 ^ bit)
    End If
    'result = W_7248_DO(0, Channel * 5 + Channel_P1B, value_b(Channel))
    result = DO_WritePort(card, Channel * 5 + Channel_P1B, value_b(Channel))
  End If
End Sub

Private Sub bit_cl_Click(Index As Integer)
  Dim Channel As Integer
  Dim bit As Integer
  Dim result As Integer
  Channel = Int(Index / 4)
  bit = Index Mod 4
  If status_cl(Channel) = OUTPUT_PORT Then
    If (Int((value_cl(Channel) / (2 ^ bit))) Mod 2) = 1 Then
      bit_cl(Index) = do_0
      value_cl(Channel) = value_cl(Channel) - (2 ^ bit)
    Else  'bit is 0
      bit_cl(Index) = doc_1
      value_cl(Channel) = value_cl(Channel) + (2 ^ bit)
    End If
    'result = W_7248_DO(0, Channel * 5 + Channel_P1CL, value_cl(Channel))
    result = DO_WritePort(card, Channel * 5 + Channel_P1CL, value_cl(Channel))
  End If
End Sub

Private Sub bit_cu_Click(Index As Integer)
  Dim Channel As Integer
  Dim bit As Integer
  Dim result As Integer
  Channel = Int(Index / 4)
  bit = Index Mod 4
  If status_cu(Channel) = OUTPUT_PORT Then
    If (Int((value_cu(Channel) / (2 ^ bit))) Mod 2) = 1 Then
      bit_cu(Index) = do_0
      value_cu(Channel) = value_cu(Channel) - (2 ^ bit)
    Else  'bit is 0
      bit_cu(Index) = doc_1
      value_cu(Channel) = value_cu(Channel) + (2 ^ bit)
    End If
    'result = W_7248_DO(0, Channel * 5 + Channel_P1CH, value_cu(Channel))
    result = DO_WritePort(card, Channel * 5 + Channel_P1CH, value_cu(Channel))
  End If
End Sub

Private Sub Card_Initial()
  Dim i As Integer, j As Integer
  Dim result As Integer
  
  For i = 0 To 1  'Initial status is Output for all channels
    result = DIO_PortConfig(card, i * 5 + Channel_P1A, OUTPUT_PORT)
    Shape_a(i).FillColor = OUTPUT_COLOR
    status_a(i) = OUTPUT_PORT
    For j = 0 To 7
      bit_a(i * 8 + j) = doa_1
    Next j
    value_a(i) = &HFF
    result = DO_WritePort(card, i * 5 + Channel_P1A, value_a(i))

    result = DIO_PortConfig(card, i * 5 + Channel_P1B, OUTPUT_PORT)
    Shape_b(i).FillColor = OUTPUT_COLOR
    status_b(i) = OUTPUT_PORT
    For j = 0 To 7
      bit_b(i * 8 + j) = dob_1
    Next j
    value_b(i) = &HFF
    result = DO_WritePort(card, i * 5 + Channel_P1B, value_b(i))

    result = DIO_PortConfig(card, i * 5 + Channel_P1CH, OUTPUT_PORT)
    Shape_cu(i).FillColor = OUTPUT_COLOR
    status_cu(i) = OUTPUT_PORT
    For j = 0 To 3
      bit_cu(i * 4 + j) = doc_1
    Next j
    value_cu(i) = &HF
    result = DO_WritePort(card, i * 5 + Channel_P1CH, value_cu(i))

    result = DIO_PortConfig(card, i * 5 + Channel_P1CL, OUTPUT_PORT)
    Shape_cl(i).FillColor = OUTPUT_COLOR
    status_cl(i) = OUTPUT_PORT
    For j = 0 To 3
      bit_cl(i * 4 + j) = doc_1
    Next j
    value_cl(i) = &HF
    result = DO_WritePort(card, i * 5 + Channel_P1CL, value_cl(i))
  Next i
End Sub

Private Sub Form_Load()
  SettingForm.Show 1
  If card < 0 Then
     MsgBox "Register Card Failed"
     End
  End If
  Card_Initial
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Dim result As Integer
    If card >= 0 Then
        result = Release_Card(card)
    End If
  End
End Sub


Private Sub input_a_Click(Index As Integer)
    Dim result As Integer
    Shape_a(Index).FillColor = INPUT_COLOR
    InputAndShow Index, Channel_P1A
    status_a(Index) = INPUT_PORT
    'result = W_7248_Config_Port(0, Index * 5 + Channel_P1A, INPUT_PORT)
    result = DIO_PortConfig(card, Index * 5 + Channel_P1A, INPUT_PORT)
End Sub

Private Sub input_b_Click(Index As Integer)
    Dim result As Integer
    Shape_b(Index).FillColor = INPUT_COLOR
    InputAndShow Index, Channel_P1B
    status_b(Index) = INPUT_PORT
    'result = W_7248_Config_Port(0, Index * 5 + Channel_P1B, INPUT_PORT)
    result = DIO_PortConfig(card, Index * 5 + Channel_P1B, INPUT_PORT)
End Sub

Private Sub input_cl_Click(Index As Integer)
    Dim result As Integer
    Shape_cl(Index).FillColor = INPUT_COLOR
    InputAndShow Index, Channel_P1CL
    status_cl(Index) = INPUT_PORT
    'result = W_7248_Config_Port(0, Index * 5 + Channel_P1CL, INPUT_PORT)
    result = DIO_PortConfig(card, Index * 5 + Channel_P1CL, INPUT_PORT)
End Sub

Private Sub input_cu_Click(Index As Integer)
    Dim result As Integer
    Shape_cu(Index).FillColor = INPUT_COLOR
    InputAndShow Index, Channel_P1CH
    status_cu(Index) = INPUT_PORT
    result = DIO_PortConfig(card, Index * 5 + Channel_P1CH, INPUT_PORT)
End Sub

Private Sub InputAndShow(ByVal Channel As Integer, ByVal Port As Integer)
  Dim databyte As Long
  Dim result As Integer
  Dim i As Integer, k As Integer
  Dim p As Integer, q As Integer, r As Integer
  result = DI_ReadPort(card, Channel * 5 + Port, databyte)
  p = databyte
  Select Case Port
  Case Channel_P1A
    k = Channel * 8
    For i = k To k + 7
      r = p Mod 2
      If r = 0 Then
        bit_a(i) = di_0
      Else    'r = 1
        bit_a(i) = dia_1
      End If
      p = Int(p / 2)
    Next
    value_a(Channel) = databyte
  Case Channel_P1B
    k = Channel * 8
    For i = k To k + 7
      r = p Mod 2
      If r = 0 Then
        bit_b(i) = di_0
      Else    'r = 1
        bit_b(i) = dib_1
      End If
      p = Int(p / 2)
    Next
    value_b(Channel) = databyte
  Case Channel_P1CH
    k = Channel * 4
    For i = k To k + 3
      r = p Mod 2
      If r = 0 Then
        bit_cu(i) = di_0
      Else    'r = 1
        bit_cu(i) = dic_1
      End If
      p = Int(p / 2)
    Next
    value_cu(Channel) = databyte
  Case Channel_P1CL
    k = Channel * 4
    For i = k To k + 3
      r = p Mod 2
      If r = 0 Then
        bit_cl(i) = di_0
      Else    'r = 1
        bit_cl(i) = dic_1
      End If
      p = Int(p / 2)
    Next
    value_cl(Channel) = databyte
'  Case PORTC
'    q = 0
'    k = channel * 8
'    For i = k To k + 3
'      r = p Mod 2
'      If r = 0 Then
'        bit_cl(i) = di_0
'      Else    'r = 1
'        bit_cl(i) = dic_1
'      End If
'      q = q + bit_cl(i) * 2 ^ (i - k)
'      p = Int(p / 2)
'    Next
'    value_cl(channel) = q
'    value_cu(channel) = p
'    For i = k To k + 3
'      If r = 0 Then
'        bit_cu(i) = di_0
'      Else    'r = 1
'        bit_cu(i) = dic_1
'      End If
'      p = Int(p / 2)
'    Next
 End Select
End Sub

Private Sub mnuExit_Click()
  Dim result As Integer
    If card >= 0 Then
        result = Release_Card(card)
    End If
  End
End Sub

Private Sub output_a_Click(Index As Integer)
  Dim i As Integer, k As Integer
  Shape_a(Index).FillColor = OUTPUT_COLOR
  value_a(Index) = &HFF
  k = Index * 8
  For i = k To k + 7
    bit_a(i) = doa_1
  Next
  'k = W_7248_Config_Port(0, Index * 5 + Channel_P1A, OUTPUT_PORT)
  k = DIO_PortConfig(card, Index * 5 + Channel_P1A, OUTPUT_PORT)
  'k = W_7248_DO(0, Index * 5 + Channel_P1A, &HFF)
  k = DO_WritePort(card, Index * 5 + Channel_P1A, &HFF)
  status_a(Index) = OUTPUT_PORT
End Sub

Private Sub output_b_Click(Index As Integer)
  Dim i As Integer, k As Integer
  Shape_b(Index).FillColor = OUTPUT_COLOR
  value_b(Index) = &HFF
  k = Index * 8
  For i = k To k + 7
    bit_b(i) = dob_1
  Next
  'k = W_7248_Config_Port(0, Index * 5 + Channel_P1B, OUTPUT_PORT)
  k = DIO_PortConfig(card, Index * 5 + Channel_P1B, OUTPUT_PORT)
  'k = W_7248_DO(0, Index * 5 + Channel_P1B, &HFF)
  k = DO_WritePort(card, Index * 5 + Channel_P1B, &HFF)
  status_b(Index) = OUTPUT_PORT
End Sub

Private Sub output_cl_Click(Index As Integer)
  Dim i As Integer, k As Integer
  Shape_cl(Index).FillColor = OUTPUT_COLOR
  value_cl(Index) = &HF
  k = Index * 4
  For i = k To k + 3
    bit_cl(i) = doc_1
  Next
  'k = W_7248_Config_Port(0, Index * 5 + Channel_P1CL, OUTPUT_PORT)
  k = DIO_PortConfig(card, Index * 5 + Channel_P1CL, OUTPUT_PORT)
  'k = W_7248_DO(0, Index * 5 + Channel_P1CL, &HF)
  k = DO_WritePort(card, Index * 5 + Channel_P1CL, &HF)
  status_cl(Index) = OUTPUT_PORT
End Sub

Private Sub output_cu_Click(Index As Integer)
  Dim i As Integer, k As Integer
  Shape_cu(Index).FillColor = OUTPUT_COLOR
  value_cu(Index) = &HF
  k = Index * 4
  For i = k To k + 3
    bit_cu(i) = doc_1
  Next
  'k = W_7248_Config_Port(0, Index * 5 + Channel_P1CH, OUTPUT_PORT)
  k = DIO_PortConfig(card, Index * 5 + Channel_P1CH, OUTPUT_PORT)
  'k = W_7248_DO(0, Index * 5 + Channel_P1CH, &HF)
  k = DO_WritePort(card, Index * 5 + Channel_P1CH, &HF)
  status_cu(Index) = OUTPUT_PORT
End Sub

Private Sub Timer1_Timer()
  Dim i As Integer, result As Long
  For i = 0 To 1
    If status_a(i) = INPUT_PORT Then
      InputAndShow i, Channel_P1A
    End If
    If status_b(i) = INPUT_PORT Then
      InputAndShow i, Channel_P1B
    End If
    If status_cl(i) = INPUT_PORT Then
      InputAndShow i, Channel_P1CL
    End If
    If status_cu(i) = INPUT_PORT Then
      InputAndShow i, Channel_P1CH
    End If
  Next
End Sub