bonsoir
pouvez vous sil vous plais me donner un code simple pour rendre mon form transparente j'ai trouver des code mai il sont compliquer
et n'oublier pas de rajouter une petite explication
merci bcp bcp
Une solution pratique est de coller dans la Form le fond d'écran :
extraits qui fonctionne parfaitement sur win_XP :
Sub Load()
...
' vider complètement le presse papier :
While Clipboard.ContainsData("specialFormat")
Clipboard.Clear()
End While
' Envoyer une commande clavier virtuelle avec
' .sendWAIT() plutôt que .send() pour laisser le temps à la machine
' de faire ce qu'on lui demande (sic)
' et avec la version à jour de l'argument PRTSC dans des accolades
' ainsi on force la copie de l'écran principal comme la combinaison ctrl + imprEcran
' ce qui se traduit par ^{PRTSC} à placer entre guillemets :
SendKeys.SendWait("^{PRTSC}")
' on récupère l'image et on la colle dans la Form (pas dans une PixBox) :
img = Clipboard.GetImage
BackgroundImage = img
'
' ensuite, utiliser des contrôles qui disposent d'un Background transparent tel que Label
...
End Sub()
ATTENTION : en version Débogage si on n'utilise pas la combinaision Ctrl + ImprEcran,
le rendu est très aléatoire : bien positionner le ^ avant PRTSC, ainsi avec le .exe c'est OK
ATTENTION : PRTSC n'a pas été testé sur d'autres plate-formes win (telle que Vista)
NB : j'utilise ce truc pour afficher à l'ouverture de session win l'éphéméride, les RDV du
jour etc. dans un Label défilant (via un timer), police 40 jaune, elle en jette ma marquise !
salut
j'ai eu un problème dans ce code
la form est transparente mai les boutons aussi
méme en utilisant
Command1.Visible = True
Option Explicit
Dim formEffectIndex As Integer
Dim mFormRegion As Long
Dim msg1 As String, msg2 As String
Private Sub Form_Load()
Me.ScaleMode = vbPixels
formEffectIndex = 1
Command1.Visible = True
changeFormEffect formEffectIndex
End Sub
Private Sub changeFormEffect(inEffect As Integer)
Dim w As Single, h As Single
Dim edge As Single, topEdge As Single
Dim mLeft, mTop
Dim i As Integer
Dim r As Long
Dim outer As Long, inner As Long
w = ScaleX(Width, vbTwips, vbPixels)
h = ScaleY(Height, vbTwips, vbPixels)
If inEffect = 0 Then
mFormRegion = CreateRectRgn(0, 0, w, h)
SetWindowRgn hwnd, mFormRegion, True
Exit Sub
End If
mFormRegion = CreateRectRgn(0, 0, 0, 0)
edge = (w - ScaleWidth) / 2
topEdge = h - edge - ScaleHeight
If inEffect = 1 Then
outer = CreateRectRgn(0, 0, w, h)
inner = CreateRectRgn(edge, topEdge, w - edge, h - edge)
CombineRgn mFormRegion, outer, inner, RGN_DIFF
End If
For i = 0 To Me.Controls.Count - 1
If Me.Controls(i).Visible = True Then
mLeft = ScaleX(Me.Controls(i).Left, Me.ScaleMode, vbPixels) + edge
mTop = ScaleX(Me.Controls(i).Top, Me.ScaleMode, vbPixels) + topEdge
r = CreateRectRgn(mLeft, mTop, _
mLeft + ScaleX(Me.Controls(i).Width, Me.ScaleMode, vbPixels), _
mTop + ScaleY(Me.Controls(i).Height, Me.ScaleMode, vbPixels))
CombineRgn mFormRegion, r, mFormRegion, RGN_OR
End If
Next
SetWindowRgn hwnd, mFormRegion, True
End Sub
code du module
Option Explicit
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Public Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Const RGN_OR = 2
Public Const RGN_DIFF = 4
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
Public xp As Long, yp As Long
Public mShape As Integer
Sub Main()
If Program_Is_Already_Running Then
GoTo Noduplicate
End If
xp = Screen.TwipsPerPixelX
yp = Screen.TwipsPerPixelY
frmTranspForm.Show
Exit Sub
Noduplicate:
MsgBox "Program is already running"
End Sub
Function Program_Is_Already_Running()
Program_Is_Already_Running = False
If (App.PrevInstance = True) Then
Program_Is_Already_Running = True
End If
End Function
Function UnloadIfExist(FormName As String) As Boolean
On Error Resume Next
Dim mloaded As Boolean
mloaded = False
Dim i As Integer
For i = Forms.Count - 1 To 0 Step -1
If UCase(Forms(i).Name) = UCase(FormName) Then
mloaded = True
Unload Forms(i)
Exit For
End If
Next
UnloadIfExist = mloaded
End Function
excuser moi j'ai pas vu vos réponse j'ai laisser la page ouvert depuis l'après-midi
merci tchconst pour ton aide ton code c'est pas ce que je voulais mai c'est une excellente elle peux m'être utile pour des prochaine projets
Bouton disparu ?! >>> Détail concernant la Form elle-même : elle n'est pas transparente du tout on l'aura compris, elle est Opacity = 1. Exemple : Lorsqu'on fait apparaître cette Form via un timer de opacity = 0 à opacity = 1, les contrôles qui sont dessus apparaissent au même rythme, la propriété .opacity est indépendante de la propriété .visible.
