unit Main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
  Spin, Menus, LazHelpHTML, ExQuestionDlg;

type
  
  { TDemoForm }

  TDemoForm = class(TForm)
    Bevel1: TBevel;
    btnQuestionDlgEx: TButton;
    btnQuestionDlg: TButton;
    btnMessageDlg: TButton;
    btnDefaultPromptDlg: TButton;
    btnDefaultQuestionDlg: TButton;
    cbDefaultFont: TCheckBox;
    cbFontName: TComboBox;
    edX: TEdit;
    edY: TEdit;
    FontDialog1: TFontDialog;
    gbFont: TGroupBox;
    gbMaxWidth: TGroupBox;
    gbTest: TGroupBox;
    gbTestStd: TGroupBox;
    HTMLBrowserHelpViewer1: THTMLBrowserHelpViewer;
    HTMLHelpDatabase1: THTMLHelpDatabase;
    Label1: TLabel;
    Label2: TLabel;
    lblResult: TLabel;
    lblResultStd: TLabel;
    rgGlyphShowMode: TRadioGroup;
    rgMsgType: TRadioGroup;
    rgPosition: TRadioGroup;
    rgBtnAlignment: TRadioGroup;
    rgTextAlignment: TRadioGroup;
    rgButtons: TRadioGroup;
    rgMessage: TRadioGroup;
    seMinWidth: TSpinEdit;
    seFontSize: TSpinEdit;
    seMaxWidth: TSpinEdit;
    procedure btnMessageDlgClick(Sender: TObject);
    procedure btnQuestionDlgExClick(Sender: TObject);
    procedure btnQuestionDlgClick(Sender: TObject);
    procedure btnDefaultPromptDlgClick(Sender: TObject);
    procedure cbDefaultFontChange(Sender: TObject);
    procedure btnDefaultQuestionDlgClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    function GetModalResultStr(res: TModalResult): String;

  public

  end;

var
  DemoForm: TDemoForm;

implementation

{$R *.lfm}

uses
  LCLIntf, LCLType, InterfaceBase, TypInfo, 
  {$IF FPC_FullVersion >= 30202}System.{$IFEND}UITypes;

const
  DLG_TITLE = 'This is the caption of the dialog';
  MSG_TEXT: array[0..4] of String = (
    'msg',
    'Short text',
    'Text text text text text text text.',
    'This is a very very very very very very very very very very very very very very long text.',
    'This is even longer, another very very very very very very very very very very very very very very very very very very very very very very long text.'
  );
    
  
{ TDemoForm }

procedure TDemoForm.btnQuestionDlgExClick(Sender: TObject);
var
  msg: String;
  X, Y: Integer;
//  F: TForm;
  mt: Dialogs.TMsgDlgType;
  res: TModalResult;
begin
  lblResult.Caption := '';
  
  QuestionDlgEx_MaxWidth := seMaxWidth.Value;
  QuestionDlgEx_MinWidth := seMinWidth.Value;
  QuestionDlgEx_ButtonAlignment := TAlignment(rgBtnAlignment.ItemIndex);
  QuestionDlgEx_TextAlignment := TAlignment(rgTextAlignment.ItemIndex);
  QuestionDlgEx_GlyphShowMode := TGlyphShowMode(rgGlyphShowMode.ItemIndex);
  if cbDefaultFont.Checked then
  begin
    QuestionDlgEx_FontName := 'default';
    QuestionDlgEx_FontSize := 0;
  end else
  begin
    QuestionDlgEx_FontName := cbFontName.Text;
    QuestionDlgEx_FontSize := seFontSize.Value;
  end;
  
  msg := MSG_TEXT[rgMessage.ItemIndex];
  mt := Dialogs.TMsgDlgType(rgMsgType.ItemIndex);

  if rgPosition.ItemIndex = 0 then
  begin 
    // interpret poDesigned as "missing X and Y", i.e. X := MaxInt; Y := MaxInt; 
    X := MaxInt; 
    Y := MaxInt;
  end else
  if rgPosition.ItemIndex = rgPosition.Items.Count-1 then
  begin
    // last item "custom" means: use X, Y from edit boxes
    if not TryStrToInt(edX.Text, x) then X := MaxInt;
    if not TryStrToInt(edY.Text, Y) then Y := MaxInt;
  end else
  begin
    // These are the "poXXXX" values.
    // Note: The poDefaultXXXX values do not work correctly.
    X := -rgPosition.ItemIndex;
    Y := MaxInt;
  end;
  
  case rgButtons.ItemIndex of
    0: res := QuestionDlgEx(DLG_TITLE, msg, mt, [mbYes, 'Yes sir', 'IsCancel'], 'HTML/index.html', X, Y);
    1: res := QuestionDlgEx(DLG_TITLE, msg, mt, [mbYes, 'Yes sir', mbNo, 'No sir', 'IsDefault', mbCancel, 'Changed my mind', 'IsCancel'], 'HTML/index.html', X, Y);
    2: res := QuestionDlgEx(DLG_TITLE, msg, mt, [mbYes, 'Yes sir', mbYesToAll, 'I fully agree', mbNo, 'No sir', 'IsDefault', mbNoToAll, 'I fully disagree', mbCancel, 'Changed my mind', 'IsCancel'], 'HTML/index.html', X, Y);
    3: res := QuestionDlgEx(DLG_TITLE, msg, mt, [mbYes, 'Yes sir', mbYesToAll, 'I fully agree', mbNo, 'No sir', 'IsDefault', mbNoToAll, 'I fully disagree', mbCancel, 'Changed my mind', 'IsCancel', mbClose, 'Close it', mbHelp, 'I need help'], 'HTML/index.html', X, Y);
  end;
  
  lblResult.Caption := GetModalResultStr(res);
