フォームの形状(ミッキーマウス)          <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