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

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

#resource "UI_Sample.rc"

Imports ActiveBasic
Imports ActiveBasic.Windows.UI

Declare Function EndDialog Lib "user32" (hDlg As HWND, nResult As LONG_PTR) As BOOL

Function GetMessageBoxFont() As HFONT
    Dim ncm As NONCLIENTMETRICS
    ncm.cbSize = Len(ncm)
    SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, VarPtr(ncm), 0)
    GetMessageBoxFont = CreateFontIndirect(ncm.lfMessageFont)
End Function

Class MyForm
    Inherits Dialog
Public
    Sub MyForm()
        AddMessageEvent(WM_INITDIALOG, AddressOf(OnInitDialog))
        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))
    End Sub

Private
    Sub OnInitDialog(sender As Object, e As MessageArgs)
        Move(100, 100, 400, 400)

        Dim wpFont = GetMessageBoxFont() As WPARAM

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

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

        buttonOk = New Button
        With buttonOk
            .Create(This, BS_DEFPUSHBUTTON, 0, IDCANCEL)
            .Move(320, 10, 60, 30)
            .Text = "Close"
            .AddClick(AddressOf(OnOK))
            .SendMessage(WM_SETFONT, wpFont, 0)
        End With

        e.LResult = TRUE
    End Sub

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

    Sub OnOK(sender As Object, e As Args)
        EndDialog(This, 0)
    End Sub

    Sub OnResize(sender As Object, e As ResizeArgs)
        If Not IsNothing(list) Then
            list.Move(0, 0, 200, e.Y)
        End If
    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
    buttonOk As Button
End Class

Control.Initialize(GetModuleHandle(0))

Dim f = New MyForm
f.DoModal(Nothing)