form1.frm

本例演示了如何使用CreatePolygonRgn函数建立不规则的热区

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "CreatPolygonRgn API"
   ClientHeight    =   4920
   ClientLeft      =   2160
   ClientTop       =   1470
   ClientWidth     =   4980
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4920
   ScaleWidth      =   4980
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   3720
      TabIndex        =   4
      Text            =   " "
      Top             =   3720
      Width           =   975
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   1080
      TabIndex        =   3
      Text            =   " "
      Top             =   3720
      Width           =   975
   End
   Begin VB.Line Line6 
      BorderColor     =   &H000000FF&
      X1              =   1560
      X2              =   3360
      Y1              =   3360
      Y2              =   3360
   End
   Begin VB.Line Line5 
      BorderColor     =   &H000000FF&
      X1              =   4200
      X2              =   3360
      Y1              =   1905
      Y2              =   3360
   End
   Begin VB.Line Line4 
      BorderColor     =   &H000000FF&
      X1              =   720
      X2              =   1560
      Y1              =   1920
      Y2              =   3360
   End
   Begin VB.Line Line3 
      BorderColor     =   &H000000FF&
      X1              =   3360
      X2              =   4200
      Y1              =   495
      Y2              =   1905
   End
   Begin VB.Line Line2 
      BorderColor     =   &H000000FF&
      X1              =   1560
      X2              =   720
      Y1              =   495
      Y2              =   1920
   End
   Begin VB.Line Line1 
      BorderColor     =   &H000000FF&
      X1              =   1560
      X2              =   3360
      Y1              =   495
      Y2              =   495
   End
   Begin VB.Label Label3 
      Caption         =   "Current Y"
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   2520
      TabIndex        =   2
      Top             =   3840
      Width           =   975
   End
   Begin VB.Label label2 
      Caption         =   "Current X"
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   3840
      Width           =   975
   End
   Begin VB.Label Label1 
      Caption         =   "现在，你正在热区内！"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   495
      Left            =   1440
      TabIndex        =   0
      Top             =   4320
      Visible         =   0   'False
      Width           =   3495
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'有问题请联系Email: [e-mail]
'原子数据工作室 - http://www.quanqiu.com/vb


Option Explicit
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Type POINTAPI
        X As Long
        Y As Long
        End Type

Const ALTERNATE = 1
Dim reg As Long

Private Sub Form_Load()
Dim pts(6) As POINTAPI
'设定多边形顶点坐标
pts(0).X = 1560
pts(0).Y = 495
pts(1).X = 3360
pts(1).Y = 495
pts(2).X = 4200
pts(2).Y = 1905
pts(3).X = 3360
pts(3).Y = 3360
pts(4).X = 1560
pts(4).Y = 3360
pts(5).X = 720
pts(5).Y = 1920
'生成热区
reg = CreatePolygonRgn(pts(0), 6, ALTERNATE)
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If PtInRegion(reg, X, Y) Then
  Me.MousePointer = 11
  Label1.Visible = True
Else
  Label1.Visible = False
  Me.MousePointer = 0
End If
Text1.Text = X
Text2.Text = Y
End Sub

Private Sub Form_Unload(Cancel As Integer)
DeleteObject (reg)
End Sub