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 | list.Items.Clear()
|
---|
71 | LockWindowUpdate(0)
|
---|
72 | End Sub
|
---|
73 |
|
---|
74 | Sub OnOK(sender As Object, e As Args)
|
---|
75 | EndDialog(This, 0)
|
---|
76 | End Sub
|
---|
77 |
|
---|
78 | Sub OnResize(sender As Object, e As ResizeArgs)
|
---|
79 | If Not IsNothing(list) Then
|
---|
80 | list.Move(0, 0, 200, e.Y)
|
---|
81 | End If
|
---|
82 | End Sub
|
---|
83 |
|
---|
84 | Sub OnMouseClick(sender As Object, e As MouseArgs)
|
---|
85 | OnMouseEvent("Click", e)
|
---|
86 | End Sub
|
---|
87 |
|
---|
88 | Sub OnMouseDoubleClick(sender As Object, e As MouseArgs)
|
---|
89 | OnMouseEvent("DoubleClick", e)
|
---|
90 | End Sub
|
---|
91 |
|
---|
92 | Sub OnMouseMove(sender As Object, e As MouseArgs)
|
---|
93 | OnMouseEvent("Move", e)
|
---|
94 | End Sub
|
---|
95 |
|
---|
96 | Sub OnMouseDown(sender As Object, e As MouseArgs)
|
---|
97 | OnMouseEvent("Down", e)
|
---|
98 | End Sub
|
---|
99 |
|
---|
100 | Sub OnMouseUp(sender As Object, e As MouseArgs)
|
---|
101 | OnMouseEvent("Up", e)
|
---|
102 | End Sub
|
---|
103 |
|
---|
104 | Sub OnMouseEnter(sender As Object, e As Args)
|
---|
105 | OnMouseEvent("Enter", New MouseArgs(MouseButtons.None, 0, 0, 0, 0))
|
---|
106 | End Sub
|
---|
107 |
|
---|
108 | Sub OnMouseLeave(sender As Object, e As Args)
|
---|
109 | OnMouseEvent("Leave", New MouseArgs(MouseButtons.None, 0, 0, 0, 0))
|
---|
110 | End Sub
|
---|
111 |
|
---|
112 | Sub OnMouseHover(sender As Object, e As MouseArgs)
|
---|
113 | OnMouseEvent("Hover", e)
|
---|
114 | End Sub
|
---|
115 |
|
---|
116 | Sub OnMouseEvent(kind As String, e As MouseArgs)
|
---|
117 | Dim items = list.Items
|
---|
118 | Dim s = kind + ": X = " + Str$(e.X) + " Y = " + Str$(e.Y)
|
---|
119 | items.Add(s)
|
---|
120 | list.SetSelected(items.Count - 1, True)
|
---|
121 | End Sub
|
---|
122 |
|
---|
123 | list As ListBox
|
---|
124 | buttonClear As Button
|
---|
125 | buttonOk As Button
|
---|
126 | End Class
|
---|
127 |
|
---|
128 | Control.Initialize(GetModuleHandle(0))
|
---|
129 |
|
---|
130 | Dim f = New MyForm
|
---|
131 | f.DoModal(Nothing)
|
---|