Discussion :

[fun31]

Bonjour à tous.
Je souhaiterai que le fond de ma picturebox soit transparent pour pouvoir voir une visualisation qui se trouve derriere la picturebox

Est ce quelqu'un pourrait me dire comment faire


Merci d'avance

[argyronet]

Bonjour,

Avec diférentes API dont celles-ci... CreateRectRgn et CombineRgn
Il te faut doubler ton pictureBox, en cacher un et le rendre avec une couleur uniforme comme couleur de fond...

Peut-être un bout de code ?

Argy

[ThierryAIM]

La question m'a paru interessante

Après quelques recherches sur le net et mis à ma sauce, voila ce que ca pourrait donner :

Le principe est d'encapsuler le controle dans une form dont on peut modifier les propriétés de transparence donc :

Dans le projet, créer une form nommée FEncaps et mettre la propriété BorderStyle à None

Dans un Module :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
 
Option Explicit
 
Public Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As Rect) As Long
Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
 
Public Const WS_CHILD = &H40000000
Public Const GWL_STYLE = (-16)
Public Const GWL_EXSTYLE = (-20)
Public Const LWA_COLORKEY = &H1
Public Const LWA_ALPHA = &H2
Public Const WS_EX_LAYERED = &H80000
Public Const SWP_FRAMECHANGED = &H20
 
Public Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
'Type Window pour encapsulation d'un contrôle
Public Type Encaps
    NumForm As Long
    LeftOrigine As Long
    TopOrigine  As Long
    widthOrigine As Long
    heightOrigine As Long
    hwnd As Long
    NameControl As String
    HwndControl As Long
End Type
 
Public EncapsWndRect As Rect
Public FrmEncaps As Encaps
Public EncapsWnd As FEncaps
 
'- Déclaration des fonctions et constantes de l'API Windows ---------
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const GWL_WNDPROC = (-4)
Private Const WM_MOVE = &H3
 
Public oldWndProc As Long
 
Public Function WndSetOpacity(ByVal hwnd As Long, Optional ByVal crKey As Long = vbBlack, Optional ByVal Alpha As Byte = 255, Optional ByVal ByAlpha As Boolean = True) As Boolean
'(de Greengold)
'Return : True si il n'y a pas eu d'erreur.
'hWnd  : hWnd de la fenêtre à rendre transparente
'crKey : Couleur à rendre transparente si ByAlpha=False (utiliser soit les constantes vb:vbWhite ou en hexa:&HFFFFFF)
'Alpha : 0-255 0=transparent 255=Opaque si ByAlpha=true (défaut)
    Dim ExStyle As Long
    ExStyle = GetWindowLong(hwnd, GWL_EXSTYLE)
    If ExStyle <> (ExStyle Or WS_EX_LAYERED) Then
        ExStyle = (ExStyle Or WS_EX_LAYERED)
        Call SetWindowLong(hwnd, GWL_EXSTYLE, ExStyle)
    End If
    WndSetOpacity = (SetLayeredWindowAttributes(hwnd, crKey, Alpha, IIf(ByAlpha, LWA_ALPHA, LWA_COLORKEY)) <> 0)
End Function
 
Public Function EncapsControl(Ctrl As Object) As Encaps
 
    With EncapsControl
        .NumForm = 1
        .LeftOrigine = Ctrl.Left
        .TopOrigine = Ctrl.Top
        .widthOrigine = Ctrl.Width
        .heightOrigine = Ctrl.Height
        .HwndControl = Ctrl.hwnd
        .NameControl = Ctrl.Name
    End With
 
    Set EncapsWnd = New FEncaps
 
    With EncapsWnd
        .Visible = True
        .Width = Ctrl.Width
        .Height = Ctrl.Height
    End With
 
    Call GetWindowRect(Ctrl.hwnd, EncapsWndRect)
    Call SetWindowPos(EncapsWnd.hwnd, -1, (EncapsWndRect.Left), (EncapsWndRect.Top), (EncapsWnd.Width / 15), (EncapsWnd.Height / 15), SWP_FRAMECHANGED)
    Call SetParent(Ctrl.hwnd, EncapsWnd.hwnd)
    Call SetWindowLong(Ctrl.hwnd, GWL_STYLE, WS_CHILD)
    Ctrl.Move 0, 0
    Ctrl.Visible = True
 
    'La fonction retourne le hwd de la Window d'encapsulation
    EncapsControl.hwnd = EncapsWnd.hwnd
 
End Function
 
