这个总的工作时间怎样才能大于65.535s，并任意设定（传上源码）

[qiangshou2301]

在我的程序里用了计时器timer控件，最大值只能设置为65535，即只有65535毫秒,哪位高手看看怎样才能让总的工作时间大于65535毫秒，并任意设定（也就是说一两个小时也是没有问题的）


这个源码怎么上传啊？

[qiangshou2301]

照8楼的还是不行

[帝企鹅已被占用]

把你的代码贴来看看，只是time下的。

[qiangshou2301]

Option Explicit
Private CurNum As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '用API函数Sleep(xms)
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'************************************************
Dim intCommPort As Long '串口号
Dim strCommSettings As String '串口设置
Dim intOutBufferSize As Long '发送缓冲区大小
Dim intInBufferSize As Long '接收缓冲区大小
Dim Season(0 To 3) '声明数组大小
Dim i '声明变量
Dim blnShowFlag As Boolean '显示或隐藏文件传输窗体标志
Dim intColorSet() As Long '用于记录消息显示的格式
Dim intArrayCount As Long '用于记录消息显示的格式
'************************************************





Private Sub Form_Load()


Dim com_cur_num As Integer
Check1.Value = 1
com_last_num = 0
com_cur_num = 1
Season(0) = "COM1": Season(1) = "COM2": Season(2) = "COM3": Season(3) = "COM4"
For i = 0 To 3
Combo1.AddItem Season(i)
Next i
Combo1.ListIndex = com_cur_num - 1
If Test_COM(com_cur_num) = False Then
Command1.Caption = "打开端口"
Shape4.FillColor = RGB(0, 0, 0)
com_last_open_num = 0
Else
initial_com (com_cur_num)
Shape4.FillColor = RGB(0, 255, 0)
com_last_open_num = com_cur_num
Command1.Caption = "关闭端口"
End If
Me.Timer2.Enabled = False
CurNum = 0
Timer3.Interval = 60000 '一分钟定时
End Sub

Private Sub initial_com(com_num As Integer)
MSComm1.CommPort = com_num
MSComm1.Settings = "9600,n,8,1"
MSComm1.OutBufferSize = 1024
MSComm1.InBufferSize = 1024
MSComm1.InputMode = 1
MSComm1.InputLen = 0
MSComm1.InBufferCount = 0
MSComm1.SThreshold = 1
MSComm1.RThreshold = 1
MSComm1.PortOpen = True
End Sub


Private Sub Combo1_Change()
If Combo1.ListIndex + 1 <> com_last_num Then
If com_last_open_num <> 0 Then
MSComm1.PortOpen = False
End If
If Test_COM(Combo1.ListIndex + 1) = True Then
Command1.Caption = "关闭端口"
Shape4.FillColor = RGB(0, 255, 0)
End If
initial_com (Combo1.ListIndex + 1)
com_last_open_num = Combo1.ListIndex + 1
Else
Command1.Caption = "打开端口"
Shape4.FillColor = RGB(0, 0, 0)
com_last_open_num = 0 '注意此处要清零
End If
com_last_num = Combo1.ListIndex + 1
End Sub

Private Function Test_COM(com_num As Integer) As Boolean
If com_num <> com_last_num Or Command1.Caption = "打开端口" Then
On Error GoTo Comm_Error
MSComm1.CommPort = com_num
MSComm1.PortOpen = True
MSComm1.PortOpen = False
Test_COM = True
Exit Function
Comm_Error:
If Err.Number = 8002 Then
MsgBox "串口不存在！"
ElseIf Err.Number = 8005 Then
MsgBox "串口已打开或被占用！"
Else
MsgBox "其它错误"
End If
Test_COM = False
Exit Function
Resume Next
End If
End Function

'打开或关闭串口
Private Sub Command1_Click()
If Command1.Caption = "关闭端口" Then
MSComm1.PortOpen = False
Command1.Caption = "打开端口"
Shape4.FillColor = RGB(0, 0, 0)
com_last_open_num = 0
Else
If Test_COM(Combo1.ListIndex + 1) = True Then
MSComm1.PortOpen = True
Command1.Caption = "关闭端口"
Shape4.FillColor = RGB(0, 255, 0)
End If
End If
End Sub

Private Sub Command10_Click()
On Error Resume Next
MSComm1.PortOpen = False
Shape4.FillColor = RGB(0, 0, 0)
com_last_open_num = 0
Unload Form5
Unload Me
End Sub

