怎么用vb制作圆形窗体？

这是代码：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 SetWindowRgn Lib "user32" (ByVal hWnd As Long, _

ByVal hRgn As Long, ByVal bRedraw As Long) As LongPrivate Sub Form_Load()

Dim a, b As Long

Dim w, h As Long

w = Form1.Width / Screen.TwipsPerPixelX

h = Form1.Height / Screen.TwipsPerPixelY

a = CreateEllipticRgn(0, 0, w, h)

b = SetWindowRgn(Me.hWnd, a, True) '设置椭圆形窗体

End Sub

Private Sub Form_Activate()

Picture1(0).Visible = True

End SubPrivate Sub Label1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

Picture1(0).Visible = False

Picture1(1).Visible = False

Picture1(2).Visible = False

Picture1(3).Visible = False

Select Case Index

Case Is = 0

Picture1(0).Visible = True '鼠标所在位置图形突起

Case Is = 1

Picture1(1).Visible = True '鼠标所在位置图形突起

Case Is = 2

Picture1(2).Visible = True '鼠标所在位置图形突起

Case Is = 3

Picture1(3).Visible = True '鼠标所在位置图形突起

End Select

End SubPrivate Sub Picture1_Click(Index As Integer)

End

End Sub

用一个灰色半透明对话框覆与对话框取异或即可

1.半透明对话框

void CForbiddenDlg::Transparent()

{

SetWindowLong(this->GetSafeHwnd(), GWL_EXSTYLE, GetWindowLong(this->GetSafeHwnd(), GWL_EXSTYLE) ^ 0x80000)

HINSTANCE hInst = LoadLibrary("User32.DLL")

if(hInst)

{

typedef BOOL(WINAPI *MYFUNC) (HWND, COLORREF, BYTE, DWORD)

MYFUNC fun = NULL

//取得SetLayeredWindowAttributes函数指针

fun = (MYFUNC)GetProcAddress(hInst, "SetLayeredWindowAttributes")

if(fun)

fun(this->GetSafeHwnd(), 0, 180, 2)

FreeLibrary(hInst)

}

}

2.对话框背景色

BOOL CForbiddenDlg::OnEraseBkgnd(CDC* pDC)

{

// TODO: Add your message handler code here and/or call default

BOOL retValue = CDialog::OnEraseBkgnd(pDC)

CRect rc

GetClientRect(&rc)

pDC->FillSolidRect(&rc, RGB(0, 0, 0))

return retValue

//return CDialog::OnEraseBkgnd(pDC)

}

3.与原对话框求异或

void CForbiddenDlg::SetupRegion()

{

CRect wRect, cRect, aRect

CRgn wndRgn, rgnTemp

CMainFrame *pMain = (CMainFrame *)AfxGetApp()->GetMainWnd()

pMain->GetWindowRect(wRect)

MoveWindow(wRect)

GetWindowRect(aRect)

pMain->GetClientRect(cRect)

wndRgn.CreateRectRgn(cRect.left, cRect.top, cRect.right + 5, cRect.bottom + 5)

rgnTemp.CreateRectRgn(aRect.left + 5 - wRect.left, aRect.top + 10 - wRect.top, aRect.right - 5 - wRect.left, aRect.bottom - 5 - wRect.top)

wndRgn.CombineRgn(&wndRgn, &rgnTemp, RGN_XOR)

rgnTemp.DeleteObject()

SetWindowRgn((HRGN)wndRgn, TRUE)

}

示例：背景为纯白色

执行后：

代码：

'========================================

'声明作用：透明化PictureBox，注意设置其背景颜色为纯白

'========================================

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) 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 CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long

Private Declare Sub ReleaseCapture Lib "user32" ()

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Const RGN_DIFF = 4

Dim CurRgn As Long, TempRgn As Long  ' Region variables

 

'========================================

'函数名称：ShapeMe

'函数作用：透明化PictureBox背景

'========================================

