paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-11 21:55:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

merged r50774 #8fd069e64f-r50778: QuestionDlg+DefaultQuestionDialog fixes

Browse Source 
git-svn-id: branches/fixes_1_6@50788 -
This commit is contained in:
ondrej 2015-12-14 10:33:12 +00:00
parent 2f1e28d82f
commit 033d704341
2 changed files with 48 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/dialogs.pp
View File

@ -22,7 +22,7 @@ interface
uses
// RTL + FCL + LCL
Types, typinfo, Classes, SysUtils,
Types, typinfo, Classes, SysUtils, LMessages,
LResources, LCLIntf, InterfaceBase, LCLStrConsts, LCLType, LCLProc, Forms,
Controls, Themes, GraphType, Graphics, Buttons, ButtonPanel, StdCtrls,
ExtCtrls, LCLClasses, ClipBrd,

52
lcl/include/promptdialog.inc
View File

@ -550,6 +550,9 @@ type
FBitmap: TCustomBitmap;
FBitmapX, FBitmapY: Integer;
FMsgMemo: TMemo;
protected
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure WMCloseQuery(var message: TLMessage); message LM_CLOSEQUERY;
public
TextBox: TRect;
TextStyle: TTextStyle;
@ -727,6 +730,20 @@ begin
Result := inherited ShowModal;
end;
procedure TQuestionDlg.WMCloseQuery(var message: TLMessage);
begin
if fsModal in FFormState then
begin
if CancelControl <> nil then
CancelControl.ExecuteCancelAction
else
ModalResult := mrCancel;
end else
Close;
// Always return 0, because we destroy the window ourselves
Message.Result := 0;
end;
constructor TQuestionDlg.CreateQuestionDlg(const aCaption, aMsg: string;
DlgType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint);
var
@ -742,6 +759,7 @@ begin
Position := poScreenCenter;
MessageTxt := ConvertLineEndings(aMsg);
HelpContext := HelpCtx;
KeyPreview := True;
// Initialize TextStyle
FillChar(TextStyle, SizeOf(TTextStyle), 0);
@ -799,6 +817,8 @@ begin
Caption := CurBtn.Caption;
Parent := Self;
Default := CurBtn.Default;
if Default then
ActiveControl := NewButton;
Cancel := CurBtn.Cancel;
end;
if FButtons = nil then
@ -814,6 +834,17 @@ begin
inherited Destroy;
end;
procedure TQuestionDlg.KeyDown(var Key: Word; Shift: TShiftState);
begin
if (Key = VK_ESCAPE) and (CancelControl = nil) 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;
@ -857,7 +888,7 @@ var
CurBtnValue: TModalResult;
CurBtnCaption, CurOptions: String;
HasOptions: Boolean;
IsDefault: Boolean;
IsDefault, IsCancel: Boolean;
NewButton: TDialogButton;
begin
DialogButtons := TDialogButtons.Create(TDialogButton);
@ -895,6 +926,7 @@ begin
// get options
CurOptions := '';
IsDefault := False;
IsCancel := False;
if (i <= High(Buttons)) then
begin
HasOptions := True;
@ -911,12 +943,20 @@ begin
end;
if HasOptions then
begin
if SysUtils.CompareText(CurOptions,'isdefault')<>0 then
if SysUtils.CompareText(CurOptions,'isdefault')=0 then
begin
if DialogButtons.DefaultButton <> nil then
raise Exception.Create('TQuestionDlg.CreateQuestionDlg only one button can be default');
IsDefault := True;
end else
if SysUtils.CompareText(CurOptions,'iscancel')=0 then
begin
if DialogButtons.CancelButton <> nil then
raise Exception.Create('TQuestionDlg.CreateQuestionDlg only one button can be cancel');
IsCancel := True;
end else
raise Exception.Create('TQuestionDlg.CreateQuestionDlg option expected at '
+IntToStr(i)+' but "'+CurOptions+'" found.');
if DialogButtons.DefaultButton <> nil then
raise Exception.Create('TQuestionDlg.CreateQuestionDlg only one button can be default');
IsDefault := True;
inc(i);
end;
end;
@ -947,6 +987,8 @@ begin
end;
if IsDefault then
DialogButtons.DefaultButton := NewButton;
if IsCancel then
DialogButtons.CancelButton := NewButton;
end
else
raise Exception.Create('TQuestionDlg.Create: invalid Buttons parameter '+dbgs(i));