mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-02 03:52:42 +02:00
Refactoring TTaskDialog:
- first attempt to get Win32 WS code working (currently littered with writeln() statements, so crashes if no console!) - fix ModalResult in OnButtonClicked for emulated dialog.
This commit is contained in:
Bart
parent
4440804744
commit
92f83f8b59
@ -639,7 +639,6 @@ type
|
||||
var ACanClose: Boolean);
|
||||
procedure SetButtons(const Value: TTaskDialogButtons);
|
||||
procedure SetRadioButtons(const Value: TTaskDialogButtons);
|
||||
function ButtonIDToModalResult(const AButtonID: Integer): TModalResult;
|
||||
protected
|
||||
class procedure WSRegisterClass; override;
|
||||
function DoExecute(ParentWnd: HWND): Boolean; dynamic;
|
||||
@ -649,6 +648,7 @@ type
|
||||
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
function ButtonIDToModalResult(const AButtonID: Integer): TModalResult;
|
||||
function Execute: Boolean; overload; dynamic;
|
||||
function Execute(ParentWnd: HWND): Boolean; overload; dynamic;
|
||||
property Button: TTaskDialogButtonItem read FButton write FButton;
|
||||
|
||||
@ -242,6 +242,11 @@ begin
|
||||
debugln(['New: FModalResult=',FModalResult]);
|
||||
debugln(['New: VerifyChecked=',tfVerificationFlagChecked in FFlags]);
|
||||
debugln(['New: ARadioRes=',ARadioRes]);
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
FillChar(TaskDlg, SizeOf(LCLTaskDialog.TTaskDialog), 0);
|
||||
|
||||
if RadioButtons.DefaultButton<> nil then
|
||||
|
||||
@ -180,6 +180,9 @@ var
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
TaskDlgEmulation;
|
||||
|
||||
function SaveApplicationState: TApplicationState;
|
||||
begin
|
||||
Result.ActiveWindow := Windows.GetActiveWindow;
|
||||
@ -1615,15 +1618,262 @@ var
|
||||
begin
|
||||
Result := 0;
|
||||
for aFlag := Low(TTaskDialogFlags) to High(TTaskDialogFlags) do
|
||||
if (aFlag in aFlags) then Result := Result or FlagValues[aFlag];
|
||||
if (aFlag in aFlags) then
|
||||
Result := Result or FlagValues[aFlag];
|
||||
end;
|
||||
|
||||
function TaskDialogCommonButtonsToInteger(const Buttons: TTaskDialogCommonButtons): Integer;
|
||||
const
|
||||
CommonButtonValues: Array[TTaskDialogCommonButton] of Integer = (
|
||||
TDCBF_OK_BUTTON,// tcbOk
|
||||
TDCBF_YES_BUTTON, //tcbYes
|
||||
TDCBF_NO_BUTTON, //tcbNo
|
||||
TDCBF_CANCEL_BUTTON, //tcbCancel
|
||||
TDCBF_RETRY_BUTTON, //tcbRetry
|
||||
TDCBF_CLOSE_BUTTON //tcbClose
|
||||
);
|
||||
var
|
||||
B: TTaskDialogCommonButton;
|
||||
begin
|
||||
Result := 0;
|
||||
for B in TTaskDialogCommonButton do
|
||||
begin
|
||||
if B in Buttons then
|
||||
Result := Result or CommonButtonValues[B];
|
||||
end;
|
||||
end;
|
||||
|
||||
function TaskDialogCallbackProc(hwnd: HWND; uNotification: UINT;
|
||||
wParam: WPARAM; {%H-}lParam: LPARAM; dwRefData: Long_Ptr): HRESULT; stdcall;
|
||||
var Dlg: TTaskDialog absolute dwRefData;
|
||||
CanClose: Boolean;
|
||||
begin
|
||||
writeln('TaskDialogCallbackProc: uNotification=',uNotification);
|
||||
//ptd^.Dialog.Wnd := hwnd;
|
||||
Result := S_OK;
|
||||
|
||||
if not (Dlg is TCustomTaskDialog) then
|
||||
begin
|
||||
writeln('TaskDialogCallbackProc: Dlg is NOT a TCustomTaskDialog');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
case uNotification of
|
||||
TDN_BUTTON_CLICKED:
|
||||
//if Assigned(ptd^.Dialog.OnButtonClicked) then
|
||||
if Assigned(Dlg.OnButtonClicked) then
|
||||
begin
|
||||
CanClose := True;
|
||||
//ptd^.Dialog.OnButtonClicked(ptd,wParam,CanClose);
|
||||
Dlg.OnButtonClicked(Dlg, Dlg.ButtonIDToModalResult(wParam), CanClose);
|
||||
if not CanClose then
|
||||
Result := S_FALSE;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
type
|
||||
TWideStringArray = array of WideString;
|
||||
TButtonArray = array of TTASKDIALOG_BUTTON;
|
||||
|
||||
procedure PrepareTaskDialogConfig(const ADlg: TTaskDialog; AParent: HWND; out Config: TTaskDialogConfig;
|
||||
out RU: TWideStringArray; out But: TButtonArray);
|
||||
var
|
||||
WindowTitle, MainInstruction, Content, VerificationText,
|
||||
ExpandedInformation, ExpandedControlText, CollapsedControlText,
|
||||
Footer: WideString;
|
||||
DefRB, DefBtn, RUCount: Integer;
|
||||
CommonButtons: TTaskDialogCommonButtons;
|
||||
B: TTaskDialogBaseButtonItem;
|
||||
List: TStringList;
|
||||
//RU: Array of WideString;
|
||||
//But: array of TTASKDIALOG_BUTTON;
|
||||
Flags: TTaskDialogFlags;
|
||||
const
|
||||
TD_BTNMOD: array[TTaskDialogCommonButton] of Integer = (
|
||||
mrOk, mrYes, mrNo, mrCancel, mrRetry, mrAbort);
|
||||
TD_ICONS: array[TLCLTaskDialogIcon] of integer = (
|
||||
0, 84, 99, 98, 81, 0, 78);
|
||||
TD_FOOTERICONS: array[TLCLTaskDialogFooterIcon] of integer = (
|
||||
0, 84, 99, 98, 65533, 65532);
|
||||
|
||||
procedure AddRU(List: TStringList; var n: longword{integer}; firstID: integer);
|
||||
var
|
||||
P: PChar;
|
||||
i: Integer;
|
||||
begin
|
||||
if (List.Count = 0) then
|
||||
Exit;
|
||||
//P := @Text[1]; // '\n' handling in GetNextStringLineToWS(P) will change P^
|
||||
//while P<>nil do
|
||||
for i := 0 to List.Count - 1 do
|
||||
begin
|
||||
if length(RU)<=RUCount then
|
||||
begin
|
||||
SetLength(RU,RUCount+16);
|
||||
SetLength(But,RUCount+16);
|
||||
end;
|
||||
RU[RUCount] := Utf8ToUtf16(List[i]);//GetNextStringLineToWS(P);
|
||||
But[RUCount].nButtonID := n+firstID;
|
||||
But[RUCount].pszButtonText := PWideChar(RU[RUCount]);
|
||||
inc(n);
|
||||
inc(RUCount);
|
||||
end;
|
||||
end;
|
||||
|
||||
function DialogBaseUnits: Integer;
|
||||
//https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-getdialogbaseunits
|
||||
type
|
||||
TLongRec = record L, H: Word; end;
|
||||
begin
|
||||
Result := TLongRec(GetDialogBaseUnits).L;
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
WindowTitle := Utf8ToUtf16(ADlg.Caption);
|
||||
if (WindowTitle = '') then
|
||||
begin
|
||||
if (Application.MainForm = nil) then
|
||||
WindowTitle := Utf8ToUtf16(Application.Title)
|
||||
else
|
||||
WindowTitle := Utf8ToUtf16(Application.MainForm.Caption);
|
||||
end;
|
||||
MainInstruction := Utf8ToUtf16(ADlg.Title);
|
||||
if (MainInstruction = '') then
|
||||
MainInstruction := Utf8ToUtf16(IconMessage(TF_DIALOGICON(ADlg.MainIcon)));
|
||||
Content := Utf8ToUtf16(ADlg.Text);
|
||||
CollapsedControlText := Utf8ToUtf16(ADlg.ExpandButtonCaption);
|
||||
VerificationText := Utf8ToUtf16(ADlg.VerificationText);
|
||||
if (aParent = 0) then
|
||||
begin
|
||||
if Assigned(Screen.ActiveCustomForm) then
|
||||
aParent := Screen.ActiveCustomForm.Handle
|
||||
else
|
||||
aParent := 0;
|
||||
end;
|
||||
ExpandedInformation := Utf8ToUtf16(ADlg.ExpandedText);
|
||||
ExpandedControlText := ''; //currently no matching field in TTaskDialog??
|
||||
CollapsedControlText := Utf8ToUtf16(ADlg.ExpandButtonCaption);
|
||||
Footer := Utf8ToUtf16(ADlg.FooterText);
|
||||
|
||||
if ADlg.RadioButtons.DefaultButton<> nil then
|
||||
DefRB := ADlg.RadioButtons.DefaultButton.Index
|
||||
else
|
||||
DefRB := 0;
|
||||
if ADlg.Buttons.DefaultButton<>nil then
|
||||
DefBtn := ADlg.Buttons.DefaultButton.ModalResult
|
||||
else
|
||||
DefBtn := TD_BTNMOD[ADlg.DefaultButton];
|
||||
|
||||
|
||||
if (ADlg.CommonButtons = []) and (ADlg.Buttons.Count = 0) then
|
||||
begin
|
||||
CommonButtons := [tcbOk];
|
||||
if (DefBtn = 0) then
|
||||
DefBtn := mrOK;
|
||||
end;
|
||||
|
||||
writeln('PrepareTaskDialogConfig A');
|
||||
|
||||
Config := Default(TTaskDialogConfig);
|
||||
Config.cbSize := SizeOf(TTaskDialogConfig);
|
||||
Config.hwndParent := aParent;
|
||||
Config.pszWindowTitle := PWideChar(WindowTitle);
|
||||
Config.pszMainInstruction := PWideChar(MainInstruction);
|
||||
Config.pszContent := PWideChar(Content);
|
||||
Config.pszVerificationText := PWideChar(VerificationText);
|
||||
Config.pszExpandedInformation := PWideChar(ExpandedInformation);
|
||||
Config.pszCollapsedControlText := PWideChar(CollapsedControlText);
|
||||
Config.pszExpandedControlText := PWideChar(ExpandedControlText);
|
||||
Config.pszFooter := PWideChar(Footer);
|
||||
Config.nDefaultButton := DefBtn;
|
||||
|
||||
writeln('PrepareTaskDialogConfig B');
|
||||
|
||||
|
||||
RUCount := 0;
|
||||
List := TStringList.Create;
|
||||
try
|
||||
for B in ADlg.Buttons do
|
||||
List.Add(B.Caption);
|
||||
AddRU(List,Config.cButtons,TaskDialogFirstButtonIndex);
|
||||
writeln('PrepareTaskDialogConfig C');
|
||||
|
||||
List.Clear;
|
||||
for B in ADlg.RadioButtons do
|
||||
List.Add(B.Caption);
|
||||
AddRU(List,Config.cRadioButtons,TaskDialogFirstRadioButtonIndex);
|
||||
writeln('PrepareTaskDialogConfig D');
|
||||
|
||||
finally
|
||||
List.Free;
|
||||
end;
|
||||
|
||||
writeln('PrepareTaskDialogConfig E');
|
||||
|
||||
if (Config.cButtons > 0) then
|
||||
Config.pButtons := @But[0];
|
||||
writeln('PrepareTaskDialogConfig F: Config.cButtons=',Config.cButtons,', Config.pButtons=',PtrInt(Config.pButtons));
|
||||
|
||||
if (Config.cRadioButtons > 0) then
|
||||
Config.pRadioButtons := @But[Config.cButtons {Config.cRadioButtons}];
|
||||
writeln('PrepareTaskDialogConfig G',', Config.pRadioButtons=',PtrInt(Config.pRadioButtons));
|
||||
|
||||
|
||||
Config.dwCommonButtons := TaskDialogCommonButtonsToInteger(ADlg.CommonButtons);
|
||||
writeln('PrepareTaskDialogConfig H');
|
||||
|
||||
|
||||
Flags := ADlg.Flags;
|
||||
writeln('PrepareTaskDialogConfig I');
|
||||
if (VerificationText <> '') and (tfVerificationFlagChecked in ADlg.Flags) then
|
||||
Include(Flags,tfVerificationFlagChecked)
|
||||
else
|
||||
Exclude(Flags,tfVerificationFlagChecked);
|
||||
writeln('PrepareTaskDialogConfig J');
|
||||
if (Config.cButtons=0) and (CommonButtons=[tcbOk]) then
|
||||
Include(Flags,tfAllowDialogCancellation); // just OK -> Esc/Alt+F4 close
|
||||
writeln('PrepareTaskDialogConfig K');
|
||||
|
||||
|
||||
Config.dwFlags := TaskDialogFlagsToInteger(Flags);
|
||||
writeln('PrepareTaskDialogConfig L');
|
||||
|
||||
|
||||
Config.hMainIcon := TD_ICONS[TF_DIALOGICON(ADlg.MainIcon)];
|
||||
writeln('PrepareTaskDialogConfig M');
|
||||
Config.hFooterIcon := TD_FOOTERICONS[TF_FOOTERICON(ADlg.FooterIcon)];
|
||||
writeln('PrepareTaskDialogConfig N');
|
||||
|
||||
{
|
||||
Although the offcial MS docs (https://learn.microsoft.com/en-us/windows/win32/api/commctrl/ns-commctrl-taskdialogconfig)
|
||||
states that setting the flag TDF_NO_DEFAULT_RADIO_BUTTON should cause that no radiobutton
|
||||
is selected when the dialog displays, testing shows that (at least on Win10) this only
|
||||
works correctly if nDefaultRadioButton does NOT point to a radiobutton in the pRadioButtons array.
|
||||
}
|
||||
if not (tfNoDefaultRadioButton in ADlg.Flags) then
|
||||
Config.nDefaultRadioButton := DefRB + TaskDialogFirstRadioButtonIndex;
|
||||
writeln('PrepareTaskDialogConfig O');
|
||||
|
||||
Config.cxWidth := MulDiv(ADlg.FWidth, 4, DialogBaseUnits); // cxWidth needed in "dialog units"
|
||||
writeln('PrepareTaskDialogConfig P');
|
||||
|
||||
Config.pfCallback := @TaskDialogCallbackProc;
|
||||
writeln('PrepareTaskDialogConfig Q');
|
||||
Config.lpCallbackData := LONG_PTR(ADlg);
|
||||
writeln('PrepareTaskDialogConfig R');
|
||||
end;
|
||||
|
||||
class function TWin32WSTaskDialog.Execute(const ADlg: TCustomTaskDialog; AParentWnd: HWND; out ARadioRes: Integer): Integer;
|
||||
var
|
||||
Config: TTASKDIALOGCONFIG;
|
||||
VerifyChecked: BOOL;
|
||||
RU: TWideStringArray;
|
||||
BUT: TButtonArray;
|
||||
begin
|
||||
writeln('TWin32WSTaskDialog.Execute');
|
||||
writeln('TWin32WSTaskDialog.Execute A');
|
||||
if not Assigned(TaskDialogIndirect) or
|
||||
(tfForceNonNative in ADlg.Flags)
|
||||
//Yet to be implemented: or (ADlg.Selection <> '') or (tfQuery in ADlg.Flags)
|
||||
@ -1631,12 +1881,19 @@ begin
|
||||
Result := inherited Execute(ADlg, AParentWnd, ARadioRes)
|
||||
else
|
||||
begin
|
||||
writeln('TWin32WSTaskDialog.Execute B');
|
||||
PrepareTaskDialogConfig(TTaskDialog(ADlg), AParentWnd, Config, RU, BUT);
|
||||
writeln('TWin32WSTaskDialog.Execute C');
|
||||
|
||||
|
||||
Result := TaskDialogIndirect(@Config, @Result, @ARadioRes, @VerifyChecked);
|
||||
writeln('TWin32WSTaskDialog.Execute D');
|
||||
|
||||
//for now let it fail, it's not functional yet.
|
||||
Result := -1;
|
||||
if (Result = S_OK) then
|
||||
begin
|
||||
writeln('TWin32WSTaskDialog.Execute E');
|
||||
if VerifyChecked then
|
||||
ADlg.Flags := ADlg.Flags + [tfVerificationFlagChecked]
|
||||
else
|
||||
|
||||
@ -772,6 +772,7 @@ var
|
||||
end;
|
||||
if ModalResult=aButtonDef then
|
||||
Dialog.Form.ActiveControl := result;
|
||||
writeln('AddButton: Result.ModalResult=',Result.ModalResult);
|
||||
end;
|
||||
{$IFDEF MSWINDOwS}
|
||||
function TaskDialogFlagsToInteger(aFlags: TTaskDialogFlags): Integer;
|
||||
|
||||
@ -74,6 +74,19 @@ var
|
||||
|
||||
function ExecuteLCLTaskDialog(const ADlg: TTaskDialog; AParentWnd: HWND; out ARadioRes: Integer): Integer;
|
||||
|
||||
|
||||
type
|
||||
TLCLTaskDialogIcon = (
|
||||
tiBlank, tiWarning, tiQuestion, tiError, tiInformation, tiNotUsed, tiShield);
|
||||
TLCLTaskDialogFooterIcon = (
|
||||
tfiBlank, tfiWarning, tfiQuestion, tfiError, tfiInformation, tfiShield);
|
||||
|
||||
function IconMessage(Icon: TLCLTaskDialogIcon): string;
|
||||
function TF_DIALOGICON(const aIcon: TTaskDialogIcon): TLCLTaskDialogIcon;
|
||||
function TF_FOOTERICON(const aIcon: TTaskDialogIcon): TLCLTaskDialogFooterIcon;
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
var
|
||||
@ -102,11 +115,6 @@ begin
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
type
|
||||
TLCLTaskDialogIcon = (
|
||||
tiBlank, tiWarning, tiQuestion, tiError, tiInformation, tiNotUsed, tiShield);
|
||||
TLCLTaskDialogFooterIcon = (
|
||||
tfiBlank, tfiWarning, tfiQuestion, tfiError, tfiInformation, tfiShield);
|
||||
|
||||
const
|
||||
LCL_IMAGES: array[TLCLTaskDialogIcon] of Integer = (
|
||||
@ -593,9 +601,10 @@ procedure TLCLTaskDialog.HandleEmulatedButtonClicked(Sender: TObject);
|
||||
var Btn: TButton absolute Sender;
|
||||
CanClose: Boolean;
|
||||
begin
|
||||
if Assigned(FDlg) and Assigned(FDlg.OnButtonClicked) then begin
|
||||
if Assigned(FDlg) and Assigned(FDlg.OnButtonClicked) then
|
||||
begin
|
||||
CanClose := True;
|
||||
FDlg.OnButtonClicked(FDlg,Btn.ModalResult,CanClose);
|
||||
FDlg.OnButtonClicked(FDlg, FDlg.ButtonIDToModalResult(Btn.ModalResult),CanClose);
|
||||
if not CanClose then
|
||||
ModalResult := mrNone;
|
||||
end;
|
||||
@ -627,9 +636,9 @@ begin
|
||||
|
||||
CustomButtons := TStringList.Create;
|
||||
for B in FDlg.Buttons do
|
||||
CustomButtons.Add(B.Caption);
|
||||
CustomButtons.Add(B.Caption); //********** ModalResult and Default???
|
||||
Radios := TStringList.Create;
|
||||
for B in FDlg.RadioButtons do
|
||||
for B in FDlg.RadioButtons do //********** Default?
|
||||
Radios.Add(B.Caption);
|
||||
|
||||
//ToDo
|
||||
|
||||
Loading…
Reference in New Issue
Block a user