フォームの形状(ミッキーマウス) <TOP>
フォームをミッキーマウスにしてみます。
CombineRgn 既存の二つの領域を結合し、新しい領域を作成
SetWindowRgn 指定の領域をウィンドウ領域として設定
CreateEllipticRgn 楕円形のリージョンを作成
DeleteObject オブジェクトを削除
SetCapture 指定のウィンドウにマウスキャプチャを設定
ReleaseCapture マウスキャプチャの解放
SetWindowPos ウィンドウのサイズ、位置、及びZオーダーを設定
GetCursorPos マウスカーソルの現在の位置に相当するスクリーン座標を取得
GetWindowRect ウィンドウの座標をスクリーン座標系で取得
例では、下図のように4個の領域を結合しています。
MainFormのプロパティで境界線を選択、サイズは240×240ピクセル。同サイズのミッキーマウスのbmpファイルを重ねています。
'================================================================ '= フォームの形状(ミッキーマウス) '= (CombineRgn.bas) '================================================================ #include "Windows.bi" Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Type POINTAPI x As Long y As Long End Type ' 既存の二つの領域を結合して新しい領域を作成 Declare Function Api_CombineRgn& Lib "gdi32" Alias "CombineRgn" (ByVal hRgnDest&, ByVal hRgnSrc1&, ByVal hRgnSrc2&, ByVal nCombineMode&) ' 指定の領域をウィンドウ領域として設定 Declare Function Api_SetWindowRgn& Lib "user32" Alias "SetWindowRgn" (ByVal hWnd&, ByVal hRgn&, ByVal bRedraw&) ' 楕円形のリージョンを作成 Declare Function Api_CreateEllipticRgn& Lib "gdi32" Alias "CreateEllipticRgn" (ByVal nLeftRect&, ByVal nTopRect&, ByVal nRightRect&, ByVal nBottomRect&) ' 論理オブジェクトを削除し、そのオブジェクトに関連付けられていたすべてのシステムリソースを解放 Declare Function Api_DeleteObject& Lib "gdi32" Alias "DeleteObject" (ByVal hObject&) ' 指定のウィンドウにマウスキャプチャを設定 Declare Function Api_SetCapture& Lib "user32" Alias "SetCapture" (ByVal hWnd&) ' マウスのキャプチャを解放 Declare Function Api_ReleaseCapture& Lib "user32" Alias "ReleaseCapture" () ' ウィンドウのサイズ、位置、および Z オーダーを設定 Declare Function Api_SetWindowPos& Lib "user32" Alias "SetWindowPos" (ByVal hWnd&, ByVal hWndInsertAfter&, ByVal X&, ByVal Y&, ByVal CX&, ByVal CY&, ByVal uFlags&) ' マウスカーソル(マウスポインタ)の現在の位置に相当するスクリーン座標を取得 Declare Function Api_GetCursorPos& Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) ' ウィンドウの座標をスクリーン座標系で取得 Declare Function Api_GetWindowRect& Lib "user32" Alias "GetWindowRect" (ByVal hWnd&, lpRect As RECT) #define PS_SOLID 0 #define SWP_NOZORDER &H4 'ウィンドウリスト内での現在位置を保持する #define SWP_NOSIZE &H1 'ウィンドウの現在のサイズを保持する #define RGN_AND 1 'リージョン同士のAND結合 #define RGN_COPY 5 'HRGNSRC1のコピーを作成 #define RGN_DIFF 4 'HRGNSRC1からHRGNSRC2を除いた領域 #define RGN_OR 2 'リージョン同士のOR結合 #define RGN_XOR 3 'リージョン同士のXOR結合 Var Shared StartCursor As POINTAPI Var Shared StartPos As RECT Var Shared Capture As Integer Var Shared Bitmap As Object BitmapObject Bitmap '================================================================ '= '================================================================ Declare Sub MainForm_Start edecl () Sub MainForm_Start() Var Rgn0 As Long Var Rgn1 As Long Var Rgn2 As Long Var Rgn3 As Long Var Ret As Long Bitmap.LoadFile "Mickey.bmp" DrawBitmap Bitmap, 0, 0 Bitmap.DeleteObject Rgn0 = Api_CreateEllipticRgn(42, 65, 202, 226) '顔中央部 Rgn1 = Api_CreateEllipticRgn(8, 8, 90, 100) '左耳 Rgn2 = Api_CreateEllipticRgn(155, 5, 230, 100) '右耳 Rgn3 = Api_CreateEllipticRgn(80, 100, 160, 236) '顎 Ret = Api_CombineRgn(Rgn0, Rgn0, Rgn1, RGN_OR) 'Rgn0 + Rgn1 = Rgn0 Ret = Api_CombineRgn(Rgn0, Rgn0, Rgn2, RGN_OR) 'Rgn0 + Rgn2 = Rgn0 Ret = Api_CombineRgn(Rgn0, Rgn0, Rgn3, RGN_OR) 'Rgn0 + Rgn3 = Rgn0 Ret = Api_SetWindowRgn(GethWnd, Rgn0, True) ShowWindow -1 End Sub '================================================================ '= '================================================================ Declare Sub MainForm_DblClick edecl () Sub MainForm_DblClick() End End Sub '================================================================ '= '================================================================ Declare Sub MainForm_MouseDown edecl (ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) Sub MainForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) Var Ret As Long If Button = 1 Then 'ドラッグ Capture = True Ret = Api_GetCursorPos(StartCursor) Ret = Api_GetWindowRect(GethWnd, StartPos) Ret = Api_SetCapture(GethWnd) End If End Sub '================================================================ '= '================================================================ Declare Sub MainForm_MouseMove edecl (ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) Sub MainForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) Var CurrentCursor As POINTAPI static Event As Integer Var Ret As Long If Capture And Button = 1 And Not Event Then Event = True CallEvent Ret = Api_GetCursorPos(CurrentCursor) Ret = Api_SetWindowPos(GethWnd, 0, StartPos.Left + CurrentCursor.x - StartCursor.x, StartPos.Top + CurrentCursor.y - StartCursor.y, 0, 0, SWP_NOZORDER Or SWP_NOSIZE) Event = False End If End Sub '================================================================ '= '================================================================ Declare Sub MainForm_MouseUp edecl (ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) Sub MainForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) Var Ret As Long If Button = 1 And Capture Then 'ドラッグ停止 Capture = False Ret = Api_ReleaseCapture End If End Sub '================================================================ '= '================================================================ While 1 WaitEvent Wend Stop End