Task Dialog Message Box with Fluent Interface

Examples

TD('Hello, World?').Execute;

TD('This is a very informative dialog.')
  .Text('You can write a lot of stuff here, if you want to.')
  .Execute(Self);

TD('This is a very informative dialog.')
  .Text('You can write a lot of stuff here, if you want to.')
  .Text('But you don''t have to. It''s optional.')
  .Execute(Self);

TD
  .WindowCaption('Frog Simulator')
  .Text('This is a frog simulator.')
  .Text('I just wanted to tell you that.')
  .Execute(Self);

var res := TD('All data on the C: drive will be lost.')
  .Warning
  .OKCancel
  .Execute(Self) = mrOk;
if res then
  TD('Disk formatted.').Execute(Self);

var res := TD('Do you want to delete all data on the C: drive?')
  .Warning
  .YesNo
  .Execute(Self) = mrYes;
if res then
  TD('Disk formatted.').Execute(Self);

var res := TD('Do you want to save the changes made to the file?')
  .YesNoCancel
  .Execute(Self);
case res of
  mrYes:
    { Save };
  mrNo:
    { Do nothing };
  mrCancel:
    { Abort app exit };
end;

TD('System battery critically low. Save all your work now.')
  .Warning
  .Execute(Self);

TD('Couldn''t write file to disk.').Error.Execute(Self);

TD('This is a very interesting piece of information.').Info.Execute(Self);

TD('This is using the app icon.').CustomIcon(Application.Icon).Execute(Self);

TD('This action requires elevated privileges.')
  .Text('Only an administrator can perform this operation.')
  .Shield
  .OKCancel
  .Execute(Self);

TD('Where do you want to go today?')
  .Text('We offer many interesting locations.')
  .AddButton('Redmond', 1)
  .AddButton('London', 2)
  .AddButton('New York City', 3)
  .Execute(Self);

TD('Where do you want to go today?')
  .Text('We offer many interesting locations.')
  .AddButton('Redmond', 1)
  .AddButton('London', 2)
  .AddButton('New York City', 3)
  .AddFlag(tfUseCommandLinks)
  .Execute(Self);

TD
  .Text('Do you want to save the changes made to "New file.txt"?')
  .AddButton('&Save', mrYes)
  .AddButton('Do&n''t save', mrNo)
  .AddButton('Cancel', mrCancel)
  .Execute(Self);

if TD
  .Text('Do you want to close all files without saving them?')
  .Text('This operation cannot be undone.')
  .Warning
  .YesNo
  .DefButton(tcbNo)
  .Execute(Self) = mrYes
then
  TD('All lost.').Execute(Self);

if TD
  .Text('Do you want to close all files without saving them?')
  .Text('This operation cannot be undone.')
  .Warning
  .AddButton('&Yes, close without saving', mrYes)
  .AddButton('&No, cancel', mrCancel, True)
  .Execute(Self) = mrYes
then
  TD('All lost.').Execute(Self);

TD('Where do you want to go today?')
  .Text('We offer many interesting locations.')
  .AddButton('Redmond', 1)
  .AddButton('London', 2)
  .AddButton('New York City', 3)
  .AddFlag(tfUseCommandLinksNoIcon)
  .Footer('You have to pay for yourself.', tdiWarning)
  .Execute(Self);

TD('Where do you want to go today?')
  .Text('We offer many interesting locations.')
  .AddButton('Redmond', 1)
  .AddButton('London', 2)
  .AddButton('New York City', 3)
  .AddFlag(tfUseCommandLinksNoIcon)
  .Details('You have to pay for yourself.', dpFooter, 'Terms and Conditions')
  .Execute(Self);

var R: Integer;
if
  TD('Where do you want to go today?')
  .Text('We offer many interesting locations.')
  .AddRadioButton('Redmond')        //
  .AddRadioButton('London')         //
  .AddRadioButton('New York City')  // or .AddRadioButtons
  .DefRadioButton(2)
  .Execute(R, Self) = mrOk
