source: trunk/ab5.0/ablib/TestCase/UI_Sample/mouse_watcher.ab@ 576

#require <Classes/ActiveBasic/Windows/UI/Form.ab>
#require <Classes/ActiveBasic/Windows/UI/ListBox.ab>
#require <Classes/ActiveBasic/Windows/UI/Application.ab>

#resource "UI_Sample.rc"

Imports ActiveBasic.Windows.UI

Const IDM_CLEAR_BUTTON = 100
Const IDM_RECOED_LIST = 101

Class MyForm
    Inherits Form
Public
    Sub MyForm()
        CreateForm()

        Dim wpFont = GetStockObject(DEFAULT_GUI_FONT) As WPARAM

        list = New ListBox
        With list
            .Create(This, IDM_RECOED_LIST, WS_VSCROLL, WS_EX_CLIENTEDGE)
            .SendMessage(WM_SETFONT, wpFont, 0)
        End With

        AddResize(AddressOf(OnResize))
        AddMouseClick(AddressOf(OnMouseClick))
        AddMouseDoubleClick(AddressOf(OnMouseDoubleClick))
        AddMouseMove(AddressOf(OnMouseMove))
        AddMouseDown(AddressOf(OnMouseDown))
        AddMouseUp(AddressOf(OnMouseUp))
        AddMouseEnter(AddressOf(OnMouseEnter))
        AddMouseLeave(AddressOf(OnMouseLeave))
        AddMouseHover(AddressOf(OnMouseHover))

        buttonClear = New Button
        With buttonClear
            .Create(This, IDM_CLEAR_BUTTON)
            .Move(320, 20, 60, 30)
            .Text = "Clear"
            .AddClick(AddressOf(OnClearClick))
            .SendMessage(WM_SETFONT, wpFont, 0)
        End With

        Show(SW_SHOWDEFAULT)
    End Sub

Private
    Sub OnClearClick(sender As Object, e As Args)
        LockWindowUpdate(list)
        While list.SendMessage(LB_DELETESTRING, 0, 0) > 0
        Wend
        LockWindowUpdate(0)
    End Sub

    Sub OnResize(sender As Object, e As ResizeArgs)
        list.Move(0, 0, 300, e.Y)
    End Sub

    Sub OnMouseClick(sender As Object, e As MouseArgs)
        OnMouseEvent("Click", e)
    End Sub

    Sub OnMouseDoubleClick(sender As Object, e As MouseArgs)
        OnMouseEvent("DoubleClick", e)
    End Sub

    Sub OnMouseMove(sender As Object, e As MouseArgs)
        OnMouseEvent("Move", e)
    End Sub

    Sub OnMouseDown(sender As Object, e As MouseArgs)
        OnMouseEvent("Down", e)
    End Sub

    Sub OnMouseUp(sender As Object, e As MouseArgs)
        OnMouseEvent("Up", e)
    End Sub

    Sub OnMouseEnter(sender As Object, e As Args)
        OnMouseEvent("Enter", New MouseArgs(MouseButtons.None, 0, 0, 0, 0))
    End Sub

    Sub OnMouseLeave(sender As Object, e As Args)
        OnMouseEvent("Leave", New MouseArgs(MouseButtons.None, 0, 0, 0, 0))
    End Sub

    Sub OnMouseHover(sender As Object, e As MouseArgs)
        OnMouseEvent("Hover", e)
    End Sub

    Sub OnMouseEvent(kind As String, e As MouseArgs)
        Dim s = kind + ": X = " + Str$(e.X) + " Y = " + Str$(e.Y)
        Dim lr = list.SendMessage(LB_ADDSTRING, 0, ToTCStr(s) As LPARAM)
        If lr <> LB_ERR And lr <> LB_ERRSPACE Then
            list.SendMessage(LB_SETCURSEL, lr As WPARAM, 0)
        End If
    End Sub

    list As ListBox
    buttonClear As Button
End Class

Control.Initialize(GetModuleHandle(0))

Dim f = New MyForm
Application.Run(f)