How to set focus on a MessageDlg button

Problem/Question/Abstract:

Is there a way to set the focus on a certain button when using MessageDlg? I want to be able to set focus to the No button when the dialog executes. By default the focus is always on the Yes button, no matter what order I code them in the function.

Answer:

Solve 1:

I had a similar situation come up and I wanted to specify which button was considered the default when pressing ENTER and which one would be the default for pressing ESCAPE. Also, I wanted other text in the buttons. So instead of Yes/ No I would have liked Save File/ Skip Save.

Then it becomes easier for the user to determine which button to press. They don't have to read the whole message, they can just look at the button. So, I will give you my code for that. I call it MultiMessageDlg, you can specify up to 4 buttons. Here is the source for my form:


unit MultiAsk;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

type
  TMultiAskMenu = class(TForm)
    LAsk: TLabel;
    PButtons: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Panel1: TPanel;
    Image1: TImage;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure Setup(MsgType: TMsgDlgType; Num: Integer; Title, Ask, S1, S2, S3, S4: string);
  end;

var
  MultiAskMenu: TMultiAskMenu;

implementation

uses
  GlobalRW;

{$R *.DFM}

procedure ButtonCode(const Butt1: TButton; var Cap: string);
begin
  Butt1.Cancel := False;
  Butt1.Tag := 0;
  if Pos(' + ', Cap) = 1 then
  begin
    Butt1.Tag := 1;
    Delete(Cap, 1, 1);
  end;
  if Pos(' - ', Cap) = 1 then
  begin
    Butt1.Cancel := True;
    Delete(Cap, 1, 1);
  end;
  Butt1.Caption := Cap;
end;

procedure TMultiAskMenu.Setup(MsgType: TMsgDlgType; Num: Integer;
  Title, Ask, S1, S2, S3, S4: string);
var
  TmpBmp: TBitMap;
  IconID: PChar;
  X, W1, W2, W3, W4: Integer;
  NonClientMetrics: TNonClientMetrics;
  HIcon1: HIcon;
const
  IconIDs: array[TMsgDlgType] of PChar = (IDI_EXCLAMATION, IDI_HAND, IDI_ASTERISK,
    IDI_QUESTION, nil);
begin
  case MsgType of
    mtInformation:
      begin
        Self.Caption := ' Information ';
      end;
    mtWarning: b
      begin
        Self.Caption := ' Warning ';
      end;
    mtError:
      begin
        Self.Caption := ' Error ';
      end;
  end;
  if Title <> '' then
    Self.Caption := Title;
  NonClientMetrics.cbSize := SizeOf(NonClientMetrics);
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
    LAsk.Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
  IconID := IconIDs[MsgType];
  if IconID <> nil then
  begin
    with Image1 do
    begin
      HIcon1 := LoadIcon(0, IconID);
      Picture.Icon.ReleaseHandle;
      Picture.Icon.Handle := HIcon1;
    end;
  end;
  TmpBmp := TBitMap.Create;
  TmpBmp.Canvas.Font := Button1.Font;
  W1 := TmpBmp.Canvas.TextWidth(S1) + 10;
  Button1.Width := W1;
  W2 := TmpBmp.Canvas.TextWidth(S2) + 10;
  Button2.Width := W2;
  W3 := TmpBmp.Canvas.TextWidth(S3) + 10;
  Button3.Width := W3;
  W4 := TmpBmp.Canvas.TextWidth(S4) + 10;
  Button4.Width := W4;
  TmpBmp.Free;
  LAsk.Caption := Ask;
  PButtons.Top := LAsk.Top + LAsk.Height + 30;
  case Num of
    1:
      begin
        Button1.Left := Button2.Left;
        Button2.Visible := False;
        Button3.Visible := False;
        Button4.Visible := False;
        Button1.Left := (Self.Width - W1) div 2;
      end;
    2:
      begin
        Button2.Left := Button3.Left;
        Button3.Visible := False;
        Button4.Visible := False;
        Button1.Caption := S1;
        X := (Self.Width - W1 - W2) div 3;
        Button1.Left := X;
        Button2.Left := X + W1 + X;
      end;
    3:
      begin
        Button4.Visible := False;
        X := (Self.Width - W1 - W2 - W3) div 4;
        Button1.Left := X;
        Button2.Left := X + W1 + X;
        Button3.Left := X + W1 + X + W2 + X;
      end;
    4:
      begin
        X := (Self.Width - W1 - W2 - W3 - W4) div 5;
        Button1.Left := X;
        Button2.Left := Button1.Left + W1 + X;
        Button3.Left := Button2.Left + W2 + X;
        Button4.Left := Button3.Left + W3 + X;
      end;
  end;
  {Take into Account pressing ESCAPE and Default buttons!!!
  +Yes  + = Default
  -No  - = Escape}
  ButtonCode(Button1, S1);
  ButtonCode(Button2, S2);
  ButtonCode(Button3, S3);
  ButtonCode(Button4, S4);
  Self.AutoSize := True;