then
  TD.TextFmt('Radio: %d', [R]).Execute(Self);

TD('Where do you want to go today?')
  .Text('We offer many interesting locations.')
  .AddButton('Redmond', 1)
  .AddButton('London', 2)
  .AddButton('New York City', 3)
  .AddFlag(tfUseCommandLinksNoIcon)
  .Footer('You have to pay for yourself. Please read our <a href="http://contoso.com">terms and conditions</a>.', tdiInformation)
  .Hypertext
  .Execute(Self);

TD('Where do you want to go today?')
  .Text('We offer many interesting locations.')
  .AddButton('Redmond', 1)
  .AddButton('London', 2)
  .AddButton('New York City', 3)
  .AddFlag(tfUseCommandLinksNoIcon)
  .Footer('You have to pay for yourself. Please read our <a href="http://contoso.com">terms and conditions</a>.', tdiInformation)
  .Hypertext(
    procedure(const AURL: string)
    begin
      TD('These are our terms and conditions:').Text('Blah, blah, blah.').Execute{todo: add handle}
    end
  )
  .Execute(Self);

var b := False;
if TD('Which OS do you want to use?')
  .AddRadioButtons(['&Windows', '&macOS', '&Linux'])
  .Verification('&Don''t ask again', @b)
  .OKCancel
  .Execute(Self) = mrOK
then
  if b then
    // Save to registry

var b := False;
CanClose := TD
  .Text('Are you sure you want to close this amazing demo app?')
  .Text('Before you close it, you should make sure you have tried all the buttons.')
  .Text('You should try each button at least once.')
  .CustomIcon(Application.Icon)
  .Footer('Copyright © 2021 <a href="https://rejbrand.se/">Andreas Rejbrand</a>')
  .AddButton('&Yes, close it', mrYes)
  .AddButton('&No, keep it open', mrNo, True)
  .Verification('&Go to rejbrand.se when this app is closed.', @b)
  .Hypertext
  .Execute(Self) = mrYes;
if CanClose and b then
  ShellExecute(Handle, 'open', 'https://rejbrand.se/', nil, nil, SW_SHOWNORMAL);

Source code

