求助Vb时钟控制脉冲输出的问题

主题：求助Vb时钟控制脉冲输出的问题

freepiw [专家分：0] 发布于 2009-07-05 10:50:00

小弟还是新手，最近要编一个低频多路器的控制程序，要控制多路器输出脉冲信号，现在程序只能控制输出5V的ttl电平，问是不是输出脉冲需要时钟来控制，另外如何操作呢。下面是完整程序。

Private Sub Command12_Click()

Command12.Enabled = False

Text8.Text = 4
Text7.Text = 20
Text10.Text = 0
Text9.Text = 0
Text12.Text = 4
Text11.Text = 48
Command8_Click

'1
'300rpm + 5port
Text8.Text = 3
Text7.Text = 252
Text10.Text = 0
Text9.Text = 0
Text12.Text = 18
Text11.Text = 197
Command8_Click

'6944steps
Text8.Text = 4
Text7.Text = 36
Text10.Text = 0
Text9.Text = 0
Text12.Text = 27
Text11.Text = 32
Command8_Click

'-27steps
Text8.Text = 4
Text7.Text = 76
Text10.Text = 255
Text9.Text = 255
Text12.Text = 230
Text11.Text = 0
Command8_Click

'3000ms
Text8.Text = 4
Text7.Text = 56
Text10.Text = 0
Text9.Text = 0
Text12.Text = 11
Text11.Text = 184
Command8_Click

'100rpm
Text8.Text = 4
Text7.Text = 176
Text10.Text = 0
Text9.Text = 0
Text12.Text = 0
Text11.Text = 100
Command8_Click

'2
'300rpm + 5port
Text8.Text = 3
Text7.Text = 254
Text10.Text = 0
Text9.Text = 0
Text12.Text = 18
Text11.Text = 197
Command8_Click

'6944steps
Text8.Text = 4
Text7.Text = 38
Text10.Text = 0
Text9.Text = 0
Text12.Text = 17
Text11.Text = 32
Command8_Click

'-27steps
Text8.Text = 4
Text7.Text = 78
Text10.Text = 255
Text9.Text = 255
Text12.Text = 200
Text11.Text = 0
Command8_Click

'3000ms
Text8.Text = 4
Text7.Text = 58
Text10.Text = 0
Text9.Text = 0
Text12.Text = 11
Text11.Text = 184
Command8_Click

'100rpm
Text8.Text = 4
Text7.Text = 178
Text10.Text = 0
Text9.Text = 0
Text12.Text = 0
Text11.Text = 100
Command8_Click

'3
'300rpm + 3port
Text8.Text = 4
Text7.Text = 0
Text10.Text = 0
Text9.Text = 0
Text12.Text = 18
Text11.Text = 195
Command8_Click

'6944steps
Text8.Text = 4
Text7.Text = 40
Text10.Text = 0
Text9.Text = 0
Text12.Text = 17
Text11.Text = 32
Command8_Click

'-27steps
Text8.Text = 4
Text7.Text = 80
Text10.Text = 255
Text9.Text = 255
Text12.Text = 200
Text11.Text = 0
Command8_Click

'3000ms
Text8.Text = 4
Text7.Text = 60
Text10.Text = 0
Text9.Text = 0
Text12.Text = 11
Text11.Text = 184
Command8_Click

'100rpm
Text8.Text = 4
Text7.Text = 180
Text10.Text = 0
Text9.Text = 0
Text12.Text = 0
Text11.Text = 100
Command8_Click

'4
'300rpm + 3port
Text8.Text = 4
Text7.Text = 2
Text10.Text = 0
Text9.Text = 0
Text12.Text = 18
Text11.Text = 195
Command8_Click

'6944steps
Text8.Text = 4
Text7.Text = 42
Text10.Text = 0
Text9.Text = 0
Text12.Text = 17
Text11.Text = 32
Command8_Click

'-27steps
Text8.Text = 4
Text7.Text = 82
Text10.Text = 255
Text9.Text = 255
Text12.Text = 200
Text11.Text = 0
Command8_Click

'3000ms
Text8.Text = 4
Text7.Text = 62
Text10.Text = 0
Text9.Text = 0
Text12.Text = 11
Text11.Text = 184
Command8_Click

