Phoenixbreath
asked on
the images blink
Hello
I'm new in vb
I tried to make an animation changing of images with a timer, but the images blinks, how can I fix this?
Thx
Sorry about my english
I'm new in vb
I tried to make an animation changing of images with a timer, but the images blinks, how can I fix this?
Thx
Sorry about my english
Perhaps you should try double buffering and using the BitBlr API call. I have an example somewhere. I will dig it out...
Oops, BitBlr should have read bitblt.
Here's one I prepared earlier:
https://www.experts-exchange.com/questions/21274261/Prevent-flickering-BitBlt.html
The idea of double buffering in animations is that you have two buffers, one visible (e.g. a picture box) and one invisible - an area of memory known as the back buffer.
All processing and drawing is done to the back buffer and when the animated frame is complete, it is copied in one memory operation (blitted) into the visible buffer. Double buffering gives flicker free animation.
Here's one I prepared earlier:
https://www.experts-exchange.com/questions/21274261/Prevent-flickering-BitBlt.html
The idea of double buffering in animations is that you have two buffers, one visible (e.g. a picture box) and one invisible - an area of memory known as the back buffer.
All processing and drawing is done to the back buffer and when the animated frame is complete, it is copied in one memory operation (blitted) into the visible buffer. Double buffering gives flicker free animation.
For some reason, that link does not appear to work, so here's the example - create a standard vb project. A form, a largish picturebox and a timer (standard control names). Picture1.Picture = <a background image of your choice> On the form and picturebox, set AutoRedraw = 0 (False)
Drop the following code into Form1:
'========================= ========== ======
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDesktopWindow Lib "User32" () As Long
Private Declare Function GetDC Lib "User32" (ByVal hwnd As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function ReleaseDC Lib "User32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function Ellipse Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function FillRect Lib "User32" _
(ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function TransparentBlt Lib "msimg32.dll" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Boolean
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private hBmp As Long
Private hBmpDC As Long
Private hDCPrev As Long
Private hBmpBG As Long
Private hDCBG As Long
Private hDCPrevBG As Long
Private hBmpSprite As Long
Private hDCSprite As Long
Private hDCPrevSprite As Long
Private Sub Form_Load()
Dim hBrush As Long
Dim hBrushOld As Long
Dim rc As RECT
Picture1.Move 0, 0, Screen.Width, Screen.Height
With Picture1
hDCSprite = CreateCompatibleDC(.hDC)
hBmpSprite = CreateCompatibleBitmap(.hD C, 15, 15)
hDCPrevSprite = SelectObject(hDCSprite, hBmpSprite)
End With
'Set up the sprite
rc.Left = 0: rc.Left = 0: rc.Bottom = 15: rc.Right = 15
hBrush = CreateSolidBrush(vbBlack)
FillRect hDCSprite, rc, hBrush
DeleteObject hBrush
hBrush = CreateSolidBrush(vbGreen)
hBrushOld = SelectObject(hDCSprite, hBrush)
Ellipse hDCSprite, 0, 0, 15, 15
SelectObject hDCSprite, hBrushOld
DeleteObject hBrush
'Force visible
Me.Show
'Set up the background
Picture1.AutoRedraw = False
Timer1.Enabled = True
End Sub
Private Sub Form_Resize()
Static again As Boolean
Timer1.Enabled = False
If again Then
RestoreEverything
Else
again = True
End If
'Get some virtual bitmaps and device contexts
With Picture1
'Resize picture1
.Move 0, 0, ScaleWidth, ScaleHeight
'Refresh the screen to get the background image - may cause a minor flicker
.Refresh
'Create a new back buffer
hBmpDC = CreateCompatibleDC(Picture 1.hDC)
hBmp = CreateCompatibleBitmap(.hD C, .ScaleX(.ScaleWidth, .ScaleMode, vbPixels), .ScaleY(.ScaleHeight, .ScaleMode, vbPixels))
hDCPrev = SelectObject(hBmpDC, hBmp)
'Create a new background image
hDCBG = CreateCompatibleDC(Picture 1.hDC)
hBmpBG = CreateCompatibleBitmap(.hD C, .ScaleX(.ScaleWidth, .ScaleMode, vbPixels), .ScaleY(.ScaleHeight, .ScaleMode, vbPixels))
hDCPrevBG = SelectObject(hDCBG, hBmpBG)
'Redraw the background
BitBlt hDCBG, 0, 0, .ScaleX(.ScaleWidth, .ScaleMode, vbPixels), .ScaleY(.ScaleHeight, .ScaleMode, vbPixels), .hDC, 0, 0, SRCCOPY
ReleaseDC hBmpBG, .hDC
'And the backbuffer
BitBlt hBmpDC, 0, 0, .ScaleX(.ScaleWidth, .ScaleMode, vbPixels), .ScaleY(.ScaleHeight, .ScaleMode, vbPixels), hDCBG, 0, 0, SRCCOPY
ReleaseDC hBmp, hDCBG
End With
Timer1.Enabled = True
End Sub
Private Sub RestoreEverything()
'Put it all back to how it was before we started
'Destroy the back buffer
SelectObject hDCPrev, hBmp
DeleteObject hBmp
DeleteDC hBmpDC
'Destroy the background image
SelectObject hDCPrevBG, hBmpBG
DeleteObject hBmpBG
DeleteDC hDCBG
End Sub
Private Sub Form_Unload(Cancel As Integer)
RestoreEverything
'Destroy the sprite
SelectObject hDCPrevSprite, hBmpSprite
DeleteObject hBmpSprite
DeleteDC hDCSprite
End Sub
Private Sub Timer1_Timer()
Static SpriteX As Long
Static SpriteY As Long
Static SpriteDX As Long
Static SpriteDY As Long
Dim NewSpriteX As Long
Dim NewSpriteY As Long
'No interruptions pleas
Timer1.Enabled = False
'Get new position
NewSpriteX = SpriteX + SpriteDX
NewSpriteY = SpriteY + SpriteDY
If NewSpriteX <= 0 Then
NewSpriteX = 0
SpriteDX = 1 + Int(Rnd * 5)
ElseIf NewSpriteX >= Picture1.ScaleX(Picture1.S caleWidth, Picture1.ScaleMode, vbPixels) - 15 Then
NewSpriteX = Picture1.ScaleX(Picture1.S caleWidth, Picture1.ScaleMode, vbPixels) - 15
SpriteDX = -(1 + Int(Rnd * 5))
End If
If NewSpriteY <= 0 Then
NewSpriteY = 0
SpriteDY = 1 + Int(Rnd * 5)
ElseIf NewSpriteY >= Picture1.ScaleY(Picture1.S caleHeight , Picture1.ScaleMode, vbPixels) - 15 Then
NewSpriteY = Picture1.ScaleY(Picture1.S caleHeight , Picture1.ScaleMode, vbPixels) - 15
SpriteDY = -(1 + Int(Rnd * 5))
End If
'blit a rectangle from the backgound image over the old sprite position on the backbuffer
BitBlt hBmpDC, SpriteX, SpriteY, 15, 15, hDCBG, SpriteX, SpriteY, vbSrcCopy
ReleaseDC hBmp, hDCBG
'Blit a sprite into the new position on the back buffer (transparent background)
TransparentBlt hBmpDC, NewSpriteX, NewSpriteY, 15, 15, hDCSprite, 0, 0, 15, 15, vbBlack
ReleaseDC hBmp, hDCSprite
'blit the back buffer into the picture box ' a bit more processing to find the maximum changed extents would allow a smaller
'rectangle to be blitted into position.
With Picture1
BitBlt .hDC, 0, 0, .ScaleX(.ScaleWidth, .ScaleMode, vbPixels), .ScaleY(.ScaleHeight, .ScaleMode, vbPixels), hBmpDC, 0, 0, SRCCOPY
ReleaseDC Picture1.hwnd, hBmpDC
End With
'store the new positions
SpriteX = NewSpriteX
SpriteY = NewSpriteY
'Turn timer back on
Timer1.Enabled = True
End Sub
Drop the following code into Form1:
'=========================
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDesktopWindow Lib "User32" () As Long
Private Declare Function GetDC Lib "User32" (ByVal hwnd As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function ReleaseDC Lib "User32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function Ellipse Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function FillRect Lib "User32" _
(ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function TransparentBlt Lib "msimg32.dll" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Boolean
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private hBmp As Long
Private hBmpDC As Long
Private hDCPrev As Long
Private hBmpBG As Long
Private hDCBG As Long
Private hDCPrevBG As Long
Private hBmpSprite As Long
Private hDCSprite As Long
Private hDCPrevSprite As Long
Private Sub Form_Load()
Dim hBrush As Long
Dim hBrushOld As Long
Dim rc As RECT
Picture1.Move 0, 0, Screen.Width, Screen.Height
With Picture1
hDCSprite = CreateCompatibleDC(.hDC)
hBmpSprite = CreateCompatibleBitmap(.hD
hDCPrevSprite = SelectObject(hDCSprite, hBmpSprite)
End With
'Set up the sprite
rc.Left = 0: rc.Left = 0: rc.Bottom = 15: rc.Right = 15
hBrush = CreateSolidBrush(vbBlack)
FillRect hDCSprite, rc, hBrush
DeleteObject hBrush
hBrush = CreateSolidBrush(vbGreen)
hBrushOld = SelectObject(hDCSprite, hBrush)
Ellipse hDCSprite, 0, 0, 15, 15
SelectObject hDCSprite, hBrushOld
DeleteObject hBrush
'Force visible
Me.Show
'Set up the background
Picture1.AutoRedraw = False
Timer1.Enabled = True
End Sub
Private Sub Form_Resize()
Static again As Boolean
Timer1.Enabled = False
If again Then
RestoreEverything
Else
again = True
End If
'Get some virtual bitmaps and device contexts
With Picture1
'Resize picture1
.Move 0, 0, ScaleWidth, ScaleHeight
'Refresh the screen to get the background image - may cause a minor flicker
.Refresh
'Create a new back buffer
hBmpDC = CreateCompatibleDC(Picture
hBmp = CreateCompatibleBitmap(.hD
hDCPrev = SelectObject(hBmpDC, hBmp)
'Create a new background image
hDCBG = CreateCompatibleDC(Picture
hBmpBG = CreateCompatibleBitmap(.hD
hDCPrevBG = SelectObject(hDCBG, hBmpBG)
'Redraw the background
BitBlt hDCBG, 0, 0, .ScaleX(.ScaleWidth, .ScaleMode, vbPixels), .ScaleY(.ScaleHeight, .ScaleMode, vbPixels), .hDC, 0, 0, SRCCOPY
ReleaseDC hBmpBG, .hDC
'And the backbuffer
BitBlt hBmpDC, 0, 0, .ScaleX(.ScaleWidth, .ScaleMode, vbPixels), .ScaleY(.ScaleHeight, .ScaleMode, vbPixels), hDCBG, 0, 0, SRCCOPY
ReleaseDC hBmp, hDCBG
End With
Timer1.Enabled = True
End Sub
Private Sub RestoreEverything()
'Put it all back to how it was before we started
'Destroy the back buffer
SelectObject hDCPrev, hBmp
DeleteObject hBmp
DeleteDC hBmpDC
'Destroy the background image
SelectObject hDCPrevBG, hBmpBG
DeleteObject hBmpBG
DeleteDC hDCBG
End Sub
Private Sub Form_Unload(Cancel As Integer)
RestoreEverything
'Destroy the sprite
SelectObject hDCPrevSprite, hBmpSprite
DeleteObject hBmpSprite
DeleteDC hDCSprite
End Sub
Private Sub Timer1_Timer()
Static SpriteX As Long
Static SpriteY As Long
Static SpriteDX As Long
Static SpriteDY As Long
Dim NewSpriteX As Long
Dim NewSpriteY As Long
'No interruptions pleas
Timer1.Enabled = False
'Get new position
NewSpriteX = SpriteX + SpriteDX
NewSpriteY = SpriteY + SpriteDY
If NewSpriteX <= 0 Then
NewSpriteX = 0
SpriteDX = 1 + Int(Rnd * 5)
ElseIf NewSpriteX >= Picture1.ScaleX(Picture1.S
NewSpriteX = Picture1.ScaleX(Picture1.S
SpriteDX = -(1 + Int(Rnd * 5))
End If
If NewSpriteY <= 0 Then
NewSpriteY = 0
SpriteDY = 1 + Int(Rnd * 5)
ElseIf NewSpriteY >= Picture1.ScaleY(Picture1.S
NewSpriteY = Picture1.ScaleY(Picture1.S
SpriteDY = -(1 + Int(Rnd * 5))
End If
'blit a rectangle from the backgound image over the old sprite position on the backbuffer
BitBlt hBmpDC, SpriteX, SpriteY, 15, 15, hDCBG, SpriteX, SpriteY, vbSrcCopy
ReleaseDC hBmp, hDCBG
'Blit a sprite into the new position on the back buffer (transparent background)
TransparentBlt hBmpDC, NewSpriteX, NewSpriteY, 15, 15, hDCSprite, 0, 0, 15, 15, vbBlack
ReleaseDC hBmp, hDCSprite
'blit the back buffer into the picture box ' a bit more processing to find the maximum changed extents would allow a smaller
'rectangle to be blitted into position.
With Picture1
BitBlt .hDC, 0, 0, .ScaleX(.ScaleWidth, .ScaleMode, vbPixels), .ScaleY(.ScaleHeight, .ScaleMode, vbPixels), hBmpDC, 0, 0, SRCCOPY
ReleaseDC Picture1.hwnd, hBmpDC
End With
'store the new positions
SpriteX = NewSpriteX
SpriteY = NewSpriteY
'Turn timer back on
Timer1.Enabled = True
End Sub
Dim Pic() As Picture
Private Sub Form_Load()
Dim Folder As String, File As String
'Folder to find bmp files
Let Folder = "C:\Windows\"
'Get the First file of the pattern
Let File = Dir(Folder & "*.bmp")
'Create to loop until end of the files
Do While File <> ""
'Dynamically increase the array size
ReDim Preserve Pic(I)
'Load and store the image file in the array
Set Pic(I) = LoadPicture(Folder & File)
'Get the next file of the pattern
File = Dir
'Increment the array size
I = I + 1
Loop
End Sub
Private Sub Timer1_Timer()
'Static so that it will not errased after exiting the function
Static I As Integer
'Show the picture on the picturebox
Picture1.Picture = Pic(I)
'Point I to the next picture, reset to first picture after last picture crossed
I = I + 1: If I > 10 Then I = 0
End Sub
The important thing here is set the picturebox(picture1) AutoRedraw property as True
Then dont use image control for animation it will flicker
For Illustration purpose I collected some pictures from windows directory
Private Sub Form_Load()
Dim Folder As String, File As String
'Folder to find bmp files
Let Folder = "C:\Windows\"
'Get the First file of the pattern
Let File = Dir(Folder & "*.bmp")
'Create to loop until end of the files
Do While File <> ""
'Dynamically increase the array size
ReDim Preserve Pic(I)
'Load and store the image file in the array
Set Pic(I) = LoadPicture(Folder & File)
'Get the next file of the pattern
File = Dir
'Increment the array size
I = I + 1
Loop
End Sub
Private Sub Timer1_Timer()
'Static so that it will not errased after exiting the function
Static I As Integer
'Show the picture on the picturebox
Picture1.Picture = Pic(I)
'Point I to the next picture, reset to first picture after last picture crossed
I = I + 1: If I > 10 Then I = 0
End Sub
The important thing here is set the picturebox(picture1) AutoRedraw property as True
Then dont use image control for animation it will flicker
For Illustration purpose I collected some pictures from windows directory
Rubyn:
I believe your technique is valid for a non-dynamic animation i.e. an animation where all frames exist before run-time. However, what is Picture in "Dim Pic() As Picture"? Is it StdPicture?
Also, might it be easier to use an imagelist instead of an array of stdPictures?
I believe your technique is valid for a non-dynamic animation i.e. an animation where all frames exist before run-time. However, what is Picture in "Dim Pic() As Picture"? Is it StdPicture?
Also, might it be easier to use an imagelist instead of an array of stdPictures?
ASKER
Hi again
fatboy, can you explain what those "functions .... lib" do?
thx
fatboy, can you explain what those "functions .... lib" do?
thx
fds_fatboy:
The Author told he is new to vb. so gave this example. Anyway I gave the example simply for understanding. The main concept I tried to communicate is using picturebox with autoredraw set to true will avoid flickering while changing picture.
The Author told he is new to vb. so gave this example. Anyway I gave the example simply for understanding. The main concept I tried to communicate is using picturebox with autoredraw set to true will avoid flickering while changing picture.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thx fds_fatboy
Bob