end;

procedure TDemoForm.btnMessageDlgClick(Sender: TObject);
var
  mt: TMsgDlgType;
  res: TModalResult;
  msg: String;
  helpkwd: String;
begin
  lblResultStd.Caption := '';
  mt := TMsgDlgType(rgMsgType.ItemIndex);
  msg := MSG_TEXT[rgMessage.ItemIndex];
  helpkwd := 'HTML/index.html';
  // Note: not possible to specify cancel button. Default button can only be
  // specified if help is given as helpctx, not as helpkeyword.
  case rgButtons.ItemIndex of
    0: res := MessageDlg(DLG_TITLE, msg, mt, [mbYes], helpkwd);
    1: res := MessageDlg(DLG_TITLE, msg, mt, [mbYes, mbNo, mbCancel], helpkwd);
    2: res := MessageDlg(DLG_TITLE, msg, mt, [mbYes, mbYesToAll, mbNo, mbNoToAll], helpkwd);
    3: res := MessageDlg(DLG_TITLE, msg, mt, [mbYes, mbYesToAll, mbNo, mbNoToAll, mbClose, mbHelp], helpkwd);
  end;
  lblResultStd.Caption := GetModalResultStr(res);
end;

procedure TDemoForm.btnQuestionDlgClick(Sender: TObject);
var
  mt: TMsgDlgType;
  res: TModalResult;
  msg: String;
  helpkwd: String;
begin
  lblResultStd.Caption := '';
  mt := TMsgDlgType(rgMsgType.ItemIndex);
  msg := MSG_TEXT[rgMessage.ItemIndex];
  helpkwd := 'HTML/index.html';
  case rgButtons.ItemIndex of
    0: res := QuestionDlg(DLG_TITLE, msg, mt, [mbYes, 'Yes sir'], helpkwd);
    1: res := QuestionDlg(DLG_TITLE, msg, mt, [mbYes, 'Yes sir', mbNo, 'No sir', 'IsDefault', mbCancel, 'Changed my mind'], helpkwd);
    2: res := QuestionDlg(DLG_TITLE, msg, mt, [mbYes, 'Yes sir', mbYesToAll, 'I fully agree', mbNo, 'No sir', 'IsDefault', mbNoToAll, 'I fully disagree', mbCancel, 'Changed my mind', 'IsCancel'], helpkwd);
    3: res := QuestionDlg(DLG_TITLE, msg, mt, [mbYes, 'Yes sir', mbYesToAll, 'I fully agree', mbNo, 'No sir', 'IsDefault', mbNoToAll, 'I fully disagree', mbCancel, 'Changed my mind', 'IsCancel', mbClose, 'Schließen', mbHelp, 'Hilfe'], helpkwd);
  end;
  lblResultStd.Caption := GetModalResultStr(res);
end;

procedure TDemoForm.btnDefaultPromptDlgClick(Sender: TObject);
const
  BUTTON_NAMES: array[idButtonOK..idButtonShield] of string = (
    'idButtonOk', 'idButtonCancel', 'idButtonHelp', 'idButtonYes', 'idButtonNo',
    'idButtonClose', 'idButtonAbort', 'idButtonRetry', 'idButtonIgnore',
    'idButtonAll', 'idButtonYesToAll', 'idButtonNoToAll', 'idButtonOpen',
    'idButtonSave', 'idButtonShield'
  );
