lazarus-ccr/components/exctrls/examples/QuestionDlgEx/main.pas

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;
    Bevel2: TBevel;
    btnQuestionDlgEx: TButton;
    btnQuestionDlg: TButton;
    btnMessageDlg: TButton;
    btnDefaultPromptDlg: TButton;
    btnDefaultQuestionDlg: TButton;
    cbDefaultFont: TCheckBox;
    cbFontName: TComboBox;
    edX: TEdit;
    edY: TEdit;
    FontDialog: TFontDialog;
    gbFont: TGroupBox;
    gbMaxWidth: TGroupBox;
    gbTestStd: TGroupBox;
    gbTest: TGroupBox;
    Panel1: TPanel;
    Panel2: TPanel;
    rgTextBkColor: TRadioGroup;
    rbLeftJustify: TRadioButton;
    rbHCenter: TRadioButton;
    rbRightJustify: TRadioButton;
    rbTop: TRadioButton;
    rbVCenter: TRadioButton;
    rbBottom: TRadioButton;
    gbTextAlignmentLayout: TGroupBox;
    HTMLBrowserHelpViewer: THTMLBrowserHelpViewer;
    HTMLHelpDatabase: THTMLHelpDatabase;
    Label1: TLabel;
    Label2: TLabel;
    rgGlyphShowMode: TRadioGroup;
    rgMsgType: TRadioGroup;
    rgPosition: TRadioGroup;
    rgBtnAlignment: TRadioGroup;
    rgButtons: TRadioGroup;
    rgMessage: TRadioGroup;
    seMinWidth: TSpinEdit;
    seFontSize: TSpinEdit;
    seMaxWidth: TSpinEdit;
    procedure btnDefaultPromptDlgClick(Sender: TObject);
    procedure btnDefaultQuestionDlgClick(Sender: TObject);
    procedure btnMessageDlgClick(Sender: TObject);
    procedure btnQuestionDlgClick(Sender: TObject);
    procedure btnQuestionDlgExClick(Sender: TObject);
    procedure cbDefaultFontChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure rgTextBkColorClick(Sender: TObject);
  private
    function GetModalResultStr(res: TModalResult): String;

  public

  end;

var
  DemoForm: TDemoForm;

implementation

{$R *.lfm}

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

const
  FORM_CAPTION = 'Test QuestionDlgEx';
  DLG_TITLE = 'This is the caption of the dialog';
  MSG_TEXT: array[0..6] of String = (
    'msg',
    'Short text',
    'This is a long long long long 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.',
    'Line 1' + LineEnding + 'Line 2' + LineEnding + 'Line 3' + LineEnding + 'Line 4' + LineEnding + 'Line 5',
    'This is a long long long long text.' + LineEnding + 'Short text.' + 'This is a very very very very very very very very very very very very very very long text.'
  );
  BUTTON_NAMES: array[idButtonOK..idButtonShield] of string = (
    'idButtonOk', 'idButtonCancel', 'idButtonHelp', 'idButtonYes', 'idButtonNo',
    'idButtonClose', 'idButtonAbort', 'idButtonRetry', 'idButtonIgnore',
    'idButtonAll', 'idButtonYesToAll', 'idButtonNoToAll', 'idButtonOpen',
    'idButtonSave', 'idButtonShield'
  );
    
  
{ TDemoForm }

procedure TDemoForm.btnQuestionDlgExClick(Sender: TObject);
var
  msg: String;
  X, Y: Integer;
  mt: Dialogs.TMsgDlgType;
  res: TModalResult;
begin
  Caption := FORM_CAPTION;
  QuestionDlgEx_MaxWidth := seMaxWidth.Value;
  QuestionDlgEx_MinWidth := seMinWidth.Value;
  QuestionDlgEx_ButtonAlignment := TAlignment(rgBtnAlignment.ItemIndex);
  if rbLeftJustify.Checked then QuestionDlgEx_TextAlignment := taLeftJustify
    else if rbRightJustify.Checked then QuestionDlgEx_TextAlignment := taRightJustify
    else if rbHCenter.Checked then QuestionDlgEx_TextAlignment := taCenter;
  if rbTop.Checked then QuestionDlgEx_TextLayout := tlTop
    else if rbVCenter.Checked then QuestionDlgEx_TextLayout := tlCenter
    else if rbBottom.Checked then QuestionDlgEx_TextLayout := tlBottom;
  QuestionDlgEx_GlyphShowMode := TGlyphShowMode(rgGlyphShowMode.ItemIndex);
  if cbDefaultFont.Checked then
  begin
    QuestionDlgEx_FontName := '';
    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;
  
  Caption := GetModalResultStr(res);