Private Sub MSComm1_OnComm()
Dim bytInput() As Byte
Dim intInputLen As Integer
Dim n As Integer
Dim teststring As String
End Sub

[qiangshou2301]

Private Sub senddata_Click()
Call Timer1_Timer
End Sub



Private Sub Timer1_Timer()

Timer1.Enabled = False
Dim longth As Integer
If Check1.Value = 1 Then
intOutMode = 1
Else
intOutMode = 0
End If
strSendText = pl.Text + zkb.Text + sq.Text
If intOutMode = 0 Then
Else
longth = strHexToByteArray(strSendText, bytSendByte())
If longth > 0 Then
MSComm1.Output = bytSendByte
End If
End If

Timer1.Enabled = True
End Sub
'单个工作时间中断时间定时
Private Sub Timer2_Timer()
Dim buff_out5() As Byte
If Dir("13.txt") <> "" Then
Dim Temp13 As String
Open App.Path & "\13.txt" For Input As #13
Line Input #13, Temp13
Close #13
End If
If Dir("14.txt") <> "" Then
Dim Temp14 As String
Open App.Path & "\14.txt" For Input As #14
Line Input #14, Temp14
Close #14
End If


Me.Timer2.Interval = Temp14 * 1000


Me.Timer2.Interval = Temp13 * 1000

ReDim buff_out5(8)
MSComm1.Settings = "9600,N,8,1"
MSComm1.InputLen = 0
buff_out5(0) = &HAA
buff_out5(1) = &HAA
buff_out5(2) = &HFF
buff_out5(3) = &H5

buff_out5(5) = &H0
buff_out5(6) = &H0
buff_out5(7) = &H0
buff_out5(8) = &HFF
MSComm1.Output = buff_out5
End Sub

'总的工作时间定时
Private Sub Timer3_Timer()
If MSComm1.PortOpen = False Then
Label1.Caption = "您的串口现在是关闭状态,请先打开串口"
Else
Label1.Caption = ""
If Shape5.BackColor = &HFF Then
Shape5.BackColor = &H80FF80
Command7.Caption = "关"
CurNum = CurNum + 1 '每达到一分钟+1
Me.Timer2.Enabled = True
If Dir("13.txt") <> "" Then
Dim Temp13 As String
Open App.Path & "\13.txt" For Input As #13
Line Input #13, Temp13
Close #13
End If
Me.Timer2.Interval = Temp13 * 1000

Else
Shape5.BackColor = &HFF
Command7.Caption = "开"
Me.Timer2.Enabled = False
Timer3.Enabled = False
Dim buff_out6() As Byte
Dim lngP6 As String
ReDim buff_out6(8)
MSComm1.Settings = "9600,N,8,1"
MSComm1.InputLen = 0
buff_out6(0) = &HAA
buff_out6(1) = &HAA
buff_out6(2) = &HFF
buff_out6(3) = &H5
buff_out6(4) = &H7E
buff_out6(5) = &H0
buff_out6(6) = &H0
buff_out6(7) = &H0
buff_out6(8) = &HFF
MSComm1.Output = buff_out6
lngP6 = GetTickCount
Do
DoEvents
Loop Until GetTickCount - lngP6 > 100 Or MSComm1.InBufferCount > 10 '当等待时间超过100毫秒或串口接受缓冲区的数据达到10个字节时退出等待循环，这就是一个通信等待的过程。
End If
End If
Timer3.Enabled = False
End Sub



Function strHexToByteArray(strText As String, bytByte() As Byte) As Integer
Dim HexData As Integer '十六进制(二进制)数据字节对应值
Dim hstr As String * 1 '高位字符
Dim lstr As String * 1 '低位字符
Dim HighHexData As Integer '高位数值
Dim LowHexData As Integer '低位数值
Dim HexDataLen As Integer '字节数
Dim StringLen As Integer '字符串长度
Dim Account As Integer '计数
Dim n As Integer
HexDataLen = 0
strHexToByteArray = 0
StringLen = Len(strText)
Account = StringLen \ 2
ReDim bytByte(Account)
For n = 1 To StringLen 'For...Next循环语句
Do '清除空格
hstr = Mid(strText, n, 1)
n = n + 1
If (n - 1) > StringLen Then
HexDataLen = HexDataLen - 1

