[576] | 1 | #require <Classes/ActiveBasic/Windows/UI/Dialog.ab>
|
---|
| 2 | #require <Classes/ActiveBasic/Windows/UI/ListBox.ab>
|
---|
| 3 | #require <Classes/ActiveBasic/Windows/UI/Application.ab>
|
---|
| 4 |
|
---|
| 5 | #resource "UI_Sample.rc"
|
---|
| 6 |
|
---|
| 7 | Imports ActiveBasic
|
---|
| 8 | Imports ActiveBasic.Windows.UI
|
---|
| 9 |
|
---|
| 10 | Declare Function EndDialog Lib "user32" (hDlg As HWND, nResult As LONG_PTR) As BOOL
|
---|
| 11 |
|
---|
| 12 | Function GetMessageBoxFont() As HFONT
|
---|
| 13 | Dim ncm As NONCLIENTMETRICS
|
---|
| 14 | ncm.cbSize = Len(ncm)
|
---|
| 15 | SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, VarPtr(ncm), 0)
|
---|
| 16 | GetMessageBoxFont = CreateFontIndirect(ncm.lfMessageFont)
|
---|
| 17 | End Function
|
---|
| 18 |
|
---|
| 19 | Class MyForm
|
---|
| 20 | Inherits Dialog
|
---|
| 21 | Public
|
---|
| 22 | Sub MyForm()
|
---|
| 23 | AddMessageEvent(WM_INITDIALOG, AddressOf(OnInitDialog))
|
---|
| 24 | AddResize(AddressOf(OnResize))
|
---|
| 25 | AddMouseClick(AddressOf(OnMouseClick))
|
---|
| 26 | AddMouseDoubleClick(AddressOf(OnMouseDoubleClick))
|
---|
| 27 | AddMouseMove(AddressOf(OnMouseMove))
|
---|
| 28 | AddMouseDown(AddressOf(OnMouseDown))
|
---|
| 29 | AddMouseUp(AddressOf(OnMouseUp))
|
---|
| 30 | AddMouseEnter(AddressOf(OnMouseEnter))
|
---|
| 31 | AddMouseLeave(AddressOf(OnMouseLeave))
|
---|
| 32 | AddMouseHover(AddressOf(OnMouseHover))
|
---|
| 33 | End Sub
|
---|
| 34 |
|
---|
| 35 | Private
|
---|
| 36 | Sub OnInitDialog(sender As Object, e As MessageArgs)
|
---|
| 37 | Move(100, 100, 400, 400)
|
---|
| 38 |
|
---|
| 39 | Dim wpFont = GetMessageBoxFont() As WPARAM
|
---|
| 40 |
|
---|
| 41 | list = New ListBox
|
---|
| 42 | With list
|
---|
| 43 | .Create(This, WS_VSCROLL, WS_EX_CLIENTEDGE)
|
---|
| 44 | .SendMessage(WM_SETFONT, wpFont, 0)
|
---|
| 45 | End With
|
---|
| 46 |
|
---|
| 47 | buttonClear = New Button
|
---|
| 48 | With buttonClear
|
---|
| 49 | .Create(This)
|
---|
| 50 | .Move(320, 50, 60, 30)
|
---|
| 51 | .Text = "Clear"
|
---|
| 52 | .AddClick(AddressOf(OnClearClick))
|
---|
| 53 | .SendMessage(WM_SETFONT, wpFont, 0)
|
---|
| 54 | End With
|
---|
| 55 |
|
---|
| 56 | buttonOk = New Button
|
---|
| 57 | With buttonOk
|
---|
| 58 | .Create(This, BS_DEFPUSHBUTTON, 0, IDCANCEL)
|
---|
| 59 | .Move(320, 10, 60, 30)
|
---|
| 60 | .Text = "Close"
|
---|
| 61 | .AddClick(AddressOf(OnOK))
|
---|
| 62 | .SendMessage(WM_SETFONT, wpFont, 0)
|
---|
| 63 | End With
|
---|
| 64 |
|
---|
| 65 | e.LResult = TRUE
|
---|
| 66 | End Sub
|
---|
| 67 |
|
---|
| 68 | Sub OnClearClick(sender As Object, e As Args)
|
---|
| 69 | LockWindowUpdate(list)
|
---|
| 70 | While list.SendMessage(LB_DELETESTRING, 0, 0) > 0
|
---|
| 71 | Wend
|
---|
| 72 | LockWindowUpdate(0)
|
---|
| 73 | End Sub
|
---|
| 74 |
|
---|
| 75 | Sub OnOK(sender As Object, e As Args)
|
---|
| 76 | EndDialog(This, 0)
|
---|
| 77 | End Sub
|
---|
| 78 |
|
---|
| 79 | Sub OnResize(sender As Object, e As ResizeArgs)
|
---|
| 80 | If Not IsNothing(list) Then
|
---|
| 81 | list.Move(0, 0, 200, e.Y)
|
---|
| 82 | End If
|
---|
| 83 | End Sub
|
---|
| 84 |
|
---|
| 85 | Sub OnMouseClick(sender As Object, e As MouseArgs)
|
---|
| 86 | OnMouseEvent("Click", e)
|
---|
| 87 | End Sub
|
---|
| 88 |
|
---|
| 89 | Sub OnMouseDoubleClick(sender As Object, e As MouseArgs)
|
---|
| 90 | OnMouseEvent("DoubleClick", e)
|
---|
| 91 | End Sub
|
---|
| 92 |
|
---|
| 93 | Sub OnMouseMove(sender As Object, e As MouseArgs)
|
---|
| 94 | OnMouseEvent("Move", e)
|
---|
| 95 | End Sub
|
---|
| 96 |
|
---|
| 97 | Sub OnMouseDown(sender As Object, e As MouseArgs)
|
---|
| 98 | OnMouseEvent("Down", e)
|
---|
| 99 | End Sub
|
---|
| 100 |
|
---|
| 101 | Sub OnMouseUp(sender As Object, e As MouseArgs)
|
---|
| 102 | OnMouseEvent("Up", e)
|
---|
| 103 | End Sub
|
---|
| 104 |
|
---|
| 105 | Sub OnMouseEnter(sender As Object, e As Args)
|
---|
| 106 | OnMouseEvent("Enter", New MouseArgs(MouseButtons.None, 0, 0, 0, 0))
|
---|
| 107 | End Sub
|
---|
| 108 |
|
---|
| 109 | Sub OnMouseLeave(sender As Object, e As Args)
|
---|
| 110 | OnMouseEvent("Leave", New MouseArgs(MouseButtons.None, 0, 0, 0, 0))
|
---|
| 111 | End Sub
|
---|
| 112 |
|
---|
| 113 | Sub OnMouseHover(sender As Object, e As MouseArgs)
|
---|
| 114 | OnMouseEvent("Hover", e)
|
---|
| 115 | End Sub
|
---|
| 116 |
|
---|
| 117 | Sub OnMouseEvent(kind As String, e As MouseArgs)
|
---|
| 118 | Dim s = kind + ": X = " + Str$(e.X) + " Y = " + Str$(e.Y)
|
---|
| 119 | Dim lr = list.SendMessage(LB_ADDSTRING, 0, ToTCStr(s) As LPARAM)
|
---|
| 120 | If lr <> LB_ERR And lr <> LB_ERRSPACE Then
|
---|
| 121 | list.SendMessage(LB_SETCURSEL, lr As WPARAM, 0)
|
---|
| 122 | End If
|
---|
| 123 | End Sub
|
---|
| 124 |
|
---|
| 125 | list As ListBox
|
---|
| 126 | buttonClear As Button
|
---|
| 127 | buttonOk As Button
|
---|
| 128 | End Class
|
---|
| 129 |
|
---|
| 130 | Control.Initialize(GetModuleHandle(0))
|
---|
| 131 |
|
---|
| 132 | Dim f = New MyForm
|
---|
| 133 | f.DoModal(Nothing)
|
---|