 |
|
 |
yronium Level: Moderator

 Registered: 14-04-2002 Posts: 907
|
Reduce flickering
Hello All. Graphic question:
got an Image control img1, an ImageList control iml1 with six images stored in, a timer control and a StdPicture variable array.
I load all the iml1 pictures into the StdPicture array items, then in the tmr1_Timer event I switch one or another in the Picture property of img1.
But every now and then a nasty flicker apeears, no matter how fast is the Interval property of tmr1. I tried with 50, 100, 200, 500 milliseconds, and even 1000, 2000 and 5000. Always appears sometimes a small img1 flash before changing image.
How can I reduce, or stop it? The form has Autoredraw=True, but seems to have no influence on it. I need an Image control because of its Stretch property (by the way, is there anybody who was anyhow able to make the StdPicture Render method working to resize an image? ), but also with a PictureBox the behaviour is the same. If I Paint directly over the form, the whole form flashes.
Every help is largely appreciated, and thanked in advance.
____________________________
Real Programmer can count up to 1024 on his fingers
|
|
02-02-2004 at 03:07 PM |
|
|
Goran Level: Moderator
 Registered: 16-05-2002 Posts: 1681
|
Re: Reduce flickering
How about this, no flickering on my comp. By the way, AutoRedraw property doesnt have any effect on your problem here.
Private Sub Timer1_Timer()
Static x As Integer
x = x + 1
If x > ImageList1.ListImages.Count Then x = 1
Image1.Picture = ImageList1.ListImages(x).Picture
End Sub |
____________________________
If you find the answer helpful, please mark this topic as solved.
|
|
02-02-2004 at 10:10 PM |
|
|
Goran Level: Moderator
 Registered: 16-05-2002 Posts: 1681
|
Re: Reduce flickering
As for you Render method question, I have been doing a research on it on the Net this evening, and strangely didn't found an example of how it is used. Most of the people that mentioned it in their articles didnt manage to make it work. Basically, there is a much easier method - PaintPicture method that Microsoft suggest to be used instead of Render method. But, since you were also asking questions about Render method on your post about streching picture to form background, I decided to do some of my own research to see if I can help you, and here is some explanantion about StdPicture Render method.
From MSDN:
The Render method syntax has these parts:
Part Description
object Required. Anobject expression that evaluates to an object in the Applies To list.
hdc Required. The handle to the destination object's device context.
xdest Required. The x-coordinate of upper left corner of the drawing region in the destination object. This coordinate is in the scale units of the destination object.
ydest Required. The y-coordinate of upper left corner of the drawing region in the destination object. This coordinate is in the scale units of the destination object.
destwid Required. The width of drawing region in the destination object, expressed in the scale units of the destination object.
desthgt Required. The height of drawing region in the destination object, expressed in the scale units of the destination object.
xsrc Required. The x-coordinate of upper left corner of the drawing region in the source object. This coordinate is in HIMETRIC units.
ysrc Required. The y-coordinate of upper left corner of the drawing region in the source object. This coordinate is in HIMETRIC units.
srcwid Required. The width of drawing region in the source object, expressed in HIMETRIC units.
srchgt Required. The height of drawing region in the source object, expressed in HIMETRIC units.
wbounds Required. The world bounds of ametafile. This argument should be passed a value of Null unless drawing to a metafile, in which case the argument is passed a user-defined type corresponding to a RECTL structure.
Last parameter is not our concern here, since we are not working with metafiles.
Considering destination object (ex PictureBox) and its left, top, width and height parameters, MSDN says it should be expressed in scale units of the destination object. It didnt work in my case, and I have come to the conclusion that it should be expressed in PIXELS. So, first thing you should do is set Pciture's ScaleMode to 3-Pixel.
As for the source object (stdPicture), its left, top, width and height should be expressed in HIMETRIC units. StdPicture's Width and height property are by default expressed in HIMETRIC units, so there is no need for converting. But if you use this code:
pic.Render Picture1.hDC, 0, 0, _
Picture1.ScaleWidth, Picture1.ScaleHeight, _
0, 0, pic.Width, pic.Height, 0 |
you will get picture that is flipped vertically. This happens beause coordinate system that use HIMETRIC values has 0,0 position in the left-bottom point. Positive x is to the right; positive y is up.
So to manage this you need to change the direction that Render methid should read source target. The idea is to "tell" Render method to read the source target in the direction left-top, right-bottom.
Private Sub Command1_Click()
Dim pic As StdPicture
Set pic = LoadPicture("D:\Goran\My Pictures\T-Shirt.jpg")
pic.Render Picture1.hDC, 0, 0, _
Picture1.ScaleWidth, Picture1.ScaleHeight, _
0, pic.Height, pic.Width, -pic.Height, 0
End Sub |
In order this example to work you need to have PictureBox's ScaleMode set to 3-Pixel.
I hope that this explanation was clear and useful to you Yronium (and stopped you from , ) and to all the others that were interested in Render method.
____________________________
If you find the answer helpful, please mark this topic as solved.
|
|
03-02-2004 at 12:36 AM |
|
|
yronium Level: Moderator

 Registered: 14-04-2002 Posts: 907
