VB无所不能之七：VB的多线程（2）

云查杀很牛X的金山毒霸！免费啦！2011下载链接！

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

Declare  Function GetDC Lib  "user32" () Declare  Function GetDC Lib  "user32" (ByVal hwnd  As Long)  As Long 
Declare  Function SetBkColor Lib  "gdi32" () Declare  Function SetBkColor Lib  "gdi32" (ByVal hdc  As Long, ByVal crColor  As Long)  As Long 
Declare  Function TextOut Lib  "gdi32" Alias  "TextOutA" () 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 
Declare  Function ReleaseDC Lib  "user32" () Declare  Function ReleaseDC Lib  "user32" (ByVal hwnd  As Long, ByVal hdc  AsLong)  As Long 

Declare  Function CreateThread Lib  "kernel32" () 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 

Declare  Sub Sleep Lib  "kernel32" () Declare  Sub Sleep Lib  "kernel32" (ByVal dwMilliseconds  As Long) 

'全局的form的句柄！ 
Public formhandle  As Long 

OutText1() 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, &HF0F0F0)     '设置绘制区域的背景色，也起清除作用 
                         Call TextOut(dc, 10, 10, s,  Len(s))  '输出文本！ 
                         Call Sleep(40)  '等待 
                 Next 
                 Call ReleaseDC(formhandle, dc)     '释放资源！ 

End  Sub 

OutText2() 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, &HF0F0F0) 
                         Call TextOut(dc, 10, 80, s,  Len(s))     '文本位置改变了 
                         Call Sleep(20)  '延时改变了 
                 Next 
                 Call ReleaseDC(formhandle, dc) 
End  Sub

Sub Command1_Click()  Sub Command1_Click() 
         
         '声明了线程ID 
         Dim threadid1  As Long 
         Dim threadid2  As Long 

         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) 
         
End  Sub 

Sub Form_Load()  Sub Form_Load() 
         '保存窗体句柄全局变量，用于在form 上绘图 
        formhandle = Form1.hwnd 
End  Sub

 本文转自 useway 51CTO博客，原文链接：http://blog.51cto.com/useway/326200，如需转载请自行联系原作者