#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)
