Pb de "transparence"

Question

Bonjour,

J'ai une brouette (un P2 350), je suis sous w2k pro sous un compte d'utilisateur restreint et j'utilise vb6 (c'est déjà pas très simple... pas moquer), alors voilà mon pb :

Je crée un composant activex avec un simple picturebox redimensionable. Sur mon picturebox, il y a une image (une belle lune et ses phases) calculée selon une date avec une source "pompée" sur vbfrance (source donné par VBbigineur à http://www.vbfrance.com/code.aspx?ID=3001) et quelques manipulation de région. Jusque là RAS.

Ma proc place ensuite l'image dans le picturebox et applique un "découpage" pour avoir un fond transparent.

Je place mon composant sur une feuille => ok (j'ai uniquement un lune bien ronde sur le fond de la fenêtre, quoique j'ai le temps de voir de temps en temps un fond noir qui disparait très vite)
Je change la date => idem, ok
Je modifie l'apparance du contrôle => ok, idem
Je fait un resize du composant (sur un feuille par exemple) par la suite => c'est la cata : ma belle lune se retrouve sur un fond noir mais dès que je modifie la date pour recalculer sa phase tout rentre dans l'ordre.

D'où vient le pb avec le resize ? (j'ai essayé un détournement avec WinProc sur les messages WM_PAINT, WM_SIZE et WM_EXITMOVESIZE ou d'autres messages du genre, sur mon picturebox et mon contrôle, mais rien à faire).

Merci à l'avance de votre aide.  :shy) 
(dès que mon "truc" sera à peu près propre, je balance)

Pour info : l'image que je vais placer dans mon picturebox est contenu par un hdc et un bitmap en mémoire (hDC3). Selon la taille du picturebox je lui applique un stretchblt dans un autre memory hdc/bitmap (hDC4) et je fais un bitblt sur le picturebox :
hDC4 = CreateCompatibleDC(Picture1.hdc)
hBMP4 = CreateCompatibleBitmap(Picture1.hdc, Picture1.ScaleWidth, Picture1.ScaleHeight)
SelectObject hDC4, hBMP4
SetStretchBltMode hDC4, STRETCH_HALFTONE
StretchBlt hDC4, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, hDC3, 0, 0, BMPW, BMPH, SRCCOPY
BitBlt Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, hDC4, 0, 0, SRCCOPY

Ensuite pour rendre transparent le tour de ma belle lune ronde, voici ma proc. :
Dim RGNMyMoon As Long, RGNBoxOutter As Long, RGNBoxInner As Long, i As Long

    i = Picture1.BorderStyle + (Picture1.BorderStyle * Picture1.Appearance)
    RGNMyMoon = CreateEllipticRgn(0 + i, 0 + i, UserControl.ScaleWidth - i, UserControl.ScaleHeight - i)
    RGNBoxOutter = CreateRectRgn(0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight)
    RGNBoxInner = CreateRectRgn(0 + i, 0 + i, UserControl.ScaleWidth - i, UserControl.ScaleHeight - i)
    CombineRgn RGNBoxOutter, RGNBoxOutter, RGNBoxInner, RGN_DIFF
    CombineRgn RGNMyMoon , RGNBoxOutter, RGNMyMoon , RGN_OR

SetWindowRgn UserControl.hWnd, RGNMyMoon , True

DeleteObject RGNMyMoon 
DeleteObject RGNBoxOutter
DeleteObject RGNBoxInner

cs_pepsi · Answer

met ton picture box en autoredraw ...

Pepsi

cs_ralphy · Answer

J'ai oublié de le préciser, mon picturebox (comme mon usercontrol) est déjà en autoredraw.  ;)

Renfield · Answer

Est-ce que tu recrées bien ta region dans ton Usercontrol_Resize ?

le fait que quand tu saisisse une date tout retre dans l'ordre indique que dans ton "Property Let Date" tu applique une operation patriculière que tu ne fais pas dans ton Usercontrol_Resize.....

cs_ralphy · Answer

Oui j'utilise les mêmes proc (calcul de l'image en mémoire, affichage par bitblt dans le picturebos puis le "découpage")dans le cas du changement de date, du changement d'apparence et dans le cas du resize.

La différence est dans un refresh et encore son ajout n'est pas toujours indispensable pour que ça "fonctionne" :

Public Property Let MoonDate(xx As Date)

DateEntree = xx
'calcul de la phase de la lune...
Calculer 

PrepareMoonImg
PasteMoonImg
'intégration d'un refresh sinon aucun changement, bizarre
Picture1.Refresh 
'intégration d'un doevents sinon SetTransparent n'a 
'aucun effet, bizarre
DoEvents
SetTransparent
End Property

Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)

Picture1.BorderStyle() = New_BorderStyle
PropertyChanged "BorderStyle"

PrepareMoonImg
PasteMoonImg
'pas besoin d'un refresh, ça marche
'intégration d'un doevents sinon SetTransparent n'a 
'aucun effet, bizarre
DoEvents
SetTransparent
End Property

Private Sub UserControl_Resize()

's'assurer que tout est en mode twips 
Dim PrevSM As Long
PrevSM = UserControl.ScaleMode
UserControl.ScaleMode = 1
'taille image=taille controle
Picture1.Height = Height
Picture1.Width = Width
UserControl.ScaleMode = PrevSM

PrepareMoonImg
PasteMoonImg
'pas besoin d'un refresh, ça marche
'intégration d'un doevents sinon SetTransparent n'a 
'aucun effet, bizarre
DoEvents
SetTransparent

End Sub

cs_ralphy · Answer

Pour éviter de voir un fond noir autour de ma lune ronde quand je change de date (causée par la lenteur de la méthode refresh du picturebox) j'ai modifié ma proc, ça marche du tonerre...  8-) 
(Pour ceux/celles que ça peut interesser dans de futures sources)

Mais j'ai toujours mon pb avec le resize...  :sad) 

[size=1]
Public Property Let MoonDate(xx As Date)
DateEntree = xx
Calculer

'l'utilisation de begin paint remplace la propriété Refresh
Dim ZoneRefresh As RECT, PStruct As PAINTSTRUCT
ZoneRefresh.Left = 0
ZoneRefresh.Right = 0
ZoneRefresh.Bottom = Picture1.ScaleHeight
ZoneRefresh.Right = Picture1.ScaleWidth
PStruct.fErase = False
PStruct.hdc = Picture1.hdc
PStruct.rcPaint = ZoneRefresh

BeginPaint Picture1.hwnd, PStruct
InvalidateRect Picture1.hwnd, ZoneRefresh, True
PrepareMoonImg
PasteMoonImg
DoEvents
SetTransparent
EndPaint Picture1.hwnd, PStruct

End Property
/size=2

Pb de "transparence"

5 réponses

Discussions similaires