paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-07 09:00:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: close DefaultQuestionDialog with ESC key

Browse Source 
git-svn-id: trunk@50774 -
This commit is contained in:
ondrej 2015-12-13 18:01:21 +00:00
parent 36c58a9b68
commit 8fd069e64f
1 changed files with 14 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
lcl/include/promptdialog.inc
View File

@ -550,6 +550,8 @@ type
FBitmap: TCustomBitmap;
FBitmapX, FBitmapY: Integer;
FMsgMemo: TMemo;
protected
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
public
TextBox: TRect;
TextStyle: TTextStyle;
@ -742,6 +744,7 @@ begin
Position := poScreenCenter;
MessageTxt := ConvertLineEndings(aMsg);
HelpContext := HelpCtx;
KeyPreview := True;
// Initialize TextStyle
FillChar(TextStyle, SizeOf(TTextStyle), 0);
@ -814,6 +817,17 @@ begin
inherited Destroy;
end;
procedure TQuestionDlg.KeyDown(var Key: Word; Shift: TShiftState);
begin
if Key = VK_ESCAPE then
begin
ModalResult := mrCancel;
Key := 0;
end;
inherited KeyDown(Key, Shift);
end;
function DefaultQuestionDialog(const aCaption, aMsg: string; DlgType: LongInt;
Buttons: TDialogButtons; HelpCtx: Longint): LongInt;