picFormShape

بسم الله الرحمن الرحيم

الاخوة الافاضل

انا احاول تحويل مثال بالفيجوال 6 يجعل الفورم باخذ شكل ال pictur shape الي الدوت نت اكسبريس2005

لكن يوجد function تعطي اخطاء عند التحويل

برجاء ان اجد من يصحح هذه ال function

الكود

    Private Declare Function CreateRectRgn Lib "gdi32" (ByVal x1 As Integer, ByVal y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer) As Integer
    Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Integer, ByVal hSrcRgn1 As Integer, ByVal hSrcRgn2 As Integer, ByVal nCombineMode As Integer) As Integer
    Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Integer, ByVal hRgn As Integer, ByVal bRedraw As Integer) As Integer
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Integer) As Integer

    ' For information on this module and other graphics
    ' programming, see the book "Visual Basic Graphics
    ' Programming, Second Edition." For more information,
    ' go to:
    '
    '       http://www.vb-helper.com/vbgp.htm

    ' DIB stuff.
    Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Integer, ByVal nCount As Integer, ByVal lpObject As Integer) As Integer
    Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, ByVal lpBits As Integer, ByVal lpBI As BITMAPINFO, ByVal wUsage As Long) As Long

    '
    Private Structure BITMAP '14 bytes
        Dim bmType As Integer
        Dim bmWidth As Integer
        Dim bmHeight As Integer
        Dim bmWidthBytes As Integer
        Dim bmPlanes As Integer
        Dim bmBitsPixel As Integer
        Dim bmBits As Integer
    End Structure
    '
    Private Structure BITMAPINFOHEADER '40 bytes
        Dim biSize As Integer
        Dim biWidth As Integer
        Dim biHeight As Integer
        Dim biPlanes As Integer
        Dim biBitCount As Integer
        Dim biCompression As Integer
        Dim biSizeImage As Integer
        Dim biXPelsPerMeter As Integer
        Dim biYPelsPerMeter As Integer
        Dim biClrUsed As Integer
        Dim biClrImportant As Integer
    End Structure
    '
    Private Structure RGBQUAD
        Dim rgbBlue As Byte
        Dim rgbGreen As Byte
        Dim rgbRed As Byte
        Dim rgbReserved As Byte
    End Structure

    '
    Private Structure BITMAPINFO
        Dim bmiHeader As BITMAPINFOHEADER
        Dim bmiColors As RGBQUAD
    End Structure
    '
    Private Const DIB_RGB_COLORS = 0&
    Private Const BI_RGB = 0&

    Private Const pixR As Integer = 3
    Private Const pixG As Integer = 2
    Private Const pixB As Integer = 1

    Private Sub UnRGB(ByRef color As Integer, ByRef R As Byte, ByRef g As Byte, ByRef b As Byte)
        R = color And &HFF&
        g = (color And &HFF00&) \ &H100&
        b = (color And &HFF0000) \ &H10000
    End Sub

ال function التي ارغب في نصحيحها الي الدوت نت

 Private Sub ShapeForm(ByVal pic As PictureBox, ByVal transparent_color As Long)
        Const RGN_OR = 2
        Dim bytes_per_scanLine As Integer
        Dim wid As Integer
        Dim hgt As Integer
        Dim bitmap_info As BITMAPINFO
        Dim pixels() As Byte
        Dim buffer() As Byte
        Dim transparent_r As Byte
        Dim transparent_g As Byte
        Dim transparent_b As Byte
        Dim border_width As Single
        Dim title_height As Single
        Dim x0 As Integer
        Dim y0 As Integer
        Dim start_c As Integer
        Dim stop_c As Integer
        Dim R As Integer
        Dim C As Integer
        Dim combined_rgn As Integer
        Dim new_rgn As Integer

        ' ScaleMode = vbPixels
        ' pic.ScaleMode = vbPixels
        '  pic.AutoRedraw = True
        pic.Picture = pic.Image

        ' Prepare the bitmap description.
        wid = pic.ClientRectangle.Width
        hgt = pic.ClientRectangle.Height
        '
        With bitmap_info.bmiHeader
            .biSize = 40
            .biWidth = wid
            ' Use negative height to scan top-down.
            .biHeight = -hgt
            .biPlanes = 1
            .biBitCount = 32
            .biCompression = BI_RGB
            bytes_per_scanLine = ((((.biWidth * .biBitCount) + 31) \ 32) * 4)
            .biSizeImage = bytes_per_scanLine * hgt
        End With

        ' Load the bitmap's data.
    ReDim pixels(1 To 4, 1 To wid, 1 To hgt)
        GetDIBits(pic.hDC, pic.Image, _
            0, hgt, pixels(1, 1, 1), _
            bitmap_info, DIB_RGB_COLORS)

        ' Process the pixels.
        ' Break the tansparent color apart.
        UnRGB(transparent_color, transparent_r, transparent_g, transparent_b)

        ' Find the form's corner.
        border_width = (ScaleX(Width, vbTwips, vbPixels) - ScaleWidth) / 2
        title_height = ScaleX(Height, vbTwips, vbPixels) - border_width - ScaleHeight

        ' Find the picture's corner.
        x0 = pic.Left + border_width
        y0 = pic.Top + title_height

        ' Create the form's regions.
        For R = 1 To hgt
            ' Create a region for this row.
            C = 1
            Do While C <= wid
                start_c = 1
                stop_c = 1

                ' Find the next non-white column.
                Do While C <= wid
                    If pixels(pixR, C, R) <> transparent_r Or _
                       pixels(pixG, C, R) <> transparent_g Or _
                       pixels(pixB, C, R) <> transparent_b _
                    Then
                        Exit Do
                    End If
                    C = C + 1
                Loop
                start_c = C

                ' Find the next white column.
                Do While C <= wid
                    If pixels(pixR, C, R) = transparent_r And _
                       pixels(pixG, C, R) = transparent_g And _
                       pixels(pixB, C, R) = transparent_b _
                    Then
                        Exit Do
                    End If
                    C = C + 1
                Loop
                stop_c = C

                ' Make a region from start_c to stop_c.
                If start_c <= wid Then
                    If stop_c > wid Then stop_c = wid

                    ' Create the region.
                    new_rgn = CreateRectRgn( _
                        start_c + x0, R + y0, _
                        stop_c + x0, R + y0 + 1)

                    ' Add it to what we have so far.
                    If combined_rgn = 0 Then
                        combined_rgn = new_rgn
                    Else
                        CombineRgn(combined_rgn, _
                            combined_rgn, new_rgn, RGN_OR)
                        DeleteObject(new_rgn)
                    End If
                End If
            Loop
        Next R

        ' Restrict the form to the region.
        SetWindowRgn(hWnd, combined_rgn, True)
        DeleteObject(combined_rgn)
    End Sub

تحياتي