程序任务是在不影响主程序执行的情况下完成一个轮询,所以新开了一个子线程,我原来尝试用一个  while   ...   wend 死循环来完成轮询,程序实现也并不复杂,可是每次执行的时候cpu占用总是100%,后来换用timer控件,可怎么也没办法把timer控件添加到子线程中,现在是采用了如下方法,请各位高手指点一下轮训是不是在子线程下面运行。
第一步:
   先做了一个Active dll,其中包含一个窗体和一个类模块,把timer控件放在窗体中(名称为:myTimer),myTimer.enabled属性设置放在类模块的一个public sub中,做为对myTimer控件开关的对外接口,如下:
   
   Public Sub StartTimer()
     myTimer.Enabled = True
   End Sub
   Public Sub EndTimer()
     myTimer.Enabled = False
   End SubmyTimer_timer事件的内容也写在类模块中,    Private Sub myTimer_Timer()
       CounterNumber = CounterNumber + 1
    End Sub                               '这里用一个累加代替对信号的读写程序
作为一个private sub,这样生成dll后,我可以通过生成它的一个对象来完成轮询,但问题是怎么把这个轮询加到子线程中。第二步:
    我在程序中新添加一个模块(名称为TriggerFunction),把对前面的dll的对象声明写在模块的通用声明部分:Public NewTimer As Cls_timer    (Cls_timer就是前面dll所生成的类)然后是两个public sub:  Public Sub Initialize()
   Set NewTimer = New Cls_timer
  End Sub                          '这个sub过程完成对NewTimer对象的初始化  Public Sub Start()
     NewTimer.StartTimer
  End Sub这两个都是公共过程,在主程序中可见第三步:
在主程序中,声明了子线程以后,我通过一个按钮的click事件把线程函数的首地址用addressof传给线程,程序如下:Private Sub Command1_Click()
     'call 模块中的子过程完成Set NewTimer = New Cls_timer
      Call TriggerFunction.Initialize  
    
      On Error Resume Next
      With TriggerThread
              .Initialize AddressOf TriggerFunction.Start   '线程函数入口
              .ThreadEnabled = True
      End With
End Sub
现在让我把我的问题说清楚,在子线程的线程函数入口处我写的是 
  
 addressof TriggerFunction.Start   而在TriggerFunction模块中的 Sub Start()过程中只完成了NewTimer.StartTimer,而StartTimer其实就是myTimer.Enabled = True,我感觉好像是没有把myTimer_Timer()所执行的轮询真正放到子线程中执行,而是只执行了一个myTimer.Enabled = True而已,所以请各位高手帮我看一看,希望能给我一个解决的办法,救我于水火,在此表示万分感谢!

解决方案 »

  1.   

    vb多线程一定要用CreateThread这个api,下面就是一个多线程的例子'form1的代码Private Sub Command1_Click()
    '声明了线程ID
        Dim threadid1 As Long
        Dim threadid2 As Long'参数一,lpThreadAttributes 线程安全属性,传递为NULL
    '参数二,dwStackSize ,线程堆栈大小,可以为0,表示堆栈和此应用堆栈相同
    '参数三,lpstartAddress ,执行函数地址,用AddressOf 获取
    '参数四,lpParameter ,执行函数的参数地址,可以是一个记录或者是别的类型,用VarPtr获取参数地址(varptr为未公开函数)!!
    '参数五,dwCreationFlags ,表示线程创建后的状态!,0表示立即运行,create_SUSPENDED表示线程挂起
    '参数六,lpThreadID 表示分配给线程的线程号
        Call CreateThread(Null, ByVal O&, AddressOf Module1.OutText1, VarPtr(0), ByVal 0&, threadid1)
        Call CreateThread(Null, ByVal 0&, AddressOf Module1.OutText2, VarPtr(0), ByVal 0&, threadid2)
    '    OutText1
    '    OutText2
    End SubPrivate Sub Command2_Click()
    '该事件运行于主线程!
        Dim i As Long
        i = CLng(Text1.Text)
        Text1.Text = CStr(i * i)  '不要点击次数太多,LONG 类型会溢出
    End SubPrivate Sub Form_Load()
    '保存窗体句柄全局变量,用于在form 上绘图
        formhandle = Form1.hwnd
    End Sub'请将该部分数据保存为 Module1.bas 文件'线程安全属性数据结构;
    Public Type SECURITY_ATTRIBUTES
            nLength As Long
            lpSecurityDescriptor As Long
            bInheritHandle As Long
    End Type'这个是用于多线程访问临界资源同步Api的数据结构
    Public Type CRITICAL_SECTION
        dummy As Long
    End Type
    '为什么用GDI 函数绘图?原因等下再讲
    Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Public Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
    Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
    Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    '请注意;createThread APi声明已被我修改过,修改的地方请自行参照APIView复制的内容
    Public Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
    '这个是sleep,作用就是让两个线程绘图频率不一致,效果才明显。
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Public Declare Sub EnterCriticalSection Lib "kernel32" (lpCriticalSection As CRITICAL_SECTION)  '进入临界区
    Public Declare Sub LeaveCriticalSection Lib "kernel32" (lpCriticalSection As CRITICAL_SECTION)  '离开临界区'几个重要的函数举例
    'ObjPtr:返回对象实例私有域的地址。
    'StrPtr:返回字符串第一个字的地址。
    'VarPtr:返回变量的地址。'全局的form的句柄!
    Public formhandle As Long
    '临界数据结构
    Public sect As CRITICAL_SECTIONSub OutText1()  '过程一
    Dim i As Long
    Dim dc As Long
    Dim s As String
        dc = GetDC(formhandle) '获取窗体句柄的DC
        For i = 1 To 100
            s = CStr(i)
            Call SetBkColor(dc, &HF0F0F0)  '设置绘制区域的背景色,也起清除作用
            Call TextOut(dc, 10, 10, s, Len(s)) '输出文本!
            Call Sleep(40) '等待
        Next
        Call ReleaseDC(formhandle, dc)  '释放资源!
       ' Call EnterCriticalSection(sect)
       ' 上下表示该处为临界区,如果要对工程全局变量做操作,最好在该区域内
       ' 否则线程同步过程中,非常容易让程序崩溃
       ' Call LeaveCriticalSection(sect)
    End SubSub OutText2()  '和过程一类似
    Dim i As Long
    Dim dc As Long
    Dim s As String
        dc = GetDC(formhandle)
        For i = 1 To 100
            s = CStr(i)
            Call SetBkColor(dc, &HF0F0F0)
            Call TextOut(dc, 10, 80, s, Len(s))  '文本位置改变了
            Call Sleep(20) '延时改变了
        Next
        Call ReleaseDC(formhandle, dc)
       ' Call EnterCriticalSection(sect)
      '  Call LeaveCriticalSection(sect)
    End Sub'关于为何使用gdi 函数输出文本,这是一个很重要的内容;
    '程序在记数时用了难用的TextOut 函数,而没有使用标签控件,这是因为
    'vb的组件不都是线程安全的,当多线程访问不是线程安全的组件,那么会
    '产生严重错误。
      

  2.   

    楼主的程序应该算是进程内的异步实现,如果想真正实现多线程除了楼上朋友的方法外,可以借用一个控件,叫Thread Factory,使用简单,就是太贵.如果想用API方式实现的话,不是高手不要用,出错的几率很大的.