'200rpm
Text8.Text = 4
Text7.Text = 182
Text10.Text = 0
Text9.Text = 0
Text12.Text = 0
Text11.Text = 200
Command8_Click

'nr.componenti vennice
Text8.Text = 3
Text7.Text = 250
Text10.Text = 0
Text9.Text = 0
Text12.Text = 0
Text11.Text = 4
Command8_Click

Text8.Text = 4
Text7.Text = 18
Text10.Text = 0
Text9.Text = 0
Text12.Text = 0
Text11.Text = 0
Command8_Click

'data valid
Text8.Text = 4
Text7.Text = 20
Text10.Text = 0
Text9.Text = 0
Text12.Text = 4
Text11.Text = 112
Command8_Click

'begin
Text8.Text = 4
Text7.Text = 18
Text10.Text = 0
Text9.Text = 0
Text12.Text = 0
Text11.Text = 1
Command8_Click

Command12.Enabled = True

End Sub
这是其中一个按键控件功能，感觉是用来控制步进电机的，如果是的话，其输出就是脉冲信号了，另外如果该程序无脉冲输出功能的话，用时钟该如何编呢，望大家指点迷津。

最后更新于：2009-07-05 11:07:00

本帖地址： http://bbs.pfan.cn/post/304747.html

回复列表（共4个回复）

沙发

freepiw [专家分：0] 发布于 2009-07-05 11:01:00

Private Sub Command1_Click()

Dim DataRx() As Byte
Dim Rx(200) As Byte
Dim crc
Dim btCRCHi As Byte, btCRCLo As Byte
Dim filenam As String

For i = 0 To 27
    Rx(i) = 0
    Text2(i).Text = 0

Next i

If MSComm1.InBufferCount = 0 Then Exit Sub
MSComm1.InputLen = 2
DataRx() = MSComm1.Input
Rx(0) = DataRx(0)
Rx(1) = DataRx(1)
Text2(0).Text = Rx(0)
Text2(1).Text = Rx(1)

If Rx(0) = 1 And Rx(1) = 3 Then

MSComm1.InputLen = 6
DataRx() = MSComm1.Input

Rx(2) = DataRx(0)
Rx(3) = DataRx(1)
Rx(4) = DataRx(2)
Rx(5) = DataRx(3)
Rx(6) = DataRx(4)
Rx(7) = DataRx(5)

Text2(2).Text = Rx(2)
Text2(3).Text = Rx(3)
Text2(4).Text = Rx(4)
Text2(5).Text = Rx(5)
Text2(6).Text = Rx(6)
Text2(7).Text = Rx(7)

FileName = "E:\testing01.txt"
Open FileName For Append As #1
Print #1, Rx(0); Rx(1); Rx(2#); Rx(3); Rx(4); Rx(5); Rx(6); Rx(7); Rx(8); Rx(9); Rx(10); Rx(11); Rx(12)

Close #1

crc = CalCRC16Fast(Rx, 6, btCRCLo, btCRCHi)

If Rx(6) <> btCRCHi Or Rx(7) <> btCRCLo Then MsgBox "CRC Error."

ElseIf Rx(0) = 1 And Rx(1) = 16 Then

MSComm1.InputLen = 4
DataRx() = MSComm1.Input

Rx(2) = DataRx(0)
Rx(3) = DataRx(1)
Rx(4) = DataRx(2)
Rx(5) = DataRx(3)

Text2(2).Text = Rx(2)
Text2(3).Text = Rx(3)
Text2(4).Text = Rx(4)
Text2(5).Text = Rx(5)

MSComm1.InputLen = Rx(6) + 3
DataRx() = MSComm1.Input

For i = 0 To Rx(6) + 2
    Rx(i + 7) = DataRx(i)
    Text2(i + 7).Text = Rx(i + 7)

Next i

crc = CalCRC16Fast(Rx, 7 + Rx(6), btCRCLo, btCRCHi)
If Rx(7 + Rx(6)) <> btCRCHi Or Rx(7 + Rx(6) + 1) <> btCRCLo Then MsgBox "CRC Error."

FileName = "E:\testing01.txt"
Open FileName For Append As #1
Print #1, Rx(0); Rx(1); Rx(2#); Rx(3); Rx(4); Rx(5); Rx(6); Rx(7); Rx(8); Rx(9); Rx(10); Rx(11); Rx(12)
Close #1

