Enlever l'effet clignottement sur un control

Question

Bonjour à tous,
Une fois de plus je me tourne vers vous au cas ou je serais passer à côté de quelque chose....

Sous W2K, VB6 SP6

Suite à une réécriture de mes UserControls au Taf, je m'étais retrouver avec des Erreurs  Runtime Error "480" Can't create autoredraw image (un autre message ICI)

J'ai donc essayer d'utiliser ce que certains appelle le "Double Buffering" et d'autres le "Back Buffering". bref le dessin dans un DC "invisible", dans le but de pouvoir mettre AutoRedraw =  False
J'ai suivi les tuto ICI

Après avoir galérer un peu avec GDI (normal je ne connaissais pas) et sa gestion des objets (toujours tout remettre comme on l'a trouver etc...), je suis arrivé à avoir un control pas trop mal avec  Autoredraw = False . Mais le problème c'est que lors du resize ca clignote (avec la couleur de fond du UserControl d'ailleurs)

Mes questions sont donc: 
- Qu'est ce que je fais mal?
- Existe t il une astuce?

Le UserControl Concerné est un simple panel, dont voici la méthode de dessin. 
Si vous pouviez me donner un petit coup de main, (un lien ou bien une explication) ça serait super.

NOte: Je sais que vous ne pourrez pas exécuter le code tel quel mais je voulais vous le montrer au cas ou quelques choses vous sauterait au yeux


Private Sub DrawPanel()
Dim R As RECT
Dim CPxl As Single
Dim bckDC As Long
Dim bckBMP As Long
Dim bckRect As RECT
Dim bckFont As Long
Dim bckPen As Long
Dim bckBrush As Long
Dim picDC As Long
Dim oldObjPicDC As Long
Dim picInfo As Bitmap
Dim OldBMP As Long
Dim oldObject As Long

    CPxl  = mCaptionHeight / Screen.TwipsPerPixelY
    CaptCoord.Left = 0
    CaptCoord.Top = 0
    CaptCoord.Bottom = CPxl
    CaptCoord.Right = ScaleWidth
    
    UserControl.ScaleMode = vbPixels
    
    'On cree le context
    bckDC = CreateCompatibleDC(hDC)
    bckBMP = CreateCompatibleBitmap(hDC, ScaleWidth, ScaleHeight)
    OldBMP = SelectObject(bckDC, bckBMP)
    
    'le fond du panel
    'bckBrush CreateSolidBrush(mPanelBackColor)
    Call SetRect(bckRect, 0, 0, ScaleWidth, ScaleHeight)
    Call FillRect(bckDC, bckRect, bckBrush)
    Call DeleteObject(bckBrush)
    'Dim oldBKColor As Long
    'oldBKColor = SetBkColor(bckDC, vbGreen)
    '===========================
    
    
    'Le Fond du caption
    '===========================
    If mCaptionGradient Then
        Call FillGradient(bckDC, mBordersColor, mCaptionBackColor, ScaleWidth, CaptCoord.Bottom)
    Else
        bckBrush = CreateSolidBrush(mCaptionBackColor)
        Call FillRect(bckDC, CaptCoord, bckBrush)
        Call DeleteObject(bckBrush)
    End If
    '============================
    
    'Le dessin des bords si nécessaire
    '============================
    If mShowBorders Then
        'On part du haut gauche
        Call MoveToEx(bckDC, 0, 0, Null)
        'création du stylo
        bckPen = CreatePen(0, mBorderWidth, mBordersColor)
        oldObject = SelectObject(bckDC, bckPen)
        '=> Bord Gauche
        Call LineTo(bckDC, 0, ScaleHeight - mBorderWidth)
        '=> Bord Bas
        Call LineTo(bckDC, ScaleWidth - mBorderWidth, ScaleHeight - mBorderWidth)
        '=> Bord Droite
        Call LineTo(bckDC, ScaleWidth - mBorderWidth, 0)
        '=> Bord Haut
        Call LineTo(bckDC, 0, 0)
        '=> Bord Sous Caption
        Call MoveToEx(bckDC, 0, CaptCoord.Bottom, Null)
        Call LineTo(bckDC, ScaleWidth, CaptCoord.Bottom)

        Call SelectObject(bckDC, oldObject)
        Call DeleteObject(bckPen)
    End If
    '===================================

    'Dessin du titre du panel
    '===================================
    Dim oldTxtColor As Long
    Call SetRect(R, 2 * mBorderWidth, (CPxl - GetCharHeight) / 2, ScaleWidth - (2 * mBorderWidth), CPxl)
    oldTxtColor = SetTextColor(bckDC, mCaptionColor)
    Call SetBkMode(bckDC, 1) '1= Transparent

    bckFont = CreateFontIndirect(mFont)
    oldObject = SelectObject(bckDC, bckFont)

    If mTextAlignment = TARightMiddle Then
        'à droite
        Call DrawText(bckDC, mCaption, Len(mCaption), R, DT_RIGHT)
    ElseIf mTextAlignment = TALeftMiddle Then
        'à gauche
        Call DrawText(bckDC, mCaption, Len(mCaption), R, DT_LEFT)
    Else
       'au centre
        Call DrawText(bckDC, mCaption, Len(mCaption), R, DT_CENTER)
    End If

    Call SelectObject(bckDC, oldObject)
    Call DeleteObject(bckFont)
    '=======================================

    'Dessin de l'icone d'expansion
    '=======================================
    If mExpandable Then
        'On place le bouton
        picDC = CreateCompatibleDC(hDC)
        If ExpState Then
            oldObjPicDC = SelectObject(picDC, mMin)
        Else
            oldObjPicDC = SelectObject(picDC, mMax)
        End If
        Call GetGDIObject(mMin, Len(picInfo), picInfo)
        Call SetRect(BpCoord, ScaleWidth - picInfo.bmWidth - 2, ((mCaptionHeight / Screen.TwipsPerPixelY) - picInfo.bmHeight) / 2, ScaleWidth - 2, (((mCaptionHeight / Screen.TwipsPerPixelY) - picInfo.bmHeight) / 2) + picInfo.bmHeight)
        Call BitBlt(bckDC, BpCoord.Left, BpCoord.Top, picInfo.bmWidth, picInfo.bmHeight, picDC, 0, 0, vbSrcCopy)
        Call SelectObject(picDC, oldObjPicDC)
        Call DeleteDC(picDC)
    End If
    '========================================
    
    Call BitBlt(hDC, 0, 0, ScaleWidth, ScaleHeight, bckDC, 0, 0, BitBltRasterOperations.SRCPAINT)
    
    '=====================================
    'On remet en place tout ce qu'on a déplacé
    Call SetTextColor(bckDC, oldTxtColor)
    Call SelectObject(bckDC, OldBMP)
    Call DeleteObject(bckBMP)
    Call DeleteDC(bckDC)
    bckBMP = 0
    bckBrush = 0
    bckDC = 0
    bckFont = 0
    bckPen = 0
    picDC = 0
End Sub



@+: Ju£i€n 
Pensez: Réponse acceptée

jrivet · Answer

Re,
Petite correction dans le code j'utilise

BitBltRasterOperations.SRCCOPY et non 

bitbltrasteroperations.srcpaint

NOTE 2: J'utilise aussi ReyXpBasics.tlb  (très utile => merci si tu passe par la)

@+: Ju£i€n 
Pensez: Réponse acceptée

Renfield · Answer

il vaut mieux avoir des controles qui n'ont pas AutoRedraw activé et dessiner le controle dans l'event _Paint qui se déclenchera alors tout seul

Renfield - Admin CodeS-SourceS - MVP Visual Basic

Enlever l'effet clignottement sur un control

2 réponses

Votre réponse

Discussions similaires