Link to home
Start Free TrialLog in
Avatar of Phoenixbreath
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
Avatar of Bob Lamberson
Bob Lamberson
Flag of United States of America image

try experimenting with the length of time in the timer. the number you enter is milliseconds.

Bob
Avatar of fds_fatboy
fds_fatboy

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.
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(.hDC, 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(Picture1.hDC)
        hBmp = CreateCompatibleBitmap(.hDC, .ScaleX(.ScaleWidth, .ScaleMode, vbPixels), .ScaleY(.ScaleHeight, .ScaleMode, vbPixels))
        hDCPrev = SelectObject(hBmpDC, hBmp)
       
        'Create a new background image
        hDCBG = CreateCompatibleDC(Picture1.hDC)
        hBmpBG = CreateCompatibleBitmap(.hDC, .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.ScaleWidth, Picture1.ScaleMode, vbPixels) - 15 Then
        NewSpriteX = Picture1.ScaleX(Picture1.ScaleWidth, 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.ScaleHeight, Picture1.ScaleMode, vbPixels) - 15 Then
        NewSpriteY = Picture1.ScaleY(Picture1.ScaleHeight, 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

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
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?
Avatar of Phoenixbreath

ASKER

Hi again
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.
ASKER CERTIFIED SOLUTION
Avatar of fds_fatboy
fds_fatboy

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thx fds_fatboy