{ $Id$ } { ***************************************************************************** * LCLMessageGlue.pas * * ------------------ * * * * * ***************************************************************************** ***************************************************************************** This file is part of the Lazarus Component Library (LCL) See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** Abstract: A Unit to make the passing of messages to the LCL from the different widgetsets easier. Your mileage will vary if you try to use these procs from within your program. } unit LCLMessageGlue; {$MODE objfpc}{$H+} interface uses Classes, Forms, LCLClasses, LCLProc, Controls, Messages, LMessages, LCLType; function DeliverMessage(const Target: TObject; var AMessage): PtrInt; function SendSimpleMessage(const Target: TControl; Msg: Cardinal): PtrInt; function LCLSendActivateMsg(const Target: TControl; Active: Word; Minimized: Boolean; ActiveWindow: HWND = 0): PtrInt; function LCLSendSetFocusMsg(const Target: TControl): PtrInt; function LCLSendKillFocusMsg(const Target: TControl): PtrInt; function LCLSendShowWindowMsg(const Target: TControl; Show: Boolean; Status: LPARAM = 0): PtrInt; function LCLSendSizeMsg(const Target: TControl; Width, Height: Word; SizeType: Longint; FromInterface: Boolean = True): PtrInt; function LCLSendMoveMsg(const Target: TControl; XPos, YPos: SmallInt; MoveType: PtrInt = Move_Default; FromInterface: Boolean = True): PtrInt; function LCLSendMouseMoveMsg(const Target: TControl; XPos, YPos: SmallInt; ShiftState: TShiftState = []): PtrInt; function LCLSendMouseDownMsg(const Target: TControl; XPos, YPos: SmallInt; Button: TMouseButton; ShiftState: TShiftState = []): PtrInt; function LCLSendMouseUpMsg(const Target: TControl; XPos, YPos: SmallInt; Button: TMouseButton; ShiftState: TShiftState = []): PtrInt; function LCLSendMouseWheelMsg(const Target: TControl; XPos, YPos, WheelDelta: SmallInt; ShiftState: TShiftState = []): PtrInt; function LCLSendCaptureChangedMsg(const Target: TControl): PtrInt; function LCLSendSelectionChangedMsg(const Target: TControl): PtrInt; function LCLSendDestroyMsg(const Target: TControl): PtrInt; function LCLSendChangedMsg(const Target: TControl; ItemIndex: WPARAM = 0): PtrInt; function LCLSendClickedMsg(const Target: TControl): PtrInt; function LCLSendMouseEnterMsg(const Target: TControl): PtrInt; function LCLSendMouseLeaveMsg(const Target: TControl): PtrInt; function LCLSendSetEditableMsg(const Target: TControl): PtrInt; function LCLSendMoveWordMsg(const Target: TControl): PtrInt; function LCLSendMovePageMsg(const Target: TControl): PtrInt; function LCLSendMoveToRowMsg(const Target: TControl): PtrInt; function LCLSendMoveToColumnMsg(const Target: TControl): PtrInt; function LCLSendKillCharMsg(const Target: TControl): PtrInt; function LCLSendKillWordMsg(const Target: TControl): PtrInt; function LCLSendKillLineMsg(const Target: TControl): PtrInt; function LCLSendCutToClipboardMsg(const Target: TControl): PtrInt; function LCLSendCopyToClipboardMsg(const Target: TControl): PtrInt; function LCLSendPasteFromClipboardMsg(const Target: TControl): PtrInt; function LCLSendConfigureEventMsg(const Target: TControl): PtrInt; function LCLSendPaintMsg(const Target: TControl;const DC: HDC; const PaintStruct: PPaintStruct): PtrInt; function LCLSendEraseBackgroundMsg(const Target: TWinControl;const DC: HDC): PtrInt; function LCLSendKeyDownEvent(const Target: TControl; var CharCode: Word; KeyData: PtrInt; BeforeEvent, IsSysKey: Boolean): PtrInt; function LCLSendKeyUpEvent(const Target: TControl; var CharCode: Word; KeyData: PtrInt; BeforeEvent, IsSysKey: Boolean): PtrInt; function LCLSendCharEvent(const Target: TControl; var CharCode: Word; KeyData: PtrInt; BeforeEvent, IsSysKey, ANotifyUserInput: Boolean): PtrInt; function LCLSendUTF8KeyPress(const Target: TWinControl; AUTF8Char: TUTF8Char; IsSysKey: Boolean): PtrInt; function LCLSendTimerMsg(const Target: TControl; TimerID: WParam; TimerProc: LParam): PtrInt; function LCLSendExitMsg(const Target: TControl): PtrInt; function LCLSendCloseQueryMsg(const Target: TControl): PtrInt; function LCLSendDragStartMsg(const Target: TControl): PtrInt; function LCLSendMonthChangedMsg(const Target: TControl): PtrInt; function LCLSendYearChangedMsg(const Target: TControl): PtrInt; function LCLSendDayChangedMsg(const Target: TControl): PtrInt; function LCLSendMouseMultiClickMsg(const Target: TControl; XPos, YPos: SmallInt; Button: TMouseButton; ClickCount: Byte = 2; ShiftState: TShiftState = []): PtrInt; function LCLSendDrawListItemMsg(const Target: TControl; const DrawListItemStruct: PDrawListItemStruct): PtrInt; function LCLSendDropDownMsg(const Target: TControl): PtrInt; function LCLSendCloseUpMsg(const Target: TControl): PtrInt; implementation type TWinControlAccess = class(TWinControl) end; function DeliverMessage(const Target: TObject; var AMessage): PtrInt; var RefCounted: Boolean; begin if Target=nil then DebugLn('[DeliverMessage] Target = nil'); {$IFDEF VerboseDeliverMessage} if (TLMessage(AMessage).Msg <>LM_MOUSEMOVE) and (TLMessage(AMessage).Msg <>LM_PAINT) and (TLMessage(AMessage).Msg <>LM_KEYDOWN) and (TLMessage(AMessage).Msg <>LM_KEYUP) and (TLMessage(AMessage).Msg <> CN_KEYDOWN ) then DebugLn('DeliverMessage ',DbgS(Target), ' ',TComponent(Target).Name,':',TObject(Target).ClassName, ' Message=',GetMessageName(TLMessage(AMessage).Msg)); {$ENDIF} RefCounted := False; try try if Target is TLCLComponent then begin TLCLComponent(Target).IncLCLRefCount; RefCounted := True; end; if Target is TControl then TControl(Target).WindowProc(TLMessage(AMessage)) else Target.Dispatch(TLMessage(AMessage)); except Application.HandleException(nil); end; finally if RefCounted then TLCLComponent(Target).DecLCLRefCount; end; Result := TLMessage(AMessage).Result; end; {****************************************************************************** * * * SendSimpleMessage * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the simple message * * Msg : Message type constant * * * ******************************************************************************} function SendSimpleMessage(const Target: TControl; Msg: Cardinal): PtrInt; var Mess : TLMessage; begin FillChar(Mess,SizeOf(Mess),0); Mess.Msg := Msg; Result := DeliverMessage(Target, Mess); end; {****************************************************************************** * * * LCLSendActivateMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_ACTIVATE * * Active : Set to True. This is currently ignored * * Minimized : Set to False. This is currently ignored * * ActiveWindow: Optional. Pass the handle of the currently or newly * * active window * * * ******************************************************************************} function LCLSendActivateMsg(const Target: TControl; Active: Word; Minimized: Boolean; ActiveWindow: HWND = 0): PtrInt; var Mess: TLMActivate; begin Result := 0; FillChar(Mess, SizeOf(Mess), 0); Mess.Msg := LM_ACTIVATE; Mess.Active := Active; Mess.Minimized := Minimized; Mess.ActiveWindow := ActiveWindow; Result := DeliverMessage(Target, Mess); end; {****************************************************************************** * * * LCLSendSetFocusMessage * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_SETFOCUS * * * ******************************************************************************} function LCLSendSetFocusMsg(const Target: TControl): PtrInt; begin Result:=SendSimpleMessage(Target, LM_SETFOCUS); end; {****************************************************************************** * * * LCLSendKillFocusMessage * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_KILLFOCUS * * * ******************************************************************************} function LCLSendKillFocusMsg(const Target: TControl): PtrInt; begin Result:=SendSimpleMessage(Target, LM_KILLFOCUS); end; {****************************************************************************** * * * LCLSendShowWindowMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_SHOWWINDOW * * Show : Set to True if Showing the window False otherwise * * Status : Usually zero. Set to non-zero if the message was generated * * by another window showing or hiding. * * * ******************************************************************************} function LCLSendShowWindowMsg(const Target: TControl; Show: Boolean; Status: LPARAM = 0): PtrInt; var Mess : TLMShowWindow; begin FillChar(Mess,SizeOf(Mess),0); Mess.Msg := LM_SHOWWINDOW; Mess.Show := True; Result := DeliverMessage(Target, Mess); end; {****************************************************************************** * * * LCLSendSizeMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_SIZE * * Width, Height : The new Width and Height for the control * * SizeType : SIZE_RESTORED, SIZE_MINIMIZED, SIZE_MAXIMIZED,... * * FromInterface : True if this message was sent from the widgetset to notify * * the LCL of a change. False to make the widgetset change * * the size of the control. Default = True * * * ******************************************************************************} function LCLSendSizeMsg(const Target: TControl; Width, Height: Word; SizeType: Longint; FromInterface: Boolean = True): PtrInt; var Mess: TLMSize; begin FillChar(Mess, SizeOf(Mess), 0); Mess.Msg := LM_SIZE; Mess.Width := Width; Mess.Height := Height; Mess.SizeType := SizeType; if FromInterface then Mess.SizeType := Mess.SizeType or Size_SourceIsInterface; Result := DeliverMessage(Target, Mess); end; {****************************************************************************** * * * LCLSendMoveMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_MOVE * * XPos, YPos : The new Top and Left for the control * * MoveType : Move_Default = update, 1 = force RequestAlign * * FromInterface : True if this message was sent from the widgetset to notify * * the LCL of a change. False to make the widgetset change * * the position of the control. Default = True * * * ******************************************************************************} function LCLSendMoveMsg(const Target: TControl; XPos, YPos: SmallInt; MoveType: PtrInt = Move_Default; FromInterface: Boolean = True): PtrInt; var Mess: TLMMove; begin FillChar(Mess, SizeOf(Mess), 0); Mess.Msg := LM_MOVE; Mess.XPos := XPos; Mess.YPos := YPos; Mess.MoveType := MoveType; if FromInterface then Mess.MoveType := Mess.MoveType or Move_SourceIsInterface; Result := DeliverMessage(Target, Mess); end; {****************************************************************************** * * * LCLSendMouseMoveMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_SIZE * * XPos, YPos : The Mouses X and Y position relative to the control. * * ShiftState : Modifier keys that are pressed at the time of the event * * * ******************************************************************************} function LCLSendMouseMoveMsg(const Target: TControl; XPos, YPos: SmallInt; ShiftState: TShiftState = []): PtrInt; var Mess: TLMMouseMove; begin FillChar(Mess, SizeOf(Mess), 0); Mess.Msg := LM_MouseMove; Mess.XPos := XPos; Mess.YPos := YPos; Mess.Keys := ShiftStateToKeys(ShiftState); Result := DeliverMessage(Target, Mess); end; {****************************************************************************** * * * LCLSendMouseDownMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_xBUTTONDOWN * * XPos, YPos : The Mouses X and Y position relative to the control. * * Button : TMouseButton (mbLeft, mbMiddle, mbRight) * * ShiftState : Modifier keys that are pressed at the time of the event * * * ******************************************************************************} function LCLSendMouseDownMsg(const Target: TControl; XPos, YPos: SmallInt; Button: TMouseButton; ShiftState: TShiftState = []): PtrInt; var Mess: TLMMouse; begin FillChar(Mess, SizeOf(Mess), 0); case Button of mbLeft : Mess.Msg := LM_LBUTTONDOWN; mbMiddle : Mess.Msg := LM_MBUTTONDOWN; mbRight : Mess.Msg := LM_RBUTTONDOWN; mbExtra1 : Mess.Msg := LM_XBUTTONDOWN; mbExtra2 : Mess.Msg := LM_XBUTTONDOWN; end; Mess.XPos := XPos; Mess.YPos := YPos; Mess.Keys := ShiftStateToKeys(ShiftState); Result := DeliverMessage(Target, Mess); end; {****************************************************************************** * * * LCLSendMouseUpMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_xBUTTONUP * * XPos, YPos : The Mouses X and Y position relative to the control. * * Button : TMouseButton (mbLeft, mbMiddle, mbRight) * * ShiftState : Modifier keys that are pressed at the time of the event * * * ******************************************************************************} function LCLSendMouseUpMsg(const Target: TControl; XPos, YPos: SmallInt; Button: TMouseButton; ShiftState: TShiftState): PtrInt; var Mess: TLMMouse; begin FillChar(Mess, SizeOf(Mess), 0); case Button of mbLeft : Mess.Msg := LM_LBUTTONUP; mbMiddle : Mess.Msg := LM_MBUTTONUP; mbRight : Mess.Msg := LM_RBUTTONUP; mbExtra1 : Mess.Msg := LM_XBUTTONUP; mbExtra2 : Mess.Msg := LM_XBUTTONUP; end; Mess.XPos := XPos; Mess.YPos := YPos; Mess.Keys := ShiftStateToKeys(ShiftState); Result := DeliverMessage(Target, Mess); end; {****************************************************************************** * * * LCLSendMouseWheelMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_xBUTTONUP * * XPos, YPos : The Mouses X and Y position relative to the control. * * WheelDelta : -1 for Up, 1 for Down * * ShiftState : Modifier keys that are pressed at the time of the event * * * ******************************************************************************} function LCLSendMouseWheelMsg(const Target: TControl; XPos, YPos, WheelDelta: SmallInt; ShiftState: TShiftState): PtrInt; var Mess: TLMMouseEvent; begin FillChar(Mess, SizeOf(Mess), 0); Mess.Msg := LM_MOUSEWHEEL; Mess.X := XPos; Mess.Y := YPos; Mess.WheelDelta := WheelDelta; Mess.State := ShiftState; Result := DeliverMessage(Target, Mess); end; {****************************************************************************** * * * LCLSendCaptureChangedMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_CAPTURECHANGED * * * ******************************************************************************} function LCLSendCaptureChangedMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_CAPTURECHANGED); end; {****************************************************************************** * * * LCLSendSelectionChangedMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_SELCHANGE * * * ******************************************************************************} function LCLSendSelectionChangedMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_SELCHANGE); end; {****************************************************************************** * * * LCLSendSelectionChangedMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_DESTROY * * * ******************************************************************************} function LCLSendDestroyMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_DESTROY); end; {****************************************************************************** * * * LCLSendChangedMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_CHANGED * * ItemIndex : Only used by Listviews and CheckBoxes. The Index of * * the Item that has changed. * * * ******************************************************************************} function LCLSendChangedMsg(const Target: TControl; ItemIndex: WPARAM = 0): PtrInt; var Mess: TLMessage; begin FillChar(Mess, SizeOf(Mess), 0); Mess.Msg := LM_CHANGED; Mess.WParam := ItemIndex; Result := DeliverMessage(Target, Mess); end; {****************************************************************************** * * * LCLSendClickedMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_CLICKED * * * ******************************************************************************} function LCLSendClickedMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_CLICKED); end; {****************************************************************************** * * * LCLSendMouseEnterMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message CM_MOUSEENTER * * * ******************************************************************************} function LCLSendMouseEnterMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, CM_MOUSEENTER); end; {****************************************************************************** * * * LCLSendMouseLeaveMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message CM_MOUSELEAVE * * * * * ******************************************************************************} function LCLSendMouseLeaveMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, CM_MOUSELEAVE); end; {****************************************************************************** * * * LCLSendSetEditableMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_SETEDITABLE * * * * Not used by the LCL * * * ******************************************************************************} function LCLSendSetEditableMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_SETEDITABLE); end; {****************************************************************************** * * * LCLSendMoveWordMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_MOVEWORD * * * * Not used by the LCL * * * ******************************************************************************} function LCLSendMoveWordMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_MOVEWORD); end; {****************************************************************************** * * * LCLSendMovePageMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_MOVEPAGE * * * * Not used by the LCL * * * ******************************************************************************} function LCLSendMovePageMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_MOVEPAGE); end; {****************************************************************************** * * * LCLSendMoveToRowMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_MOVETOROW * * * * Not used by the LCL * * * ******************************************************************************} function LCLSendMoveToRowMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_MOVETOROW); end; {****************************************************************************** * * * LCLSendMoveToColumnMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_MOVETOCOLUMN * * * * Not used by the LCL * * * ******************************************************************************} function LCLSendMoveToColumnMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_MOVETOCOLUMN); end; {****************************************************************************** * * * LCLSendKillCharMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_KILLCHAR * * * * Not used by the LCL * * * ******************************************************************************} function LCLSendKillCharMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_KILLCHAR); end; {****************************************************************************** * * * LCLSendKillWordMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_KILLWORD * * * * Not used by the LCL * * * ******************************************************************************} function LCLSendKillWordMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_KILLWORD); end; {****************************************************************************** * * * LCLSendKillLineMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_KILLLINE * * * * Not used by the LCL * * * ******************************************************************************} function LCLSendKillLineMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_KILLLINE); end; {****************************************************************************** * * * LCLSendCutToClipboardMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_CUT * * * ******************************************************************************} function LCLSendCutToClipboardMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_CUT); end; {****************************************************************************** * * * LCLSendCopyToClipboardMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_COPY * * * ******************************************************************************} function LCLSendCopyToClipboardMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_COPY); end; {****************************************************************************** * * * LCLSendPasteFromClipboardMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_COPY * * * ******************************************************************************} function LCLSendPasteFromClipboardMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_PASTE); end; {****************************************************************************** * * * LCLSendConfigureEventMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_CONFIGUREEVENT * * * * Not used by the LCL * * * ******************************************************************************} function LCLSendConfigureEventMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_CONFIGUREEVENT); end; {****************************************************************************** * * * LCLSendPaintMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_PAINT * * DC : This is the Device Context * * PaintStruct : PaintStruct * * * ******************************************************************************} function LCLSendPaintMsg(const Target: TControl;const DC: HDC; const PaintStruct: PPaintStruct): PtrInt; var Mess: TLMPaint; begin FillChar(Mess, SizeOf(Mess), 0); Mess.Msg := LM_PAINT; Mess.DC := DC; Mess.PaintStruct := PaintStruct; Result := DeliverMessage(Target, Mess); end; function LCLSendEraseBackgroundMsg(const Target: TWinControl; const DC: HDC): PtrInt; var Mess: TLMEraseBkgnd; begin FillChar(Mess, SizeOf(Mess), 0); Mess.Msg := LM_ERASEBKGND; Mess.DC := DC; Include(TWinControlAccess(Target).FWinControlFlags, wcfEraseBackground); Result := DeliverMessage(Target, Mess); Exclude(TWinControlAccess(Target).FWinControlFlags, wcfEraseBackground); end; {****************************************************************************** * * * LCLSendKeyDownEvent * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message xx_xxKEYDOWN * * CharCode : This is the VK Key code. Check if this has changed after * * sending the message. * * KeyData : Bitwise or'ed combination of the KF_xxxx constants. * * BeforeEvent : True if we are sending the message before the widgetset * * has handled the keystroke. False otherwise * * IsSysKey : True if the Alt Key was also pressed. * * * ******************************************************************************} function LCLSendKeyDownEvent(const Target: TControl; var CharCode: Word; KeyData: PtrInt; BeforeEvent, IsSysKey: Boolean): PtrInt; var Mess: TLMKeyDown; begin FillChar(Mess, SizeOf(Mess), 0); if BeforeEvent then begin if IsSysKey then Mess.Msg := CN_SYSKEYDOWN else Mess.Msg := CN_KEYDOWN; end else begin if IsSysKey then Mess.Msg := LM_SYSKEYDOWN else Mess.Msg := LM_KEYDOWN; end; Mess.CharCode := CharCode; Mess.KeyData := KeyData; Result := DeliverMessage(Target, Mess); CharCode := Mess.CharCode; end; {****************************************************************************** * * * LCLSendKeyUpEvent * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message xx_xxKEYUP * * CharCode : This is the VK Key code. Check if this has changed after * * sending the message. * * KeyData : Bitwise or'ed combination of the KF_xxxx constants. * * BeforeEvent : True if we are sending the message before the widgetset * * has handled the keystroke. False otherwise. * * IsSysKey : True if the Alt Key was also pressed. * * * ******************************************************************************} function LCLSendKeyUpEvent(const Target: TControl; var CharCode: Word; KeyData: PtrInt; BeforeEvent, IsSysKey: Boolean): PtrInt; var Mess: TLMKeyUp; begin FillChar(Mess, SizeOf(Mess), 0); if BeforeEvent then begin if IsSysKey then Mess.Msg := CN_SYSKEYUP else Mess.Msg := CN_KEYUP; end else begin if IsSysKey then Mess.Msg := LM_SYSKEYUP else Mess.Msg := LM_KEYUP; end; Mess.CharCode := CharCode; Mess.KeyData := KeyData; Result := DeliverMessage(Target, Mess); CharCode := Mess.CharCode; end; function LCLSendCharEvent(const Target: TControl; var CharCode: Word; KeyData: PtrInt; BeforeEvent, IsSysKey, ANotifyUserInput: Boolean): PtrInt; var Mess: TLMChar; begin FillChar(Mess, SizeOf(Mess), 0); if BeforeEvent then begin if IsSysKey then Mess.Msg := CN_SYSCHAR else Mess.Msg := CN_CHAR; end else begin if IsSysKey then Mess.Msg := LM_SYSCHAR else Mess.Msg := LM_CHAR; end; Mess.CharCode := CharCode; Mess.KeyData := KeyData; Result := DeliverMessage(Target, Mess); CharCode := Mess.CharCode; if ANotifyUserInput then NotifyApplicationUserInput(Target, Mess.Msg); end; function LCLSendUTF8KeyPress(const Target: TWinControl; AUTF8Char: TUTF8Char; IsSysKey: Boolean): PtrInt; begin {if not IsControlKey then} Target.IntfUTF8KeyPress(AUTF8Char, 1, IsSysKey); Result := 1; end; {****************************************************************************** * * * LCLSendTimerMsg * * * * Returns : 0 to accept the message, non-zero to allow the message to * * continue to process. * * * * Params * * * * Target : The Control that will recieve the message LM_TIMER * * TimerID : ID of the timer. * * TimerProc : The procedure to call. * * * ******************************************************************************} function LCLSendTimerMsg(const Target: TControl; TimerID: WParam; TimerProc: LParam): PtrInt; var Mess: TLMessage; begin FillChar(Mess, SizeOf(Mess), 0); Mess.Msg := LM_TIMER; Mess.WParam := TimerID; Mess.LParam := TimerProc; Result:=DeliverMessage(Target, Mess); end; {****************************************************************************** * * * LCLSendExitMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_EXIT * * * * Not used by the LCL * * * ******************************************************************************} function LCLSendExitMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_EXIT); end; {****************************************************************************** * * * LCLSendCloseQueryMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_CLOSEQUERY * * * ******************************************************************************} function LCLSendCloseQueryMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_CLOSEQUERY); end; {****************************************************************************** * * * LCLSendDragStartMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_DRAGSTART * * * ******************************************************************************} function LCLSendDragStartMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_DRAGSTART); end; {****************************************************************************** * * * LCLSendMonthChangedMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_MONTHCHANGED * * * ******************************************************************************} function LCLSendMonthChangedMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_MONTHCHANGED); end; {****************************************************************************** * * * LCLSendYearChangedMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_YEARCHANGED * * * ******************************************************************************} function LCLSendYearChangedMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_YEARCHANGED); end; {****************************************************************************** * * * LCLSendDayChangedMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_DAYCHANGED * * * ******************************************************************************} function LCLSendDayChangedMsg(const Target: TControl): PtrInt; begin Result := SendSimpleMessage(Target, LM_DAYCHANGED); end; {****************************************************************************** * * * LCLSendMouseMultiClickMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_xBUTTONxxxCLK * * XPos, YPos : The Mouses X and Y position relative to the control. * * Button : TMouseButton (mbLeft, mbMiddle, mbRight) * * ClickCount : 2 = LM_xBUTTONDBLCLK, 3 = LM_xBUTTONTRIPLECLK, * * 4 = LM_xBUTTONQUADCLK * * ShiftState : Modifier keys that are pressed at the time of the event * * * ******************************************************************************} function LCLSendMouseMultiClickMsg(const Target: TControl; XPos, YPos: SmallInt; Button: TMouseButton; ClickCount: Byte = 2; ShiftState: TShiftState = []): PtrInt; var Mess: TLMMouse; begin FillChar(Mess, SizeOf(Mess), 0); Mess.Msg := LM_UNKNOWN; case ClickCount of 2: case Button of mbLeft : Mess.Msg := LM_LBUTTONDBLCLK; mbMiddle : Mess.Msg := LM_MBUTTONDBLCLK; mbRight : Mess.Msg := LM_RBUTTONDBLCLK; mbExtra1 : Mess.Msg := LM_XBUTTONDBLCLK; mbExtra2 : Mess.Msg := LM_XBUTTONDBLCLK; end; 3: case Button of mbLeft : Mess.Msg := LM_LBUTTONTRIPLECLK; mbMiddle : Mess.Msg := LM_MBUTTONTRIPLECLK; mbRight : Mess.Msg := LM_RBUTTONTRIPLECLK; mbExtra1 : Mess.Msg := LM_XBUTTONTRIPLECLK; mbExtra2 : Mess.Msg := LM_XBUTTONTRIPLECLK; end; 4: case Button of mbLeft : Mess.Msg := LM_LBUTTONQUADCLK; mbMiddle : Mess.Msg := LM_MBUTTONQUADCLK; mbRight : Mess.Msg := LM_RBUTTONQUADCLK; mbExtra1 : Mess.Msg := LM_XBUTTONQUADCLK; mbExtra2 : Mess.Msg := LM_XBUTTONQUADCLK; end; end; Mess.XPos := XPos; Mess.YPos := YPos; Mess.Keys := ShiftStateToKeys(ShiftState); Result := DeliverMessage(Target, Mess); end; {****************************************************************************** * * * LCLSendDrawListItemMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message LM_DRAWLISTITEM * * DrawListItemStruct : Pointer to a TDrawListItemStruct * * * ******************************************************************************} function LCLSendDrawListItemMsg(const Target: TControl; const DrawListItemStruct: PDrawListItemStruct): PtrInt; var Mess: TLMDrawListItem; begin FillChar(Mess, SizeOf(Mess), 0); Mess.Msg := LM_DRAWLISTITEM; Mess.DrawListItemStruct := DrawListItemStruct; Result := DeliverMessage(Target, Mess); end; {****************************************************************************** * * * LCLSendDropDownMsg * * * * Returns : 0 to accept the message, non-zero to reject the message * * * * Params * * * * Target : The Control that will recieve the message CN_Command * * * * Used to notify a combo that the combobox is popping down * * * ******************************************************************************} function LCLSendDropDownMsg(const Target: TControl): PtrInt; var Mess : TLMCommand; begin FillChar(Mess, SizeOf(Mess), 0); Mess.Msg := CN_Command; Mess.NotifyCode := CBN_DROPDOWN; Result := DeliverMessage(Target, Mess); end; function LCLSendCloseUpMsg(const Target: TControl): PtrInt; var Mess : TLMCommand; begin FillChar(Mess, SizeOf(Mess), 0); Mess.Msg := CN_Command; Mess.NotifyCode := CBN_CLOSEUP; Result := DeliverMessage(Target, Mess); end; // Remove these lines as you implement the function { LM_ACTIVATEITEM // NOT USED LM_FOCUS // NOT USED LM_SIZEALLOCATE // NOT USED LM_CHECKRESIZE // NOT USED LM_SHOW // NOT USED LM_MOVERESIZE // NOT USED LM_DRAW // NOT USED LM_MOUSEBTNPRESS // NOT USED LM_MOUSEBTNRELEASE // NOT USED } end.