ElseIf Rx(0) = 1 And Rx(1) = 5 Then

MSComm1.InputLen = 7
DataRx() = MSComm1.Input

For i = 0 To 6
    Rx(i + 2) = DataRx(i)
    Text2(i + 2).Text = Rx(i + 2)

Next i

crc = CalCRC16Fast(Rx, 6, btCRCLo, btCRCHi) 'Rx为数组，Rx(?)为CRC校验需要计算的个数。
If Rx(6) <> btCRCHi Or (Rx(6 + 1)) <> btCRCLo Then MsgBox "CRC Error."

FileName = "E:\testing01.txt"
Open FileName For Append As #1
Print #1, Rx(0); Rx(1); Rx(2#); Rx(3); Rx(4); Rx(5); Rx(6); Rx(7); Rx(8); Rx(9); Rx(10); Rx(11); Rx(12)
Close #1

End If

End Sub

Private Sub Command10_Click()

    MSComm1.InBufferCount = 0

End Sub

Private Sub Command11_Click()
Dim DataTx(8) As Byte
Dim address_h As Byte
Dim address_l As Byte
Dim data_0 As Byte
Dim data_1 As Byte

Dim crc
Dim btCRCHi As Byte, btCRCLo As Byte

address_h = Text17.Text
address_l = Text18.Text
data_0 = Text15.Text
data_1 = Text16.Text

DataTx(0) = 1
DataTx(1) = 5

DataTx(2) = address_h
DataTx(3) = address_l

DataTx(4) = data_0
DataTx(5) = data_1

crc = CalCRC16Fast(DataTx, 6, btCRCLo, btCRCHi)
DataTx(6) = btCRCHi
DataTx(7) = btCRCLo

DataTx(8) = 0

MSComm1.Output = DataTx

End Sub

板凳

freepiw [专家分：0] 发布于 2009-07-05 11:05:00

Private Sub Command13_Click()

Text8.Text = 3
Text7.Text = 244
Text10.Text = 0
Text9.Text = 0
Text12.Text = 0
Text11.Text = 16 + 5
Command8_Click

End Sub

Private Sub Command14_Click()

Text8.Text = 3
Text7.Text = 244
Text10.Text = 0
Text9.Text = 0
Text12.Text = 0
Text11.Text = 5
Command8_Click

End Sub

Private Sub Command15_Click()

Text8.Text = 3
Text7.Text = 244
Text10.Text = 0
Text9.Text = 0
Text12.Text = 0
Text11.Text = 32 + 16 + 5
Command8_Click

End Sub

Private Sub Command16_Click()

Command10_Click

Text3.Text = 0
Text6.Text = 242
Command2_Click

Command4_Click

End Sub

Private Sub Command17_Click()

Command10_Click

Text3.Text = 3
Text6.Text = 248
Command2_Click

Command4_Click

End Sub

Private Sub Command18_Click()

Command10_Click

Text3.Text = 0
Text6.Text = 244
Command2_Click

Command4_Click

End Sub

Private Sub Command19_Click()

Command10_Click

Text3.Text = 0
Text6.Text = 250
Command2_Click

Command4_Click

End Sub

Private Sub Command2_Click()

Dim DataTx(7) As Byte
Dim address_h As Byte
Dim address_l As Byte
Dim crc
Dim btCRCHi As Byte, btCRCLo As Byte

Command2.Enabled = False

Command10_Click

address_h = Text3.Text
address_l = Text6.Text

DataTx(0) = 1
DataTx(1) = 3

DataTx(2) = address_h
DataTx(3) = address_l

DataTx(4) = 0
DataTx(5) = 2

crc = CalCRC16Fast(DataTx, 6, btCRCLo, btCRCHi)
DataTx(6) = btCRCHi
DataTx(7) = btCRCLo

MSComm1.Output = DataTx

Command2.Enabled = True

End Sub

'模块文件:modCRC，其中包含了CRC校验的函数。

'data     待校验的数组名称
'no       数组中元素个数
'btLoCRC  算出的CRC高字节
'btHiCRC  算出的CRC低字节

