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

lcl:

Browse Source 
- cleanup: remove TQuestionDlg.ButtonKeyDown, simplify PromptDialogKeyDown - LCL do this already perfect itself
  - formatting

git-svn-id: trunk@28443 -
This commit is contained in:
paul 2010-11-24 07:56:46 +00:00
parent dd2575c2e0
commit 6ded956938
1 changed files with 114 additions and 192 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

306
lcl/include/promptdialog.inc
View File

@ -20,11 +20,9 @@ type
{ TPromptDialog } { TPromptDialog }
TPromptDialog = class(TForm) TPromptDialog = class(TForm)
procedure PromptDialogKeyDown(Sender: TObject; var Key: Word; procedure PromptDialogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
Shift: TShiftState);
private private
function CreateButtons(AVerticalLayout: Boolean; ASpacing: Integer function CreateButtons(AVerticalLayout: Boolean; ASpacing: Integer): Integer;
): Integer;
public public
IsSmallDevice: Boolean; IsSmallDevice: Boolean;
@ -46,61 +44,10 @@ type
destructor Destroy; override; destructor Destroy; override;
end; end;
procedure TPromptDialog.PromptDialogKeyDown(Sender: TObject; var Key: Word; procedure TPromptDialog.PromptDialogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
Shift: TShiftState);
var
OldFocusControl, NewFocusControl: TWinControl;
i: integer;
begin begin
if (Key=VK_Escape) then if (Key = VK_Escape) then
ModalResult := -1; ModalResult := -1;
if (Key=VK_LEFT) or (Key=VK_RIGHT) then begin
// focus the next button to the left or right
// search old focused button
OldFocusControl:=FindOwnerControl(LCLIntf.GetFocus);
if (OldFocusControl=nil) or (GetParentForm(OldFocusControl)<>Self)
or (not (OldFocusControl is TCustomButton)) then
begin
OldFocusControl:=nil;
for i:=0 to ComponentCount-1 do
if (Components[i] is TCustomButton)
and (TCustomButton(Components[i]).Default) then
begin
OldFocusControl:=TCustomButton(Components[i]);
break;
end;
end;
// find next focused button
if (OldFocusControl<>nil) then begin
i:=ComponentCount-1;
while i>=0 do begin
if Components[i]=OldFocusControl then
break
else
dec(i);
end;
if i<0 then exit;
NewFocusControl:=nil;
repeat
if Key=VK_LEFT then begin
dec(i);
if i<0 then i:=ComponentCount-1;
end else begin
inc(i);
if i>=ComponentCount then i:=0;
end;
if Components[i] is TCustomButton then begin
NewFocusControl:=TWinControl(Components[i]);
break;
end;
until false;
ActiveControl:=NewFocusControl;
Key:=VK_UNKNOWN;
end;
end;
end; end;
function TPromptDialog.CreateButtons(AVerticalLayout: Boolean; function TPromptDialog.CreateButtons(AVerticalLayout: Boolean;
@ -115,7 +62,7 @@ begin
ButtonIndex := -1; ButtonIndex := -1;
for curBtn := 0 to NumButtons - 1 do for curBtn := 0 to NumButtons - 1 do
begin begin
If (Buttons[curBtn] >= Low(DialogButtonKind)) and if (Buttons[curBtn] >= Low(DialogButtonKind)) and
(Buttons[curBtn] <= High(DialogButtonKind)) (Buttons[curBtn] <= High(DialogButtonKind))
then then
begin begin
@ -177,8 +124,8 @@ begin
IsSmallDevice := (Screen.Width <= 300); IsSmallDevice := (Screen.Width <= 300);
AutoScroll:=false; AutoScroll := False;
OnKeyDown :=@PromptDialogKeyDown; OnKeyDown := @PromptDialogKeyDown;
//debugln('TPromptDialog.CreateMessageDialog A ButtonCount=',dbgs(ButtonCount)); //debugln('TPromptDialog.CreateMessageDialog A ButtonCount=',dbgs(ButtonCount));
ControlStyle:= ControlStyle-[csSetCaption]; ControlStyle:= ControlStyle-[csSetCaption];
@ -214,12 +161,10 @@ begin
NumButtons := ButtonCount; NumButtons := ButtonCount;
Buttons := TheButtons; Buttons := TheButtons;
if (DefaultIndex >= ButtonCount) or if (DefaultIndex >= ButtonCount) or (DefaultIndex < 0) then
(DefaultIndex < 0)
then
TheDefaultIndex := 0 TheDefaultIndex := 0
else else
theDefaultIndex := DefaultIndex; TheDefaultIndex := DefaultIndex;
// Assures a minimum text size // Assures a minimum text size
if MSG = '' then MSG := ' '; if MSG = '' then MSG := ' ';
@ -237,9 +182,9 @@ begin
end; end;
if IsSmallDevice then if IsSmallDevice then
LayoutDialogSmallDevice() LayoutDialogSmallDevice
else else
LayoutDialog(); LayoutDialog;
end; end;
destructor TPromptDialog.Destroy; destructor TPromptDialog.Destroy;
@ -249,7 +194,7 @@ begin
end; end;
procedure TPromptDialog.LayoutDialog; procedure TPromptDialog.LayoutDialog;
Const const
cBtnCalcWidth = 50; cBtnCalcWidth = 50;
cBtnCalcHeight = 13; cBtnCalcHeight = 13;
cBtnCalcSpace = 4; cBtnCalcSpace = 4;
@ -555,34 +500,28 @@ begin
end; end;
end; end;
function CreateMessageDialog(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): TForm;
function CreateMessageDialog(const Msg: string; DlgType: TMsgDlgType; var
Buttons: TMsgDlgButtons): TForm; PDlg: TPromptDialog;
var PDlg: TPromptDialog; aCaption: String;
aCaption: String; Btns: PLongInt;
Btns: PLongInt; CancelValue, DefaultIndex, ButtonCount: Longint;
CancelValue, DefaultIndex, ButtonCount: Longint;
begin begin
if DlgType <> mtCustom then if DlgType <> mtCustom then
aCaption := MsgDlgCaptions[DlgType] aCaption := MsgDlgCaptions[DlgType]
else else
aCaption := Application.Title; aCaption := Application.Title;
Btns := GetPromptUserButtons(Buttons, CancelValue, DefaultIndex, ButtonCount, Btns := GetPromptUserButtons(Buttons, CancelValue, DefaultIndex, ButtonCount, False, mbOk);
False, mbOk);
PDlg := TPromptDialog.CreateMessageDialog(aCaption, Msg, DialogIds[DlgType], Btns, ButtonCount, DefaultIndex); PDlg := TPromptDialog.CreateMessageDialog(aCaption, Msg, DialogIds[DlgType], Btns, ButtonCount, DefaultIndex);
Result := TForm(PDlg); Result := TForm(PDlg);
ReallocMem(Btns, 0); ReallocMem(Btns, 0);
end; end;
type type
{ TQuestionDlg } { TQuestionDlg }
TQuestionDlg = class(TForm) TQuestionDlg = class(TForm)
procedure ButtonKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private private
FButtons: TList; FButtons: TList;
FBitmap: TCustomBitmap; FBitmap: TCustomBitmap;
@ -743,40 +682,22 @@ var
CurValue: TModalResult; CurValue: TModalResult;
j: Integer; j: Integer;
begin begin
if FButtons=nil then begin if FButtons = nil then
Result:=nil; begin
exit; Result := nil;
Exit;
end; end;
for i:=Low(Order) to High(Order) do begin for i := Low(Order) to High(Order) do
CurValue:=Order[i]; begin
for j:=0 to FButtons.Count-1 do begin CurValue := Order[i];
Result:=TBitBtn(FButtons[j]); for j := 0 to FButtons.Count - 1 do
if Result.ModalResult=CurValue then exit; begin
Result := TBitBtn(FButtons[j]);
if Result.ModalResult = CurValue then
Exit;
end; end;
end; end;
Result:=nil; Result := nil;
end;
procedure TQuestionDlg.ButtonKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
Handled: Boolean;
begin
if Shift<>[] then exit;
Handled:=true;
if (Key=VK_ESCAPE) and (CancelControl<>nil) then
CancelControl.ExecuteCancelAction
else if (Key in [VK_RETURN,VK_SPACE]) and (Sender is TBitBtn) then
ModalResult:=TBitBtn(Sender).ModalResult
else if (Key=VK_RETURN) and (DefaultControl<>nil) then
DefaultControl.ExecuteDefaultAction
else if (Key=VK_LEFT) then
TWinControl(Sender).PerformTab(false)
else if (Key=VK_RIGHT) then
TWinControl(Sender).PerformTab(true)
else
Handled:=false;
if Handled then Key:=VK_UNKNOWN;
end; end;
constructor TQuestionDlg.CreateQuestionDlg(const aCaption, aMsg: string; constructor TQuestionDlg.CreateQuestionDlg(const aCaption, aMsg: string;
@ -800,7 +721,6 @@ begin
Position := poScreenCenter; Position := poScreenCenter;
MessageTxt := ConvertLineEndings(aMsg); MessageTxt := ConvertLineEndings(aMsg);
HelpContext := HelpCtx; HelpContext := HelpCtx;
OnKeyDown := @ButtonKeyDown;
// Initialize TextStyle // Initialize TextStyle
FillChar(TextStyle, SizeOf(TTextStyle), 0); FillChar(TextStyle, SizeOf(TTextStyle), 0);
@ -817,28 +737,31 @@ begin
try try
DefaultBtn:=nil; DefaultBtn:=nil;
i:=Low(Buttons); i:=Low(Buttons);
while i<=High(Buttons) do begin while i <= High(Buttons) do
if Buttons[i].VType<>vtInteger then begin
if Buttons[i].VType <> vtInteger then
raise Exception.Create('TQuestionDlg.CreateQuestionDlg integer expected at ' raise Exception.Create('TQuestionDlg.CreateQuestionDlg integer expected at '
+IntToStr(i)+' but VType='+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;
//debugln('TQuestionDlg.CreateQuestionDlg i=',dbgs(i),' CurBtnValue=',dbgs(CurBtnValue)); //debugln('TQuestionDlg.CreateQuestionDlg i=',dbgs(i),' CurBtnValue=',dbgs(CurBtnValue));
inc(i); inc(i);
// get button caption // get button caption
CurBtnCaption:=''; CurBtnCaption := '';
if (i<=High(Buttons)) then begin if (i <= High(Buttons)) then
begin
//debugln('TQuestionDlg.CreateQuestionDlg i=',dbgs(i),' Buttons[i].VType=',dbgs(Buttons[i].VType),' vtString=',dbgs(vtString)); //debugln('TQuestionDlg.CreateQuestionDlg i=',dbgs(i),' Buttons[i].VType=',dbgs(Buttons[i].VType),' vtString=',dbgs(vtString));
case Buttons[i].VType of case Buttons[i].VType of
vtString: CurBtnCaption:=Buttons[i].VString^; vtString: CurBtnCaption := Buttons[i].VString^;
vtAnsiString: CurBtnCaption:=AnsiString(Buttons[i].VAnsiString); vtAnsiString: CurBtnCaption := AnsiString(Buttons[i].VAnsiString);
vtChar: CurBtnCaption:=Buttons[i].VChar; vtChar: CurBtnCaption := Buttons[i].VChar;
vtPChar: CurBtnCaption:=Buttons[i].VPChar; vtPChar: CurBtnCaption := Buttons[i].VPChar;
vtPWideChar: CurBtnCaption:=Buttons[i].VPWideChar; vtPWideChar: CurBtnCaption := Buttons[i].VPWideChar;
vtWideChar: CurBtnCaption:=Buttons[i].VWideChar; vtWideChar: CurBtnCaption := Buttons[i].VWideChar;
vtWidestring: CurBtnCaption:=WideString(Buttons[i].VWideString); vtWidestring: CurBtnCaption := WideString(Buttons[i].VWideString);
else else
dec(i); // prevent the following inc(i) dec(i); // prevent the following inc(i)
end; end;
@ -846,21 +769,22 @@ begin
end; end;
// get options // get options
CurOptions:=''; CurOptions := '';
IsDefault:=false; IsDefault := False;
if (i<=High(Buttons)) then begin if (i<=High(Buttons)) then
begin
//debugln('TQuestionDlg.CreateQuestionDlg i=',dbgs(i),' Buttons[i].VType=',dbgs(Buttons[i].VType),' vtString=',dbgs(vtString)); //debugln('TQuestionDlg.CreateQuestionDlg i=',dbgs(i),' Buttons[i].VType=',dbgs(Buttons[i].VType),' vtString=',dbgs(vtString));
HasOptions:=true; HasOptions := True;
case Buttons[i].VType of case Buttons[i].VType of
vtString: CurOptions:=Buttons[i].VString^; vtString: CurOptions := Buttons[i].VString^;
vtAnsiString: CurOptions:=AnsiString(Buttons[i].VAnsiString); vtAnsiString: CurOptions := AnsiString(Buttons[i].VAnsiString);
vtChar: CurOptions:=Buttons[i].VChar; vtChar: CurOptions := Buttons[i].VChar;
vtPChar: CurOptions:=Buttons[i].VPChar; vtPChar: CurOptions := Buttons[i].VPChar;
vtPWideChar: CurOptions:=Buttons[i].VPWideChar; vtPWideChar: CurOptions := Buttons[i].VPWideChar;
vtWideChar: CurOptions:=Buttons[i].VWideChar; vtWideChar: CurOptions := Buttons[i].VWideChar;
vtWidestring: CurOptions:=WideString(Buttons[i].VWideString); vtWidestring: CurOptions := WideString(Buttons[i].VWideString);
else else
HasOptions:=false; HasOptions := False;
end; end;
if HasOptions then if HasOptions then
begin begin
@ -869,69 +793,70 @@ begin
+IntToStr(i)+' but "'+CurOptions+'" found.'); +IntToStr(i)+' but "'+CurOptions+'" found.');
if DefaultBtn<>nil then if DefaultBtn<>nil then
raise Exception.Create('TQuestionDlg.CreateQuestionDlg only one button can be default'); raise Exception.Create('TQuestionDlg.CreateQuestionDlg only one button can be default');
IsDefault:=true; IsDefault := True;
inc(i); inc(i);
end; end;
end; end;
//DebugLn('TQuestionDlg.CreateQuestionDlg CurBtnCaption=',CurBtnCaption,' CurOptions="',CurOptions,'"'); //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
mrOk : CurBtnCaption:=rsmbOk; mrOk : CurBtnCaption := rsmbOk;
mrCancel : CurBtnCaption:=rsmbCancel; mrCancel : CurBtnCaption := rsmbCancel;
mrYes : CurBtnCaption:=rsmbYes; mrYes : CurBtnCaption := rsmbYes;
mrNo : CurBtnCaption:=rsmbNo; mrNo : CurBtnCaption := rsmbNo;
mrAbort : CurBtnCaption:=rsmbAbort; mrAbort : CurBtnCaption := rsmbAbort;
mrRetry : CurBtnCaption:=rsmbRetry; mrRetry : CurBtnCaption := rsmbRetry;
mrIgnore : CurBtnCaption:=rsmbIgnore; mrIgnore : CurBtnCaption := rsmbIgnore;
mrAll : CurBtnCaption:=rsmbAll; mrAll : CurBtnCaption := rsmbAll;
mrYesToAll : CurBtnCaption:=rsmbYesToAll; mrYesToAll : CurBtnCaption := rsmbYesToAll;
mrNoToAll : CurBtnCaption:=rsmbNoToAll; mrNoToAll : CurBtnCaption := rsmbNoToAll;
end; end;
end; end;
if CurBtnCaption='' then begin if CurBtnCaption = '' then
raise Exception.Create( raise Exception.Create('TQuestionDlg.Create: missing Button caption '+dbgs(i-1));
'TQuestionDlg.Create: missing Button caption '+dbgs(i-1));
end;
// get button kind // get button kind
case curBtnValue of case curBtnValue of
mrOk: NewKind:=bkOK; mrOk: NewKind := bkOK;
mrCancel: NewKind:=bkCancel; mrCancel: NewKind := bkCancel;
mrYes: NewKind:=bkYes; mrYes: NewKind := bkYes;
mrNo: NewKind:=bkNo; mrNo: NewKind := bkNo;
mrAbort: NewKind:=bkAbort; mrAbort: NewKind := bkAbort;
mrRetry: NewKind:=bkRetry; mrRetry: NewKind := bkRetry;
mrIgnore: NewKind:=bkIgnore; mrIgnore: NewKind := bkIgnore;
mrAll: NewKind:=bkAll; mrAll: NewKind := bkAll;
mrNoToAll: NewKind:=bkNoToAll; mrNoToAll: NewKind := bkNoToAll;
mrYesToAll: NewKind:=bkYesToAll; mrYesToAll: NewKind := bkYesToAll;
else NewKind:=bkCustom; else
NewKind := bkCustom;
end; end;
// add button // add button
if FButtons=nil then FButtons:=TList.Create; if FButtons = nil then
NewButton:=TBitBtn.Create(Self); FButtons := TList.Create;
with NewButton do begin NewButton := TBitBtn.Create(Self);
AutoSize:=false; with NewButton do
Anchors:=[akLeft, akBottom]; begin
ModalResult:=curBtnValue; AutoSize := False;
Layout:=blGlyphLeft; Anchors := [akLeft, akBottom];
Kind:=NewKind; ModalResult := curBtnValue;
Caption:=curBtnCaption; Layout := blGlyphLeft;
Parent:=Self; Kind := NewKind;
Default:=IsDefault; Caption := curBtnCaption;
OnKeyDown:=@ButtonKeyDown; Parent := Self;
Default := IsDefault;
end; end;
if IsDefault then if IsDefault then
DefaultBtn:=NewButton; DefaultBtn := NewButton;
FButtons.Add(NewButton); FButtons.Add(NewButton);
end else end
raise Exception.Create( else
'TQuestionDlg.Create: invalid Buttons parameter '+dbgs(i)); raise Exception.Create('TQuestionDlg.Create: invalid Buttons parameter '+dbgs(i));
end; end;
ok:=true; ok := True;
finally finally
if not Ok then if not Ok then
FreeAndNil(FButtons); FreeAndNil(FButtons);
@ -955,12 +880,10 @@ begin
Caption:=NewCaption; Caption:=NewCaption;
// find default and cancel button // find default and cancel button
if DefaultBtn=nil then if DefaultBtn = nil then
DefaultBtn:=FindButton([mrYes,mrOk,mrYesToAll,mrAll,mrRetry,mrCancel, DefaultBtn := FindButton([mrYes, mrOk, mrYesToAll, mrAll, mrRetry, mrCancel, mrNo, mrNoToAll, mrAbort, mrIgnore]);
mrNo,mrNoToAll,mrAbort,mrIgnore]); DefaultControl := DefaultBtn;
DefaultControl:=DefaultBtn; CancelControl := FindButton([mrAbort, mrCancel, mrNo, mrIgnore, mrNoToAll, mrYes, mrOk, mrRetry, mrAll, mrYesToAll])
CancelControl:=FindButton([mrAbort,mrCancel,mrNo,mrIgnore,mrNoToAll,mrYes,
mrOk,mrRetry,mrAll,mrYesToAll])
end; end;
destructor TQuestionDlg.Destroy; destructor TQuestionDlg.Destroy;
@ -993,10 +916,9 @@ function QuestionDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
var var
QuestionDialog: TQuestionDlg; QuestionDialog: TQuestionDlg;
begin begin
QuestionDialog:=TQuestionDlg.CreateQuestionDlg(aCaption,aMsg,DlgType,Buttons, QuestionDialog := TQuestionDlg.CreateQuestionDlg(aCaption, aMsg, DlgType, Buttons, HelpCtx);
HelpCtx);
try try
Result:=QuestionDialog.ShowModal; Result := QuestionDialog.ShowModal;
finally finally
QuestionDialog.Free; QuestionDialog.Free;
end; end;
@ -1006,7 +928,7 @@ function QuestionDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
Buttons: array of const; const HelpKeyword: string): TModalResult; Buttons: array of const; const HelpKeyword: string): TModalResult;
begin begin
// TODO: handle HelpKeyword // TODO: handle HelpKeyword
Result:=QuestionDlg(aCaption,aMsg,DlgType,Buttons,0); Result := QuestionDlg(aCaption, aMsg, DlgType, Buttons, 0);
end; end;
// included by dialogs.pp // included by dialogs.pp