jrivet
Messages postés7392Date d'inscriptionmercredi 23 avril 2003StatutMembreDernière intervention 6 avril 2012
-
12 oct. 2009 à 11:32
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 2021
-
13 oct. 2009 à 14:23
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