Exit For
End If
Loop While hstr = " " 'DO...Loop While循环
Do
lstr = Mid(strText, n, 1)
n = n + 1
If (n - 1) > StringLen Then
HexDataLen = HexDataLen - 1

Exit For
End If
Loop While lstr = " "
n = n - 1
If n > StringLen Then
HexDataLen = HexDataLen - 1
Exit For
End If
HighHexData = ConvertHexChr(hstr)
LowHexData = ConvertHexChr(lstr)
If HighHexData = -1 Or LowHexData = -1 Then '遇到非法字符中断转化
HexDataLen = HexDataLen - 1
Exit For
Else
HexData = HighHexData * 16 + LowHexData
bytByte(HexDataLen) = HexData
HexDataLen = HexDataLen + 1
End If
Next n
If HexDataLen > 0 Then '修正最后一次循环改变的数值
HexDataLen = HexDataLen - 1
ReDim Preserve bytByte(HexDataLen)
Else
ReDim Preserve bytByte(0)
End If

If StringLen = 0 Then '如果是空串,则不会进入循环体
strHexToByteArray = 0
Else
strHexToByteArray = HexDataLen + 1
End If
End Function



Function ConvertHexChr(str As String) As Integer
Dim test As Integer
test = Asc(str)
If test >= Asc("0") And test <= Asc("9") Then
test = test - Asc("0")
ElseIf test >= Asc("a") And test <= Asc("f") Then
test = test - Asc("a") + 10
ElseIf test >= Asc("A") And test <= Asc("F") Then
test = test - Asc("A") + 10
Else
test = -1 '出错信息
End If
ConvertHexChr = test
End Function

Private Sub Command13_Click()
If Form5.Visible = True Then
Unload Form5
Else
Form5.Show
End If
End Sub



Private Sub Form_Unload(Cancel As Integer) '程序退出时，关闭串口

If MSComm1.PortOpen Then
MSComm1.PortOpen = False
End If
End Sub




Private Sub Text3_KeyPress(KeyAscii As Integer)
Dim command As String
Dim report As String
report = Space$(128)
If KeyAscii = 13 Then


End If
End Sub



Private Sub Command7_Click()
If MSComm1.PortOpen = False Then
Label1.Caption = "您的串口现在是关闭状态,请先打开串口"
Else
Label1.Caption = ""
If Dir("15.txt") <> "" Then
Dim Temp15 As String
Open App.Path & "\15.txt" For Input As #15
Line Input #15, Temp15
Close #15
End If
Timer3.Interval = Temp15 * 1000
Timer3.Enabled = True
If Shape5.BackColor = &HFF Then
Shape5.BackColor = &H80FF80
Command7.Caption = "关"
Me.Timer2.Enabled = True '加上这句
If Dir("13.txt") <> "" Then
Dim Temp13 As String
Open App.Path & "\13.txt" For Input As #13
Line Input #13, Temp13
Close #13
End If
Me.Timer2.Interval = Temp13 * 1000

Else
Shape5.BackColor = &HFF
Command7.Caption = "开"
Me.Timer2.Enabled = False '加上这句
Me.Timer3.Enabled = False
Dim buff_out6() As Byte
Dim lngP6 As String
ReDim buff_out6(8)
MSComm1.Settings = "9600,N,8,1"
MSComm1.InputLen = 0 ' 当输入占用时，告诉控件读入整个缓冲区。
buff_out6(0) = &HAA
buff_out6(1) = &HAA
buff_out6(2) = &HFF
buff_out6(3) = &H5
buff_out6(4) = &H7E
buff_out6(5) = &H0
buff_out6(6) = &H0
buff_out6(7) = &H0
buff_out6(8) = &HFF
MSComm1.Output = buff_out6
lngP6 = GetTickCount 'API函数
Do
DoEvents
Loop Until GetTickCount - lngP6 > 100 Or MSComm1.InBufferCount > 10 '当等待时间超过100毫秒或串口接受缓冲区的数据达到10个字节时退出等待循环，这就是一个通信等待的过程。
End If
End If
End Sub

[帝企鹅已被占用]

本来以为是个简单的问题，不是喽。
king 帮忙看下，我家里没vb。

[舉杯邀明月]

你的代码中有好几处类似：
XXX.Interval = NNN * 1000

的地方，是这些语句出错吧？

[贝隆]

