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