Rendre un frame transparent

Version imprimable

Voir 40 message(s) de cette discussion en une page

12/04/2018, 12h31
pijaku

Merci Jacques.

Je dois bien avouer que je n'ai pas un seul instant pensé à un Label. Alors que c'est bien là sa fonction...

Citation:

Envoyé par unparia

Je sais que tu n'auras aucune difficulté à comprendre pourquoi je "sépare" et traite en premier le label koko dans la procédure reparer_deplacer ;)

Oh, tu pourrais le traiter en dernier sans plus de difficulté...
Suffit de le placer derrière pour pouvoir utiliser les contrôles de la Frame : zPosition = 1.

Amicalement,
Franck
12/04/2018, 12h47
unparia

Citation:

Suffit de le placer derrière pour pouvoir utiliser les contrôles de la Frame : zPosition = 1.

Egalement.
Voilà un jour faste, à tous points de vue (premiers pas à domicile, certes aidée d'un déambulateur, mais bien là et accompagnés de joie ;))
12/04/2018, 12h49
pijaku

Citation:

Envoyé par unparia

Voilà un jour faste, à tous points de vue (premiers pas à domicile, certes aidée d'un déambulateur, mais bien là et accompagnés de joie ;))

En voilà une bonne nouvelle !
Je vous souhaite un très bon week end à vous.
12/04/2018, 13h13
patricktoulon

re

bien vu le remplacement des bordure disparue par celle de koko j'ai pas testé mais y a pas de raison
peu etre prevoir un zorder histoire d'etre tranquille ;)
joli
12/04/2018, 13h17
pijaku

Citation:

Envoyé par patricktoulon

peu etre prevoir un zorder histoire d'etre tranquille ;)

Il y est le ZOrder mon koko ;)
Il y est.
12/04/2018, 13h41
patricktoulon

re

oui pour la frame pas le koko et d'apres le code du move je supose qu'il est a l'interieur de la frame avec d'autre controls ;)
a moins que la frame soit a zero aussi et que les deux soit enfant de l'usf au quel cas ajouter le .top et .left au move du koko histoire que ca foncionne meme si la frame n'est pas en haut a gauche ;)

Il y est mon koko.
Lire le code jusqu'au bout ;)

Code:

1
2
3
4
5
6
7
8
9
Private Sub reparer_deplacer()
  Dim c As Control
  koko.ZOrder 'Le ZOrder de mon koko il y est.............................
'ma remarque à Unparia : on pourrait mettre le ZOrder de koko à 1 cf fin de code ::::::
  For Each c In Frame1.Controls
     If c.Name <> "koko" Then c.ZOrder
   Next
   'koko.ZOrder 1   'ICI ::::::::::::::::::::::::::::
End Sub

12/04/2018, 21h22
pijaku

Dommage que ce procédé ne soit pas applicable à une Frame posée sur une feuille de calcul...
12/04/2018, 21h29
unparia

Bonjour Franck

Citation:

Dommage que ce procédé ne soit pas applicable à une Frame posée sur une feuille de calcul...

En effet, mais nous n'y pouvons rien dès lors qu'un composant Frame mis sur une feuille de calcul n'est pas le même que l'activex (natif) de VBA.
Un Frame de VBA est, lui, une fenêtre Windows à part entière

bonjour unparia
on a un petit probleme avec ta methode

teste avec des labels transparent dans ta frame ;) surprise surprise il on la couleur de font de la frame plus precisément on vois a travers la coleur de la frame

ensuite
j'ai essayé de mettre ajouter dynamiquement un label transparent avec cadre et dimentionné a la frame pour remplacer le cadre de la frame

selon sa position soit les labels qui etait present ont disparus soit on vois la couleur de la frame

j'ai donc procédé comme suit