end;

procedure TDemoForm.btnMessageDlgClick(Sender: TObject);
var
  mt: TMsgDlgType;
  res: TModalResult;
  msg: String;
  helpkwd: String;
begin
  Caption := FORM_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;
  Caption := GetModalResultStr(res);
end;

procedure TDemoForm.btnQuestionDlgClick(Sender: TObject);
var
  mt: TMsgDlgType;
  res: Integer;
  msg: String;
  helpkwd: String;
begin
  Caption := FORM_CAPTION;
  mt := TMsgDlgType(rgMsgType.ItemIndex);
  msg := MSG_TEXT[rgMessage.ItemIndex];
  helpkwd := 'HTML/index.html';                     
  // There are two ways to work with this dialog:
  // - use the Delphi compatible mrXXX constants (DO NOT USE THE mbXXX CONSTANTS!)
  // - use the LCL idButtonXXX constants
  case rgButtons.ItemIndex of
    0: res := QuestionDlg(DLG_TITLE, msg, mt, [mrYes, 'Yes sir'], helpkwd);
    1: res := QuestionDlg(DLG_TITLE, msg, mt, [mrYes, 'Yes sir', mrNo, 'No sir', 'IsDefault', mrCancel, 'Changed my mind'], helpkwd);
    2: res := QuestionDlg(DLG_TITLE, msg, mt, [mrYes, 'Yes sir', mrYesToAll, 'I fully agree', mrNo, 'No sir', 'IsDefault', mrNoToAll, 'I fully disagree', mrCancel, 'Changed my mind', 'IsCancel'], helpkwd);
    3: res := QuestionDlg(DLG_TITLE, msg, mt, [mrYes, 'Yes sir', mrYesToAll, 'I fully agree', mrNo, 'No sir', 'IsDefault', mrNoToAll, 'I fully disagree', mrCancel, 'Changed my mind', 'IsCancel', mrClose, 'Schließen', mrNone, 'Hilfe'], helpkwd);
  end;
  Caption := GetModalResultStr(res);                  
                                                        (*
  case rgButtons.ItemIndex of
    0: res := QuestionDlg(DLG_TITLE, msg, mt, [idButtonYes, 'Yes sir'], helpkwd);
    1: res := QuestionDlg(DLG_TITLE, msg, mt, [idButtonYes, 'Yes sir', idButtonNo, 'No sir', 'IsDefault', idButtonCancel, 'Changed my mind'], helpkwd);
    2: res := QuestionDlg(DLG_TITLE, msg, mt, [idButtonYes, 'Yes sir', idButtonYesToAll, 'I fully agree', idButtonNo, 'No sir', 'IsDefault', idButtonNoToAll, 'I fully disagree', idButtonCancel, 'Changed my mind', 'IsCancel'], helpkwd);
    3: res := QuestionDlg(DLG_TITLE, msg, mt, [idButtonYes, 'Yes sir', idButtonYesToAll, 'I fully agree', idButtonNo, 'No sir', 'IsDefault', idButtonNoToAll, 'I fully disagree', idButtonCancel, 'Changed my mind', 'IsCancel', idButtonClose, 'Schließen', idButtonHelp, 'Hilfe'], helpkwd);
  end;
  Caption := FORM_CAPTION + ' - Result: ' + BUTTON_NAMES[res];
                                                          *)
end;

procedure TDemoForm.btnDefaultPromptDlgClick(Sender: TObject);
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
  Caption := FORM_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! 
  Caption := FORM_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
  Caption := FORM_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
  );
  Caption := GetModalResultStr(res);

  btns.Free;
end;

procedure TDemoForm.FormCreate(Sender: TObject);
begin
  Caption := FORM_CAPTION;
  cbFontName.Items.Assign(Screen.Fonts);
  cbFontName.ItemIndex := Max(0, cbFontName.Items.IndexOf('Liberation Sans'));
  cbFontName.Enabled := false;
  seFontSize.Enabled := false;
end;

procedure TDemoForm.rgTextBkColorClick(Sender: TObject);
begin
  case rgTextBkColor.ItemIndex of
    0: QuestionDlgEx_TextBkColor := clWindow;
    1: QuestionDlgEx_TextBkColor := clBtnFace;
  end;
end;

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

end.