1.ç¨vb6å¯ä¸å¯ä»¥è®¾è®¡å¤çº¿ç¨åºçåºç¨ç¨åºï¼å¦ä½å®ç°
ç¨vb6å¯ä¸å¯ä»¥è®¾è®¡å¤çº¿ç¨åºçåºç¨ç¨åºï¼å¦ä½å®ç°
å¤çº¿ç¨æ¯å¯ä»¥åï¼åªæ¯ä¸å¤ªå®å ¨ï¼å®¹æéæ³æä½ï¼
æºä»£ç å¦ä¸ï¼
çªä½ä¸ç代ç ï¼
Option Explicit
'å¼å§
Private Sub Command1_Click()
On Error Resume Next
With myThreadleft
.Initialize AddressOf Fillleft 'ä¼ éè¿ç¨å°åç»çº¿ç¨
.ThreadEnabled = True
End With
With myThreadright
.Initialize AddressOf Fillright
.ThreadEnabled = True
End With
With myThreadbottom
.Initialize AddressOf Fillbottom
.ThreadEnabled = True
End With
MsgBox "å¤çº¿ç¨æ£å¨è¿è¡...ï¼ççå¾çæ¡æ§ä»¶çåè²ææï¼",源码口袋支点源码 , "ä¿¡æ¯"
'ç»æ¢çº¿ç¨è¿è¡
Set myThreadleft = Nothing
Set myThreadright = Nothing
Set myThreadbottom = Nothing
End Sub
'ç»æ
Private Sub Command2_Click()
Unload Me
End Sub
模åä¸ç代ç ï¼
Option Explicit
'æ¶é´è®¡æ°API
Private Declare Function GetTickCount Lib "kernel" () As Long
'声æcls_threadç±»ç对象åé
Public myThreadleft As New cls_thread, myThreadright As New cls_thread, myThreadbottom As New cls_thread
Sub Main()
Load Form1
Form1.Show
End Sub
Public Sub Fillleft()
Static Bkgcolor As Long
Dim LongTick As Long, Longcounter As Long
On Error Resume Next
For Longcounter = 0 To
DoEvents
Bkgcolor = Longcounter Mod
Form1.Picture1.BackColor = RGB(Bkgcolor, 0, 0)
LongTick = GetTickCount
While GetTickCount - LongTick < '延æ¶æ¯«ç§,ä¸å
Wend
Next
Set myThreadleft = Nothing 'å¦æ循ç¯ç»æåç»æ¢å½å线ç¨è¿è¡ï¼ä¸å
End Sub
Public Sub Fillright()
Static Bkgcolor As Long
Dim LongTickValue As Long, Longcounter As Long
On Error Resume Next
For Longcounter = 0 To
DoEvents
Bkgcolor = Longcounter Mod
Form1.Picture2.BackColor = RGB(0, Bkgcolor, 0)
LongTickValue = GetTickCount
While GetTickCount - LongTickValue <
Wend
Next
Set myThreadright = Nothing
End Sub
Public Sub Fillbottom()
Static Bkgcolor As Long
Dim LongTick As Long, Longcounter As Long
On Error Resume Next
For Longcounter = 0 To
DoEvents
Bkgcolor = Longcounter Mod
Form1.Picture3.BackColor = RGB(0, 0, Bkgcolor)
LongTick = GetTickCount
While GetTickCount - LongTick <
Wend
Next
Set myThreadright = Nothing
End Sub
类模åä¸ç代ç ï¼
'åè½ï¼å建å¤çº¿ç¨ç±»ï¼ç¨äºåå§å线ç¨ã ç±»åï¼cls_Thread
'åæ°ï¼LongPointFunction ç¨äºæ¥æ¶ä¸»è°è¿ç¨ä¼ éè¿æ¥çå½æ°å°åå¼
'è°ç¨æ¹æ³ï¼1.声æ线ç¨ç±»å¯¹è±¡åé Dim mythread as cls_Thread
' 2.è°ç¨å½¢å¼ï¼With mythread
' .Initialize AddressOf èªå®ä¹è¿ç¨æå½æ°å '(åå§å线ç¨) .
' .ThreadEnabled = True '(设置线ç¨æ¯å¦æ¿æ´»)
' End With
' 3.ç»æ¢è°ç¨ï¼ Set mythread = Nothing
' Crate By : éå® On .5. Copyright(C).Ldt By CY-soft --
' Email:4y4ycoco@.com
' Test Onï¼ VB6.0+Win AND VB6.0+WinXP It's Pass ï¼
Option Explicit
'å建线ç¨API
'æ¤APIç»è¿æ¹é ï¼lpThreadAttributesæ¹ä¸ºAnyåï¼lpStartAddressæ¹ä¸ºä¼ å¼å¼ç¨ï¼
'å 为å½æ°çå ¥å£å°åç±å½¢ååéä¼ éï¼å¦æç¨ä¼ åé£å°ä¼ éå½¢ååéçå°åèä¸æ¯å½æ°çå ¥å£å°å
Private Declare Function CreateThread Lib "kernel" (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
Private Declare Function TerminateThread Lib "kernel" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
'æ¿æ´»çº¿ç¨API
Private Declare Function ResumeThread Lib "kernel" (ByVal hThread As Long) As Long
'æ起线ç¨API
Private Declare Function SuspendThread Lib "kernel" (ByVal hThread As Long) As Long
Private Const CREATE_SUSPENDED = &H4 '线ç¨æ起常é
'èªå®ä¹çº¿ç¨ç»æç±»å
Private Type udtThread
Handle As Long
Enabled As Boolean
End Type
Private meTheard As udtThread
'åå§å线ç¨
Public Sub Initialize(ByVal LongPointFunction As Long)
Dim LongStackSize As Long, LongCreationFlags As Long, LpthreadId As Long, LongNull As Long
On Error Resume Next
LongNull = 0
LongStackSize = 0
LongCreationFlags = CREATE_SUSPENDED 'å建线ç¨åå æèµ·ï¼ç±ç¨åºæ¿æ´»çº¿ç¨
'å建线ç¨å¹¶è¿çº¿ç¨å¥æ
meTheard.Handle = CreateThread(LongNull, LongStackSize, ByVal LongPointFunction, LongNull, LongCreationFlags, LpthreadId)
If meTheard.Handle = LongNull Then
MsgBox "线ç¨å建失败ï¼", , "é误"
End If
End Sub
'è·å线ç¨æ¯å¦æ¿æ´»å±æ§
Public Property Get ThreadEnabled() As Boolean
On Error Resume Next
Enabled = meTheard.Enabled
End Property
'设置线ç¨æ¯å¦æ¿æ´»å±æ§
Public Property Let ThreadEnabled(ByVal Newvalue As Boolean)
On Error Resume Next
'è¥æ¿æ´»çº¿ç¨ï¼Newvalue为çï¼è®¾ä¸ºTRUEä¸æ¤çº¿ç¨åæ¥æ²¡ææ¿æ´»æ¶æ¿æ´»æ¤çº¿ç¨
If Newvalue And (Not meTheard.Enabled) Then
ResumeThread meTheard.Handle
meTheard.Enabled = True
Else 'è¥æ¿æ´»çº¿ç¨ï¼Newvalue为çï¼ä¸æ¤çº¿ç¨åæ¥å·²æ¿æ´»åæèµ·æ¤çº¿ç¨
If meTheard.Enabled Then
SuspendThread meTheard.Handle
meTheard.Enabled = False
End If
End If
End Property
'ç»æ¢çº¿ç¨äºä»¶
Private Sub Class_Terminate()
On Error Resume Next
Call TerminateThread(meTheard.Handle, 0)
End Sub