角を丸めたフォーム(リージョン)             <TOP>

メインフォームプロパティ

    フレームの種類  →  境界線

    タイトルバー  →  なし

図ではメインフォームと同サイズのビットマップを貼り付けています。（無くてもかまいません）

フォームをクリックする毎に、半径(R)が0〜100まで10刻みで変化します。

CreateRoundRectRgn 角を丸めた領域の設定

SetWindowRgn 指定領域をウィンドウ領域として設定

DeleteObject システムリソースの解放

　


　

'================================================================
'= リージョン(MAINFORMの角を丸く)
'=    (RoundRect.bas)
'================================================================
#include "Windows.bi"

' 角の丸い長方形のリージョンを作成
Declare Function Api_CreateRoundRectRgn& Lib "gdi32" Alias "CreateRoundRectRgn" (ByVal nLeftRect&, ByVal nTopRect&, ByVal nRightRect&, ByVal nBottomRect&, ByVal nWidthEllipse&, ByVal nHeightEllipse&)

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

' 論理オブジェクトを削除し、そのオブジェクトに関連付けられていたすべてのシステムリソースを解放
Declare Function Api_DeleteObject& Lib "gdi32" Alias "DeleteObject" (ByVal hObject&)

Var Shared Bitmap As Object
Var Shared Button1 As Object

BitmapObject Bitmap
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

Var Shared R As Long                    '半径

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    On Error Goto *Er_Trap

    R = 0
    Bitmap.LoadFile "RoundRect.bmp"     '無くても可
    DrawBitmap Bitmap, 0, 0
    Bitmap.DeleteObject
    Button1.SetWindowtext "半径→(" & Trim$(Str$(R))  & ")"
    Exit Sub

*Er_Trap
    Resume Next
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_On edecl ()
Sub Button1_On()
    Var Rgn As Long
    Var Ret As Long

    R = R + 10 : If R > 100 Then R = 0
    Rgn = Api_CreateRoundRectRgn(0, 0, GetWidth - 1, GetHeight - 1, R, R)
    Ret = Api_SetWindowRgn(GethWnd, Rgn, 1)
    Ret = Api_DeleteObject(Rgn)
    Button1.SetWindowtext "半径→(" & Trim$(Str$(R))  & ")"
End Sub

'================================================================
'=
'================================================================
Declare Sub Button2_On edecl ()
Sub Button2_On()
    End
End Sub

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