方法有很多，我常用的方法是使用API函数：GetTickCount，大致如下：

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim lngP As Long
Private Sub Form_Load()
    Timer1.Enabled = True
    Timer1.Interval = 100
    lngP = GetTickCount '记录计时起点
End Sub

Private Sub Timer1_Timer()
    If GetTickCount - lngP >= 66000 Then
        '添加你的代码
        lngP = GetTickCount '记录新的计时起点
    End If
End Sub

[贝隆]

楼主是做串口通信吧？
看看这个：http://download.csdn.net/source/1262066

[king06]

楼主是用到秒的,那么每个timer的interval设置成1000
dim a ,b ,c

Me.Timer2.Interval = Temp14 * 1000 换成 a=Temp14

Private Sub Timer1_Timer()
    Static idx As Long
    If idx = 0 Then idx = 1
    
    If idx < a Then '设置a秒执行一次
        idx = idx + 1
    Else
        Timer1.Enabled = False
        Dim longth As Integer
        If Check1.Value = 1 Then
        intOutMode = 1
        Else
        intOutMode = 0
        End If
        strSendText = pl.Text + zkb.Text + sq.Text
        If intOutMode = 0 Then
        Else
            longth = strHexToByteArray(strSendText, bytSendByte())
            If longth > 0 Then
                MSComm1.Output = bytSendByte
          End If
        End If
        Timer1.Enabled = True
        
        idx = 0
    End If
End Sub

其它类似.
不过你的代码比较乱,固定的东西不用放到timer中来执行.

[qiangshou2301]

对 就是Private Sub Command7_Click()下的
Timer3.Interval = Temp15 * 1000出错 其他正确

[zdingyun]

LZ:仔细看了你的代码,是使用于串口通信的.其中主要代码是借鉴串口调试精灵.
你需要详细描述你通信协议.

[舉杯邀明月]

[Quote=引用 21 楼 qiangshou2301 的回复:]
对 就是Private Sub Command7_Click()下的
Timer3.Interval = Temp15 * 1000出错 其他正确
[/Quote]
是因为　temp15 * 1000　已经大于65535了吧？

[贝隆]

[Quote=引用 22 楼 zdingyun 的回复:]
LZ:仔细看了你的代码,是使用于串口通信的.其中主要代码是借鉴串口调试精灵.
你需要详细描述你通信协议.
[/Quote]

有道理，我也觉得是这样

[sizhirunhua]

可以判断系统时间啊，interval设多少自己定，每次触发的时候判断系统时间，时间到了就执行，不到就略过

[qiangshou2301]

我的目的是想执行Timer3.Interval = Temp15 * 1000的时间后就停止工作了 Temp15代表输入的时间

[sizhirunhua]

PrivateSub Timer1_Timer()
Static idx As Long
idx= idx+1
if idx>Temp15 Then
'停止操作
else
'继续
EndIf
End Sub



Timer3.Interval = 1000

[Tiger_Zhao]

Option Explicit

Private m_StopTime As Date

Private Sub Command7_Click()
    ...
    'Timer3.Interval = Temp15 * 1000 改为下面两句->
    Timer3.Interval = 500
    m_StopTime = DateAdd("s", Val(Temp15), Now)
    Timer3.Enabled = True
    ...
End Sub

Private Sub Timer3_Timer()
    If Now() < m_StopTime Then Exit Sub '增加这个判断'
    
    ... '到点时的执行代码'
End Sub

[舉杯邀明月]

[Quote=引用 27 楼 qiangshou2301 的回复:]
我的目的是想执行Timer3.Interval = Temp15 * 1000的时间后就停止工作了 Temp15代表输入的时间
[/Quote]

前面给你说了那么多，还没明白啊？
在你的 Private Sub Command7_Click() 中：
Timer3.Interval = Temp15 * 1000
Timer3.Enabled = True
这样处理（这两句替换成这几句）：

lCount = Temp15         'lCount 声明成模块级的变量，Long类型
Timer3.Interval = 1000  '设计时确定，可以不要这句
Timer3.Enabled = True

Timer3_Timer() 要这样写：

Private Sub Timer3_Timer()
    lCount = lCount - 1
    if (lCount > 0) then exit sub
    Timer3.Enabled = False
    .............   '你的其它代码....
end sub

[qiangshou2301]

好的 非常感谢 用Tiger_Zhao和Chen8013都弄出来了

[kim8378]

jf