var
  mt: Integer;
  res: Integer;
  msg: String;
  btns1: array[0..0] of Integer = (idButtonYes);
  btns3: array[0..2] of Integer = (idButtonYes, idButtonNo, idButtonCancel);
  btns5: array[0..4] of Integer = (idButtonYes, idbuttonYesToAll, idButtonNo, idButtonNoToAll, idButtonCancel);
  btns7: array[0..6] of Integer = (idButtonYes, idbuttonYesToAll, idButtonNo, idButtonNoToAll, idButtonCancel, idButtonClose, idButtonHelp);
  defaultPos: Boolean;
  X, Y: Integer;
  s: String;
begin
  lblResultStd.Caption := '';
  mt := idDialogBase + 1 + rgMsgType.ItemIndex;
  msg := MSG_TEXT[rgMessage.ItemIndex];
  if not TryStrToInt(edX.Text, X) then X := 0;
  if not TryStrToInt(edY.Text, Y) then Y := 0;
  defaultPos := (rgPosition.ItemIndex <> rgPosition.Items.Count-1);
  // No help context support here.
  case rgButtons.ItemIndex of
    0: res := DefaultPromptDialog(DLG_TITLE, msg, mt, @btns1, 1, 0, 0, defaultPos, X, Y);
    1: res := DefaultPromptdialog(DLG_TITLE, msg, mt, @btns3, 3, 1, 2, defaultPos, X, Y);
    2: res := DefaultPromptDialog(DLG_TITLE, msg, mt, @btns5, 5, 2, 4, defaultPos, X, Y);
    3: res := DefaultPromptDialog(DLG_TITLE, msg, mt, @btns7, 7, 2, 4, defaultPos, X, Y);
  end;
  // Note: res is an idButtonXXXX value here! 
  lblResultStd.Caption := 'Result: ' +BUTTON_NAMES[res];
end;

procedure TDemoForm.cbDefaultFontChange(Sender: TObject);
begin
  cbFontName.Enabled := not cbDefaultFont.Checked;
  seFontSize.Enabled := not cbDefaultFont.Checked;
end;

procedure TDemoForm.btnDefaultQuestionDlgClick(Sender: TObject);
var
  btns: TDialogButtons;
  res: TModalResult;
  
  procedure AddBtn(ACaption: String; AKind: TModalResult; ADefault: Boolean = false);
  begin
    with btns.Add do
    begin
      Caption := ACaption;
      ModalResult := AKind;
      Default := ADefault;
    end;
  end;
  
begin
  lblResultStd.Caption := '';
  
  btns := TDialogButtons.Create(TDialogButton);
  case rgButtons.ItemIndex of
    0: AddBtn('Yes sir', mrYes);
    1: begin
         AddBtn('Yes sir', mrYes);
         AddBtn('No sir', mrNo, true);
         AddBtn('Changed my mind', mrCancel);
       end;
    2: begin
         AddBtn('Yes sir', mrYes);
         AddBtn('I fully agree', mrYesToAll);
         AddBtn('No sir', mrNo, true);
         AddBtn('I fully disagree', mrNoToAll);
         AddBtn('Changed my mind', mrCancel);
       end;  
    3: begin
         AddBtn('Yes sir', mrYes);
         AddBtn('I fully agree', mrYesToAll);
         AddBtn('No sir', mrNo, true);
         AddBtn('I fully disagree', mrNoToAll);
         AddBtn('Changed my mind', mrCancel);
         AddBtn('Close it', mrClose);
         AddBtn('Help me', 100);
       end;  
  end;
    
  res := DefaultQuestionDialog(
    DLG_TITLE,
    MSG_TEXT[rgMessage.ItemIndex],
    rgMsgType.ItemIndex + 1 + idDialogBase,
    btns,
    0
  );
  lblResultStd.Caption := GetModalResultStr(res);

  btns.Free;
end;

procedure TDemoForm.FormCreate(Sender: TObject);
begin
  cbFontName.Items.Assign(Screen.Fonts);
  cbFontName.ItemIndex := cbFontName.Items.IndexOf('Consolas');;
  cbFontName.Enabled := false;
  seFontSize.Enabled := false;
  lblResult.Caption := '';
  lblResultStd.Caption := '';
end;

function TDemoForm.GetModalResultStr(res: TModalResult): String;
begin
  Result := 'ModalResult: ' + {$IF FPC_FullVersion>=30202}System.{$IFEND}UITypes.ModalResultStr[res];
end;

end.