paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 23:59:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: QuestionDlg: added option to set default button

Browse Source 
git-svn-id: trunk@28079 -
This commit is contained in:
mattias 2010-11-05 00:11:35 +00:00
parent b6a99db82e
commit e8b131614c
1 changed files with 44 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
lcl/include/promptdialog.inc
View File

@ -783,12 +783,15 @@ constructor TQuestionDlg.CreateQuestionDlg(const aCaption, aMsg: string;
var var
i: Integer; i: Integer;
CurBtnValue: TModalResult; CurBtnValue: TModalResult;
CurBtnCaption: String; CurBtnCaption, CurOptions: String;
NewButton: TBitBtn; NewButton: TBitBtn;
NewKind: TBitBtnKind; NewKind: TBitBtnKind;
NewCaption: String; NewCaption: String;
dlgId: LongInt; dlgId: LongInt;
ok: Boolean; ok: Boolean;
DefaultBtn: TBitBtn;
HasOptions: Boolean;
IsDefault: Boolean;
begin begin
inherited Create(nil); inherited Create(nil);
@ -811,11 +814,12 @@ begin
ok := false; ok := false;
try try
DefaultBtn:=nil;
i:=Low(Buttons); i:=Low(Buttons);
while i<=High(Buttons) do begin while i<=High(Buttons) do begin
if Buttons[i].VType<>vtInteger then if Buttons[i].VType<>vtInteger then
RaiseGDBException('TQuestionDlg.CreateQuestionDlg integer expected at ' raise Exception.Create('TQuestionDlg.CreateQuestionDlg integer expected at '
+IntToStr(i)+' but '+IntToStr(ord(Buttons[i].VType))+' found.'); +IntToStr(i)+' but VType='+IntToStr(ord(Buttons[i].VType))+' found.');
if Buttons[i].VType=vtInteger then begin if Buttons[i].VType=vtInteger then begin
// get TModalResult // get TModalResult
CurBtnValue:=Buttons[i].VInteger; CurBtnValue:=Buttons[i].VInteger;
@ -839,7 +843,37 @@ begin
end; end;
inc(i); inc(i);
end; end;
//DebugLn('TQuestionDlg.CreateQuestionDlg CurBtnCaption=',CurBtnCaption);
// get options
CurOptions:='';
IsDefault:=false;
if (i<=High(Buttons)) then begin
//debugln('TQuestionDlg.CreateQuestionDlg i=',dbgs(i),' Buttons[i].VType=',dbgs(Buttons[i].VType),' vtString=',dbgs(vtString));
HasOptions:=true;
case Buttons[i].VType of
vtString: CurOptions:=Buttons[i].VString^;
vtAnsiString: CurOptions:=AnsiString(Buttons[i].VAnsiString);
vtChar: CurOptions:=Buttons[i].VChar;
vtPChar: CurOptions:=Buttons[i].VPChar;
vtPWideChar: CurOptions:=Buttons[i].VPWideChar;
vtWideChar: CurOptions:=Buttons[i].VWideChar;
vtWidestring: CurOptions:=WideString(Buttons[i].VWideString);
else
HasOptions:=false;
end;
if HasOptions then
begin
if SysUtils.CompareText(CurOptions,'isdefault')<>0 then
raise Exception.Create('TQuestionDlg.CreateQuestionDlg option expected at '
+IntToStr(i)+' but "'+CurOptions+'" found.');
if DefaultBtn<>nil then
raise Exception.Create('TQuestionDlg.CreateQuestionDlg only one button can be default');
IsDefault:=true;
inc(i);
end;
end;
//DebugLn('TQuestionDlg.CreateQuestionDlg CurBtnCaption=',CurBtnCaption,' CurOptions="',CurOptions,'"');
if CurBtnCaption='' then begin if CurBtnCaption='' then begin
// find default caption // find default caption
case CurBtnValue of case CurBtnValue of
@ -886,8 +920,11 @@ begin
Kind:=NewKind; Kind:=NewKind;
Caption:=curBtnCaption; Caption:=curBtnCaption;
Parent:=Self; Parent:=Self;
Default:=IsDefault;
OnKeyDown:=@ButtonKeyDown; OnKeyDown:=@ButtonKeyDown;
end; end;
if IsDefault then
DefaultBtn:=NewButton;
FButtons.Add(NewButton); FButtons.Add(NewButton);
end else end else
raise Exception.Create( raise Exception.Create(
@ -917,8 +954,10 @@ begin
Caption:=NewCaption; Caption:=NewCaption;
// find default and cancel button // find default and cancel button
DefaultControl:=FindButton([mrYes,mrOk,mrYesToAll,mrAll,mrRetry,mrCancel, if DefaultBtn=nil then
DefaultBtn:=FindButton([mrYes,mrOk,mrYesToAll,mrAll,mrRetry,mrCancel,
mrNo,mrNoToAll,mrAbort,mrIgnore]); mrNo,mrNoToAll,mrAbort,mrIgnore]);
DefaultControl:=DefaultBtn;
CancelControl:=FindButton([mrAbort,mrCancel,mrNo,mrIgnore,mrNoToAll,mrYes, CancelControl:=FindButton([mrAbort,mrCancel,mrNo,mrIgnore,mrNoToAll,mrYes,
mrOk,mrRetry,mrAll,mrYesToAll]) mrOk,mrRetry,mrAll,mrYesToAll])
end; end;