Private 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
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 CreateEllipticRgn 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 SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long 'Funzione Private Function fMakeATranspArea(AreaType As String, pCordinate() As Long) As Boolean Const RGN_DIFF = 4 Dim lOriginalForm As Long Dim ltheHole As Long Dim lNewForm As Long Dim lFwidth As Single Dim lFHeight As Single Dim lborder_width As Single Dim ltitle_height As Single On Error Goto Trap lFwidth = ScaleX(Width, vbTwips, vbPixels) lFHeight = ScaleY(Height, vbTwips, vbPixels) lOriginalForm = CreateRectRgn(0, 0, lFwidth, lFHeight) lborder_width = (lFHeight - ScaleWidth) / 2 ltitle_height = lFHeight - lborder_width - ScaleHeight Select Case AreaType Case "Elliptic" ltheHole = CreateEllipticRgn(pCordinate(1), _ pCordinate(2), _ pCordinate(3), _ pCordinate(4)) Case "RectAngle" ltheHole = CreateRectRgn(pCordinate(1), _ pCordinate(2), _ pCordinate(3), _ pCordinate(4)) Case "RoundRect" ltheHole = CreateRoundRectRgn(pCordinate(1), _ pCordinate(2), _ pCordinate(3), _ pCordinate(4), _ pCordinate(5), _ pCordinate(6)) Case "Circle" ltheHole = CreateRoundRectRgn(pCordinate(1), _ pCordinate(2), _ pCordinate(3), _ pCordinate(4), _ pCordinate(3), _ pCordinate(4)) Case Else MsgBox "Unknown Shape!!" Exit Function End Select lNewForm = CreateRectRgn(0, 0, 0, 0) CombineRgn lNewForm, lOriginalForm, _ ltheHole, RGN_DIFF SetWindowRgn hWnd, lNewForm, True Me.Refresh fMakeATranspArea = True Exit Function Trap: MsgBox "error Occurred. Error # " & Err.Number & ", " & Err.Description End Function 'come chiamarlo Dim lParam(1 To 6) As Long lParam(1) = 100 lParam(2) = 100 lParam(3) = 250 lParam(4) = 250 lParam(5) = 50 lParam(6) = 50 Call fMakeATranspArea("RoundRect", lParam()) 'Call fMakeATranspArea("RectAngle", lParam()) 'Call fMakeATranspArea("Circle", lParam()) 'Call fMakeATranspArea("Elliptic", lParam()) Questo codice va inserito nelle dichiarazioni del Form Se viene utilizzato un modulo ricordarsi di omettere la stringa Private |