Public Function CalCRC16Fast(data() As Byte, no As Integer, btLoCRC As Byte, btHiCRC As Byte) As String

      Dim CL As Byte, CH As Byte                '多项式码&HA001
      Dim SaveHi As Byte, SaveLo As Byte
      Dim i As Integer
      Dim Flag As Integer

      btHiCRC = &HFF
      btLoCRC = &HFF
      CL = &H1
      CH = &HA0

      For i = 0 To (no - 1)

        btHiCRC = btHiCRC Xor data(i) '每一个数据与CRC寄存器进行异或

        For Flag = 0 To 7

          SaveHi = btLoCRC
          SaveLo = btHiCRC
          btLoCRC = btLoCRC \ 2            '高位右移一位
          btHiCRC = btHiCRC \ 2            '低位右移一位

          If ((SaveHi And &H1) = &H1) Then '如果高位字节最后一位为1
            btHiCRC = btHiCRC Or &H80      '则低位字节右移后前面补1
          End If                           '否则自动补0

          If ((SaveLo And &H1) = &H1) Then '如果LSB为1，则与多项式码进行异或
            btLoCRC = btLoCRC Xor CH
            btHiCRC = btHiCRC Xor CL
          End If

        Next Flag

      Next i

      Dim ReturnData(1) As Byte
      ReturnData(0) = btHiCRC              'CRC高位
      ReturnData(1) = btLoCRC              'CRC低位

      CalCRC16Fast = ReturnData

    End Function

Public Function CalCRC16Tbl(data() As Byte, no As Integer, btLoCRC As Byte, btHiCRC As Byte) As String

      btLoCRC = &HFF
      btHiCRC = &HFF

      Dim i As Integer
      Dim iIndex As Long

      For i = 0 To (no - 1)

        iIndex = btHiCRC Xor data(i)
        btHiCRC = btLoCRC Xor GetCRCLo(iIndex)        '低位处理
        btLoCRC = GetCRCHi(iIndex)                    '高位处理

      Next i

      Dim ReturnData() As Byte

      ReturnData(0) = btHiCRC        'CRC高位
      ReturnData(1) = btLoCRC        'CRC低位

      CalCRC16Tbl = ReturnData

End Function

3 楼

freepiw [专家分：0] 发布于 2009-07-05 11:07:00

Private Sub Command20_Click()

Command10_Click

Text3.Text = 1
Text6.Text = 0
Command2_Click

Command4_Click

End Sub

Private Sub Command21_Click()

Command10_Click

Text3.Text = 0
Text6.Text = 254
Command2_Click

Command4_Click

End Sub

Private Sub Command22_Click()

Command10_Click

Text3.Text = 0
Text6.Text = 252
Command2_Click

Command4_Click

End Sub

Private Sub Command23_Click()

Command10_Click

Text3.Text = 4
Text6.Text = 196
Command2_Click

Command4_Click

End Sub

Private Sub Command24_Click()

Command10_Click

Text3.Text = 4
Text6.Text = 26
Command2_Click

Command4_Click

End Sub

Private Sub Command3_Click()

    Dim btSend(13) As Byte
    Dim crc
    Dim btCRCHi As Byte, btCRCLo As Byte


    For i = 0 To 13
        btSend(i) = Val(Text4(i).Text)
    Next i

    crc = CalCRC16Fast(btSend, Val(Text5.Text), btCRCLo, btCRCHi)

Text4(Val(Text5.Text)).Text = btCRCHi
Text4(Val(Text5.Text) + 1).Text = btCRCLo

End Sub

Private Sub Command4_Click()

Dim DataRx() As Byte
Dim Rx(200) As Byte
Dim crc
Dim btCRCHi As Byte, btCRCLo As Byte
Dim filenam As String

For i = 0 To 27
    Rx(i) = 0
    Text2(i).Text = 0

Next i

If MSComm1.InBufferCount = 0 Then Exit Sub
MSComm1.InputLen = 2
DataRx() = MSComm1.Input
Rx(0) = DataRx(0)
Rx(1) = DataRx(1)
Text2(0).Text = Rx(0)
Text2(1).Text = Rx(1)

If Rx(0) = 1 And Rx(1) = 3 Then

MSComm1.InputLen = 1
DataRx() = MSComm1.Input
Rx(2) = DataRx(0)
Text2(2).Text = Rx(2)

MSComm1.InputLen = Rx(2) + 2
DataRx() = MSComm1.Input

For i = 0 To Rx(2) + 1
    Rx(i + 3) = DataRx(i)
    Text2(i + 3).Text = Rx(i + 3)

