Refactoring TTaskDialog:

- Deprecated unit LCLTaskDialog.
- Unit TaskDlgEmulation: work in progress.
  - Start implementing TLCLTaskDialog class. Not functional yet (but at least it should compile).
  - Code copied and adapted from the now deprecated LCLTaskDialog unit.
- Temporarily exposed a private variable of Dialogs.TTaskDialog

lcl/dialogs.pp

@@ -634,7 +634,6 @@ type
     FText: TTranslateString;
     FTitle: TTranslateString;
     FVerificationText: TTranslateString;
-    FWidth: Integer;
     FOnButtonClicked: TTaskDlgClickEvent;
     procedure DoOnButtonClickedHandler(Sender: PTaskDialog; AButtonID: Integer;
       var ACanClose: Boolean);
@@ -646,6 +645,10 @@ type
     function DoExecute(ParentWnd: HWND): Boolean; dynamic;
     procedure DoOnButtonClicked(AModalResult: Integer; var ACanClose: Boolean); dynamic;
   public
+
+    FWidth: Integer; //ToDo: make this a readonly property, so we can use it in the TaskDlgEmulation unit.
+
+
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     function Execute: Boolean; overload; dynamic;

lcl/include/taskdialog.inc

@@ -256,6 +256,9 @@ begin
   ButtonID := TaskDlg.Execute(TD_COMMONBUTTONS(CommonButtons), DefBtn, TD_FLAGS(Flags), TF_DIALOGICON(MainIcon), TF_FOOTERICON(FooterIcon),
     DefRB, FWidth, ParentWnd, tfForceNonNative in Flags, tfEmulateClassicStyle in Flags, @DoOnButtonClickedHandler);
   Result := ButtonID>=0;
+
+
+
   FModalResult := ButtonIDToModalResult(ButtonID);
 
   if (TaskDlg.RadioRes>=200) and (TaskDlg.RadioRes-200<RadioButtons.Count) then

lcl/lcltaskdialog.pas

@@ -22,7 +22,7 @@
 }
 
 
