円周のみのフォーム          <TOP>


円周のみのフォームを作成します。

ReleaseCapture マウスキャプチャの解放

Sendmessage ウィンドウにメッセージを送信

CreateEllipticRgn 楕円形のリージョンを作成

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

CombineRgn 既存の二つの領域を結合して新しい領域を作成

SetWindowPos ウィンドウのサイズ、位置およびZオーダーを設定

 

例では、3ドットの楕円を描画し、円周のみをフォームとしています。

円周上をドラッグするとフォームを移動させることが出来ますが、それ以外は受けつけません。

同様に、円周上をダブルクリックで終了させています。

 

'================================================================
'= 円周のみのフォーム
'=    (CreateEllipticRgn2.bas)
'================================================================
#include "Windows.bi"

' マウスのキャプチャを解放
Declare Function Api_ReleaseCapture& Lib "user32" Alias "ReleaseCapture" ()

' ウィンドウにメッセージを送信。この関数は、指定したウィンドウのウィンドウプロシージャが処理を終了するまで制御を返さない
Declare Function Api_SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, lParam As Any)

' 楕円形のリージョンを作成
Declare Function Api_CreateEllipticRgn& Lib "gdi32" Alias "CreateEllipticRgn" (ByVal nLeftRect&, ByVal nTopRect&, ByVal nRightRect&, ByVal nBottomRect&)

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

' 既存の二つの領域を結合して新しい領域を作成
Declare Function Api_CombineRgn& Lib "gdi32" Alias "CombineRgn" (ByVal hRgnDest&, ByVal hRgnSrc1&, ByVal hRgnSrc2&, ByVal nCombineMode&)

' ウィンドウのサイズ、位置、および Z オーダーを設定
Declare Function Api_SetWindowPos& Lib "user32" Alias "SetWindowPos" (ByVal hWnd&, ByVal hWndInsertAfter&, ByVal X&, ByVal Y&, ByVal CX&, ByVal CY&, ByVal uFlags&)

#define HTCAPTION 2                     'タイトルバーをクリックしたことを示す
#define WM_NCLBUTTONDOWN &HA1           '非クライアント領域で左マウスボタンを押す
#define RGN_DIFF 4                      'HRGNSRC1からHRGNSRC2を除いた領域
#define HWND_TOPMOST (-1)               'ウィンドウを常に最前面に配置
#define SWP_SHOWWINDOW &H40             'ウィンドウを表示する
#define SWP_NOMOVE &H2                  'ウィンドウの現在位置を保持する
#define SWP_NOSIZE &H1                  'ウィンドウの現在のサイズを保持する

'================================================================
'=
'================================================================
Declare Sub ShapeForm()
Sub ShapeForm()
    Var iRgn As Long
    Var oRgn As Long
    Var Ret As Long

    SetBackColor RGB(255, 0, 0)
    Cls

    '楕円描画(外側)
    oRgn = Api_CreateEllipticRgn(0, 0, GetWidth, GetHeight)

    '楕円描画(内側)
    iRgn = Api_CreateEllipticRgn(3, 3, GetWidth - 3, GetHeight - 3)

    '新しい領域を作成
    Ret = Api_CombineRgn(oRgn, oRgn, iRgn, RGN_DIFF)

    '指定の領域をウィンドウ領域として設定
    Ret = Api_SetWindowRgn(GethWnd, oRgn, True)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_MouseDown edecl (Button As Integer, Shift As Integer, x As Single, y As Single)
Sub MainForm_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Var Ret As Long

    Ret = Api_ReleaseCapture()
    Ret = Api_SendMessage(GethWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End Sub

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

    Ret = Api_SetWindowPos(GethWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE)
    ShapeForm
End Sub

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

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