Public Sub ShapeMe(Color As Long, HorizontalScan As Boolean, Optional Name1 As Form = Nothing, Optional Name2 As PictureBox = Nothing)

   

    Dim X As Integer, Y As Integer 'points on form

   Dim dblHeight As Double, dblWidth As Double 'height and width of object

   Dim lngHDC As Long 'the hDC property of the object

   Dim booMiddleOfSet As Boolean 'used during the gathering of transparent points

   Dim colPoints As Collection 'this will hold all usrPoints

   Set colPoints = New Collection

    Dim Z As Variant 'used during iteration through collection

   Dim dblTransY As Double 'these 3 variables hold each point that will be made transparent

   Dim dblTransStartX As Double

    Dim dblTransEndX As Double

    Dim Name As Object 'will hold the name of the object.  Late-bound and slower, but allows different types (in this case Form or PictureBox)

   

    'check out the name or names passed into the subroutine

   If Name1 Is Nothing Xor Name2 Is Nothing Then 'we know there is a name in one of them

       If Name1 Is Nothing Then 'set the name

           Set Name = Picture1

        Else

           Set Name = Picture1

        End If

    Else 'both or none hold valid names

       MsgBox "Must pass in the name of either a Form OR a PictureBox.  TransForm received NONE or BOTH.  Function failed.", vbOKOnly, "ShapeMe Subroutine"

        Exit Sub

    End If

   

    'initialization

   With Name

        .AutoRedraw = True 'object must have this setting

       .ScaleMode = 3 'object must have this setting

       lngHDC = .hdc 'faster to use a variable VB help recommends using the property, but I didn't encounter any problems

       If HorizontalScan = True Then 'look for lines of transparency horizontally

           dblHeight = .ScaleHeight 'faster to use a variable

           dblWidth = .ScaleWidth 'faster to use a variable

       Else 'look vertically (note that the names "dblHeight" and "dblWidth" are non-sensical now, but this was an easy way to do this

           dblHeight = .ScaleWidth 'faster to use a variable

           dblWidth = .ScaleHeight 'faster to use a variable

       End If 'HorizontalScan = True

   End With

    booMiddleOfSet = False

   

    'gather all points that need to be made transparent

   For Y = 0 To dblHeight  ' Go through each column of pixels on form

       dblTransY = Y

        For X = 0 To dblWidth  ' Go through each line of pixels on form

           'note that using GetPixel appears to be faster than using VB's Point

           If TypeOf Name Is Form Then 'check to see if this is a form and use GetPixel function which is a little faster

               If GetPixel(lngHDC, X, Y) = Color Then  ' If the pixel's color is the transparency color, record it

                   If booMiddleOfSet = False Then

                        dblTransStartX = X

                        dblTransEndX = X

                        booMiddleOfSet = True

                    Else

                        dblTransEndX = X

                    End If 'booMiddleOfSet = False

               Else

                    If booMiddleOfSet Then

                        colPoints.Add Array(dblTransY, dblTransStartX, dblTransEndX)

                        booMiddleOfSet = False

                    End If 'booMiddleOfSet = True

               End If 'GetPixel(lngHDC, X, Y) = Color

           ElseIf TypeOf Name Is PictureBox Then 'if a PictureBox then use Point a little slower but works when GetPixel doesn't

               If Name.Point(X, Y) = Color Then

                    If booMiddleOfSet = False Then

                        dblTransStartX = X

                        dblTransEndX = X

                        booMiddleOfSet = True

                    Else

                        dblTransEndX = X

                    End If 'booMiddleOfSet = False

               Else

                    If booMiddleOfSet Then

                        colPoints.Add Array(dblTransY, dblTransStartX, dblTransEndX)

                        booMiddleOfSet = False

                    End If 'booMiddleOfSet = True

               End If 'Name.Point(X, Y) = Color

           End If 'TypeOf Name Is Form

           

        Next X

    Next Y

   

    CurRgn = CreateRectRgn(0, 0, dblWidth, dblHeight)  ' Create base region which is the current whole window

   

    For Each Z In colPoints 'now make it transparent

       TempRgn = CreateRectRgn(Z(1), Z(0), Z(2) + 1, Z(0) + 1)  ' Create a temporary pixel region for this pixel

       CombineRgn CurRgn, CurRgn, TempRgn, RGN_DIFF  ' Combine temp pixel region with base region using RGN_DIFF to extract the pixel and make it transparent

       DeleteObject (TempRgn)  ' Delete the temporary region and free resources

   Next

   

    SetWindowRgn Name.hwnd, CurRgn, True  ' Finally set the windows region to the final product

   'I do not use DeleteObject on the CurRgn, going with the advice in Dan Appleman's book:

   'once set to a window using SetWindowRgn, do not delete the region.

   

    Set colPoints = Nothing

   

End Sub

Private Sub Command1_Click()

Picture1.BackColor = RGB(0, 0, 0) '需要透明的颜色(纯白色)

ShapeMe RGB(255, 255, 255), True, , Picture1 '透明底色

End Sub

---