API问题：请举个CreatePolygonRgn的例子。希望有说明，高分送上。

[Dickson]

API问题：请举个CreatePolygonRgn的例子。希望有说明，高分送上。

[用户 昵称]

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 Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hDC As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function Polyline Lib "gdi32" (ByVal hDC As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long

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 ReleaseCapture Lib "user32" () As Long

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Type POINTAPI
X As Long
Y As Long
End Type

Private scnPts() As POINTAPI
Private rgnPts() As POINTAPI

Private Const SM_CYCAPTION = 4
Private Const SM_CXFRAME = 32
Private Const SM_CYFRAME = 33

' PolyFill() Modes
Private Const ALTERNATE = 1
Private Const WINDING = 2

' Used to support captionless drag
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

Private m_FillMode As Long
Private Const nPts& = 36

Private Sub Command1_Click()
Dim hRgn As Long
Static UsingPoly As Boolean
'
' Flag variable tracks current state.
'
UsingPoly = Not UsingPoly
If UsingPoly Then
'
' Create a region, then turn on
' clipping to that region.
'
hRgn = CreatePolygonRgn(rgnPts(0), nPts, m_FillMode)
Call SetWindowRgn(Me.hWnd, hRgn, True)
Else
'
' Turn off clipping.
'
Call SetWindowRgn(Me.hWnd, 0&, True)
End If

Timer1.Enabled = UsingPoly
End Sub

Private Sub Form_Load()
m_FillMode = ALTERNATE
With Me
.ScaleMode = vbPixels
.Width = Screen.Width \ 2
.Height = .Width
.Move (Screen.Width - .Width) \ 2, (Screen.Height - .Height) \ 2
.Icon = Nothing
End With
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'
' Allow captionless drag if form is clipped to region
'
If Timer1.Enabled Then
Call ReleaseCapture
Call SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub

Private Sub Form_Paint()
Dim hBrush As Long
Dim hRgn As Long
'
' Create region and a brush to fill it with.
'
hBrush = CreateSolidBrush(vbRed)
hRgn = CreatePolygonRgn(scnPts(0), nPts, m_FillMode)
Call FillRgn(Me.hDC, hRgn, hBrush)
'
' Clean up GDI objects.
'
Call DeleteObject(hRgn)
Call DeleteObject(hBrush)
'
' Draw outline around polygon.
'
Call Polyline(Me.hDC, scnPts(0), nPts + 1)
End Sub

Private Sub Form_Resize()
With Me
Command1.Move (.ScaleWidth - Command1.Width) \ 2, _
(.ScaleHeight - Command1.Height) \ 2
If .Visible Then
CalcRgnPoints
.Refresh
End If
End With
End Sub

Private Static Sub CalcRgnPoints()
ReDim scnPts(0 To nPts) As POINTAPI
ReDim rgnPts(0 To nPts) As POINTAPI
Dim offset As Long
Dim angle As Long
Dim theta As Double
Dim radius1 As Long
Dim radius2 As Long
Dim x1 As Long
Dim y1 As Long
Dim xOff As Long
Dim yOff As Long
Dim n As Long
'
' Some useful constants.
'
Const Pi# = 3.14159265358979
Const DegToRad# = Pi / 180
'
' Calc radius based on form size.
'
x1 = Me.ScaleWidth \ 2
y1 = Me.ScaleHeight \ 2
If x1 > y1 Then
radius1 = y1 * 0.85
Else
radius1 = x1 * 0.85
End If
radius2 = radius1 * 0.5
'
' Offsets to move origin to upper
' left of window.
'
xOff = GetSystemMetrics(SM_CXFRAME)
yOff = GetSystemMetrics(SM_CYFRAME) + GetSystemMetrics(SM_CYCAPTION)
'
' Step through a circle, 10 degrees each
' loop, finding points for polygon.
'
n = 0
For angle = 0 To 360 Step 10
theta = (angle - offset) * DegToRad
'
' First region is for drawing.
' One long, one short, one long...
'
If n Mod 2 Then
scnPts(n).X = x1 + (radius1 * (Sin(theta)))
scnPts(n).Y = y1 + (radius1 * (Cos(theta)))
Else
scnPts(n).X = x1 + (radius2 * (Sin(theta)))
scnPts(n).Y = y1 + (radius2 * (Cos(theta)))
End If
'
' Second region is for clipping.
' Add offsets.
'
rgnPts(n).X = scnPts(n).X + xOff
rgnPts(n).Y = scnPts(n).Y + yOff
n = n + 1
Next angle

offset = (offset + 2) Mod 360
End Sub

Private Sub Option1_Click(Index As Integer)
m_FillMode = Index + 1
End Sub

Private Static Sub Timer1_Timer()
Dim nRet As Long
Dim hRgn As Long

CalcRgnPoints
hRgn = CreatePolygonRgn(rgnPts(0), nPts, m_FillMode)
nRet = SetWindowRgn(Me.hWnd, hRgn, True)
End Sub

[rainstormmaster]

Private Type COORD
x As Long
y As Long
End Type
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As Any, ByVal nCount As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Const ALTERNATE = 1 ' ALTERNATE and WINDING are
Const WINDING = 2 ' constants for FillMode.
Const BLACKBRUSH = 4 ' Constant for brush type.
Private Sub Form_Paint()
Dim poly(1 To 3) As COORD, NumCoords As Long, hBrush As Long, hRgn As Long
Me.Cls
' Number of vertices in polygon.
NumCoords = 3
' Set scalemode to pixels to set up points of triangle.
Me.ScaleMode = vbPixels
' Assign values to points.
Poly(1).x = Form1.ScaleWidth / 2
poly(1).y = Form1.ScaleHeight / 2
poly(2).x = Form1.ScaleWidth / 4
poly(2).y = 3 * Form1.ScaleHeight / 4
poly(3).x = 3 * Form1.ScaleWidth / 4
poly(3).y = 3 * Form1.ScaleHeight / 4
' Polygon function creates unfilled polygon on screen.
' Remark FillRgn statement to see results.
Polygon Me.hdc, poly(1), NumCoords
' Gets stock black brush.
hBrush = GetStockObject(BLACKBRUSH)
' Creates region to fill with color.
hRgn = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE)
' If the creation of the region was successful then color.
If hRgn Then FillRgn Me.hdc, hRgn, hBrush
DeleteObject hRgn
End Sub
Private Sub Form_Resize()
Form_Paint
End Sub

