'================================================================
'= フォームの形状いろいろ
'=    (CopyRect.bas)
'================================================================
#include "Windows.bi"

Type POINTAPI
    x As Long
    y As Long
End Type
 
Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type
 
' 角の丸い長方形のリージョンを作成
Declare Function Api_CreateRoundRectRgn& Lib "gdi32" Alias "CreateRoundRectRgn" (ByVal nLeftRect&, ByVal nTopRect&, ByVal nRightRect&, ByVal nBottomRect&, ByVal nWidthEllipse&, ByVal nHeightEllipse&)

' 指定の領域をウィンドウ領域として設定
Declare Function Api_CreateEllipticRgnIndirect& Lib "gdi32" Alias "CreateEllipticRgnIndirect" (lpRect As RECT)

' 指定のウィンドウのウィンドウ領域を取得
Declare Function Api_GetWindowRgn& Lib "user32" Alias "GetWindowRgn" (ByVal hWnd&, ByVal hRgn&)

' 指定の領域をウィンドウ領域として設定
Declare Function Api_SetWindowRgn& Lib "user32" Alias "SetWindowRgn" (ByVal hWnd&, ByVal hRgn&, ByVal bRedraw&)

' 論理オブジェクトを削除
Declare Function Api_DeleteObject& Lib "gdi32" Alias "DeleteObject" (ByVal hObject&)

' 多角形のリージョンを作成
Declare Function Api_CreatePolygonRgn& Lib "gdi32" Alias "CreatePolygonRgn" (lppt As POINTAPI, ByVal nCount&, ByVal nPolygonFillMode&)

' ウィンドウの座標をスクリーン座標系で取得
Declare Function Api_GetWindowRect& Lib "user32" Alias "GetWindowRect" (ByVal hWnd&, lpRect As RECT)

' 矩形領域をRECT構造体に基づいて作成
Declare Function Api_CreateRectRgnIndirect& Lib "gdi32" Alias "CreateRectRgnIndirect" (lpRect As RECT)

' RECT構造体の座標値を拡大・縮小
Declare Function Api_InflateRect& Lib "user32" Alias "InflateRect" (lpRect As RECT, ByVal x&, ByVal y&)

' RECT構造体の座標値を別のRECT構造体にコピー
Declare Function Api_CopyRect& Lib "user32" Alias "CopyRect" (lpDestRect As RECT, lpSourceRect As RECT)

' RECT構造体の値を設定
Declare Function Api_SetRect& Lib "user32" Alias "SetRect" (lpRect As RECT, ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&)

#define ALTERNATE 1
#define WINDING 2
 
Var Shared RectRgn As Long
Var Shared EllipticRgn As Long
Var Shared PolygonRgn As Long
Var Shared PolygonRgn2 As Long
Var Shared RoundRectRgn As Long
Var Shared BufferRgn As Long
Var Shared n As Long

'================================================================
'=
'================================================================
Declare Function CreateRgns () As Long
Function CreateRgns() As Long
    Var rct As RECT
    Var trct As RECT
    Var Polygon(2) As POINTAPI
    Var Polygon2(4) As POINTAPI
    Var Ret As Long

    Ret = Api_GetWindowRect(GethWnd, rct)
    Ret = Api_SetRect(rct, 0, 0, rct.Right - rct.Left, rct.Bottom - rct.Top)

    '矩形領域をRECT構造体に基づいて作成
    BufferRgn = Api_CreateRectRgnIndirect(trct)

    '楕円形
    EllipticRgn = Api_CreateEllipticRgnIndirect(rct)
   
    '三角形
    Polygon(0).x = rct.Right / 2
    Polygon(0).y = 0
    Polygon(1).x = 0
    Polygon(1).y = rct.Bottom
    Polygon(2).x = rct.Right
    Polygon(2).y = rct.Bottom
    PolygonRgn = Api_CreatePolygonRgn(Polygon(0), 3, WINDING)

    '五角形
    Polygon2(0).x = rct.Right / 2
    Polygon2(0).y = rct.Bottom / 5
    Polygon2(1).x = rct.Right / 4.5
    Polygon2(1).y = 2 * rct.Bottom / 4.5
    Polygon2(2).x = rct.Right / 3
    Polygon2(2).y = 3 * rct.Bottom / 5
    Polygon2(3).x = 3 * rct.Right / 4.5
    Polygon2(3).y = 3 * rct.Bottom / 5
    Polygon2(4).x = 4 * rct.Right / 5
    Polygon2(4).y = 2 * rct.Bottom / 4.5
    PolygonRgn2 = Api_CreatePolygonRgn(Polygon2(0), 5, WINDING)

    '角を丸める
    RoundRectRgn = Api_CreateRoundRectRgn(rct.Left, rct.Top, rct.Right, rct.Bottom, 50, 50)
   
    'RECT構造体の座標値を別のRECT構造体にコピーして縮小
    Ret = Api_CopyRect(trct, rct)
    Ret = Api_InflateRect(trct, -50, -50)
    RectRgn = Api_CreateRectRgnIndirect(trct)
End Function

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    n = 0
    Ret = CreateRgns
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Click edecl ()
Sub MainForm_Click()
    Var Ret As Long

    Ret = Api_GetWindowRgn(GethWnd, BufferRgn)

    n = n + 1
    If n > 6 Then n = 1

    Select Case n
        Case 1
            Ret = Api_SetWindowRgn(GethWnd, EllipticRgn, 1)
        Case 2
            Ret = Api_SetWindowRgn(GethWnd, PolygonRgn, 1)
        Case 3
            Ret = Api_SetWindowRgn(GethWnd, PolygonRgn2, 1)
        Case 4
            Ret = Api_SetWindowRgn(GethWnd, RoundRectRgn, 1)
        Case 5
            Ret = Api_SetWindowRgn(GethWnd, RectRgn, 1)
        Case 6
            Ret = Api_SetWindowRgn(GethWnd, 0, 1)
            Ret = CreateRgns
    End Select
End Sub
 
'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose edecl ()
Sub MainForm_QueryClose()
    Var Ret As Long

    Ret = Api_DeleteObject(EllipticRgn)
    Ret = Api_DeleteObject(PolygonRgn)
    Ret = Api_DeleteObject(PolygonRgn2)
    Ret = Api_DeleteObject(RoundRectRgn)
    Ret = Api_DeleteObject(StdRgn)
    Ret = Api_DeleteObject(BufferRgn)
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End