Next i

crc = CalCRC16Fast(Rx, 3 + Rx(2), btCRCLo, btCRCHi)
If Rx(3 + Rx(2)) <> btCRCHi Or Rx(3 + Rx(2) + 1) <> btCRCLo Then MsgBox "CRC Error."

FileName = "E:\testing01.txt"
Open FileName For Append As #1
Print #1, Rx(0); Rx(1); Rx(2#); Rx(3); Rx(4); Rx(5); Rx(6); Rx(7); Rx(8); Rx(9); Rx(10); Rx(11); Rx(12)
Close #1

ElseIf Rx(0) = 1 And Rx(1) = 16 Then

MSComm1.InputLen = 6
DataRx() = MSComm1.Input

For i = 0 To 5
    Rx(i + 2) = DataRx(i)
    Text2(i + 2).Text = Rx(i + 2)

Next i

crc = CalCRC16Fast(Rx, 6, btCRCLo, btCRCHi) 'Rx为数组，Rx(?)为CRC校验需要计算的个数。
If Rx(6) <> btCRCHi Or (Rx(6 + 1)) <> btCRCLo Then MsgBox "CRC Error."

FileName = "E:\testing01.txt"
Open FileName For Append As #1
Print #1, Rx(0); Rx(1); Rx(2#); Rx(3); Rx(4); Rx(5); Rx(6); Rx(7); Rx(8); Rx(9); Rx(10); Rx(11); Rx(12)
Close #1

ElseIf Rx(0) = 2 And Rx(1) = 5 Then

MSComm1.InputLen = 7
DataRx() = MSComm1.Input

For i = 0 To 5
    Rx(i + 2) = DataRx(i)
    Text2(i + 2).Text = Rx(i + 2)

Next i

crc = CalCRC16Fast(Rx, 6, btCRCLo, btCRCHi) 'Rx为数组，Rx(?)为CRC校验需要计算的个数。
If Rx(6) <> btCRCHi Or (Rx(6 + 1)) <> btCRCLo Then MsgBox "CRC Error."

FileName = "E:\testing01.txt"
Open FileName For Append As #1
Print #1, Rx(0); Rx(1); Rx(2#); Rx(3); Rx(4); Rx(5); Rx(6); Rx(7); Rx(8); Rx(9); Rx(10); Rx(11); Rx(12)
Close #1

End If

End Sub

Private Sub Command7_Click()

If (MSComm1.PortOpen = False) Then

    MSComm1.CommPort = Text1.Text
    MSComm1.PortOpen = True
    MSComm1.InBufferCount = 0
    Command7.Enabled = False
End If

End Sub

Private Sub Command8_Click()

Dim DataTx(12) As Byte
Dim address_h As Byte
Dim address_l As Byte
Dim data_0 As Byte
Dim data_1 As Byte
Dim data_2 As Byte
Dim data_3 As Byte

Dim crc
Dim btCRCHi As Byte, btCRCLo As Byte

address_h = Text8.Text
address_l = Text7.Text
data_0 = Text10.Text
data_1 = Text9.Text
data_2 = Text12.Text
data_3 = Text11.Text

DataTx(0) = 1
DataTx(1) = 16

DataTx(2) = address_h
DataTx(3) = address_l

DataTx(4) = 0
DataTx(5) = 2
DataTx(6) = 4

DataTx(7) = data_0
DataTx(8) = data_1
DataTx(9) = data_2
DataTx(10) = data_3

crc = CalCRC16Fast(DataTx, 11, btCRCLo, btCRCHi)
DataTx(11) = btCRCHi
DataTx(12) = btCRCLo

MSComm1.Output = DataTx

End Sub

Private Sub Command9_Click()

    MSComm1.DTREnable = True
    MSComm1.DTREnable = False

End Sub

4 楼

老大徒伤悲 [专家分：29120] 发布于 2009-07-05 14:23:00

太高深了，看不懂。

我来回复

您尚未登录，请登录后再回复。点此登录或注册

主题：求助Vb时钟控制脉冲输出的问题

回复列表（共4个回复）

我来回复

程序员工具箱 new

代码片段

本版新帖

主题：求助Vb时钟控制脉冲输出的问题

回复列表 （共4个回复）

我来回复

程序员工具箱 new

代码片段

本版新帖

回复列表（共4个回复）