Public Sub FreeMem(WEncaps As Encaps, Ctrl As Object, FrmInit As Form)
    Dim i As Integer
 
    On Error GoTo FreeMem_Error
 
    Call SetParent(Ctrl.hwnd, FrmInit.hwnd) 'Replace le controle dans sa Form initial
    Ctrl.Move WEncaps.LeftOrigine, WEncaps.TopOrigine
 
    Unload Forms(WEncaps.NumForm) 'Décharge la window d'encapsulation
    On Error GoTo 0
    Exit Sub
 
FreeMem_Error:
    Err.Clear
End Sub
 
Function WindowProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
    If msg = WM_MOVE Then
        EncapsWnd.Top = Form1.Top + FrmEncaps.TopOrigine + 350
        EncapsWnd.Left = Form1.Left + FrmEncaps.LeftOrigine + 40
    End If
    WindowProc = CallWindowProc(oldWndProc, hwnd, msg, wParam, lParam)
 
End Function

Dans la form qui contient la PictureBox (et un CommandButton pour l'exemple) :
(Pour tester, coller un label sous la PictureBox)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 
Private Sub Command1_Click()
    Select Case Command1.Caption
    Case "Opaque"
        Call WndSetOpacity(FrmEncaps.hwnd, 0, 255)
        FreeMem FrmEncaps, Form1.Picture1, Form1
        Command1.Caption = "Transparent"
    Case "Transparent"
        FrmEncaps = EncapsControl(Form1.Picture1)
        Call WndSetOpacity(FrmEncaps.hwnd, 0, 100) '<== Regler ici la transparence de 0 à 255
        Command1.Caption = "Opaque"
    End Select
End Sub
 
Private Sub Form_Load()
    Picture1.Picture = LoadPicture("C:\Documents and Settings\Administrateur\Mes documents\Mes images\Athlète.jpg")
    oldWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
 
    Command1.Caption = "Opaque"
    FrmEncaps = EncapsControl(Form1.Picture1)
    Call WndSetOpacity(FrmEncaps.hwnd, 0, 100)
 
End Sub
 
Private Sub Form_Terminate()
    End
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    SetWindowLong hwnd, GWL_WNDPROC, oldWndProc
    FreeMem FrmEncaps, Form1.Picture1, Form1
End Sub

Pfffiuuu !!!
J'ai du combiner l'aimantation de forms avec la transparence, sinon j'avais des résultats surprenant, mais ca a l'aire de gazer

Tester sur W2K

[Catbull]

[argyronet]

Tu peux essayer ça...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
 
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function timeGetTime Lib "winmm.dll" () As Long
 
 
Public Function fnctCreateTransForm(theForm As Form, thePicture As PictureBox, theColor As Long)
Dim lGetTime As Long
 
Dim lX As Long, lY As Long
Dim lXStart As Long, lYStart As Long
Dim lXFinal As Long, lYFinal As Long
Dim hRgn As Long, lCreateRec As Long
Dim lVoid As Long
Dim bStatus As Boolean
 
lGetTime = timeGetTime
 
theForm.Width = theForm.ScaleX(thePicture.Width, vbPixels, vbTwips)
theForm.Height = theForm.ScaleY(thePicture.Height, vbPixels, vbTwips)
DoEvents
bStatus = False
For lX = 0 To thePicture.ScaleWidth
    bStatus = False
    For lY = 0 To thePicture.ScaleHeight
        If bStatus Then
            If thePicture.Point(lX, lY) = theColor Then
                lXFinal = lX
                lYFinal = lY
                If hRgn = 0 Then
                    hRgn = CreateRectRgn(lXStart, lYStart, lXFinal + 1, lYFinal)
                Else
                    lCreateRec = CreateRectRgn(lXStart, lYStart, lXFinal + 1, lYFinal)
                    lVoid = CombineRgn(hRgn, hRgn, lCreateRec, RGN_OR)
                    DeleteObject lCreateRec
                End If
                bStatus = False
            End If
         Else
            If thePicture.Point(lX, lY) <> theColor Then
                lXStart = lX
                lYStart = lY
                lXFinal = lX
                lYFinal = lY
                bStatus = True
            End If
        End If
    Next
Next
 
lVoid = SetWindowRgn(theForm.hWnd, hRgn, True)
lVoid = DeleteObject(hRgn)
End Function

Exemple d'utilisation si ton Picture box est Rouge depuis ton Form...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub CreateTransparentPicture()
	fnctCreateTransForm Me, Picture1, RGB(0, 0, 255)
End Sub

Argy