Changeset 564


Ignore:
Timestamp:
Jul 22, 2008, 1:12:35 AM (16 years ago)
Author:
イグトランス (egtra)
Message:

MouseLeave, MouseHoverが動作するようにした。

Location:
trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab

    r561 r564  
    77Namespace UI
    88
    9 'Namespace Detail
    10 '   TypeDef PTrackMouseEvent = *Function(ByRef tme As TRACKMOUSEEVENT) As BOOL
    11 'End Namespace
     9Namespace Detail
     10    TypeDef PTrackMouseEvent = *Function(ByRef tme As TRACKMOUSEEVENT) As BOOL
     11End Namespace
    1212
    1313Class Control
     
    176176        AddMessageEvent(WM_XBUTTONUP, mu)
    177177        Dim mb = New MessageHandler(AddressOf(OnMouseDblClkBase))
    178         AddMessageEvent(WM_LBUTTONDBLCLK, mu)
    179         AddMessageEvent(WM_RBUTTONDBLCLK, mu)
    180         AddMessageEvent(WM_MBUTTONDBLCLK, mu)
    181         AddMessageEvent(WM_XBUTTONDBLCLK, mu)
     178        AddMessageEvent(WM_LBUTTONDBLCLK, mb)
     179        AddMessageEvent(WM_RBUTTONDBLCLK, mb)
     180        AddMessageEvent(WM_MBUTTONDBLCLK, mb)
     181        AddMessageEvent(WM_XBUTTONDBLCLK, mb)
    182182
    183183        AddMessageEvent(WM_MOUSEMOVE, AddressOf(OnMouseMoveBase))
    184184        AddMessageEvent(WM_MOUSELEAVE, AddressOf(OnMouseLeaveBase))
     185        AddMessageEvent(WM_MOUSEHOVER, AddressOf(OnMouseHoverBase))
    185186        AddMessageEvent(WM_PAINT, AddressOf(OnPaintBase))
    186187        AddMessageEvent(WM_KEYDOWN, AddressOf(OnKeyDownBase))
     
    191192
    192193    Sub OnEraseBackground(sender As Object, e As MessageArgs)
    193         Dim rc = ClientRect
    194         FillRect(e.WParam As HDC, rc, (COLOR_3DFACE + 1) As HBRUSH)
     194        If IsNothing(paintBackground) Then
     195            Dim rc = ClientRect
     196            FillRect(e.WParam As HDC, rc, (COLOR_3DFACE + 1) As HBRUSH)
     197        Else
     198            OnPaintBackground(New PaintBackgroundArgs(e.WParam, e.LParam))
     199        End If
    195200        e.LResult = TRUE
    196201    End Sub
     
    225230            mouseEntered = True
    226231            OnMouseEnter(me)
     232            trackMouseEvent(TME_LEAVE Or TME_HOVER)
    227233        End If
    228234    End Sub
    229235
    230236    Sub OnMouseLeaveBase(sender As Object, e As MessageArgs)
     237        OnMouseLeave(Args.Empty)
     238        mouseEntered = False
     239    End Sub
     240
     241    Sub OnMouseHoverBase(sender As Object, e As MessageArgs)
    231242        Dim me = makeMouseEventFromMsg(e)
    232         OnMouseLeave(me)
    233         mouseEntered = False
     243        OnMouseHover(me)
    234244    End Sub
    235245
     
    415425'   その他の補助関数
    416426Private
    417 '   Sub tracMouseEvent()
    418 /*      If pTrackMouseEvent <> 0 Then
     427    Function trackMouseEvent(flags As DWord) As BOOL
     428        If pTrackMouseEvent <> 0 Then
    419429            Dim tme As TRACKMOUSEEVENT
    420430            With tme
    421431                .cbSize = Len(tme)
    422                 .dwFlags = TME_HOVER Or TME_LEAVE
    423                 .hwndTrack = wnd
     432                .dwFlags = flags
     433                .hwndTrack = hwnd
    424434                .dwHoverTime = HOVER_DEFAULT
    425435            End With
    426             pTrackMouseEvent(tme)
    427         End If
    428 */  'End Sub
     436            trackMouseEvent = pTrackMouseEvent(tme)
     437        End If
     438    End Function
    429439
    430440'--------------------------------
     
    437447    Static atom As ATOM
    438448    Static hmodComctl As HMODULE
    439 '   Static pTrackMouseEvent As PTrackMouseEvent
     449    Static pTrackMouseEvent As Detail.PTrackMouseEvent
    440450
    441451    Static Const WindowClassName = "ActiveBasic.Windows.UI.Control"
     
    445455        tlsIndex = TlsAlloc()
    446456        hInstance = hinst
    447 '       hmodComctl = LoadLibrary("comctl32.dll")
    448 '       pTrackMouseEvent = GetProcAddress(hmodComctl, ToMBStr("_TrackMouseEvent"))
     457        hmodComctl = LoadLibrary("comctl32.dll")
     458        pTrackMouseEvent = GetProcAddress(hmodComctl, ToMBStr("_TrackMouseEvent")) As Detail.PTrackMouseEvent
    449459
    450460        Dim PropertyInstanceString = WindowClassName + " " + Hex$(GetCurrentProcessId())
     
    483493            TlsFree(tlsIndex)
    484494        End If
    485 '       If hmodComctl <> 0 Then
    486 '           FreeLibrary(hmodComctl)
    487 '       End If
     495        If hmodComctl <> 0 Then
     496            FreeLibrary(hmodComctl)
     497        End If
    488498        If PropertyInstance <> 0 Then
    489499            GlobalDeleteAtom(PropertyInstance)
  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/ControlEvent.sbp

    r561 r564  
    176176
    177177Public
    178     Sub AddMouseLeave(h As MouseHandler)
     178    Sub AddMouseLeave(h As Handler)
    179179        If IsNothing(mouseLeave) Then
    180180            mouseLeave = h
     
    183183        End If
    184184    End Sub
    185     Sub RemoveMouseLeave(h As MouseHandler)
     185    Sub RemoveMouseLeave(h As Handler)
    186186        If Not IsNothing(mouseLeave) Then
    187187            mouseLeave -= h
     
    189189    End Sub
    190190Protected
    191     Sub OnMouseLeave(e As MouseArgs)
     191    Sub OnMouseLeave(e As Args)
    192192        If Not IsNothing(mouseLeave) Then
    193193            mouseLeave(This, e)
     
    195195    End Sub
    196196Private
    197     mouseLeave As MouseHandler
     197    mouseLeave As Handler
    198198
    199199Public
     
    395395    destroy As Handler
    396396
     397Public
     398    Sub AddPaintBackground(h As PaintBackgroundHandler)
     399        If IsNothing(paintBackground) Then
     400            paintBackground = h
     401        Else
     402            paintBackground += h
     403        End If
     404    End Sub
     405    Sub RemovePaintBackground(h As PaintBackgroundHandler)
     406        If Not IsNothing(paintBackground) Then
     407            paintBackground -= h
     408        End If
     409    End Sub
     410Protected
     411    Sub OnPaintBackground(e As PaintBackgroundArgs)
     412        If Not IsNothing(paintBackground) Then
     413            paintBackground(This, e)
     414        End If
     415    End Sub
     416Private
     417    paintBackground As PaintBackgroundHandler
     418
  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/ControlEventList.txt

    r561 r564  
    1111MouseMove   Mouse   マウスカーソルがコントロール上で移動すると呼び出されます
    1212MouseHover  Mouse   マウスカーソルがコントロール上で静止すると呼び出されます。
    13 MouseLeave  Mouse   マウスカーソルがコントロールから出て行くと呼び出されます。
     13MouseLeave      マウスカーソルがコントロールから出て行くと呼び出されます。
    1414MouseDown   Mouse   マウスボタンが押されたときに呼び出されます。
    1515MouseClick  Mouse   マウスでクリックされたときに呼び出されます。
     
    2222Create  Create  ウィンドウが作成されたときに呼ばれます。
    2323Destroy     ウィンドウが破棄されるときに呼ばれます。
     24PaintBackground PaintBackground 背景の描画を行うときに呼ばれます。
  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/EventArgs.ab

    r561 r564  
    545545Delegate Sub ResizeHandler(sender As Object, e As ResizeArgs)
    546546
     547Class PaintBackgroundArgs
     548    Inherits Args
     549Public
     550    Sub PaintBackgroundArgs(hdc As HDC)
     551        This.hdc = hdc
     552    End Sub
     553
     554    Sub PaintBackgroundArgs(wp As WPARAM, lp As LPARAM)
     555        This.hdc = wp As HDC
     556    End Sub
     557
     558    Const Function Handle() As HDC
     559        Handle = hdc
     560    End Function
     561Private
     562    hdc As HDC
     563End Class
     564
     565Delegate Sub PaintBackgroundHandler(sender As Object, e As PaintBackgroundArgs)
     566
    547567End Namespace 'UI
    548568End Namespace 'Widnows
Note: See TracChangeset for help on using the changeset viewer.