1Use Windows.pkg
2
3// Key State Masks for Mouse Messages
4
5Define MK_LBUTTON for |CI$0001
6Define MK_RBUTTON for |CI$0002
7Define MK_SHIFT for |CI$0004
8Define MK_CONTROL for |CI$0008
9Define MK_MBUTTON for |CI$0010
10Define MK_XBUTTON1 for |CI$0020
11Define MK_XBUTTON2 for |CI$0040
12
13Enum_List // Mouse Key Flags
14 Define mkLeft for MK_LBUTTON
15 Define mkMiddle for MK_MBUTTON
16 Define mkRight for MK_RBUTTON
17 Define mkX1 for MK_XBUTTON1
18 Define mkX2 for MK_XBUTTON2
19 Define mkShift for MK_SHIFT
20 Define mkControl for MK_CONTROL
21End_Enum_List
22
23Enum_List // Mouse Buttons. Used in OnMouseXXX messages
24 Define mbLeft
25 Define mbMiddle
26 Define mbRight
27 Define mbX1
28 Define mbX2
29End_Enum_List
30
31{ ClassType=Abstract }
32{ HelpTopic=cWinControl }
33{ OverrideProperty=Attach_Parent_State DesignTime=False }
34{ OverrideProperty=Bitmap DesignTime=False }
35{ OverrideProperty=Bitmap_Style DesignTime=False }
36{ OverrideProperty=Block_Mouse_State DesignTime=False }
37{ OverrideProperty=Client_Area_State DesignTime=False }
38{ OverrideProperty=OEM_Translate_State DesignTime=False }
39{ OverrideProperty=Physical_FontSize DesignTime=False }
40{ OverrideProperty=Popup_State DesignTime=False }
41{ OverrideProperty=Ring_State DesignTime=False }
42{ OverrideProperty=Scope_State DesignTime=False }
43{ OverrideProperty=Search_Case DesignTime=False }
44{ OverrideProperty=Visible_State DesignTime=False }
45Class cWinControl is a DfBaseControl
46 Procedure Construct_Object
47 Forward Send Construct_Object
48 { Visibility=Private }
49 Property Integer private_pbEnabled True
50 { Visibility=Private }
51 Property Integer private_pbVisible True
52 End_Procedure
53
54 Procedure End_Construct_Object
55 Forward Send End_Construct_Object
56
57 Set External_Message WM_LBUTTONDOWN To msg_OnWmLButtonDown
58 Set External_Message WM_MBUTTONDOWN To msg_OnWmMButtonDown
59 Set External_Message WM_RBUTTONDOWN To msg_OnWmRButtonDown
60 Set External_Message WM_LBUTTONUP To msg_OnWmLButtonUp
61 Set External_Message WM_MBUTTONUP To msg_OnWmMButtonUp
62 Set External_Message WM_RBUTTONUP To msg_OnWmRButtonUp
63 Set External_Message WM_LBUTTONDBLCLK To msg_OnWmLButtonDblClk
64 Set External_Message WM_MBUTTONDBLCLK To msg_OnWmMButtonDblClk
65 Set External_Message WM_RBUTTONDBLCLK To msg_OnWmRButtonDblClk
66 Set External_Message WM_MOUSEMOVE To msg_OnWmMouseMove
67 End_Procedure
68
69 { MethodType=Event Visibility=Private }
70 Procedure Notify Integer wParam Integer lParam
71 //Intentionally cancelled
72 End_Procedure
73
74 { Visibility=Private MethodType=Event }
75 Procedure Command Integer wParam Integer lParam
76 //Intentionally cancelled
77 End_Procedure
78
79 Procedure DoRecreateWindow
80 // Recreates the window
81 If (Window_Handle(self)) Begin
82 // attempt to do this without disturbing the focus tree.
83 Send Page_delete // prior to 8.3 this was Send Page_Object 0
84 Send Page 1 // Send Page_Object 1
85 End
86 End_Procedure
87
88 Procedure DoUpdateWindow
89 // Forces windows to update the window by bypassing WM_PAINT
90 Handle hWnd
91
92 Get Window_Handle To hWnd
93 If hWnd Move (UpdateWindow(hWnd)) To hWnd
94 End_Procedure
95
96 { MethodType=Event NoDoc=True }
97 Procedure Page Integer iState
98 Set Window_Style To WS_DISABLED (private_pbEnabled(self) =False)
99 Set Window_Style To WS_VISIBLE (private_pbVisible(self))
100 Forward Send Page iState
101 End_Procedure
102
103 { Visibility=Private MethodType=Event }
104 Procedure OnWmLButtonUp Integer wParam Integer lParam
105 Integer x y eButton
106
107 Move (Hi(lParam)) To y
108 Move (Low(lParam)) To x
109
110 Send OnMouseUp mbLeft x y wParam
111 End_Procedure
112
113 { Visibility=Private MethodType=Event }
114 Procedure OnWmMButtonUp Integer wParam Integer lParam
115 Integer x y eButton
116
117 Move (Hi(lParam)) To y
118 Move (Low(lParam)) To x
119
120 Send OnMouseUp mbMiddle x y wParam
121 End_Procedure
122
123 { Visibility=Private MethodType=Event }
124 Procedure OnWmRButtonUp Integer wParam Integer lParam
125 Integer x y eButton
126
127 Move (Hi(lParam)) To y
128 Move (Low(lParam)) To x
129
130 Send OnMouseUp mbRight x y wParam
131 End_Procedure
132
133 { Visibility=Private MethodType=Event }
134 Procedure OnWmLButtonDown Integer wParam Integer lParam
135 Integer x y eButton fKeys
136
137 Move (Hi(lParam)) To y
138 Move (Low(lParam)) To x
139
140 Send OnMouseDown mbLeft x y wParam
141 End_Procedure
142 { Visibility=Private MethodType=Event }
143 Procedure OnWmMButtonDown Integer wParam Integer lParam
144 Integer x y eButton
145
146 Move (Hi(lParam)) To y
147 Move (Low(lParam)) To x
148
149 Send OnMouseDown mbMiddle x y wParam
150 End_Procedure
151 { Visibility=Private MethodType=Event }
152 Procedure OnWmRButtonDown Integer wParam Integer lParam
153 Integer x y eButton
154
155 Move (Hi(lParam)) To y
156 Move (Low(lParam)) To x
157
158 Send OnMouseDown mbRight x y wParam
159 End_Procedure
160
161 { Visibility=Private MethodType=Event }
162 Procedure OnWmLButtonDblClk Integer wParam Integer lParam
163 Integer x y eButton
164
165 Move (Hi(lParam)) To y
166 Move (Low(lParam)) To x
167
168 Send OnMouseDoubleClick mbLeft x y wParam
169 End_Procedure
170 { Visibility=Private MethodType=Event }
171 Procedure OnWmMButtonDblClk Integer wParam Integer lParam
172 Integer x y eButton
173
174 Move (Hi(lParam)) To y
175 Move (Low(lParam)) To x
176
177 Send OnMouseDoubleClick mbMiddle x y wParam
178 End_Procedure
179 { Visibility=Private MethodType=Event }
180 Procedure OnWmRButtonDblClk Integer wParam Integer lParam
181 Integer x y eButton
182
183 Move (Hi(lParam)) To y
184 Move (Low(lParam)) To x
185
186 Send OnMouseDoubleClick mbRight x y wParam
187 End_Procedure
188
189 { Visibility=Private MethodType=Event }
190 Procedure OnWmMouseMove Integer wParam Integer lParam
191 Integer x y eButton
192
193 Move (Hi(lParam)) To y
194 Move (Low(lParam)) To x
195
196 Send OnMouseMove x y wParam
197 End_Procedure
198
199 { MethodType=Event }
200 Procedure OnMouseDown Integer eButton Integer x Integer y Integer fKeys
201 //Boolean bShiftKey bControlKey bLeftButton bRightButton
202 //String sButton
203 //Move (IsFlagIn(mkShift, fKeys)) To bShiftKey
204 //Move (IsFlagIn(mkControl, fKeys)) To bControlKey
205 //Move (IsFlagIn(mkLeft, fKeys)) To bLeftButton
206 //Move (IsFlagIn(mkRight, fKeys)) To bRightButton
207
208 //If (eButton = mbLeft) Move 'Left Button' To sButton
209 //If (eButton = mbRight) Move 'Right Button' To sButton
210 //Showln 'OnMouseDown ' sButton ' ' x ' ' y ' shift=' bShiftKey ' ctrl=' bControlKey ' left=' bLeftButton ' right=' bRightButton
211 End_Procedure
212
213 { MethodType=Event }
214 Procedure OnMouseUp Integer eButton Integer x Integer y Integer fKeys
215 //Boolean bShiftKey bControlKey bLeftButton bRightButton
216 //String sButton
217 //Move (IsFlagIn(mkShift, fKeys)) To bShiftKey
218 //Move (IsFlagIn(mkControl, fKeys)) To bControlKey
219 //Move (IsFlagIn(mkLeft, fKeys)) To bLeftButton
220 //Move (IsFlagIn(mkRight, fKeys)) To bRightButton
221
222 //If (eButton = mbLeft) Move 'Left Button' To sButton
223 //If (eButton = mbRight) Move 'Right Button' To sButton
224 //Showln 'OnMouseUp ' sButton ' ' x ' ' y ' shift=' bShiftKey ' ctrl=' bControlKey ' left=' bLeftButton ' right=' bRightButton
225 End_Procedure
226
227 { MethodType=Event }
228 Procedure OnMouseDoubleClick Integer eButton Integer x Integer y Integer fKeys
229 //Boolean bShiftKey bControlKey bLeftButton bRightButton
230 //String sButton
231 //Move (IsFlagIn(mkShift, fKeys)) To bShiftKey
232 //Move (IsFlagIn(mkControl, fKeys)) To bControlKey
233 //Move (IsFlagIn(mkLeft, fKeys)) To bLeftButton
234 //Move (IsFlagIn(mkRight, fKeys)) To bRightButton
235
236 //If (eButton = mbLeft) Move 'Left Button' To sButton
237 //If (eButton = mbRight) Move 'Right Button' To sButton
238 //Showln 'OnMouseDblClk ' sButton ' ' x ' ' y ' shift=' bShiftKey ' ctrl=' bControlKey ' left=' bLeftButton ' right=' bRightButton
239 End_Procedure
240
241 { MethodType=Event }
242 Procedure OnMouseMove Integer x Integer y Integer fKeys
243 //Boolean bShiftKey bControlKey bLeftButton bRightButton
244 //Move (IsFlagIn(mkShift, fKeys)) To bShiftKey
245 //Move (IsFlagIn(mkControl, fKeys)) To bControlKey
246 //Move (IsFlagIn(mkLeft, fKeys)) To bLeftButton
247 //Move (IsFlagIn(mkRight, fKeys)) To bRightButton
248
249 //Showln 'OnMouseMove ' x ' ' y ' shift=' bShiftKey ' ctrl=' bControlKey ' left=' bLeftButton ' right=' bRightButton
250 End_Procedure
251
252 { MethodType=Property }
253 { InitialValue=True }
254 { Category=Appearance }
255 Procedure Set pbEnabled Boolean bEnabled
256 Handle hWnd
257
258 If (bEnabled <> private_pbEnabled(self)) Begin
259 Set private_pbEnabled To bEnabled
260 Get Window_Handle to hWnd
261 If hWnd Move (EnableWindow(hWnd, bEnabled)) To hWnd
262 End
263 End_Procedure
264 { MethodType=Property }
265 Function pbEnabled Returns Boolean
266 Function_Return (private_pbEnabled(self))
267 End_Function
268
269 { MethodType=Property }
270 { InitialValue=True }
271 { Category=Appearance }
272 Procedure Set pbVisible Boolean bVisible
273 Handle hWnd
274 Integer iVoid
275
276 If (bVisible <> private_pbVisible(self)) Begin
277 Set private_pbVisible To bVisible
278 Get Window_Handle to hWnd
279 If hWnd Move (ShowWindow(hWnd, If (bVisible, SW_SHOWNA, SW_HIDE))) To iVoid
280 End
281 End_Procedure
282 { MethodType=Property }
283 Function pbVisible Returns Boolean
284 Function_Return (private_pbVisible(self))
285 End_Function
286
287End_Class