|
Re: Reduce flickering
Private Sub tmr1_Timer()
' numlogo is a module level variable, set = 1 on Form_Load event
imgLogo.Picture = iml1.ListImages.Item(numLogo).Picture
If numLogo < 6 Then
numLogo = numLogo + 1
Else
numLogo = 1
End If
End Sub |
This is my code, Goran. I get the terrible flickering I described above, even running the compiled executable in a PIII 800Mhz pc.
The alternative I tried out, but without any flickering reduction is as following:Option Explicit
Dim numLogo As Integer
Dim picLogo(5) as StdPicture
Private Sub Form_Load()
Dim i As Integer
' load the pictures into a variable's array
For i = 0 To 5
Set picLogo(i) = iml1.ListImages.Item(i + 1).Picture
Next i
numLogo = 1
End Sub
Private Sub tmr1_Timer()
imgLogo.Picture = picLogo(numLogo - 1)
If numLogo < 6 Then
numLogo = numLogo + 1
Else
numLogo = 1
End If
End Sub |
Maybe it matter that the image control is very small, so therefore I notice more the flicker effect, but I experienced it even after putting another larger image control. And I tried hard keeping the code as simpler as possible. But I still get a flick every three, four or five timer ticks. (It's not always the same picture, but they all do it at random)
The flick I mean is: my six pictures are .gif files, having a transparent background. The imgLogo control show its backcolor on the backgroud of the picture, but after three or four pictures it quickly flashes a rectangle - its real shape, like it needed to redraw itself every now and then. When running faster, it's a very nasty effect.
Steve, have you got only one single Image1 control? In your code there's something I miss, you put only the Image1(0) item, isn't it?
Anyway, I tried it out and it works, but still got flicks. I also tried to increase anyway the numLogo variable, and then check it with the If condition, as you both did, like numLogo = numLogo + 1
If numLogo > iml1.ListImages.Count Then numLogo = 1 |
but no changes (....ugh...)
I made all the tests with 1000 milliseconds on timer's Interval property.
____________________________
Real Programmer can count up to 1024 on his fingers
|
|
03-02-2004 at 12:37 AM |
|
|
yronium Level: Moderator

 Registered: 14-04-2002 Posts: 907
|
Re: Reduce flickering
(About Render method
Goran, you made a very huge work, and your explanation is far clearer than MSDN ones. I will try your example at once and print this topic to study it. I am very thankful to you, and if I was your boss, I will increase your pay for sure
I hope that I will be able to resize my StdPicture images now. Like actual app: I have my six pics, say 480x96 pixels, but I want to store them in a StdPicture array as, say, 100x30 pixels, and I was never able to do it. I hope it work.
I have read all the MSDN stuff (very few) about StdPicture and Render method, and I read that they suggest to use PaintPicture instead, but still had this problem: how resize them before, in order to paint or just load a smaller image? And I read about the parameter types, but I must confess I'm not deep with graphic measurement units, so it never worked to me. Again, you made a very huge and important study on it. Thank you again so much!!)
____________________________
Real Programmer can count up to 1024 on his fingers
|
|
03-02-2004 at 12:53 AM |
|
|
Goran Level: Moderator
 Registered: 16-05-2002 Posts: 1681
|
Re: Reduce flickering
Dont miss my previous post, cause we have made posts at the same time. I have Duron 750Mhz, 256DDR, and no flickering.
I have put a image control on the form, with
Width=3000
Height=2200
Strecth=True
Imagelist control, with 10 pictures size 800x600 (approximate size is 200Kbs), and a Timer control with Interval set to 1000, 500, and 100 respectively, and no flickering occured.
[Edited by Goran on 03-02-2004 at 02:03 AM GMT]
____________________________
If you find the answer helpful, please mark this topic as solved.
|
|
03-02-2004 at 12:56 AM |
|
|
Goran Level: Moderator
 Registered: 16-05-2002 Posts: 1681
|
Re: Reduce flickering
vbgen, what do u mean by subclassing, what idea are you reffering to? (every image is repainted only once)
____________________________
If you find the answer helpful, please mark this topic as solved.
|
|
04-02-2004 at 08:17 PM |
|
|
Goran Level: Moderator
 Registered: 16-05-2002 Posts: 1681
|
Re: Reduce flickering
fabulous, I didnt mean what subclassing means, I am well intruduced in it ( in my posts there are some subclassing codes) , my question was what idea did he had in mind when he reffered to subclassing.
quote: I'm yet to see the code that vbgen has directed us to but I suppose it hooks (intercepts messages for) the image control and does something to prevent the flicker.
this something to prevent flicker is the thing I was reffering to. Flickering occurs when u have multiple painting of the control, so to prevent it you can lock the window from updating while while invalidating and then redraw it.
(the example for this would be subclassing the text box to set transparent background - flickering would occur while scrolling multiline textbox)
This is why I asked vbgen what idea did he had in mind when he mentioned subclassing, because every image that is loaded is drawn only once (unles there is a overcast over the image), and timing betwen loading images is long enough - 1 sec (I have even tested this example with 0,1 sec and no flickering occured), so I was wondering what is he trying to achieve with subclassing?
[Edited by Goran on 05-02-2004 at 12:30 AM GMT]
____________________________
If you find the answer helpful, please mark this topic as solved.
|
|
04-02-2004 at 11:22 PM |
|
|
vbgen Level: Moderator
 Registered: 10-10-2002 Posts: 876
|
Re: Reduce flickering
here it is...
http://www.vbaccelerator.com/home/VB/Code/Libraries/Graphics_and_GDI/Flicker_Free_API_Drawing/article.asp
and the code of the class module... *sorry, don't have vb yet in this pc*
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "cDrawSample"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal xOffset As Long, ByVal yOffset As Long) As Long
Private Declare Function GetSysColorBrush Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Const PS_SOLID = 0
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Enum EDrawTextFormat
DT_BOTTOM = &H8
DT_CALCRECT = &H400
DT_CENTER = &H1
DT_EXPANDTABS = &H40
DT_EXTERNALLEADING = &H200
DT_INTERNAL = &H1000
DT_LEFT = &H0
DT_NOCLIP = &H100
DT_NOPREFIX = &H800
DT_RIGHT = &H2
DT_SINGLELINE = &H20
DT_TABSTOP = &H80
DT_TOP = &H0
DT_VCENTER = &H4
DT_WORDBREAK = &H10
DT_EDITCONTROL = &H2000&
DT_PATH_ELLIPSIS = &H4000&
DT_END_ELLIPSIS = &H8000&
DT_MODIFYSTRING = &H10000
DT_RTLREADING = &H20000
DT_WORD_ELLIPSIS = &H40000
End Enum
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Const OPAQUE = 2
Private Const TRANSPARENT = 1
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Type DrawObjectData
iDirX As Integer
iDirY As Integer
foreColor As Long
backColor As Long
sCaption As String
tP As POINTAPI
lSize As Long
End Type
Private m_tDrawObject() As DrawObjectData
Private m_iDrawObjectCount As Long
Private m_font As IFont
Private m_bUseMemDc As Boolean
Private m_cMemDc As pcMemDC
Private m_tR As RECT
Public Property Get UseMemDc() As Boolean
UseMemDc = m_bUseMemDc
End Property
Public Property Let UseMemDc(ByVal value As Boolean)
m_bUseMemDc = value
End Property
Public Property Get Left() As Long
Left = m_tR.Left
End Property
Public Property Let Left(ByVal value As Long)
m_tR.Left = value
End Property
Public Property Get Top() As Long
Top = m_tR.Top
End Property
Public Property Let Top(ByVal value As Long)
m_tR.Top = value
End Property
Public Property Get Width() As Long
Width = m_cMemDc.Width
End Property
Public Property Let Width(ByVal value As Long)
m_cMemDc.Width = value
End Property
Public Property Get Height() As Long
Height = m_cMemDc.Height
End Property
Public Property Let Height(ByVal value As Long)
m_cMemDc.Height = value
End Property
Public Property Get Font() As IFont
Set Font = m_font
End Property
Public Property Let Font(value As IFont)
pSetFont value
End Property
Public Property Set Font(value As IFont)
pSetFont value
End Property
Private Sub pSetFont(theFont As IFont)
theFont.Clone m_font
End Sub
Public Sub Draw(ByVal lOutputDc As Long)
Dim tDrawR As RECT
Dim lhDC As Long
' set up the drawing rectangle:
m_tR.Right = m_tR.Left + m_cMemDc.Width
m_tR.Bottom = m_tR.Top + m_cMemDc.Height
' Get where we're drawing to:
Dim lOffsetX As Long
Dim lOffsetY As Long
LSet tDrawR = m_tR
If (m_bUseMemDc) Then
lhDC = m_cMemDc.hdc
OffsetRect tDrawR, -m_tR.Left, -m_tR.Top
Else
lhDC = lOutputDc
lOffsetX = m_tR.Left
lOffsetY = m_tR.Top
End If
' draw the background:
drawBackground lhDC, tDrawR
Dim hFont As Long
Dim hFontOld As Long
hFont = SelectObject(lhDC, m_font.hFont)
SetBkMode lhDC, TRANSPARENT
' draw the objects
Dim i As Long
For i = 1 To m_iDrawObjectCount
drawObject lhDC, i, lOffsetX, lOffsetY
Next i
SelectObject lhDC, hFontOld
' if using a memory DC, we need to copy the result:
If (m_bUseMemDc) Then
m_cMemDc.Draw lOutputDc, , , , , m_tR.Left, m_tR.Top
End If
End Sub
Private Sub drawBackground(ByVal lhDC As Long, tDrawR As RECT)
Dim hBr As Long
hBr = GetSysColorBrush(vbWindowBackground And &H1F&)
FillRect lhDC, tDrawR, hBr
DeleteObject hBr
Dim hPen As Long
Dim hPenOld As Long
Dim tJunk As POINTAPI
hPen = CreatePen(PS_SOLID, 1, GetSysColor(vbHighlight And &H1F&))
hPenOld = SelectObject(lhDC, hPen)
MoveToEx lhDC, tDrawR.Left, tDrawR.Top, tJunk
LineTo lhDC, tDrawR.Right - 1, tDrawR.Top
LineTo lhDC, tDrawR.Right - 1, tDrawR.Bottom - 1
LineTo lhDC, tDrawR.Left, tDrawR.Bottom - 1
LineTo lhDC, tDrawR.Left, tDrawR.Top
SelectObject lhDC, hPenOld
DeleteObject hPen
End Sub
Public Sub CreateObjects(ByVal iCount As Long)
m_iDrawObjectCount = iCount
ReDim Preserve m_tDrawObject(1 To m_iDrawObjectCount) As DrawObjectData
Dim i As Long
Dim lSize As Long
Dim h As Single, s As Single, l As Single
Dim r As Long, b As Long, g As Long
Dim rf As Long, bf As Long, gf As Long
RGBToHLS &H33, &H99, &HEE, h, s, l
For i = 1 To m_iDrawObjectCount
With m_tDrawObject(i)
HLSToRGB h, s, l, r, g, b
l = l * 0.95
.backColor = RGB(r, g, b)
HLSToRGB h, s, l * 4, rf, gf, bf
.foreColor = RGB(rf, gf, bf)
Do While (.iDirX = 0)
.iDirX = Rnd * 8 - 4
Loop
Do While (.iDirY = 0)
.iDirY = Rnd * 8 - 4
Loop
.sCaption = Hex(.backColor)
.lSize = 32 + Rnd * 32
.tP.x = Rnd * (m_cMemDc.Width - .lSize)
.tP.y = Rnd * (m_cMemDc.Height - .lSize)
End With
Next i
End Sub
Private Sub drawObject(ByVal lhDC As Long, ByVal iIndex As Long, ByVal lOffsetX As Long, ByVal lOffsetY As Long)
With m_tDrawObject(iIndex)
' update the position
If (.tP.x + .lSize + .iDirX >= m_cMemDc.Width) Then
.iDirX = -.iDirX
End If
If (.tP.x + .iDirX <= 0) Then
.iDirX = -.iDirX
End If
If (.tP.y + .lSize + .iDirY >= m_cMemDc.Height) Then
.iDirY = -.iDirY
End If
If (.tP.y + .iDirY <= 0) Then
.iDirY = -.iDirY
End If
.tP.x = .tP.x + .iDirX
.tP.y = .tP.y + .iDirY
Dim hBr As Long
Dim tR As RECT
tR.Left = .tP.x
tR.Top = .tP.y
tR.Right = tR.Left + .lSize
tR.Bottom = tR.Top + .lSize
OffsetRect tR, lOffsetX, lOffsetY
hBr = CreateSolidBrush(.backColor)
FillRect lhDC, tR, hBr
DeleteObject hBr
SetTextColor lhDC, .foreColor
DrawText lhDC, .sCaption, -1, tR, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
End With
End Sub
Private Sub RGBToHLS( _
ByVal r As Long, ByVal g As Long, ByVal b As Long, _
h As Single, s As Single, l As Single _
)
Dim Max As Single
Dim Min As Single
Dim delta As Single
Dim rR As Single, rG As Single, rB As Single
rR = r / 255: rG = g / 255: rB = b / 255
'{Given: rgb each in [0,1].
' Desired: h in [0,360] and s in [0,1], except if s=0, then h=UNDEFINED.}
Max = Maximum(rR, rG, rB)
Min = Minimum(rR, rG, rB)
l = (Max + Min) / 2 '{This is the lightness}
'{Next calculate saturation}
If Max = Min Then
'begin {Acrhomatic case}
s = 0
h = 0
'end {Acrhomatic case}
Else
'begin {Chromatic case}
'{First calculate the saturation.}
If l <= 0.5 Then
s = (Max - Min) / (Max + Min)
Else
s = (Max - Min) / (2 - Max - Min)
End If
'{Next calculate the hue.}
delta = Max - Min
If rR = Max Then
h = (rG - rB) / delta '{Resulting color is between yellow and magenta}
ElseIf rG = Max Then
h = 2 + (rB - rR) / delta '{Resulting color is between cyan and yellow}
ElseIf rB = Max Then
h = 4 + (rR - rG) / delta '{Resulting color is between magenta and cyan}
End If
'end {Chromatic Case}
End If
End Sub
Private Sub HLSToRGB( _
ByVal h As Single, ByVal s As Single, ByVal l As Single, _
r As Long, g As Long, b As Long _
)
Dim rR As Single, rG As Single, rB As Single
Dim Min As Single, Max As Single
If s = 0 Then
' Achromatic case:
rR = l: rG = l: rB = l
Else
' Chromatic case:
' delta = Max-Min
If l <= 0.5 Then
's = (Max - Min) / (Max + Min)
' Get Min value:
Min = l * (1 - s)
Else
's = (Max - Min) / (2 - Max - Min)
' Get Min value:
Min = l - s * (1 - l)
End If
' Get the Max value:
Max = 2 * l - Min
' Now depending on sector we can evaluate the h,l,s:
If (h < 1) Then
rR = Max
If (h < 0) Then
rG = Min
rB = rG - h * (Max - Min)
Else
rB = Min
rG = h * (Max - Min) + rB
End If
ElseIf (h < 3) Then
rG = Max
If (h < 2) Then
rB = Min
rR = rB - (h - 2) * (Max - Min)
Else
rR = Min
rB = (h - 2) * (Max - Min) + rR
End If
Else
rB = Max
If (h < 4) Then
rR = Min
rG = rR - (h - 4) * (Max - Min)
Else
rG = Min
rR = (h - 4) * (Max - Min) + rG
End If
End If
End If
r = rR * 255: g = rG * 255: b = rB * 255
End Sub
Private Function Maximum(rR As Single, rG As Single, rB As Single) As Single
If (rR > rG) Then
If (rR > rB) Then
Maximum = rR
Else
Maximum = rB
End If
Else
If (rB > rG) Then
Maximum = rB
Else
Maximum = rG
End If
End If
End Function
Private Function Minimum(rR As Single, rG As Single, rB As Single) As Single
If (rR < rG) Then
If (rR < rB) Then
Minimum = rR
Else
Minimum = rB
End If
Else
If (rB < rG) Then
Minimum = rB
Else
Minimum = rG
End If
End If
End Function
Private Sub Class_Initialize()
Set m_cMemDc = New pcMemDC
Dim s As New StdFont
s.Name = "Arial"
s.Size = 8
Set m_font = s
End Sub |
____________________________
Been busy trying to take a second degree <--it's not working out...
|
|
05-02-2004 at 06:26 PM |
|
|
Goran Level: Moderator
 Registered: 16-05-2002 Posts: 1681
|
Re: Reduce flickering
Activity: milions of questions seeking for answers. Place: my head. This code works with own drawing, and as it is said in the article it does the same thing as Autoredraw property (creates an off-screen buffer). Since image control doesnt have a hDC, Yronium would have to use picture box. I still dont understand why does Yronium get flickering and I dont, altough I have slower PC that he does.
Main question would be does anyone know how the picture property behaves? (what stuff is performing inside VB?) Does it also create an off-screen buffer after receiving an image, perfors drawing on it, and at last does bltblt stuff on control? If it does, then basically we have then some sort of already implemented code we have here. if it, doesnt (which might be the case since there is flickering), then Yronium, you would have to do next:
- create a DC and bitmap based on your picturebox's height and with.
- Resize your images with code, which might bring you back to transparency problem. While ago when I wrote some code similar to this code vbgen presented, I had problem which occured when I loaded a transparent picture in Bitmap object - it lost all transparent bits, so you would have to either use TransparentBlt API, or to create your own code for setting transparency color. All this might slow down execution enough to be noticable.
- bitblt to a picture box DC.
The sub's you can use from this code are CreateFromPicture and Draw sub's from pcMemDC class, with some modifications.
Dont know if all this stuff you have read from our posts helped you, but this might be the only way you can solve our problem.
____________________________
If you find the answer helpful, please mark this topic as solved.
|
|
06-02-2004 at 01:08 AM |
|
|
| |