查看: 7  |  回复: 0
  VB6 代码管家-设置不规则窗体
楼主
发表于 2024年12月8日 22:19
'画一个三角形
Option Explicit
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode 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 Type POINTAPI
     x As Long
     y As Long
End Type

Private Sub Form_Load()
     Dim Result As Long
     Dim Points(3) As POINTAPI '3代表坐标数量,这个数必须大于或等于实际坐标数
    
     Points(0).x = 0
     Points(0).y = 0
     '第一个坐标

     Points(1).x = 300
     Points(1).y = 0
     '第二个坐标

     Points(2).x = 150
     Points(2).y = 300
     '第三个坐标
     Result = CreatePolygonRgn(Points(0), 6, 1) '创建区域
     SetWindowRgn Me.hwnd, Result, True '裁剪窗体
End Sub
'设置坐标必须以顺时针方向设置,只有包裹在坐标内的部份才不会被裁剪掉
_______________________________________________________
'画一个圆形或者椭圆形
Option Explicit
Private Declare Function CreateEllipticRgn Lib "gdi32" Alias "CreateEllipticRgn" (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 Boolean) As Long'裁剪窗体
Private Sub Form_Load()
	Dim Result As Long '声明变量用于保存区域的句柄
	Result = CreateEllipticRgn(右下角x, 右下角y, 右下角x, 右下角y) '如果右下角x和右下角y一样则为圆形
	SetWindowRgn Me.Hwnd, Result, True '剪裁窗体
End Sub
'注意:圆形和椭圆形分别是正方形和矩形的内切圆
_______________________________________________________
'创建一个圆环
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) 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 Const RGN_AND = 1 '区域合并结果预设成区域1和区域2相交的部分
Private Const RGN_COPY = 2 '区域1和区域2重叠在一起合成一个新的区域
Private Const RGN_DIFF = 3 '区域合并结果预设成区域1和区域2不相交的部分
Private Const RGN_OR = 4 '(区域2被区域1遮住部分)连同区域1一起被吃掉
Private Const RGN_XOR = 5 '不知道怎么用

Private Sub Form_Load()
	Dim hRgn1 As Long, hRgn2 As Long, hRgn3 As Long
	
	hRgn1 = CreateEllipticRgn(0, 0, 200, 200) '创建一个大圆区域
	hRgn2 = CreateEllipticRgn(60, 60, 140, 140) '创建一个小圆区域
	hRgn3 = CombineRgn(hRgn1, hRgn1, hRgn2, 3) '参数3跟根实际情况而设
	
	SetWindowRgn Form1.hWnd, hRgn1, True  '开始裁剪窗体
End Sub

_______________________________________________________
'创建一个矩形
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 Sub Form_Load()
	SetWindowRgn Form1.hWnd, CreateRectRgn(右下角x, 右下角y, 左下角x, 左下角y), True  '开始裁剪窗体
End Sub

_______________________________________________________
'画一个圆角矩形
Private Declare Function SetWindowRgn Lib "USER32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) 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 Sub Form_Load()
	Me.BorderStyle = 0
	Me.Caption = ""
	Call SetWindowRgn(Form1.hWnd, CreateRoundRectRgn(0, 0, Me.Width / 15, Me.Height / 15, 20, 20), True) '两个20分别表示圆角的宽和高
End Sub


您需要登录后才可以回帖 登录 | 立即注册
【本版规则】请勿发表违反国家法律的内容,否则会被冻结账号和删贴。
用户名: 立即注册
密码:
2020-2024 MaNongKu.com