end;

procedure TMultiAskMenu.Button1Click(Sender: TObject);
begin
  ModalResult := 1;
end;

procedure TMultiAskMenu.Button2Click(Sender: TObject);
begin
  ModalResult := 2;
end;

procedure TMultiAskMenu.Button3Click(Sender: TObject);
begin
  ModalResult := 3;
end;

procedure TMultiAskMenu.Button4Click(Sender: TObject);
begin
  ModalResult := 4;
end;

procedure TMultiAskMenu.FormShow(Sender: TObject);
begin
  if Button1.Tag = 1 then
    Button1.SetFocus;
  if Button2.Tag = 1 then
    Button2.SetFocus;
  if Button3.Tag = 1 then
    Button3.SetFocus;
  if Button4.Tag = 1 then
    Button4.SetFocus;
end;

procedure TMultiAskMenu.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Self.Image1.Picture.Icon.ReleaseHandle;
end;

end.

So in order to use it you would do something like this:


if MultiMessageDlg('',
  ' It has been awhile since you last checked for updates. Do you  wish to check the TurboView Internet site for updates to TurboView?',
  mtInformation, 2, ' + Check NOW ', ' - Check Next Month', '', '') = 1 then
begin
  {code to do checking for the latest version of program}
end;


So the format is MultiMessageDlg(TitleText, MessageText, MessageType, NumberOfButtons, Button1Text, Button2Text, Button3Text, Button4Text);

The return value is which button was pressed [1..4];

TitleText is optional, if not title is given then the normal MessageDlg title will be used for window dialog title.

MessageText is what message you want displayed

MessageType is the same thing you provide to the normal MessageDlg function

NumberOfButtons is how many buttons to actually display

ButtonText, you can provide text for up to 4 buttons.

Note: If you want a certain button to be the DEFAULT button, then you would put a "+" plus sign in front of the text. For example: "+Save File" . And if you want a button to be the default ESCAPE button, then put a "-" minus in front, like so: "-Dont Save".


Solve 2:

The following function will let you define the default button, then center the dialog above the OwnerWnd, and then play the sound associated with the message type:


function MessageDlgEx(OwnerWnd: HWND; DefButton: Integer; const Msg: string;
  DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): Integer;
var
  vButton: TButton;
  vRect: TRect;
  vWidth: Integer;
  vHeight: Integer;
  vTop: Integer;
  vLeft: Integer;
  I: Integer;
begin
  with CreateMessageDialog(Msg, DlgType, Buttons) do
  begin
    try
      { Get the TRect }
      GetWindowRect(OwnerWnd, vRect);
      { Center the dialog }
      vWidth := vRect.Right - vRect.Left;
      vHeight := vRect.Bottom - vRect.Top;
      vTop := vRect.Top;
      vLeft := vRect.Left;
      Top := vTop + ((vHeight - Height) div 2);
      Left := vLeft + ((vWidth - Width) div 2);
      { Set the default button }
      for I := 0 to Pred(ComponentCount) do
      begin
        if Components[I] is TButton then
        begin
          vButton := TButton(Components[I]);
          vButton.Default := (vButton.ModalResult = DefButton);
          if vButton.Default then
          begin
            ActiveControl := vButton;
          end;
        end;
      end;
      { Play the sound associated with the DlgType }
      case DlgType of
        mtConfirmation: MessageBeep(MB_ICONQUESTION);
        mtError: MessageBeep(MB_ICONERROR);
        mtInformation: MessageBeep(MB_ICONINFORMATION);
        mtWarning: MessageBeep(MB_ICONWARNING);
      end;
      { Show the dialog }
      Result := ShowModal;
    finally
      free;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if MessageDlgEx(Handle, mrNo, 'Do you wan''t this program to erase all of your files?',
    mtWarning, [mbYes, mbNo]) = mrYes then
    ShowMessage('Okay...');
end;