神马文学网VB - 浅谈圆角窗体
来源：百度文库 编辑：神马文学网 时间：2024/04/29 15:41:40
先来理解一个重要的概念→“区域”。区域是描述设备场景中某一块的GDI对象，每个区域都有一个句柄。一个区域可以是矩形，也可以是复杂的多边形，甚至是几个区域组织在一起。窗体默认的区域就是我们看到的矩形，当然它并非一定要用这个默认的区域。
现在开始，新建VB工程，把默认窗体"Form1"的"BorderStyle"属性设置为[0 - None]。
源代码如下：
Option Explicit
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 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 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 Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Const RGN_AND = 1
Private MyRgn1 As Long
Private MyRgn2 As Long
Private MyRgn As Long '保存圆角区域，也是窗体最终的形状
Private Sub Form_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim w As Long, h As Long
w = ScaleX(Me.Width, vbTwips, vbPixels)
h = ScaleY(Me.Height, vbTwips, vbPixels)
'----｛下面为十五种圆角窗体代码，任选一种即可实现相应的效果｝----
'01.左上圆其余直
' MyRgn = CreateRoundRectRgn(30, 30, w + 30, h + 30, 16, 16)
'02.左下圆其余直
' MyRgn = CreateRoundRectRgn(30, -30, w + 30, h - 30, 16, 16)
'03.右上圆其余直
' MyRgn = CreateRoundRectRgn(-30, 30, w - 30, h + 30, 16, 16)
'04.右下圆其余直
' MyRgn = CreateRoundRectRgn(-30, -30, w - 30, h - 30, 16, 16)
'05.上圆下直
' MyRgn = CreateRoundRectRgn(30, 30, w - 30, h + 30, 16, 16)
'06.上直下圆
' MyRgn = CreateRoundRectRgn(30, -30, w - 30, h - 30, 16, 16)
'07.左圆右直
' MyRgn = CreateRoundRectRgn(30, 30, w + 30, h - 30, 16, 16)
'08.左直右圆
' MyRgn = CreateRoundRectRgn(-30, 30, w - 30, h - 30, 16, 16)
'09.左上右下圆左下右上直
' MyRgn = CreateRectRgn(0, 0, 0, 0)
' MyRgn1 = CreateRoundRectRgn(30, 30, w + 30, h + 30, 16, 16)
' MyRgn2 = CreateRoundRectRgn(-30, -30, w - 30, h - 30, 16, 16)
' Call CombineRgn(MyRgn, MyRgn1, MyRgn2, RGN_AND)
'10.左下右上圆左上右下直
' MyRgn = CreateRectRgn(0, 0, 0, 0)
' MyRgn1 = CreateRoundRectRgn(-30, 30, w - 30, h + 30, 16, 16)
' MyRgn2 = CreateRoundRectRgn(30, -30, w + 30, h - 30, 16, 16)
' Call CombineRgn(MyRgn, MyRgn1, MyRgn2, RGN_AND)
'11.左上直其余圆
' MyRgn = CreateRectRgn(0, 0, 0, 0)
' MyRgn1 = CreateRoundRectRgn(30, -30, w - 30, h - 30, 16, 16)
' MyRgn2 = CreateRoundRectRgn(-30, 30, w - 30, h + 30, 16, 16)
' Call CombineRgn(MyRgn, MyRgn1, MyRgn2, RGN_AND)
'12.左下直其余圆
' MyRgn = CreateRectRgn(0, 0, 0, 0)
' MyRgn1 = CreateRoundRectRgn(30, 30, w - 30, h + 30, 16, 16)
' MyRgn2 = CreateRoundRectRgn(-30, -30, w - 30, h - 30, 16, 16)
' Call CombineRgn(MyRgn, MyRgn1, MyRgn2, RGN_AND)
'13.右上直其余圆
' MyRgn = CreateRectRgn(0, 0, 0, 0)
' MyRgn1 = CreateRoundRectRgn(30, -30, w - 30, h - 30, 16, 16)
' MyRgn2 = CreateRoundRectRgn(30, 30, w + 30, h + 30, 16, 16)
' Call CombineRgn(MyRgn, MyRgn1, MyRgn2, RGN_AND)
'14.右下直其余圆
' MyRgn = CreateRectRgn(0, 0, 0, 0)
' MyRgn1 = CreateRoundRectRgn(30, 30, w - 30, h + 30, 16, 16)
' MyRgn2 = CreateRoundRectRgn(30, -30, w + 30, h - 30, 16, 16)
' Call CombineRgn(MyRgn, MyRgn1, MyRgn2, RGN_AND)
'15.四角都为圆角
' MyRgn = CreateRoundRectRgn(30, 30, w - 30, h - 30, 16, 16)
'--------------------------------------------------------------------------------------
Call SetWindowRgn(Me.hWnd, MyRgn, True) '改变窗口的区域为"MyRgn"
Me.BackColor = QBColor(5)
End Sub
Private Sub Form_Unload(Cancel As Integer)
'删除非空区域
If MyRgn <> 0 Then DeleteObject MyRgn
If MyRgn1 <> 0 Then DeleteObject MyRgn1
If MyRgn2 <> 0 Then DeleteObject MyRgn2
End Sub