1. A PictureBox to make animation (delay LoadPicture thus frame by frame by timeGetTime implementation)
2. Will the PictureBox continuous displacement (use timeGetTime continue to change to delay its Left value)
The problem here:
Displacement, the original frame of animation will pause.
A displacement or frame animation, original would suspend
Their use, it's no use DoEvent
Do you have a solution?
Cannot put attachment, only stick the example code:
1. This is my picturebox implementation frame of animation (IMG folder within 1. 2. GIF GIF 3. GIF is I set three static GIF image)
Private Declare Function timeGetTime Lib "winmm. DLL () As" Long
Sub Img1_LoadPic ()
Dim Cycle As Integer
Dim PicNum As Integer
Dim Savetime As Double
For Cycle=1 To 10
For PicNum=1 To 3
Image1. Picture=LoadPicture (ThisWorkbook. Path & amp; "\ IMG " & amp; PicNum & amp; ". GIF ")
DoEvents
Savetime=timeGetTime
While timeGetTime & lt; Savetime + 500
DoEvents
Wend
Next
Next
End Sub
2. This is I realize picturebox constant displacement
Two at the same time run time interrupt another
Do you have two sub solution can produce effect?
Big brand how do I change ~ ~ ~
Sub Img1_Mov ()
Dim Savetime As Double
Dim NowMovNum As Integer
Dim AddMovNum As Integer
Dim AddValue As Integer
For AddValue=https://bbs.csdn.net/topics/1 To 5
NowMovNum=Image1. Left
AddMovNum=NowMovNum + AddValue
Image1. Left=AddMovNum
DoEvents
Savetime=timeGetTime
While timeGetTime & lt; Savetime + 500
DoEvents
Wend
Next
End Sub
CodePudding user response:
Simulations show animation in vba, more difficult ah, directly on the webbrowser control is bad?CodePudding user response:
Use task queue:1) to define a task interface
'ITask
Option Explicit
'in the operation of the tasks to be'
Public Property Get Enabled () As a Boolean
End Property
'the next trigger point'
Public Property Get NextTime () As Long
End Property
'when to trigger point is called,'
'display next frame animation or move next,'
'at the same time need to increase the value of the NextTime set Enabled if the animation/mobile end to False'
Public Sub OnTimer ()
End Sub
2) animation/mobile respectively to make the Class implementing the ITask interface
3) call as follows
Private Sub RunTasks ()
Dim colTasks As Collection
Dim cTask As ITask
Dim lTime As Long
Dim bOnTimer As Boolean
Dim lEnabledCount As Long
The Set colTasks=New Collection
'initialize the animation/mobile task instance, join colTasks collection'
Do
LTime=timeGetTime ()
LEnabledCount=0
BOnTimer=False
For Each cTask colTasks In
If cTask. Enabled Then
If lTime & gt; .=cTask NextTime Then
CTask. OnTimer
BOnTimer=True
If cTask. Enabled Then
LEnabledCount=lEnabledCount + 1
End the If
The Else
LEnabledCount=lEnabledCount + 1
End the If
End the If
Next
If bOnTimer Then
DoEvents
End the If
Loop While lEnabledCount & gt; 0
End Sub