-unit LCLTaskDialog;
+unit LCLTaskDialog deprecated 'Will be removed in Lazarus 4.0. Use TTaskDialog from unit Dialogs instead.';
 
 {
     This file is part of Synopse framework.
@@ -903,6 +903,7 @@ begin
     Dialog.Form.ClientWidth := aWidth;
     Dialog.Form.Height := FirstRadioButtonIndex;
     Dialog.Form.Caption := Title;
+
     // create a white panel for the main dialog part
     Panel := TPanel.Create(Dialog.Form);
     Panel.Parent := Dialog.Form;

lcl/taskdlgemulation.pp

@@ -7,18 +7,337 @@ interface
 uses
   Classes, SysUtils,
   LazUTF8,
-  LCLType, LCLStrConsts, LCLIntf, InterfaceBase, ImgList,
+  LCLType, LCLStrConsts, LCLIntf, InterfaceBase, ImgList, LCLProc,
   LResources, Menus, Graphics, Forms, Controls, StdCtrls, ExtCtrls, Buttons, Dialogs, DialogRes;
 
+
+type
+
+  TTaskDialogElement = (
+    tdeContent, tdeExpandedInfo, tdeFooter, tdeMainInstruction,
+    tdeEdit, tdeVerif);
+
+
+  { TLCLTaskDialog }
+
+  TLCLTaskDialog = class(TForm)
+  private
+    /// the Task Dialog structure which created the form
+    FDlg: TTaskDialog;
+  protected
+    procedure HandleEmulatedButtonClicked(Sender: TObject);
+    procedure SetupControls;
+  public
+    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+
+    constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
+
+    function Execute: Boolean;
+  public
+    /// the labels corresponding to the Task Dialog main elements
+    Element: array[tdeContent..tdeMainInstruction] of TLabel;
+    /// the Task Dialog selection list
+    Combo: TComboBox;
+    /// the Task Dialog optional query editor
+    Edit: TEdit;
+    /// the Task Dialog optional checkbox
+    Verif: TCheckBox;
+  end;
+
+
+type
+  TTaskDialogTranslate = function(const aString: string): string;
+var
+  TaskDialog_Translate: TTaskDialogTranslate;
+
+
 function ExecuteLCLTaskDialog(const ADlg: TTaskDialog): Boolean;
 
 implementation
 
-function ExecuteLCLTaskDialog(const ADlg: TTaskDialog): Boolean;
+var
+  LDefaultFont: TFont;
+
+function DefaultFont: TFont;
 begin
-  //writeln('ExecuteLCLTaskDialog');
+  if LDefaultFont<>nil then
-  Result := False;
+    Exit(LDefaultFont);
+  LDefaultFont := TFont.Create;
+  LDefaultFont.Name := 'default';
+  LDefaultFont.Style := [];
+  LDefaultFont.Size := 10;
+  Result := LDefaultFont;
+
+  {$IFDEF WINDOWS}
+  if Screen.Fonts.IndexOf('Calibri')>=0 then begin
+    LDefaultFont.Size := 11;
+    LDefaultFont.Name := 'Calibri';
+  end else begin
+    if Screen.Fonts.IndexOf('Tahoma')>=0 then
+      LDefaultFont.Name := 'Tahoma'
+    else
+      LDefaultFont.Name := 'Arial';
   end;
+  {$ENDIF}
+end;
+
+type
+  TLCLTaskDialogIcon = (
+    tiBlank, tiWarning, tiQuestion, tiError, tiInformation, tiNotUsed, tiShield);
+
+const
+  LCL_IMAGES: array[TLCLTaskDialogIcon] of Integer = (
+    0, idDialogWarning, idDialogConfirm, idDialogError, idDialogInfo, 0, idDialogShield);
+
+
+function ExecuteLCLTaskDialog(const ADlg: TTaskDialog): Boolean;
+var
+  DlgForm: TLCLTaskDialog;
+begin
+  debugln('ExecuteLCLTaskDialog');
+  Result := False;
+  DlgForm := TLCLTaskDialog.CreateNew(ADlg);
+  try
+    Result := DlgForm.Execute;
+  finally
+    FreeAndNil(DlgForm);
+  end;
+end;
+
+constructor TLCLTaskDialog.CreateNew(AOwner: TComponent; Num: Integer);
+begin
+  inherited CreateNew(AOwner, Num);
+
+  KeyPreview := True;
+end;
+
+function TLCLTaskDialog.Execute: Boolean;
+var
+  mRes: Integer;
+begin
+  SetupControls;
+  mRes := ShowModal;
+  Result := (mRes > 0);
+end;
+
+procedure TLCLTaskDialog.HandleEmulatedButtonClicked(Sender: TObject);
+var Btn: TButton absolute Sender;
+    CanClose: Boolean;
+begin
+  if Assigned(FDlg) and Assigned(FDlg.OnButtonClicked) then begin
+    CanClose := true;
+    FDlg.{Dialog.}OnButtonClicked(FDlg,Btn.ModalResult,CanClose);
+    if not CanClose then
+      ModalResult := mrNone;
+  end;
+end;
+
+
+
+//const
+//  LCL_IMAGES: array[TTaskDialogIcon] of Integer = (
+//    0, idDialogWarning, idDialogConfirm, idDialogError, idDialogInfo, 0, idDialogShield);
+  //LCL_FOOTERIMAGES: array[TTaskDialogFooterIcon] of Integer = (
+  //  0, idDialogWarning, idDialogConfirm, idDialogError, idDialogInfo, idDialogShield);
+
+
+function TD_Trans(const aString: string): string;
+begin
+  if Assigned(TaskDialog_Translate) then
+    Result := TaskDialog_Translate(aString)
+  else
+    Result := aString;
+end;
+
+function TF_DIALOGICON(const aIcon: TTaskDialogIcon): TLCLTaskDialogIcon;
+begin
+  case aIcon of
+    tdiWarning: Result := tiWarning;
+    tdiError: Result := tiError;
+    tdiInformation: Result := tiInformation;
+    tdiShield: Result := tiShield;
+    tdiQuestion: Result := tiQuestion;
+  else
+    Result := tiBlank;
+  end;
+end;
+
+
+function IconMessage(Icon: TLCLTaskDialogIcon): string;
+begin
+  case Icon of
+    tiWarning:   result := rsMtWarning;
+    tiQuestion:  result := rsMtConfirmation;
+    tiError:     result := rsMtError;
+    tiInformation, tiShield: result := rsMtInformation;
+    else result := '';
+  end;
+  result := TD_Trans(result);
+end;
+
+
+procedure TLCLTaskDialog.SetupControls;
+var
+  //TaskDlg: LCLTaskDialog.TTaskDialog;
+  DefRB, aButtonDef: TModalResult;
+  B: TTaskDialogBaseButtonItem;
+  ButtonID: Integer;
+  Buttons, TaskDlgRadios, Title, Inst, Content,
+  TaskDlgInfoCollapse, TaskDlgInfo, TaskDlgFooter,
+  TaskDlgVerify: TTranslateString;
+  ARadioOffset, FontHeight, aWidth, IconBorder, X, Y: integer;
+  aCommonButtons: TTaskDialogCommonButtons;
+  Panel: TPanel;
+  Par: TWinControl;
+  aDialogIcon: TLCLTaskDialogIcon;
+  Image: TImage;
+const
+  FirstButtonIndex = 100;
+  FirstRadioButtonIndex = 200;
+  TD_BTNMOD: array[TTaskDialogCommonButton] of Integer = (
+    mrOk, mrYes, mrNo, mrCancel, mrRetry, mrAbort);
+begin
+
+  if FDlg.RadioButtons.DefaultButton<> nil then
+    DefRB := FDlg.RadioButtons.DefaultButton.Index
+  else
+    DefRB := 0;
+  if FDlg.Buttons.DefaultButton<>nil then
+    aButtonDef := FDlg.Buttons.DefaultButton.ModalResult
+  else
+    aButtonDef := TD_BTNMOD[FDlg.DefaultButton];
+
+  Buttons := '';
+  for B in FDlg.Buttons do
+    Buttons := Buttons + B.Caption + #10;
+  TaskDlgRadios := '';
+  for B in FDlg.RadioButtons do
+    TaskDlgRadios := TaskDlgRadios + B.Caption + #10;
+
+  Title := FDlg.Caption;
+  Inst := FDlg.Title;
+  Content := FDlg.Text;
+  TaskDlgInfoCollapse := FDlg.ExpandButtonCaption;
+  TaskDlgInfo := FDlg.ExpandedText;
+  TaskDlgFooter := FDlg.FooterText;
+  TaskDlgVerify := FDlg.VerificationText;
+
+  aCommonButtons := FDlg.CommonButtons;
+
+  if (aCommonButtons=[]) and (Buttons='') then
+  begin
+    aCommonButtons := [tcbOk];
+    if (aButtonDef = 0) then
+      aButtonDef := mrOk;
+  end;
+
+  if (Title = '') then
+    if (Application.MainForm = nil) then
+      Title := Application.Title else
+      Title := Application.MainForm.Caption;
+  //
+  if (Inst = '') then
+    Inst := IconMessage(TF_DIALOGICON(FDlg.MainIcon));
+
+  //Dialog.OnButtonClicked := aOnButtonClicked;
+
+
+  PixelsPerInch := 96; // we are using 96 PPI in the code, scale it automatically at ShowModal
+  Font.PixelsPerInch := 96;
+  BorderStyle := bsDialog;
+  if (tfAllowDialogCancellation in FDlg.Flags) then
+    BorderIcons := [biSystemMenu]
+  else
+    BorderIcons := [];
+  if (tfPositionRelativeToWindow in FDlg.Flags) then
+    Position := poOwnerFormCenter
+  else
+    Position := poScreenCenter;
+
+  if not (tfEmulateClassicStyle in FDlg.Flags) then
+    Font := DefaultFont;
+
+  FontHeight := Font.Height;
+  if (FontHeight = 0) then
+    FontHeight := Screen.SystemFont.Height;
+
+  aWidth := FDlg.FWidth;
+  if (aWidth <= 0) then
+  begin
+    aWidth := Canvas.TextWidth(Inst);
+    if (aWidth > 300) or (Canvas.TextWidth(Content) > 300) or
+       (Length(Buttons) > 40) then
+      aWidth := 480 else
+      aWidth := 420;
+  end
+  else
+    if (aWidth < 120) then aWidth := 120;
+  ClientWidth := aWidth;
+
+  Height := FirstRadioButtonIndex;
+  Caption := Title;
+
+  // create a white panel for the main dialog part
+  Panel := TPanel.Create(Self);
+  Panel.Parent := Self;
+  Panel.Align := alTop;
+  Panel.BorderStyle := bsNone;
+  Panel.BevelOuter := bvNone;
+  if not (tfEmulateClassicStyle in FDlg.Flags) then begin
+    Panel.Color := clWindow;
+  end;
+  Par := Panel;
+
+  // handle main dialog icon
+  if (tfEmulateClassicStyle in FDlg.Flags) then
+    IconBorder := 10
+  else
+    IconBorder := 24;
+
+  aDialogIcon := TF_DIALOGICON(FDlg.MainIcon);
+  if (LCL_IMAGES[aDialogIcon]<>0) then
+  begin
+    Image := TImage.Create(Self);
+    Image.Parent := Par;
+    Image.Images := DialogGlyphs;
+    Image.ImageIndex := DialogGlyphs.DialogIcon[LCL_IMAGES[aDialogIcon]];
+    Image.SetBounds(IconBorder,IconBorder, 32, 32);
+    Image.Stretch := True;
+    Image.StretchOutEnabled := False;
+    Image.Proportional := True;
+    Image.Center := True;
+    X := Image.Width+IconBorder*2;
+    Y := Image.Top;
+    if (tfEmulateClassicStyle in FDlg.Flags) then
+      inc(Y, 8);
+  end else
+  begin
+    Image := nil;
+    if (not (tfEmulateClassicStyle in FDlg.Flags)) and (Inst <> '') then
+      IconBorder := IconBorder*2;
+    X := IconBorder;
+    Y := IconBorder;
+  end;
+
+
+end;
+
+procedure TLCLTaskDialog.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+  if (biSystemMenu in BorderIcons) then//is Alt+F4/Esc cancellation allowed?
+  begin//yes -> cancel on ESC
+    if Key = VK_ESCAPE then
+      Close;
+  end else
+  begin//no -> block Alt+F4
+    if (Key = VK_F4) and (ssAlt in Shift) then//IMPORTANT: native task dialog blocks Alt+F4 to close the dialog -> we have to block it as well
+      Key := 0;
+  end;
+
+  inherited KeyDown(Key, Shift);
+end;
+
+
 
 end.