Code:

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
Option Explicit
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function InvalidateRectLong Lib "user32" Alias "InvalidateRect" (ByVal hwnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long
Private Const WS_EX_TRANSPARENT = &H20&
Private Const GWL_EXSTYLE = (-20)
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_FRAMECHANGED = &H20
Private Const TRANSPARENT = 1
'bouton transparence
Private Sub CommandButton1_Click()
    FrameTransparent Frame1, True  '(2d argument true=cadre;false= pas de cadre
End Sub
 
Private Sub FrameTransparent(ByVal fraThis As Control, Optional border As Boolean = False)
    Dim lehwnd As Long, lExStyle As Long, c As Control
    If border = True Then
        Set c = fraThis.Controls.Add("forms.Label.1", "cadre")
        c.Move 0, 0, fraThis.Width - 2, fraThis.Height - 2
        c.BackStyle = 0: c.BorderStyle = 1: c.BorderColor = fraThis.BorderColor:
       End If
 
    lehwnd = fraThis.[_GethWnd]
    lExStyle = GetWindowLong(lehwnd, GWL_EXSTYLE)
    lExStyle = lExStyle Or WS_EX_TRANSPARENT
    SetWindowLong lehwnd, GWL_EXSTYLE, lExStyle
    SetBkMode GetDC(lehwnd), TRANSPARENT ' cette ligne bloquée ou pas la frame est transparente
    SetWindowPos lehwnd, 0, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE + SWP_FRAMECHANGED
    InvalidateRectLong lehwnd, vbNull, True
    DoEvents
    fraThis.ZOrder
    fraThis.Top = fraThis.Top + 1    '******* lire pourquoi cette étrange manoeuvre ca arrive quand on utilise le GWL_EXSTYLE
    fraThis.Top = fraThis.Top - 1    '*******  à la suite du code
 
    fraThis.cadre.ZOrder    'important il doit etre au dessus au au depart!!!!!
 
    For Each c In Frame1.Controls
        'c.ZOrder 'avec cette ligne et celle avant la boucle "for" bloquée les controls ne sont plus accessibles
       If TypeName(c) <> "Label" Then c.ZOrder    'tout les label seront en dessous. sans cette ligne ela ligne importante tout les labels disparaissent
    Next
End Sub
 
Private Sub UserForm_Click()
End Sub

test1
bloque l'argument "true" dans l'appel et la ligne 40 et 44 et debloque la ligne 43 ta base quoi

test2
bloque les ligne 40 et 44 et debloque la 43 et debloque le true dans l'appel et teste

test3
ensuite bloque la ligne la ligne 32 et teste etonnant non?

surprenant tout ca non?

pou etre plus precis si on ajoute pas un label transparent de la taille de la frame a l'interieur border ou pas les autres labels deja presents et transparent ne le seront plus (visuellement)
version finale

Code:

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
Option Explicit
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function InvalidateRectLong Lib "user32" Alias "InvalidateRect" (ByVal hwnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long
Private Const WS_EX_TRANSPARENT = &H20&
Private Const GWL_EXSTYLE = (-20)
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_FRAMECHANGED = &H20
Private Const TRANSPARENT = 1
'bouton transparence
Private Sub CommandButton1_Click()
    FrameTransparent Frame1, True   '(2d argument true=cadre;false= pas de cadre
End Sub
 
Private Sub FrameTransparent(ByVal fraThis As Control, Optional border As Boolean = False)
    Dim lehwnd As Long, lExStyle As Long, c As Control
    If border = True Then
        Set c = fraThis.Controls.Add("forms.Label.1", "cadre")
        c.Move 0, 0, fraThis.Width - 2, fraThis.Height - 2
        c.BackStyle = 0: c.BorderStyle = 1: c.BorderColor = fraThis.BorderColor:
       End If
 
    lehwnd = fraThis.[_GethWnd]
    lExStyle = GetWindowLong(lehwnd, GWL_EXSTYLE)
    lExStyle = lExStyle Or WS_EX_TRANSPARENT
    SetWindowLong lehwnd, GWL_EXSTYLE, lExStyle
    SetBkMode GetDC(lehwnd), TRANSPARENT ' cette ligne bloquée ou pas la frame est transparente
    SetWindowPos lehwnd, 0, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE + SWP_FRAMECHANGED
    InvalidateRectLong lehwnd, vbNull, True
    DoEvents
    fraThis.ZOrder
    fraThis.Top = fraThis.Top + 1    '******* lire pourquoi cette étrange manoeuvre ca arrive quand on utilise le GWL_EXSTYLE
    fraThis.Top = fraThis.Top - 1    '*******  à la suite du code
 
 
    For Each c In Frame1.Controls
        c.ZOrder
    Next
If border = True Then fraThis.cadre.ZOrder 1  'important il doit etre au dessus au au depart!!!!!
 
End Sub
 
Private Sub Label1_Click()
MsgBox "coucou"
End Sub

j'ai testé avec une frame dans la quelle il y a un bouton et un label transparent j'ai mis un evenement au label 1 pour tester

21/04/2018, 14h29
patricktoulon

re

je confirme que la ligne "SetBkMode GetDC(lehwnd), TRANSPARENT" ' cette ligne bloquée ou pas la frame est transparente
est completement inutile du au fait que par le SetWindowLong lehwnd, GWL_EXSTYLE, lExStyle elle n'est plus accessible
j'avais eu le meme soucis avec un userform en changeant son windowlong et effectivement il avait fallu que je le deplace de +1 et -1 pour voir les effet de setwindowlong
d'ailleurs essaie de lui mettre un evenement click tu verra

je pense avoir un peu compris pourquoi le label remplissant toute la frame remet tout les labels transparent (ceux qui l'etaient)
21/04/2018, 20h36
unparia

Citation:

je confirme que la ligne "SetBkMode GetDC(lehwnd), TRANSPARENT" ' cette ligne bloquée ou pas la frame est transparente
est completement inutile du au fait que par le SetWindowLong lehwnd, GWL_EXSTYLE, lExStyle elle n'est plus accessible

Je n'enlèverais sûrement pas cette ligne de code qui évite dans certains cas bien des déboires aléatoires lors de la réception de messages système vm_paint

Citation:

il avait fallu que je le deplace de +1 et -1 pour voir les effet de setwindowlong

ou n'importe quelle autre instruction qui forcerait un message vm_paint, tout simplement

Je vois mal quel problème tu "dénonces". Lorsque je regarde au travers d'une vitre elle-même posée sur une vitre, c'est bien le fond des deux vitres, que je dois voir.
21/04/2018, 20h51
patricktoulon

re

re

Citation:

Je vois mal quel problème tu "dénonces". Lorsque je regarde au travers d'une vitre elle-même posée sur une vitre, c'est bien le fond des deux vitres, que je dois voir

et non justement j'ai du mal me faire comprendre

essaie ton propre code en metant dans la frame un/des labels transparents (backstyle=0)en mode VBE quand la frame deviend transparente a travers les labels transparents on voit la couleur du fond de la frame avant quelle soit transparente :ptdr:

si on ajoute un label dans la frame (frathis.controls.add(.....))
transparen et de meme taille que la frame et un zorder 1 a la fin les labels qui etait transparents dont on voyais le fond couleur de frame1 on y voit le font du userform

c'est ca qui etonnant

je te fait un fichier de demo simple car j'ai poussé beaucoup plus loin le mien maintenant il y a d'autre option comme les angles arrondis de la frame entre autres
je te fait un exemple simple et reviens

2 pièce(s) jointe(s)

re
comme il apparait que je me soit fait mal comprendre
je reprends donc

voici comment est le userform dans l'editeur VBE
dans la frame un bouton, un label transparent bordure rouge font color orange
Pièce jointe 372020
et voila le code de ce userform

Code:

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
Option Explicit
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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
Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function InvalidateRectLong Lib "user32" Alias "InvalidateRect" (ByVal hwnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long
Private Const WS_EX_TRANSPARENT = &H20&
Private Const GWL_EXSTYLE = (-20)
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_FRAMECHANGED = &H20
Private Const TRANSPARENT = 1
'bouton transparence avec cadre ou pas (2d argument)
'on verra  la couleur grise de la frame dans tout les label transparent de la frame
Private Sub CommandButton1_Click()
    FrameTransparent Frame1
End Sub
Private Sub FrameTransparent(ByVal Frathis As Control, Optional border As Boolean = False)
    Dim lehwnd As Long, lExStyle As Long, c As Control
 
        'ajout dans userform en dimension et place de la frame un label transparent avec cadre
        'Set c = Frathis.Controls.Add("forms.Label.1", "cadre")
        'c.Move 0, 0, Frathis.Width - 2, Frathis.Height - 2
        'c.BackStyle = 0: c.BorderStyle = 1: c.BorderColor = Frathis.BorderColor:
 
    lehwnd = Frathis.[_GethWnd]
    lExStyle = GetWindowLong(lehwnd, GWL_EXSTYLE)
    lExStyle = lExStyle Or WS_EX_TRANSPARENT
    SetWindowLong lehwnd, GWL_EXSTYLE, lExStyle
    SetBkMode GetDC(lehwnd), TRANSPARENT ' cette ligne bloquée ou pas la frame est transparente
    SetWindowPos lehwnd, 0, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE + SWP_FRAMECHANGED
    InvalidateRectLong lehwnd, vbNull, True
 
    DoEvents
    Frathis.ZOrder
    Frathis.Top = Frathis.Top + 1    '******* lire pourquoi cette étrange manoeuvre ca arrive quand on utilise le GWL_EXSTYLE
    Frathis.Top = Frathis.Top - 1    '*******  à la suite du code
    For Each c In Frame1.Controls
        c.ZOrder
    Next
'Frathis.Controls("cadre").ZOrder 1
End Sub

tu peux deja tester regarde bien se que l'on voit a travers le label transparent

etonnant non?

maintenant encore plus etonnant
debloque les ligne 24,25,26,27 et 44 qui sont la pour ajouter un label meme taille que la frame et transparent avec bordure
et regarde le label

si ca c'est pas un mystere hein !!????;)

quel raport peut il y avoir entre le fait d'ajouter un label dynamiquement et le fait que l'autre label ne voit plus la couleur verte a travers ????????????????

si tu vois pas le phenomene je sais plus comment te le montrer

fichier exemple

21/04/2018, 22h42
unparia

Je croyais qu'entre la présente discussion et une autre discussion très récente (elle concernait l'export d'une image) je m'étais fait suffisamment comprendre. Je vois que je n'y suis pas parvenu.
Je vais alors tenter d'utiliser des mots très simples :
Les propriétés graphiques décidées en mode création ne sont la cause d'un message VM_PAINT que lors du chargement de l'userform et de ses objets.
Tant qu'aucune de ces propriétés d'un objet n'est modifiée --->> pas de nouveau message VM_PAINT
un nouveau message est par contre généré lorsque l'on modifie l'une de ces propriétés graphiques de l'objet.
Bonne nuit.

EDIT : j'espère que personne ne va me dire que le label est pourtant transparent lors du chargement. Il l'est, oui. LUI.;)
22/04/2018, 11h43
patricktoulon

re

re
donc si je te comprends bien lors du setwindowlong wd_paint n'est pas executé et le seul fait d'ajouter un control declanche le repaint

autrement dit aussi on pourrait dire que deplacer un des concrol declencherait le wd_paint

testé!!

test1 ajout d'un control quelque part : ca marche pas
test 2 ajout du label au niveau d'un des label transparent: ca marche pas non plus
test 3 deplacement d'un control : ca marche pas non plus;le controls est bien deplacé mais la partie "verte" demeure
test 4 ajout meme taille que frame et suppression a la fin : ca marche pas non plus
test 5 mettres tout les controls invisible avant visible apres les apis ca marche pas non plus

bref
la seule solution que qui va vers ta théorie c'est que le wd_paint repaint chaque parties de la frame correspondant a un control SEPAREMENT!!!! et que comme le label de fond est transparent il paint donc aussi la partie verte transparente du label1 puisque celui ci occupe une partie du label cadre transparent
perso c'est un peu tiré par les cheveux mais bon
autrement dit c'est bien la seule solution pour garder la transparence de mes labels

on pourrait penser par rapport a mes constattions que wd_paint repant le label cadre avec la photo de la frame et se label transparent + le fond de l'userform

donc l'ajout de ce label n'est meme plus une option mais une necessitéet surtout pas le supprimer ;) jusqu'a methode plus pro trouvé
22/04/2018, 12h02
unparia

Citation:

donc si je te comprends bien lors du setwindowlong wd_paint n'est pas executé et le seul fait d'ajouter un control declanche le repaint

Rien de cela.
Je vais tenter de simplifier plus encore
La gestion du rectangle du label a été décidée lors de la dernière communication des éléments graphiques en présence : un label transparent sur un Frame non encore transparent.
Je vais arrêter là ma participation à une discussion qui s'éloigne de plus en plus des connaissances en VBA et aborde d'autres aspects totalement distincts.

Voir 40 message(s) de cette discussion en une page