[twobug]

用VB5设计五角星窗体

窗体是用户进行界面设计的窗口,我们一般见到的都是标准的WINDOWS方形窗体,但在有的时候,我们却需要一些非标准的窗体,如多边形窗体,圆形窗体,椭圆形窗体,以满足程序开发的需要,这时候我们可以利用WINDOWS API 函数来解决这些问题,下面这个程序就向大家介绍如何利用WINDOWS API函数设计五角星窗体.

本程序有两个关键部分,一是如何利用API函数,二是如何完成五角星的顶点坐标定位，现分别作一介绍.

Windows API 函数 CreatePolygonRgn() and SetWindowRgn() 使用如下:
1）函数声明：

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

2）函数的使用:

Dim hRgn As Long

Dim lRes As Long

ReDim Star(9) As POINTAPI

hRgn = CreatePolygonRgn(Star(0), 10, 2)

lRes = SetWindowRgn(Me.hwnd, hRgn, True)

其中CreatePolygonRgn() 返回一个多边形区域的句柄,其参数的意义如下:

lpPoint 为POINTAPI 类型数组,表示多边形各顶点的坐标,本题中五角星有碍10个顶点,所以定义一个组为 Star(9),POINTAPI 类型在API 声明文件中有如下声明:

Private Type POINTAPI

x As Long

y As Long

End Type

