form1.frm

从库中调用图片(10KB) 从库中调用图片(10KB)

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H80000000&
   Caption         =   "在窗体上单击变形；在窗体上双单击退出"
   ClientHeight    =   4830
   ClientLeft      =   1860
   ClientTop       =   2160
   ClientWidth     =   7080
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4830
   ScaleWidth      =   7080
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' API 函数声明

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 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 Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

'常数声明

Private Const RGN_DIFF = 4
' 目标区域被设置为两个区域不相交的部分

'模块级变量声明

Private OutRgn As Long
' 外边的圆角矩形区域
Private InRgn As Long
' 里边的椭圆区域
Private MyRgn As Long
' 圆角区域剪切掉椭圆区域后的区域，也是窗体最终的形状

Private Sub Form_Click()
If OutRgn <> 0 And InRgn <> 0 And MyRgn <> 0 Then Exit Sub
Dim w As Long, h As Long
w = ScaleX(Form1.Width, vbTwips, vbPixels)
h = ScaleY(Form1.Height, vbTwips, vbPixels)
MyRgn = CreateRectRgn(0, 0, 0, 0)
OutRgn = CreateRoundRectRgn(30, 30, w - 30, h - 30, 100, 100)
InRgn = CreateEllipticRgn(100, 100, w - 100, h - 100)
Call CombineRgn(MyRgn, OutRgn, InRgn, RGN_DIFF)
Call SetWindowRgn(Form1.hWnd, MyRgn, True)
Form1.BackColor = QBColor(4)
End Sub

Private Sub Form_DblClick()
Unload Form1
End Sub

Private Sub Form_Load()
OutRgn = 0
InRgn = 0
MyRgn = 0
Form1.Width = 7800
Form1.Height = 6000
End Sub

Private Sub Form_Unload(Cancel As Integer)
If MyRgn <> 0 Then DeleteObject MyRgn
If OutRgn <> 0 Then DeleteObject OutRgn
If InRgn <> 0 Then DeleteObject InRgn
End Sub