#require #require #require #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) list.Items.Clear() 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 items = list.Items Dim s = kind + ": X = " + Str$(e.X) + " Y = " + Str$(e.Y) items.Add(s) list.SetSelected(items.Count - 1, True) End Sub list As ListBox buttonClear As Button buttonOk As Button End Class Control.Initialize(GetModuleHandle(0)) Dim f = New MyForm f.DoModal(Nothing)