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
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
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionPrivate Sub command2_click() If formEffectIndex <> 0 Then formEffectIndex = 0 Else formEffectIndex = 1 End If changeFormEffect formEffectIndex End Sub
Private Sub Form_Load() Me.ScaleMode = vbPixels formEffectIndex = 0 changeFormEffect formEffectIndex End Sub