{******************************************************************************}
{                                                                              }
{ Rejbrand Task Dialog Message Box                                             }
{                                                                              }
{ Copyright © 2021 Andreas Rejbrand                                            }
{                                                                              }
{ https://english.rejbrand.se/                                                 }
{                                                                              }
{******************************************************************************}

unit TDMB;

interface

uses
  Windows, Messages, SysUtils, Types, UITypes, Classes, Dialogs, Forms, Graphics;

type
  TTaskDialogButtonRec = record
    Caption: string;
    ModalResult: TModalResult;
    Default: Boolean;
  end;
  TDetailsPosition = (dpMain, dpFooter);
  TLinkHandler = reference to procedure(const AURL: string);
  TMsgBox = record
  strict private
    FOwner: HWND;
    FCaption,
    FMainText,
    FSecondText,
    FDetailsCaption,
    FDetailsText: string;
    FDetailsPosition: TDetailsPosition;
    FDetailsExpanded: Boolean;
    FIcon: TTaskDialogIcon;
    FCustomIcon: TIcon;
    FButtons: TTaskDialogCommonButtons;
    FDefButton: TTaskDialogCommonButton;
    FCustomButtons: TArray<TTaskDialogButtonRec>;
    FFooterText: string;
    FFooterIcon: TTaskDialogIcon;
    FCustomFooterIcon: TIcon;
    FVerificationText: string;
    FVerificationChecked: Boolean;
    FVerificationCheckedRes: PBoolean;
    FFlags: TTaskDialogFlags;
    FHyperlinks: Boolean;
    FRadioButtons: TArray<string>;
    FDefRadioButton: Integer;
    FLinkHandler: TLinkHandler;
    FRadioOut: Integer;
    procedure HyperlinkClicked(Sender: TObject);
  public
    const DefaultFlags = [tfAllowDialogCancellation, tfPositionRelativeToWindow];
    function Execute(AOwnerForm: TCustomForm = nil): TModalResult; overload;
    function Execute(out ARadioButton: Integer; AOwnerForm: TCustomForm = nil): TModalResult; overload;
    function Text(const AText: string): TMsgBox;
    function TextFmt(const AText: string; const Args: array of const): TMsgBox;
    function Info: TMsgBox;
    function Warning: TMsgBox;
    function Error: TMsgBox;
    function Shield: TMsgBox;
    function CustomIcon(AIcon: TIcon): TMsgBox;
    function WindowCaption(const AText: string): TMsgBox;
    function Details(const AText: string; APosition: TDetailsPosition = dpMain;
      const ACaption: string = ''; AExpanded: Boolean = False): TMsgBox;
    function Footer(const AText: string; AIcon: TTaskDialogIcon = tdiNone;
      ACustomIcon: TIcon = nil): TMsgBox;
    function Verification(const AText: string; AChecked: PBoolean): TMsgBox;
    function Hypertext(ALinkHandler: TLinkHandler = nil): TMsgBox;
    function Close: TMsgBox;
    function OK: TMsgBox;
    function OKCancel: TMsgBox;
    function YesNo: TMsgBox;
    function YesNoCancel: TMsgBox;
    function AddButton(const ACaption: string; AModalResult: TModalResult;
      ADefault: Boolean = False): TMsgBox;
    function DefButton(AButton: TTaskDialogCommonButton): TMsgBox;
    function AddRadioButton(const ACaption: string): TMsgBox;
    function AddRadioButtons(const ACaptions: array of string): TMsgBox;
    function DefRadioButton(AIndex: Integer): TMsgBox;
    function SetFlags(AFlags: TTaskDialogFlags): TMsgBox;
    function AddFlag(AFlag: TTaskDialogFlag): TMsgBox;
    function ClearFlag(AFlag: TTaskDialogFlag): TMsgBox;
  end;

function TD(const AText: string = ''): TMsgBox;

implementation

uses
  Math, DateUtils, StrUtils, ShellAPI;

function TD(const AText: string): TMsgBox;
begin
  Result := Default(TMsgBox).SetFlags(TMsgBox.DefaultFlags).Text(AText);
end;

{ TMsgBox }

function TMsgBox.AddButton(const ACaption: string;
  AModalResult: TModalResult; ADefault: Boolean): TMsgBox;
begin
  Result := Self;
  SetLength(Result.FCustomButtons, Succ(Length(Result.FCustomButtons)));
  Result.FCustomButtons[High(Result.FCustomButtons)].Caption := ACaption;
  Result.FCustomButtons[High(Result.FCustomButtons)].ModalResult := AModalResult;
  Result.FCustomButtons[High(Result.FCustomButtons)].Default := ADefault;
end;

function TMsgBox.AddFlag(AFlag: TTaskDialogFlag): TMsgBox;
begin
  Result := Self;
  Include(Result.FFlags, AFlag);
end;

function TMsgBox.AddRadioButton(const ACaption: string): TMsgBox;
begin
  Result := Self;
  Result.FRadioButtons := Result.FRadioButtons + [ACaption];
end;

function TMsgBox.AddRadioButtons(const ACaptions: array of string): TMsgBox;
begin
  Result := Self;
  var LOldLength := Length(Result.FRadioButtons);
  SetLength(Result.FRadioButtons, Length(Result.FRadioButtons) + Length(ACaptions));
  for var i := 0 to High(ACaptions) do
    Result.FRadioButtons[LOldLength + i] := ACaptions[i];
end;

function TMsgBox.ClearFlag(AFlag: TTaskDialogFlag): TMsgBox;
begin
  Result := Self;
  Exclude(Result.FFlags, AFlag);
end;

function TMsgBox.Close: TMsgBox;
begin
  Result := Self;
  Result.FButtons := [tcbClose];
  Result.FCustomButtons := nil;
end;

function TMsgBox.CustomIcon(AIcon: TIcon): TMsgBox;
begin
  Result := Self;
  Result.FCustomIcon := AIcon;
end;

function TMsgBox.DefButton(AButton: TTaskDialogCommonButton): TMsgBox;
begin
  Result := Self;
  Result.FDefButton := AButton;
end;

function TMsgBox.DefRadioButton(AIndex: Integer): TMsgBox;
begin
  Result := Self;
  Result.FDefRadioButton := AIndex;
  if AIndex = -1 then
    Include(Result.FFlags, tfNoDefaultRadioButton);
end;

function TMsgBox.Details(const AText: string; APosition: TDetailsPosition;
  const ACaption: string; AExpanded: Boolean): TMsgBox;
begin
  Result := Self;
  Result.FDetailsCaption := ACaption;
  Result.FDetailsText := AText;
  Result.FDetailsPosition := APosition;
  Result.FDetailsExpanded := AExpanded;
end;

function TMsgBox.Error: TMsgBox;
begin
  Result := Self;
  Result.FIcon := tdiError;
end;

function TMsgBox.Execute(out ARadioButton: Integer;
  AOwnerForm: TCustomForm): TModalResult;
begin
  Result := Execute(AOwnerForm);
  ARadioButton := FRadioOut;
end;

function TMsgBox.Execute(AOwnerForm: TCustomForm): TModalResult;
var
  TD: TTaskDialog;
begin

  TD := TTaskDialog.Create(AOwnerForm);
  try
    if Assigned(AOwnerForm) then
      FOwner := AOwnerForm.Handle
    else
      FOwner := 0;
    TD.Flags := FFlags;
    if not FCaption.IsEmpty then
      TD.Caption := FCaption
    else
      TD.Caption := Application.Title;
    TD.Title := FMainText;
    TD.Text := FSecondText;
    TD.CommonButtons := FButtons;
    TD.DefaultButton := FDefButton;
    for var br in FCustomButtons do
    begin
      var b := TD.Buttons.Add;
      b.Caption := br.Caption;
      b.ModalResult := br.ModalResult;
      b.Default := br.Default;
    end;
    TD.ExpandButtonCaption := FDetailsCaption;
    TD.ExpandedText := FDetailsText;
    case FDetailsPosition of
      dpMain:
        TD.Flags := TD.Flags - [tfExpandFooterArea];
      dpFooter:
        TD.Flags := TD.Flags + [tfExpandFooterArea];
    end;
    case FDetailsExpanded of
      False:
        TD.Flags := TD.Flags - [tfExpandedByDefault];
      True:
        TD.Flags := TD.Flags + [tfExpandedByDefault];
    end;
    TD.MainIcon := FIcon;
    if Assigned(FCustomIcon) then
    begin
      TD.Flags := TD.Flags + [tfUseHiconMain];
      TD.CustomMainIcon := FCustomIcon;
    end
    else
      TD.Flags := TD.Flags - [tfUseHiconMain];
    TD.FooterText := FFooterText;
    TD.FooterIcon := FFooterIcon;
    if Assigned(FCustomFooterIcon) then
    begin
      TD.Flags := TD.Flags + [tfUseHiconFooter];
      TD.CustomFooterIcon := FCustomFooterIcon;
    end
    else
      TD.Flags := TD.Flags - [tfUseHiconFooter];
    TD.VerificationText := FVerificationText;
    case FVerificationChecked of
      False:
        TD.Flags := TD.Flags - [tfVerificationFlagChecked];
      True:
        TD.Flags := TD.Flags + [tfVerificationFlagChecked];
    end;
    for var rb in FRadioButtons do
    begin
      var b := TD.RadioButtons.Add;
      b.Caption := rb;
      if not (tfNoDefaultRadioButton in TD.Flags) and (FDefRadioButton = b.Index) then
        b.Default := True;
    end;
    if FHyperlinks then
    begin
      TD.Flags := TD.Flags + [tfEnableHyperlinks];
      TD.OnHyperlinkClicked := HyperlinkClicked;
    end
    else
      TD.Flags := TD.Flags - [tfEnableHyperlinks];
    if FOwner <> 0 then
    begin
      if TD.Execute(FOwner) then
        Result := TD.ModalResult
      else
        Result := mrCancel;
    end
    else
    begin
      if TD.Execute then
        Result := TD.ModalResult
      else
        Result := mrCancel;
    end;
    if (Length(FRadioButtons) > 0) and Assigned(TD.RadioButton) then
      FRadioOut := TD.RadioButton.Index
    else
      FRadioOut := -1;
    if Assigned(FVerificationCheckedRes) then
      FVerificationCheckedRes^ := tfVerificationFlagChecked in TD.Flags;
  finally
    TD.Free;
  end;

end;

function TMsgBox.Footer(const AText: string; AIcon: TTaskDialogIcon;
  ACustomIcon: TIcon): TMsgBox;
begin
  Result := Self;
  Result.FFooterText := AText;
  Result.FFooterIcon := AIcon;
  Result.FCustomFooterIcon := ACustomIcon;
end;

procedure TMsgBox.HyperlinkClicked(Sender: TObject);
begin
  if Sender is TTaskDialog then
  begin
    if Assigned(FLinkHandler) then
      FLinkHandler(TTaskDialog(Sender).URL)
    else
      ShellExecute(FOwner, 'open', PChar(TTaskDialog(Sender).URL), nil, nil, SW_SHOWNORMAL);
  end;
end;

function TMsgBox.Hypertext(ALinkHandler: TLinkHandler): TMsgBox;
begin
  Result := Self;
  Result.FLinkHandler := ALinkHandler;
  Result.FHyperlinks := True;
end;

function TMsgBox.Info: TMsgBox;
begin
  Result := Self;
  Result.FIcon := tdiInformation;
end;

function TMsgBox.OK: TMsgBox;
begin
  Result := Self;
  Result.FButtons := [tcbOk];
  Result.FCustomButtons := nil;
end;

function TMsgBox.OKCancel: TMsgBox;
begin
  Result := Self;
  Result.FButtons := [tcbOk, tcbCancel];
  Result.FCustomButtons := nil;
end;

function TMsgBox.SetFlags(AFlags: TTaskDialogFlags): TMsgBox;
begin
  Result := Self;
  Result.FFlags := AFlags;
end;

function TMsgBox.Shield: TMsgBox;
begin
  Result := Self;
  Result.FIcon := tdiShield;
end;

function TMsgBox.Text(const AText: string): TMsgBox;
begin
  Result := Self;
  if Result.FMainText.IsEmpty then
    Result.FMainText := AText
  else if Result.FSecondText.IsEmpty then
    Result.FSecondText := AText
  else
    Result.FSecondText := Result.FSecondText + sLineBreak + sLineBreak + AText;
end;

function TMsgBox.TextFmt(const AText: string;
  const Args: array of const): TMsgBox;
begin
  Result := Text(Format(AText, Args));
end;

function TMsgBox.Verification(const AText: string; AChecked: PBoolean): TMsgBox;
begin
  Result := Self;
  Result.FVerificationText := AText;
  Result.FVerificationCheckedRes := AChecked;
  if Assigned(AChecked) then
    Result.FVerificationChecked := AChecked^;
end;

function TMsgBox.Warning: TMsgBox;
begin
  Result := Self;
  Result.FIcon := tdiWarning;
end;

function TMsgBox.WindowCaption(const AText: string): TMsgBox;
begin
  Result := Self;
  Result.FCaption := AText;
end;

function TMsgBox.YesNo: TMsgBox;
begin
  Result := Self;
  Result.FButtons := [tcbYes, tcbNo];
  Result.FFlags := Result.FFlags - [tfAllowDialogCancellation];
  Result.FCustomButtons := nil;
end;

function TMsgBox.YesNoCancel: TMsgBox;
begin
  Result := Self;
  Result.FButtons := [tcbYes, tcbNo, tcbCancel];
  Result.FCustomButtons := nil;
end;

end.