一个lpPoint 元素为一个点的坐标,在给CreatePolygonRgn() 函数lpPoint参数时,只须把lpPoint的第一个元素传送过去即可,如上面五角星所使用的参数为Star() ，nCount 为长整形参数,用来说明多边形顶点的个数,如上面五角星中使用的参数是10， NPolyFillMode 为长整形参数,用来指定多边形区域的填充模式,参数为2则是不透明模式.

SetWindowRgn()函数各参数的意义为:

hWnd 为长整形参数,表示要变为多边形窗体的句柄.
hRgn 为长整形参数,表示多边形区域的句柄.
Bredraw 为布尔型参数,表示是否要立刻重新刷新窗体,如为TRUE 则表示函数调用后立即刷新,为FALSE则相反.
二： 完成五角星的顶点坐标

这里我采用了分别取顶点坐标法:先取外顶点的坐标存入临时数组x()、y()，然后再取内顶点的坐标存入临时数组x()、y(),最后把临时数组中的坐标值存入窗体数组.

'取得外部五个顶点的坐标

For i = 0 To 8 Step 2

x(i) = x0 + R1 * Cos(a * rad) * k

y(i) = y0 - R1 * Sin(a * rad)

a = a + 72

Next i

'取得内部五个顶点的坐标

For i = 1 To 9 Step 2

x(i) = x0 + R2 * Cos(a * rad) * k

y(i) = y0 - R2 * Sin(a * rad)

a = a + 72

Next i

'将五角星的十个顶点坐标存入数组 Star()

For i = 0 To 9

Star(i).x = CLng(x(i))

Star(i).y = CLng(y(i))

Next i

a为起始角,为窗体宽与高的比值,k值不同,得到的五角星形状也就不同,本程序在一开始就把窗体定为480*480.

另外,本程序还加入了窗体闪烁功能,它利用了函数FlashWindow和Timer控件.

此程序在WINDOWS98与windowNT操作系统上,利用VB5调试通过,我想大家看了这个例子会想出更多更好的新创意.

附原程序代码:

'声明 POINTAPI 型数组

Private Type POINTAPI

x As Long

y As Long

End Type

Dim Star() As POINTAPI

Dim StartFlag As Boolean

Dim x(), y() As Double

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 Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal_ bInvert As Long) As Long

Private Sub Form_Load()

StartFlag = True

End Sub

Public Sub wjl()

ReDim x(9), y(9) As Double

Dim rad, k, R1, R2 As Double

Dim i, a As Integer

Me.Scale (0, 0)-(480, 480)

Me.WindowState = 2

x0 = Me.ScaleWidth / 2

y0 = Me.ScaleHeight / 2

R1 = Me.ScaleWidth / 2

rad = 3.1415926 / 180#

k = 480 / 480

a = 18

'取得外部五个顶点的坐标

For i = 0 To 8 Step 2

x(i) = x0 + R1 * Cos(a * rad) * k

y(i) = y0 - R1 * Sin(a * rad)

a = a + 72

Next i

R2 = R1 * (Sin(18 * rad) / Sin(54 * rad))

a = 54

'取得内部五个顶点的坐标

For i = 1 To 9 Step 2

x(i) = x0 + R2 * Cos(a * rad) * k

y(i) = y0 - R2 * Sin(a * rad)

a = a + 72

Next i

'将五角星的十个顶点坐标存入数组 Star()

For i = 0 To 9

Star(i).x = CLng(x(i))

Star(i).y = CLng(y(i))

Next i

End Sub

Private Sub Command1_Click()

Dim hRgn As Long

Dim lRes As Long

ReDim Star(9) As POINTAPI

If StartFlag = True Then

StartFlag = False

Command1.Caption = "关闭星形窗体"

wjl

Else

End

End If

'把窗体变成五角星形

hRgn = CreatePolygonRgn(Star(0), 10, 2)

lRes = SetWindowRgn(Me.hwnd, hRgn, True)

End Sub

Private Sub Timer1_Timer()

'窗体标题栏闪烁

FlashWindow Me.hwnd, 1

End Sub