マウスホーバーとマウスリーブ(T)          <TOP>


マウスホーバー(コントロール上にマウスがある状態)と、マウスリーブ(マウスがコントロール上から離れた状態)のテスト

GetCapture マウス入力を受け持っているハンドルを取得

SetCapture 指定のウィンドウにマウスキャプチャを設定

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

SetFocus ウィンドウにフォーカスを設定

 

左:フォームにPictureBoxを貼り付ける    右:マウスがコントロールの左半分上にあるとき(赤・斜体・ボールド)・右半分にあるとき(青・標準・取消線)

 

 

'================================================================
'= マウスホーバーとマウスリーブ
'=    (SetCapture.bas)
'================================================================
#include "Windows.bi"

' マウス入力を受け持っているハンドルを取得
Declare Function Api_GetCapture& Lib "user32" Alias "GetCapture" ()

' 指定のウィンドウにマウスキャプチャを設定
Declare Function Api_SetCapture& Lib "user32" Alias "SetCapture" (ByVal hWnd&)

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

' ウィンドウにフォーカスを設定
Declare Function Api_SetFocus& Lib "user32" Alias "SetFocus" (ByVal hWnd&)

Var Shared Picture1 As Object
Picture1.Attach GetDlgItem("Picture1")

Var Shared myStr As String

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    myStr = "北海道札幌市白石区"
    Picture1.SetFontName "MS ゴシック"
    Picture1.SetFontSize 20
    Picture1.Symbol(0, 0), myStr, 1, 1
End Sub

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

    'ピクチャボックスの左半分にマウスがある場合(赤・ボールド)
    If X >= 0 And Y >= 0 And X <= Picture1.GetWidth / 2 And Y <= Picture1.GetHeight Then
        Ret = Api_SetCapture(Picture1.Gethwnd)
        Picture1.Cls
        Picture1.SetFontBold -1
        Picture1.SetFontItalic -1
        Picture1.SetFontStrikeOut 0
        Picture1.Symbol(0, 0), myStr, 1, 1, 5

    'ピクチャボックスの右半分にマウスがある場合(青・取り消し線)
    Else If X > Picture1.GetWidth / 2 And Y >= 0 And X <= Picture1.GetWidth And Y <= Picture1.GetHeight Then
        Ret = Api_SetCapture(Picture1.Gethwnd)
        Picture1.Cls
        Picture1.SetFontBold 0
        Picture1.SetFontItalic 0
        Picture1.SetFontStrikeOut -1
        Picture1.Symbol(0, 0), myStr, 1, 1, 2

    '通常(黒・標準)
    Else
        Ret = Api_ReleaseCapture
        Picture1.Cls
        Picture1.SetFontBold 0
        Picture1.SetFontItalic 0
        Picture1.SetFontStrikeOut 0
        Picture1.Symbol(0, 0), myStr, 1, 1

    End If
End Sub

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