'请将该部分数据保存为 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
'线程安全属性数据结构;
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
解决方案 »
- VB截取截取字符串问题
- 高中毕业,vb程序员,canon ,1000去不去做 困惑
- 落花意,流水情!
- 欢迎加入vb编程乐园(QQ群)!
- 高分问几个问题,不够+++++
- 大家来讨论讨论VB生成的文件如果保存在以多个汉字命名的文件夹中,为什么保存不成功!!一定给分!!
- VB6.0做的浏览器横向滚动条拖动后出现白板
- VB6.0调用Visual Studio 2005编写的静态连接MFC的DLL,导致崩溃!!
- 高分求教一个商用数据库备份恢复问题!!
- 21.我的任务列表经常出Mdm这个项,死机时经常伴随这个任务出现,请问这是个什么任务,有什么作用?
- 能不能在vb中用语句实现“手工在控制面板的ODBC中设置access的数据源”的功能
- 能不能更改VB调试的快捷键,我想把F8与shift+f8 两个快捷键对换!
那么就会得到错误值, 导致非法操作。
我不死心,还是想知道是不是真没解。
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
如你所说加了那两个API,但是:
Private Sub Form_Load()
Call InitializeCriticalSection(sect)
formhandle = Form1.hwnd '保存窗体句柄全局变量,用于在form 上绘图(在这一行内存溢出,显示form1.hwnd的值是内存溢出)
End Sub
' 上下表示该处为临界区,如果要对工程全局变量做操作,最好在该区域内
' 否则线程同步过程中,非常容易让程序崩溃
' Call LeaveCriticalSection(sect)
还有过程outtext1的这段,是什么意思呢?是不是说把操作工程全局变量的操作放在这两行中间呢?那对我自己写的两个SUB来说,有什么用处没有呢?我试了在我写的SUB的FOR循环外面放了这两行,但是执行到上面那一行的时候程序就死了,VB也报错崩溃退了出来。