1 { $Id: lclmessageglue.pas 57496 2018-03-10 16:32:56Z mattias $ }
2 {
3 *****************************************************************************
4 * LCLMessageGlue.pas *
5 * ------------------ *
6 * *
7 * *
8 *****************************************************************************
9
10 *****************************************************************************
11 This file is part of the Lazarus Component Library (LCL)
12
13 See the file COPYING.modifiedLGPL.txt, included in this distribution,
14 for details about the license.
15 *****************************************************************************
16
17 Abstract:
18 A Unit to make the passing of messages to the LCL from the different
19 widgetsets easier. Your mileage will vary if you try to use these procs
20 from within your program.
21
22 }
23 unit LCLMessageGlue;
24
25 {$MODE objfpc}{$H+}
26
27 interface
28
29 uses
30 Classes, Forms, LCLClasses, LCLProc, Controls, Messages, LMessages, LCLType;
31
DeliverMessagenull32 function DeliverMessage(const Target: TObject; var AMessage): PtrInt;
SendSimpleMessagenull33 function SendSimpleMessage(const Target: TControl; Msg: Cardinal): PtrInt;
34
LCLSendActivateMsgnull35 function LCLSendActivateMsg(const Target: TControl; Active: Word; Minimized: Boolean; ActiveWindow: HWND = 0): PtrInt;
LCLSendSetFocusMsgnull36 function LCLSendSetFocusMsg(const Target: TControl): PtrInt;
LCLSendKillFocusMsgnull37 function LCLSendKillFocusMsg(const Target: TControl): PtrInt;
LCLSendShowWindowMsgnull38 function LCLSendShowWindowMsg(const Target: TControl; Show: Boolean; Status: LPARAM = 0): PtrInt;
LCLSendSizeMsgnull39 function LCLSendSizeMsg(const Target: TControl; Width, Height: Word; SizeType: Longint; FromInterface: Boolean = True): PtrInt;
LCLSendMoveMsgnull40 function LCLSendMoveMsg(const Target: TControl; XPos, YPos: SmallInt; MoveType: PtrInt = Move_Default; FromInterface: Boolean = True): PtrInt;
LCLSendMouseMoveMsgnull41 function LCLSendMouseMoveMsg(const Target: TControl; XPos, YPos: SmallInt; ShiftState: TShiftState = []): PtrInt;
LCLSendMouseDownMsgnull42 function LCLSendMouseDownMsg(const Target: TControl; XPos, YPos: SmallInt; Button: TMouseButton; ShiftState: TShiftState = []): PtrInt;
LCLSendMouseUpMsgnull43 function LCLSendMouseUpMsg(const Target: TControl; XPos, YPos: SmallInt; Button: TMouseButton; ShiftState: TShiftState = []): PtrInt;
LCLSendMouseWheelMsgnull44 function LCLSendMouseWheelMsg(const Target: TControl; XPos, YPos, WheelDelta: SmallInt; ShiftState: TShiftState = []): PtrInt;
LCLSendCaptureChangedMsgnull45 function LCLSendCaptureChangedMsg(const Target: TControl): PtrInt;
LCLSendSelectionChangedMsgnull46 function LCLSendSelectionChangedMsg(const Target: TControl): PtrInt;
LCLSendDestroyMsgnull47 function LCLSendDestroyMsg(const Target: TControl): PtrInt;
LCLSendChangedMsgnull48 function LCLSendChangedMsg(const Target: TControl; ItemIndex: WPARAM = 0): PtrInt;
LCLSendClickedMsgnull49 function LCLSendClickedMsg(const Target: TControl): PtrInt;
LCLSendMouseEnterMsgnull50 function LCLSendMouseEnterMsg(const Target: TControl): PtrInt;
LCLSendMouseLeaveMsgnull51 function LCLSendMouseLeaveMsg(const Target: TControl): PtrInt;
LCLSendSetEditableMsgnull52 function LCLSendSetEditableMsg(const Target: TControl): PtrInt;
LCLSendMoveWordMsgnull53 function LCLSendMoveWordMsg(const Target: TControl): PtrInt;
LCLSendMovePageMsgnull54 function LCLSendMovePageMsg(const Target: TControl): PtrInt;
LCLSendMoveToRowMsgnull55 function LCLSendMoveToRowMsg(const Target: TControl): PtrInt;
LCLSendMoveToColumnMsgnull56 function LCLSendMoveToColumnMsg(const Target: TControl): PtrInt;
LCLSendKillCharMsgnull57 function LCLSendKillCharMsg(const Target: TControl): PtrInt;
LCLSendKillWordMsgnull58 function LCLSendKillWordMsg(const Target: TControl): PtrInt;
LCLSendKillLineMsgnull59 function LCLSendKillLineMsg(const Target: TControl): PtrInt;
LCLSendCutToClipboardMsgnull60 function LCLSendCutToClipboardMsg(const Target: TControl): PtrInt;
LCLSendCopyToClipboardMsgnull61 function LCLSendCopyToClipboardMsg(const Target: TControl): PtrInt;
LCLSendPasteFromClipboardMsgnull62 function LCLSendPasteFromClipboardMsg(const Target: TControl): PtrInt;
LCLSendConfigureEventMsgnull63 function LCLSendConfigureEventMsg(const Target: TControl): PtrInt;
LCLSendPaintMsgnull64 function LCLSendPaintMsg(const Target: TControl;const DC: HDC; const PaintStruct: PPaintStruct): PtrInt;
LCLSendEraseBackgroundMsgnull65 function LCLSendEraseBackgroundMsg(const Target: TWinControl;const DC: HDC): PtrInt;
LCLSendKeyDownEventnull66 function LCLSendKeyDownEvent(const Target: TControl; var CharCode: Word; KeyData: PtrInt; BeforeEvent, IsSysKey: Boolean): PtrInt;
LCLSendKeyUpEventnull67 function LCLSendKeyUpEvent(const Target: TControl; var CharCode: Word; KeyData: PtrInt; BeforeEvent, IsSysKey: Boolean): PtrInt;
LCLSendCharEventnull68 function LCLSendCharEvent(const Target: TControl; var CharCode: Word; KeyData: PtrInt; BeforeEvent, IsSysKey, ANotifyUserInput: Boolean): PtrInt;
LCLSendUTF8KeyPressnull69 function LCLSendUTF8KeyPress(const Target: TWinControl; AUTF8Char: TUTF8Char; IsSysKey: Boolean): PtrInt;
LCLSendTimerMsgnull70 function LCLSendTimerMsg(const Target: TControl; TimerID: WParam; TimerProc: LParam): PtrInt;
LCLSendExitMsgnull71 function LCLSendExitMsg(const Target: TControl): PtrInt;
LCLSendCloseQueryMsgnull72 function LCLSendCloseQueryMsg(const Target: TControl): PtrInt;
LCLSendDragStartMsgnull73 function LCLSendDragStartMsg(const Target: TControl): PtrInt;
LCLSendMonthChangedMsgnull74 function LCLSendMonthChangedMsg(const Target: TControl): PtrInt;
LCLSendYearChangedMsgnull75 function LCLSendYearChangedMsg(const Target: TControl): PtrInt;
LCLSendDayChangedMsgnull76 function LCLSendDayChangedMsg(const Target: TControl): PtrInt;
LCLSendMouseMultiClickMsgnull77 function LCLSendMouseMultiClickMsg(const Target: TControl; XPos, YPos: SmallInt; Button: TMouseButton; ClickCount: Byte = 2; ShiftState: TShiftState = []): PtrInt;
LCLSendDrawListItemMsgnull78 function LCLSendDrawListItemMsg(const Target: TControl; const DrawListItemStruct: PDrawListItemStruct): PtrInt;
LCLSendDropDownMsgnull79 function LCLSendDropDownMsg(const Target: TControl): PtrInt;
LCLSendCloseUpMsgnull80 function LCLSendCloseUpMsg(const Target: TControl): PtrInt;
81
82 implementation
83
84 type
85 TWinControlAccess = class(TWinControl)
86 end;
87
DeliverMessagenull88 function DeliverMessage(const Target: TObject; var AMessage): PtrInt;
89 var
90 RefCounted: Boolean;
91 begin
92 if Target=nil then DebugLn('[DeliverMessage] Target = nil');
93 {$IFDEF VerboseDeliverMessage}
94 if (TLMessage(AMessage).Msg <>LM_MOUSEMOVE)
95 and (TLMessage(AMessage).Msg <>LM_PAINT)
96 and (TLMessage(AMessage).Msg <>LM_KEYDOWN)
97 and (TLMessage(AMessage).Msg <>LM_KEYUP)
98 and (TLMessage(AMessage).Msg <> CN_KEYDOWN ) then
99 DebugLn('DeliverMessage ',DbgS(Target),
100 ' ',TComponent(Target).Name,':',TObject(Target).ClassName,
101 ' Message=',GetMessageName(TLMessage(AMessage).Msg));
102 {$ENDIF}
103 RefCounted := False;
104 try
105 try
106 if Target is TLCLComponent then
107 begin
108 TLCLComponent(Target).IncLCLRefCount;
109 RefCounted := True;
110 end;
111 if Target is TControl then
112 TControl(Target).WindowProc(TLMessage(AMessage))
113 else
114 Target.Dispatch(TLMessage(AMessage));
115 except
116 Application.HandleException(nil);
117 end;
118 finally
119 if RefCounted then
120 TLCLComponent(Target).DecLCLRefCount;
121 end;
122 Result := TLMessage(AMessage).Result;
123 end;
124
125 {******************************************************************************
126 * *
127 * SendSimpleMessage *
128 * *
129 * Returns : 0 to accept the message, non-zero to reject the message *
130 * *
131 * Params *
132 * *
133 * Target : The Control that will recieve the simple message *
134 * Msg : Message type constant *
135 * *
136 ******************************************************************************}
SendSimpleMessagenull137 function SendSimpleMessage(const Target: TControl; Msg: Cardinal): PtrInt;
138 var
139 Mess : TLMessage;
140 begin
141 FillChar(Mess,SizeOf(Mess),0);
142 Mess.Msg := Msg;
143 Result := DeliverMessage(Target, Mess);
144 end;
145
146
147 {******************************************************************************
148 * *
149 * LCLSendActivateMsg *
150 * *
151 * Returns : 0 to accept the message, non-zero to reject the message *
152 * *
153 * Params *
154 * *
155 * Target : The Control that will recieve the message LM_ACTIVATE *
156 * Active : Set to True. This is currently ignored *
157 * Minimized : Set to False. This is currently ignored *
158 * ActiveWindow: Optional. Pass the handle of the currently or newly *
159 * active window *
160 * *
161 ******************************************************************************}
LCLSendActivateMsgnull162 function LCLSendActivateMsg(const Target: TControl; Active: Word; Minimized: Boolean; ActiveWindow: HWND = 0): PtrInt;
163 var
164 Mess: TLMActivate;
165 begin
166 Result := 0;
167 FillChar(Mess, SizeOf(Mess), 0);
168 Mess.Msg := LM_ACTIVATE;
169 Mess.Active := Active;
170 Mess.Minimized := Minimized;
171 Mess.ActiveWindow := ActiveWindow;
172 Result := DeliverMessage(Target, Mess);
173 end;
174
175
176 {******************************************************************************
177 * *
178 * LCLSendSetFocusMessage *
179 * *
180 * Returns : 0 to accept the message, non-zero to reject the message *
181 * *
182 * Params *
183 * *
184 * Target : The Control that will recieve the message LM_SETFOCUS *
185 * *
186 ******************************************************************************}
LCLSendSetFocusMsgnull187 function LCLSendSetFocusMsg(const Target: TControl): PtrInt;
188 begin
189 Result:=SendSimpleMessage(Target, LM_SETFOCUS);
190 end;
191
192 {******************************************************************************
193 * *
194 * LCLSendKillFocusMessage *
195 * *
196 * Returns : 0 to accept the message, non-zero to reject the message *
197 * *
198 * Params *
199 * *
200 * Target : The Control that will recieve the message LM_KILLFOCUS *
201 * *
202 ******************************************************************************}
LCLSendKillFocusMsgnull203 function LCLSendKillFocusMsg(const Target: TControl): PtrInt;
204 begin
205 Result:=SendSimpleMessage(Target, LM_KILLFOCUS);
206 end;
207
208 {******************************************************************************
209 * *
210 * LCLSendShowWindowMsg *
211 * *
212 * Returns : 0 to accept the message, non-zero to reject the message *
213 * *
214 * Params *
215 * *
216 * Target : The Control that will recieve the message LM_SHOWWINDOW *
217 * Show : Set to True if Showing the window False otherwise *
218 * Status : Usually zero. Set to non-zero if the message was generated *
219 * by another window showing or hiding. *
220 * *
221 ******************************************************************************}
LCLSendShowWindowMsgnull222 function LCLSendShowWindowMsg(const Target: TControl; Show: Boolean;
223 Status: LPARAM = 0): PtrInt;
224 var
225 Mess : TLMShowWindow;
226 begin
227 FillChar(Mess,SizeOf(Mess),0);
228 Mess.Msg := LM_SHOWWINDOW;
229 Mess.Show := True;
230
231 Result := DeliverMessage(Target, Mess);
232 end;
233
234 {******************************************************************************
235 * *
236 * LCLSendSizeMsg *
237 * *
238 * Returns : 0 to accept the message, non-zero to reject the message *
239 * *
240 * Params *
241 * *
242 * Target : The Control that will recieve the message LM_SIZE *
243 * Width, Height : The new Width and Height for the control *
244 * SizeType : SIZE_RESTORED, SIZE_MINIMIZED, SIZE_MAXIMIZED,... *
245 * FromInterface : True if this message was sent from the widgetset to notify *
246 * the LCL of a change. False to make the widgetset change *
247 * the size of the control. Default = True *
248 * *
249 ******************************************************************************}
LCLSendSizeMsgnull250 function LCLSendSizeMsg(const Target: TControl; Width, Height: Word;
251 SizeType: Longint; FromInterface: Boolean = True): PtrInt;
252 var
253 Mess: TLMSize;
254 begin
255 FillChar(Mess, SizeOf(Mess), 0);
256 Mess.Msg := LM_SIZE;
257 Mess.Width := Width;
258 Mess.Height := Height;
259 Mess.SizeType := SizeType;
260 if FromInterface then
261 Mess.SizeType := Mess.SizeType or Size_SourceIsInterface;
262
263 Result := DeliverMessage(Target, Mess);
264 end;
265
266
267 {******************************************************************************
268 * *
269 * LCLSendMoveMsg *
270 * *
271 * Returns : 0 to accept the message, non-zero to reject the message *
272 * *
273 * Params *
274 * *
275 * Target : The Control that will recieve the message LM_MOVE *
276 * XPos, YPos : The new Top and Left for the control *
277 * MoveType : Move_Default = update, 1 = force RequestAlign *
278 * FromInterface : True if this message was sent from the widgetset to notify *
279 * the LCL of a change. False to make the widgetset change *
280 * the position of the control. Default = True *
281 * *
282 ******************************************************************************}
LCLSendMoveMsgnull283 function LCLSendMoveMsg(const Target: TControl; XPos, YPos: SmallInt;
284 MoveType: PtrInt = Move_Default; FromInterface: Boolean = True): PtrInt;
285 var
286 Mess: TLMMove;
287 begin
288 FillChar(Mess, SizeOf(Mess), 0);
289 Mess.Msg := LM_MOVE;
290 Mess.XPos := XPos;
291 Mess.YPos := YPos;
292 Mess.MoveType := MoveType;
293 if FromInterface then
294 Mess.MoveType := Mess.MoveType or Move_SourceIsInterface;
295
296 Result := DeliverMessage(Target, Mess);
297 end;
298
299
300 {******************************************************************************
301 * *
302 * LCLSendMouseMoveMsg *
303 * *
304 * Returns : 0 to accept the message, non-zero to reject the message *
305 * *
306 * Params *
307 * *
308 * Target : The Control that will recieve the message LM_SIZE *
309 * XPos, YPos : The Mouses X and Y position relative to the control. *
310 * ShiftState : Modifier keys that are pressed at the time of the event *
311 * *
312 ******************************************************************************}
LCLSendMouseMoveMsgnull313 function LCLSendMouseMoveMsg(const Target: TControl; XPos, YPos: SmallInt;
314 ShiftState: TShiftState = []): PtrInt;
315 var
316 Mess: TLMMouseMove;
317 begin
318 FillChar(Mess, SizeOf(Mess), 0);
319 Mess.Msg := LM_MouseMove;
320 Mess.XPos := XPos;
321 Mess.YPos := YPos;
322
323 Mess.Keys := ShiftStateToKeys(ShiftState);
324
325 Result := DeliverMessage(Target, Mess);
326 end;
327
328
329 {******************************************************************************
330 * *
331 * LCLSendMouseDownMsg *
332 * *
333 * Returns : 0 to accept the message, non-zero to reject the message *
334 * *
335 * Params *
336 * *
337 * Target : The Control that will recieve the message LM_xBUTTONDOWN *
338 * XPos, YPos : The Mouses X and Y position relative to the control. *
339 * Button : TMouseButton (mbLeft, mbMiddle, mbRight) *
340 * ShiftState : Modifier keys that are pressed at the time of the event *
341 * *
342 ******************************************************************************}
LCLSendMouseDownMsgnull343 function LCLSendMouseDownMsg(const Target: TControl; XPos, YPos: SmallInt;
344 Button: TMouseButton; ShiftState: TShiftState = []): PtrInt;
345 var
346 Mess: TLMMouse;
347 begin
348 FillChar(Mess, SizeOf(Mess), 0);
349 case Button of
350 mbLeft : Mess.Msg := LM_LBUTTONDOWN;
351 mbMiddle : Mess.Msg := LM_MBUTTONDOWN;
352 mbRight : Mess.Msg := LM_RBUTTONDOWN;
353 mbExtra1 : Mess.Msg := LM_XBUTTONDOWN;
354 mbExtra2 : Mess.Msg := LM_XBUTTONDOWN;
355 end;
356
357 Mess.XPos := XPos;
358 Mess.YPos := YPos;
359
360 Mess.Keys := ShiftStateToKeys(ShiftState);
361
362 Result := DeliverMessage(Target, Mess);
363 end;
364
365 {******************************************************************************
366 * *
367 * LCLSendMouseUpMsg *
368 * *
369 * Returns : 0 to accept the message, non-zero to reject the message *
370 * *
371 * Params *
372 * *
373 * Target : The Control that will recieve the message LM_xBUTTONUP *
374 * XPos, YPos : The Mouses X and Y position relative to the control. *
375 * Button : TMouseButton (mbLeft, mbMiddle, mbRight) *
376 * ShiftState : Modifier keys that are pressed at the time of the event *
377 * *
378 ******************************************************************************}
LCLSendMouseUpMsgnull379 function LCLSendMouseUpMsg(const Target: TControl; XPos, YPos: SmallInt;
380 Button: TMouseButton; ShiftState: TShiftState): PtrInt;
381 var
382 Mess: TLMMouse;
383 begin
384 FillChar(Mess, SizeOf(Mess), 0);
385 case Button of
386 mbLeft : Mess.Msg := LM_LBUTTONUP;
387 mbMiddle : Mess.Msg := LM_MBUTTONUP;
388 mbRight : Mess.Msg := LM_RBUTTONUP;
389 mbExtra1 : Mess.Msg := LM_XBUTTONUP;
390 mbExtra2 : Mess.Msg := LM_XBUTTONUP;
391 end;
392
393 Mess.XPos := XPos;
394 Mess.YPos := YPos;
395
396 Mess.Keys := ShiftStateToKeys(ShiftState);
397
398 Result := DeliverMessage(Target, Mess);
399 end;
400
401 {******************************************************************************
402 * *
403 * LCLSendMouseWheelMsg *
404 * *
405 * Returns : 0 to accept the message, non-zero to reject the message *
406 * *
407 * Params *
408 * *
409 * Target : The Control that will recieve the message LM_xBUTTONUP *
410 * XPos, YPos : The Mouses X and Y position relative to the control. *
411 * WheelDelta : -1 for Up, 1 for Down *
412 * ShiftState : Modifier keys that are pressed at the time of the event *
413 * *
414 ******************************************************************************}
LCLSendMouseWheelMsgnull415 function LCLSendMouseWheelMsg(const Target: TControl; XPos, YPos,
416 WheelDelta: SmallInt; ShiftState: TShiftState): PtrInt;
417 var
418 Mess: TLMMouseEvent;
419 begin
420 FillChar(Mess, SizeOf(Mess), 0);
421
422 Mess.Msg := LM_MOUSEWHEEL;
423 Mess.X := XPos;
424 Mess.Y := YPos;
425 Mess.WheelDelta := WheelDelta;
426 Mess.State := ShiftState;
427
428 Result := DeliverMessage(Target, Mess);
429 end;
430
431 {******************************************************************************
432 * *
433 * LCLSendCaptureChangedMsg *
434 * *
435 * Returns : 0 to accept the message, non-zero to reject the message *
436 * *
437 * Params *
438 * *
439 * Target : The Control that will recieve the message LM_CAPTURECHANGED *
440 * *
441 ******************************************************************************}
LCLSendCaptureChangedMsgnull442 function LCLSendCaptureChangedMsg(const Target: TControl): PtrInt;
443 begin
444 Result := SendSimpleMessage(Target, LM_CAPTURECHANGED);
445 end;
446
447 {******************************************************************************
448 * *
449 * LCLSendSelectionChangedMsg *
450 * *
451 * Returns : 0 to accept the message, non-zero to reject the message *
452 * *
453 * Params *
454 * *
455 * Target : The Control that will recieve the message LM_SELCHANGE *
456 * *
457 ******************************************************************************}
LCLSendSelectionChangedMsgnull458 function LCLSendSelectionChangedMsg(const Target: TControl): PtrInt;
459 begin
460 Result := SendSimpleMessage(Target, LM_SELCHANGE);
461 end;
462
463 {******************************************************************************
464 * *
465 * LCLSendSelectionChangedMsg *
466 * *
467 * Returns : 0 to accept the message, non-zero to reject the message *
468 * *
469 * Params *
470 * *
471 * Target : The Control that will recieve the message LM_DESTROY *
472 * *
473 ******************************************************************************}
LCLSendDestroyMsgnull474 function LCLSendDestroyMsg(const Target: TControl): PtrInt;
475 begin
476 Result := SendSimpleMessage(Target, LM_DESTROY);
477 end;
478
479 {******************************************************************************
480 * *
481 * LCLSendChangedMsg *
482 * *
483 * Returns : 0 to accept the message, non-zero to reject the message *
484 * *
485 * Params *
486 * *
487 * Target : The Control that will recieve the message LM_CHANGED *
488 * ItemIndex : Only used by Listviews and CheckBoxes. The Index of *
489 * the Item that has changed. *
490 * *
491 ******************************************************************************}
LCLSendChangedMsgnull492 function LCLSendChangedMsg(const Target: TControl; ItemIndex: WPARAM = 0): PtrInt;
493 var
494 Mess: TLMessage;
495 begin
496 FillChar(Mess, SizeOf(Mess), 0);
497 Mess.Msg := LM_CHANGED;
498 Mess.WParam := ItemIndex;
499 Result := DeliverMessage(Target, Mess);
500 end;
501
502 {******************************************************************************
503 * *
504 * LCLSendClickedMsg *
505 * *
506 * Returns : 0 to accept the message, non-zero to reject the message *
507 * *
508 * Params *
509 * *
510 * Target : The Control that will recieve the message LM_CLICKED *
511 * *
512 ******************************************************************************}
LCLSendClickedMsgnull513 function LCLSendClickedMsg(const Target: TControl): PtrInt;
514 begin
515 Result := SendSimpleMessage(Target, LM_CLICKED);
516 end;
517
518 {******************************************************************************
519 * *
520 * LCLSendMouseEnterMsg *
521 * *
522 * Returns : 0 to accept the message, non-zero to reject the message *
523 * *
524 * Params *
525 * *
526 * Target : The Control that will recieve the message CM_MOUSEENTER *
527 * *
528 ******************************************************************************}
LCLSendMouseEnterMsgnull529 function LCLSendMouseEnterMsg(const Target: TControl): PtrInt;
530 begin
531 Result := SendSimpleMessage(Target, CM_MOUSEENTER);
532 end;
533
534 {******************************************************************************
535 * *
536 * LCLSendMouseLeaveMsg *
537 * *
538 * Returns : 0 to accept the message, non-zero to reject the message *
539 * *
540 * Params *
541 * *
542 * Target : The Control that will recieve the message CM_MOUSELEAVE *
543 * *
544 * *
545 ******************************************************************************}
LCLSendMouseLeaveMsgnull546 function LCLSendMouseLeaveMsg(const Target: TControl): PtrInt;
547 begin
548 Result := SendSimpleMessage(Target, CM_MOUSELEAVE);
549 end;
550
551
552 {******************************************************************************
553 * *
554 * LCLSendSetEditableMsg *
555 * *
556 * Returns : 0 to accept the message, non-zero to reject the message *
557 * *
558 * Params *
559 * *
560 * Target : The Control that will recieve the message LM_SETEDITABLE *
561 * *
562 * Not used by the LCL *
563 * *
564 ******************************************************************************}
LCLSendSetEditableMsgnull565 function LCLSendSetEditableMsg(const Target: TControl): PtrInt;
566 begin
567 Result := SendSimpleMessage(Target, LM_SETEDITABLE);
568 end;
569
570 {******************************************************************************
571 * *
572 * LCLSendMoveWordMsg *
573 * *
574 * Returns : 0 to accept the message, non-zero to reject the message *
575 * *
576 * Params *
577 * *
578 * Target : The Control that will recieve the message LM_MOVEWORD *
579 * *
580 * Not used by the LCL *
581 * *
582 ******************************************************************************}
LCLSendMoveWordMsgnull583 function LCLSendMoveWordMsg(const Target: TControl): PtrInt;
584 begin
585 Result := SendSimpleMessage(Target, LM_MOVEWORD);
586 end;
587
588 {******************************************************************************
589 * *
590 * LCLSendMovePageMsg *
591 * *
592 * Returns : 0 to accept the message, non-zero to reject the message *
593 * *
594 * Params *
595 * *
596 * Target : The Control that will recieve the message LM_MOVEPAGE *
597 * *
598 * Not used by the LCL *
599 * *
600 ******************************************************************************}
LCLSendMovePageMsgnull601 function LCLSendMovePageMsg(const Target: TControl): PtrInt;
602 begin
603 Result := SendSimpleMessage(Target, LM_MOVEPAGE);
604 end;
605
606 {******************************************************************************
607 * *
608 * LCLSendMoveToRowMsg *
609 * *
610 * Returns : 0 to accept the message, non-zero to reject the message *
611 * *
612 * Params *
613 * *
614 * Target : The Control that will recieve the message LM_MOVETOROW *
615 * *
616 * Not used by the LCL *
617 * *
618 ******************************************************************************}
LCLSendMoveToRowMsgnull619 function LCLSendMoveToRowMsg(const Target: TControl): PtrInt;
620 begin
621 Result := SendSimpleMessage(Target, LM_MOVETOROW);
622 end;
623
624 {******************************************************************************
625 * *
626 * LCLSendMoveToColumnMsg *
627 * *
628 * Returns : 0 to accept the message, non-zero to reject the message *
629 * *
630 * Params *
631 * *
632 * Target : The Control that will recieve the message LM_MOVETOCOLUMN *
633 * *
634 * Not used by the LCL *
635 * *
636 ******************************************************************************}
LCLSendMoveToColumnMsgnull637 function LCLSendMoveToColumnMsg(const Target: TControl): PtrInt;
638 begin
639 Result := SendSimpleMessage(Target, LM_MOVETOCOLUMN);
640 end;
641
642 {******************************************************************************
643 * *
644 * LCLSendKillCharMsg *
645 * *
646 * Returns : 0 to accept the message, non-zero to reject the message *
647 * *
648 * Params *
649 * *
650 * Target : The Control that will recieve the message LM_KILLCHAR *
651 * *
652 * Not used by the LCL *
653 * *
654 ******************************************************************************}
LCLSendKillCharMsgnull655 function LCLSendKillCharMsg(const Target: TControl): PtrInt;
656 begin
657 Result := SendSimpleMessage(Target, LM_KILLCHAR);
658 end;
659
660 {******************************************************************************
661 * *
662 * LCLSendKillWordMsg *
663 * *
664 * Returns : 0 to accept the message, non-zero to reject the message *
665 * *
666 * Params *
667 * *
668 * Target : The Control that will recieve the message LM_KILLWORD *
669 * *
670 * Not used by the LCL *
671 * *
672 ******************************************************************************}
LCLSendKillWordMsgnull673 function LCLSendKillWordMsg(const Target: TControl): PtrInt;
674 begin
675 Result := SendSimpleMessage(Target, LM_KILLWORD);
676 end;
677
678 {******************************************************************************
679 * *
680 * LCLSendKillLineMsg *
681 * *
682 * Returns : 0 to accept the message, non-zero to reject the message *
683 * *
684 * Params *
685 * *
686 * Target : The Control that will recieve the message LM_KILLLINE *
687 * *
688 * Not used by the LCL *
689 * *
690 ******************************************************************************}
LCLSendKillLineMsgnull691 function LCLSendKillLineMsg(const Target: TControl): PtrInt;
692 begin
693 Result := SendSimpleMessage(Target, LM_KILLLINE);
694 end;
695
696 {******************************************************************************
697 * *
698 * LCLSendCutToClipboardMsg *
699 * *
700 * Returns : 0 to accept the message, non-zero to reject the message *
701 * *
702 * Params *
703 * *
704 * Target : The Control that will recieve the message LM_CUT *
705 * *
706 ******************************************************************************}
LCLSendCutToClipboardMsgnull707 function LCLSendCutToClipboardMsg(const Target: TControl): PtrInt;
708 begin
709 Result := SendSimpleMessage(Target, LM_CUT);
710 end;
711
712 {******************************************************************************
713 * *
714 * LCLSendCopyToClipboardMsg *
715 * *
716 * Returns : 0 to accept the message, non-zero to reject the message *
717 * *
718 * Params *
719 * *
720 * Target : The Control that will recieve the message LM_COPY *
721 * *
722 ******************************************************************************}
LCLSendCopyToClipboardMsgnull723 function LCLSendCopyToClipboardMsg(const Target: TControl): PtrInt;
724 begin
725 Result := SendSimpleMessage(Target, LM_COPY);
726 end;
727
728 {******************************************************************************
729 * *
730 * LCLSendPasteFromClipboardMsg *
731 * *
732 * Returns : 0 to accept the message, non-zero to reject the message *
733 * *
734 * Params *
735 * *
736 * Target : The Control that will recieve the message LM_COPY *
737 * *
738 ******************************************************************************}
LCLSendPasteFromClipboardMsgnull739 function LCLSendPasteFromClipboardMsg(const Target: TControl): PtrInt;
740 begin
741 Result := SendSimpleMessage(Target, LM_PASTE);
742 end;
743
744 {******************************************************************************
745 * *
746 * LCLSendConfigureEventMsg *
747 * *
748 * Returns : 0 to accept the message, non-zero to reject the message *
749 * *
750 * Params *
751 * *
752 * Target : The Control that will recieve the message LM_CONFIGUREEVENT *
753 * *
754 * Not used by the LCL *
755 * *
756 ******************************************************************************}
LCLSendConfigureEventMsgnull757 function LCLSendConfigureEventMsg(const Target: TControl): PtrInt;
758 begin
759 Result := SendSimpleMessage(Target, LM_CONFIGUREEVENT);
760 end;
761
762 {******************************************************************************
763 * *
764 * LCLSendPaintMsg *
765 * *
766 * Returns : 0 to accept the message, non-zero to reject the message *
767 * *
768 * Params *
769 * *
770 * Target : The Control that will recieve the message LM_PAINT *
771 * DC : This is the Device Context *
772 * PaintStruct : PaintStruct *
773 * *
774 ******************************************************************************}
LCLSendPaintMsgnull775 function LCLSendPaintMsg(const Target: TControl;const DC: HDC; const PaintStruct: PPaintStruct): PtrInt;
776 var
777 Mess: TLMPaint;
778 begin
779 FillChar(Mess, SizeOf(Mess), 0);
780 Mess.Msg := LM_PAINT;
781 Mess.DC := DC;
782 Mess.PaintStruct := PaintStruct;
783
784 Result := DeliverMessage(Target, Mess);
785 end;
786
LCLSendEraseBackgroundMsgnull787 function LCLSendEraseBackgroundMsg(const Target: TWinControl; const DC: HDC): PtrInt;
788 var
789 Mess: TLMEraseBkgnd;
790 begin
791 FillChar(Mess, SizeOf(Mess), 0);
792 Mess.Msg := LM_ERASEBKGND;
793 Mess.DC := DC;
794
795 Include(TWinControlAccess(Target).FWinControlFlags, wcfEraseBackground);
796 Result := DeliverMessage(Target, Mess);
797 Exclude(TWinControlAccess(Target).FWinControlFlags, wcfEraseBackground);
798 end;
799
800 {******************************************************************************
801 * *
802 * LCLSendKeyDownEvent *
803 * *
804 * Returns : 0 to accept the message, non-zero to reject the message *
805 * *
806 * Params *
807 * *
808 * Target : The Control that will recieve the message xx_xxKEYDOWN *
809 * CharCode : This is the VK Key code. Check if this has changed after *
810 * sending the message. *
811 * KeyData : Bitwise or'ed combination of the KF_xxxx constants. *
812 * BeforeEvent : True if we are sending the message before the widgetset *
813 * has handled the keystroke. False otherwise *
814 * IsSysKey : True if the Alt Key was also pressed. *
815 * *
816 ******************************************************************************}
LCLSendKeyDownEventnull817 function LCLSendKeyDownEvent(const Target: TControl; var CharCode: Word;
818 KeyData: PtrInt; BeforeEvent, IsSysKey: Boolean): PtrInt;
819 var
820 Mess: TLMKeyDown;
821 begin
822 FillChar(Mess, SizeOf(Mess), 0);
823 if BeforeEvent then begin
824 if IsSysKey then
825 Mess.Msg := CN_SYSKEYDOWN
826 else Mess.Msg := CN_KEYDOWN;
827 end
828 else begin
829 if IsSysKey then
830 Mess.Msg := LM_SYSKEYDOWN
831 else Mess.Msg := LM_KEYDOWN;
832 end;
833 Mess.CharCode := CharCode;
834 Mess.KeyData := KeyData;
835 Result := DeliverMessage(Target, Mess);
836 CharCode := Mess.CharCode;
837 end;
838
839 {******************************************************************************
840 * *
841 * LCLSendKeyUpEvent *
842 * *
843 * Returns : 0 to accept the message, non-zero to reject the message *
844 * *
845 * Params *
846 * *
847 * Target : The Control that will recieve the message xx_xxKEYUP *
848 * CharCode : This is the VK Key code. Check if this has changed after *
849 * sending the message. *
850 * KeyData : Bitwise or'ed combination of the KF_xxxx constants. *
851 * BeforeEvent : True if we are sending the message before the widgetset *
852 * has handled the keystroke. False otherwise. *
853 * IsSysKey : True if the Alt Key was also pressed. *
854 * *
855 ******************************************************************************}
LCLSendKeyUpEventnull856 function LCLSendKeyUpEvent(const Target: TControl; var CharCode: Word;
857 KeyData: PtrInt; BeforeEvent, IsSysKey: Boolean): PtrInt;
858 var
859 Mess: TLMKeyUp;
860 begin
861 FillChar(Mess, SizeOf(Mess), 0);
862 if BeforeEvent then begin
863 if IsSysKey then
864 Mess.Msg := CN_SYSKEYUP
865 else Mess.Msg := CN_KEYUP;
866 end
867 else begin
868 if IsSysKey then
869 Mess.Msg := LM_SYSKEYUP
870 else Mess.Msg := LM_KEYUP;
871 end;
872 Mess.CharCode := CharCode;
873 Mess.KeyData := KeyData;
874 Result := DeliverMessage(Target, Mess);
875 CharCode := Mess.CharCode;
876 end;
877
LCLSendCharEventnull878 function LCLSendCharEvent(const Target: TControl; var CharCode: Word;
879 KeyData: PtrInt; BeforeEvent, IsSysKey, ANotifyUserInput: Boolean): PtrInt;
880 var
881 Mess: TLMChar;
882 begin
883 FillChar(Mess, SizeOf(Mess), 0);
884 if BeforeEvent then begin
885 if IsSysKey then
886 Mess.Msg := CN_SYSCHAR
887 else Mess.Msg := CN_CHAR;
888 end
889 else begin
890 if IsSysKey then
891 Mess.Msg := LM_SYSCHAR
892 else Mess.Msg := LM_CHAR;
893 end;
894 Mess.CharCode := CharCode;
895 Mess.KeyData := KeyData;
896 Result := DeliverMessage(Target, Mess);
897 CharCode := Mess.CharCode;
898
899 if ANotifyUserInput then NotifyApplicationUserInput(Target, Mess.Msg);
900 end;
901
LCLSendUTF8KeyPressnull902 function LCLSendUTF8KeyPress(const Target: TWinControl; AUTF8Char: TUTF8Char;
903 IsSysKey: Boolean): PtrInt;
904 begin
905 {if not IsControlKey then}
906 Target.IntfUTF8KeyPress(AUTF8Char, 1, IsSysKey);
907 Result := 1;
908 end;
909
910 {******************************************************************************
911 * *
912 * LCLSendTimerMsg *
913 * *
914 * Returns : 0 to accept the message, non-zero to allow the message to *
915 * continue to process. *
916 * *
917 * Params *
918 * *
919 * Target : The Control that will recieve the message LM_TIMER *
920 * TimerID : ID of the timer. *
921 * TimerProc : The procedure to call. *
922 * *
923 ******************************************************************************}
LCLSendTimerMsgnull924 function LCLSendTimerMsg(const Target: TControl; TimerID: WParam;
925 TimerProc: LParam): PtrInt;
926 var
927 Mess: TLMessage;
928 begin
929 FillChar(Mess, SizeOf(Mess), 0);
930 Mess.Msg := LM_TIMER;
931 Mess.WParam := TimerID;
932 Mess.LParam := TimerProc;
933 Result:=DeliverMessage(Target, Mess);
934 end;
935
936 {******************************************************************************
937 * *
938 * LCLSendExitMsg *
939 * *
940 * Returns : 0 to accept the message, non-zero to reject the message *
941 * *
942 * Params *
943 * *
944 * Target : The Control that will recieve the message LM_EXIT *
945 * *
946 * Not used by the LCL *
947 * *
948 ******************************************************************************}
LCLSendExitMsgnull949 function LCLSendExitMsg(const Target: TControl): PtrInt;
950 begin
951 Result := SendSimpleMessage(Target, LM_EXIT);
952 end;
953
954 {******************************************************************************
955 * *
956 * LCLSendCloseQueryMsg *
957 * *
958 * Returns : 0 to accept the message, non-zero to reject the message *
959 * *
960 * Params *
961 * *
962 * Target : The Control that will recieve the message LM_CLOSEQUERY *
963 * *
964 ******************************************************************************}
LCLSendCloseQueryMsgnull965 function LCLSendCloseQueryMsg(const Target: TControl): PtrInt;
966 begin
967 Result := SendSimpleMessage(Target, LM_CLOSEQUERY);
968 end;
969
970 {******************************************************************************
971 * *
972 * LCLSendDragStartMsg *
973 * *
974 * Returns : 0 to accept the message, non-zero to reject the message *
975 * *
976 * Params *
977 * *
978 * Target : The Control that will recieve the message LM_DRAGSTART *
979 * *
980 ******************************************************************************}
LCLSendDragStartMsgnull981 function LCLSendDragStartMsg(const Target: TControl): PtrInt;
982 begin
983 Result := SendSimpleMessage(Target, LM_DRAGSTART);
984 end;
985
986 {******************************************************************************
987 * *
988 * LCLSendMonthChangedMsg *
989 * *
990 * Returns : 0 to accept the message, non-zero to reject the message *
991 * *
992 * Params *
993 * *
994 * Target : The Control that will recieve the message LM_MONTHCHANGED *
995 * *
996 ******************************************************************************}
LCLSendMonthChangedMsgnull997 function LCLSendMonthChangedMsg(const Target: TControl): PtrInt;
998 begin
999 Result := SendSimpleMessage(Target, LM_MONTHCHANGED);
1000 end;
1001
1002 {******************************************************************************
1003 * *
1004 * LCLSendYearChangedMsg *
1005 * *
1006 * Returns : 0 to accept the message, non-zero to reject the message *
1007 * *
1008 * Params *
1009 * *
1010 * Target : The Control that will recieve the message LM_YEARCHANGED *
1011 * *
1012 ******************************************************************************}
LCLSendYearChangedMsgnull1013 function LCLSendYearChangedMsg(const Target: TControl): PtrInt;
1014 begin
1015 Result := SendSimpleMessage(Target, LM_YEARCHANGED);
1016 end;
1017
1018 {******************************************************************************
1019 * *
1020 * LCLSendDayChangedMsg *
1021 * *
1022 * Returns : 0 to accept the message, non-zero to reject the message *
1023 * *
1024 * Params *
1025 * *
1026 * Target : The Control that will recieve the message LM_DAYCHANGED *
1027 * *
1028 ******************************************************************************}
LCLSendDayChangedMsgnull1029 function LCLSendDayChangedMsg(const Target: TControl): PtrInt;
1030 begin
1031 Result := SendSimpleMessage(Target, LM_DAYCHANGED);
1032 end;
1033
1034 {******************************************************************************
1035 * *
1036 * LCLSendMouseMultiClickMsg *
1037 * *
1038 * Returns : 0 to accept the message, non-zero to reject the message *
1039 * *
1040 * Params *
1041 * *
1042 * Target : The Control that will recieve the message LM_xBUTTONxxxCLK *
1043 * XPos, YPos : The Mouses X and Y position relative to the control. *
1044 * Button : TMouseButton (mbLeft, mbMiddle, mbRight) *
1045 * ClickCount : 2 = LM_xBUTTONDBLCLK, 3 = LM_xBUTTONTRIPLECLK, *
1046 * 4 = LM_xBUTTONQUADCLK *
1047 * ShiftState : Modifier keys that are pressed at the time of the event *
1048 * *
1049 ******************************************************************************}
LCLSendMouseMultiClickMsgnull1050 function LCLSendMouseMultiClickMsg(const Target: TControl; XPos, YPos: SmallInt;
1051 Button: TMouseButton; ClickCount: Byte = 2; ShiftState: TShiftState = []): PtrInt;
1052 var
1053 Mess: TLMMouse;
1054 begin
1055 FillChar(Mess, SizeOf(Mess), 0);
1056 Mess.Msg := LM_UNKNOWN;
1057 case ClickCount of
1058 2:
1059 case Button of
1060 mbLeft : Mess.Msg := LM_LBUTTONDBLCLK;
1061 mbMiddle : Mess.Msg := LM_MBUTTONDBLCLK;
1062 mbRight : Mess.Msg := LM_RBUTTONDBLCLK;
1063 mbExtra1 : Mess.Msg := LM_XBUTTONDBLCLK;
1064 mbExtra2 : Mess.Msg := LM_XBUTTONDBLCLK;
1065 end;
1066 3:
1067 case Button of
1068 mbLeft : Mess.Msg := LM_LBUTTONTRIPLECLK;
1069 mbMiddle : Mess.Msg := LM_MBUTTONTRIPLECLK;
1070 mbRight : Mess.Msg := LM_RBUTTONTRIPLECLK;
1071 mbExtra1 : Mess.Msg := LM_XBUTTONTRIPLECLK;
1072 mbExtra2 : Mess.Msg := LM_XBUTTONTRIPLECLK;
1073 end;
1074 4:
1075 case Button of
1076 mbLeft : Mess.Msg := LM_LBUTTONQUADCLK;
1077 mbMiddle : Mess.Msg := LM_MBUTTONQUADCLK;
1078 mbRight : Mess.Msg := LM_RBUTTONQUADCLK;
1079 mbExtra1 : Mess.Msg := LM_XBUTTONQUADCLK;
1080 mbExtra2 : Mess.Msg := LM_XBUTTONQUADCLK;
1081 end;
1082 end;
1083
1084 Mess.XPos := XPos;
1085 Mess.YPos := YPos;
1086
1087 Mess.Keys := ShiftStateToKeys(ShiftState);
1088
1089 Result := DeliverMessage(Target, Mess);
1090 end;
1091
1092 {******************************************************************************
1093 * *
1094 * LCLSendDrawListItemMsg *
1095 * *
1096 * Returns : 0 to accept the message, non-zero to reject the message *
1097 * *
1098 * Params *
1099 * *
1100 * Target : The Control that will recieve the message LM_DRAWLISTITEM *
1101 * DrawListItemStruct : Pointer to a TDrawListItemStruct *
1102 * *
1103 ******************************************************************************}
LCLSendDrawListItemMsgnull1104 function LCLSendDrawListItemMsg(const Target: TControl; const DrawListItemStruct: PDrawListItemStruct): PtrInt;
1105 var
1106 Mess: TLMDrawListItem;
1107 begin
1108 FillChar(Mess, SizeOf(Mess), 0);
1109 Mess.Msg := LM_DRAWLISTITEM;
1110 Mess.DrawListItemStruct := DrawListItemStruct;
1111
1112 Result := DeliverMessage(Target, Mess);
1113 end;
1114
1115 {******************************************************************************
1116 * *
1117 * LCLSendDropDownMsg *
1118 * *
1119 * Returns : 0 to accept the message, non-zero to reject the message *
1120 * *
1121 * Params *
1122 * *
1123 * Target : The Control that will recieve the message CN_Command *
1124 * *
1125 * Used to notify a combo that the combobox is popping down *
1126 * *
1127 ******************************************************************************}
LCLSendDropDownMsgnull1128 function LCLSendDropDownMsg(const Target: TControl): PtrInt;
1129 var
1130 Mess : TLMCommand;
1131 begin
1132 FillChar(Mess, SizeOf(Mess), 0);
1133 Mess.Msg := CN_Command;
1134 Mess.NotifyCode := CBN_DROPDOWN;
1135
1136 Result := DeliverMessage(Target, Mess);
1137 end;
1138
LCLSendCloseUpMsgnull1139 function LCLSendCloseUpMsg(const Target: TControl): PtrInt;
1140 var
1141 Mess : TLMCommand;
1142 begin
1143 FillChar(Mess, SizeOf(Mess), 0);
1144 Mess.Msg := CN_Command;
1145 Mess.NotifyCode := CBN_CLOSEUP;
1146
1147 Result := DeliverMessage(Target, Mess);
1148 end;
1149
1150
1151 // Remove these lines as you implement the function
1152
1153 {
1154 LM_ACTIVATEITEM // NOT USED
1155 LM_FOCUS // NOT USED
1156 LM_SIZEALLOCATE // NOT USED
1157 LM_CHECKRESIZE // NOT USED
1158 LM_SHOW // NOT USED
1159 LM_MOVERESIZE // NOT USED
1160 LM_DRAW // NOT USED
1161 LM_MOUSEBTNPRESS // NOT USED
1162 LM_MOUSEBTNRELEASE // NOT USED
1163 }
1164
1165
1166 end.
1167