'请将该部分数据保存为 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
'Public Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, LpthreadId As Long) As Long
'终止线程API
Public Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
'激活线程API,参数hThread为CreateThread创建的线程句柄
Public Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long
'挂起线程API
Public Declare Function SuspendThread Lib "kernel32" (ByVal hThread 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 100000
        s = CStr(i)
        Call SetBkColor(dc, &HFF0000)  '设置绘制区域的背景色,也起清除作用
        Call TextOut(dc, 10, 10, s, Len(s)) '输出文本!
        Call Sleep(20) '等待
  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 100000
        s = CStr(i)
        Call SetBkColor(dc, &HFF0000)
        Call TextOut(dc, 10, 80, s, Len(s))  '文本位置改变了
        Call Sleep(10) '延时改变了
  Next
    Call ReleaseDC(formhandle, dc)
   ' Call EnterCriticalSection(sect)
  '  Call LeaveCriticalSection(sect)
End Sub
'关于为何使用gdi 函数输出文本,这是一个很重要的内容;
'程序在记数时用了难用的TextOut 函数,而没有使用标签控件,这是因为
'vb的组件不都是线程安全的,当多线程访问不是线程安全的组件,那么会
'产生严重错误。Sub Sub1()  '自定义的过程1
For i = 1 To 10000000
  Form1.Label2.Caption = Form1.Label2.Caption + 1
  Call Sleep(10)
Next
End Sub
Sub Sub2()   '自定义的过程2
For i = 1 To 10000000
  Form1.Label3.Caption = Form1.Label3.Caption + 1
  Call Sleep(20)
Next
End Sub
'以下是form1的代码。
Dim threadid1 As Long
Dim threadid2 As Long
Dim H1 As Long
Dim H2 As LongPrivate Sub cmdStop_Click()
Call TerminateThread(H1, 0)
Call TerminateThread(H2, 0)
End SubPrivate Sub Command1_Click()
'参数一,lpThreadAttributes 线程安全属性,传递为NULL
'参数二,dwStackSize ,线程堆栈大小,可以为0,表示堆栈和此应用堆栈相同
'参数三,lpstartAddress ,执行函数地址,用AddressOf 获取
'参数四,lpParameter ,执行函数的参数地址,可以是一个记录或者是别的类型,用VarPtr获取参数地址(varptr为未公开函数)!!
'参数五,dwCreationFlags ,表示线程创建后的状态!,0表示立即运行,create_SUSPENDED表示线程挂起
'参数六,lpThreadID 表示分配给线程的线程号
'以下两行便是创建两个线程来运行自定义的两个过程的,在VB开发环境中可以运行,但编译成P-代码后点这个按钮,能够显示线程号句柄,但马上就报错说:"0x660d8f53e"指令引用的"0x00000076"内存。该内存不能为"read"。而如果编译为本机代码的时候点这个按钮,显示出来的两个线程号句柄都是0,程序也不会出错,但是线程不会执行。怎么办呀?是不是如代码作者上面写的说:vb的组件不都是线程安全的,当多线程访问不是线程安全的组件,那么会产生严重错误?    H1 = CreateThread(Null, ByVal O&, AddressOf Sub1, VarPtr(0), ByVal 0&, threadid1)
    H2 = CreateThread(Null, ByVal 0&, AddressOf Sub2, VarPtr(0), ByVal 0&, threadid2)
    MsgBox H1 & " " & H2  '显示返回的线程号句柄
End SubPrivate Sub Command2_Click()
'该事件运行于主线程!
    Dim i As Long
    i = CLng(Text1.Text)
    Text1.Text = CStr(i * i)  '不要点击次数太多,LONG 类型会溢出
End Sub
Private Sub Command3_Click()
Call SuspendThread(H1)
Call SuspendThread(H2)
End SubPrivate Sub Command4_Click()
Call ResumeThread(H1)
Call ResumeThread(H2)
End SubPrivate Sub Command5_Click()
'如果不以多线程方式执行两个循环的过程将导致程序停止响应。
Sub1
Sub2
End SubPrivate Sub Form_Load()
'保存窗体句柄全局变量,用于在form 上绘图
    formhandle = Form1.hwnd
End Sub

解决方案 »

  1.   

    忘了说,详细问题在Command1_Click()代码处。
      

  2.   

    无解vb的函数前经常调用TlsGetValue, 这是一个线程级的api, 如果执行线程序不是vb主线程,
    那么就会得到错误值, 导致非法操作。
      

  3.   

    但是我用作者写的好两个过程outtext1和2,编译成执行程序后就可以运行哦。那这是不是表示就不能用VB的组件而只能用一些API或者说像GDI函数这样的函数来完成线程中的工作。那就没什么意义了呀。
    我不死心,还是想知道是不是真没解。
      

  4.   

    另外加上:
    Public Declare Sub InitializeCriticalSection Lib "kernel32" (lpCriticalSection As CRITICAL_SECTION)
    Public Declare Sub DeleteCriticalSection Lib "kernel32" (lpCriticalSection As CRITICAL_SECTION)Private Sub Form_Load()
        Call InitializeCriticalSection(sect)
    End SubPrivate Sub Form_Unload(Cancel As Integer)
        Call DeleteCriticalSection(sect)
    End Sub
      

  5.   

    当然。 如果你编译成 p-code, 多线程是可以通过的。
      

  6.   

    Modest(塞北雪貂)·(偶最欣赏楼主的分) 
    如你所说加了那两个API,但是:
    Private Sub Form_Load()
        Call InitializeCriticalSection(sect)
        formhandle = Form1.hwnd  '保存窗体句柄全局变量,用于在form 上绘图(在这一行内存溢出,显示form1.hwnd的值是内存溢出)
    End Sub
      

  7.   

    ' Call EnterCriticalSection(sect)
       ' 上下表示该处为临界区,如果要对工程全局变量做操作,最好在该区域内
       ' 否则线程同步过程中,非常容易让程序崩溃
       ' Call LeaveCriticalSection(sect)
    还有过程outtext1的这段,是什么意思呢?是不是说把操作工程全局变量的操作放在这两行中间呢?那对我自己写的两个SUB来说,有什么用处没有呢?我试了在我写的SUB的FOR循环外面放了这两行,但是执行到上面那一行的时候程序就死了,VB也报错崩溃退了出来。