How to implement custom button captions in a MessageDlg

Problem/Question/Abstract:

Is there a way to show a message box with some custom button captions (not only Yes, No, Cancel, etc.)? I know there are some third party components for using translating an application in different languages, but I would like to do it with only the standard functions or APIs.

Answer:

{
TggMessageDlg Component.
Author: Geurts Guido.
Date: 04 December 1998.
Delphi version: Delphi 3 Client/Server, no patches installed.
Operating System: Windows NT 4 WorkStation.
Known bugs: None at this time

Still to test features:
Try running it under different languages of windows, see if it still is able to change the captions of
the buttons.
}

unit ggMsgDlg;

interface

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

type
  TAboutProperty = class(TPropertyEditor)
  private
  protected
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetName: string; override;
    function GetValue: string; override;
  end;

  {This class can hold the different values for the caption used in the messagebox}
  TggDlgTypeCaption = class(TPersistent)
  private
    FInformationText: string;
    FWarningText: string;
    FErrorText: string;
    FConfirmationText: string;
    FCustomText: string;
  protected
  public
  published
    property InformationText: string read FInformationText write FInformationText;
    property WarningText: string read FWarningText write FWarningText;
    property ErrorText: string read FErrorText write FErrorText;
    property ConfirmationText: string read FConfirmationText write FConfirmationText;
    property CustomText: string read FCustomText write FCustomText;
  end;

  {This class stores values that can be used later to determine if a "button" is to be included
  in the messagebox or not, and if so, if the caption and/ or width needs to be overriden.}
  TggButton = class(TPersistent)
  private
    FInclude: Boolean;
    FCaption: string;
    FWidth: Integer;
  protected
  public
  published
    property Include: Boolean read FInclude write FInclude;
    property Caption: string read FCaption write FCaption;
    property Width: Integer read FWidth write FWidth;
  end;

  {This class defines the possible buttons that can be set and configured in the messagebox.
  To know if a button is to be included or not, and any other information about this button, is
  stored in the TggButton Class.}
  TggButtons = class(TPersistent)
  private
    FYes: TggButton;
    FNO: TggButton;
    FCancel: TggButton;
    FOK: TggButton;
    FHelp: TggButton;
    FAbort: TggButton;
    FRetry: TggButton;
    FIgnore: TggButton;
    FAll: TggButton;
  protected
  public
    constructor Create;
    destructor Destroy; override;
  published
    property Yes: TggButton read FYes write FYes;
    property NO: TggButton read FNo write FNo;
    property Cancel: TggButton read FCancel write FCancel;
    property OK: TggButton read FOK write FOK;
    property Help: TggButton read FHelp write FHelp;
    property Abort: TggButton read FAbort write FAbort;
    property Retry: TggButton read FRetry write FRetry;
    property Ignore: TggButton read FIgnore write FIgnore;
    property All: TggButton read FAll write FAll;
  end;

  {This is the actual ggMessageBox Component. This is the only registed class of this unit.}
  TggMessageDlg = class(TComponent)
  private
    FAbout: TAboutProperty;
    FDlgType: TMsgDlgType;
    FDlgTypeText: TggDlgTypeCaption;
    FMsgDlgButtons: TMsgDlgButtons;
    FText: string;
    FWidth: Integer;
    FggButtons: TggButtons;
    FDesignTimeTest: Boolean;
  protected
    function DoggMessageDLG(const Msg: string; DlgType: TMsgDlgType;
      ggButtons: TMsgDlgButtons; HelpCtx: LongInt): Integer;
    procedure SetDesignTimeTest(Value: Boolean);
    property MsgDlgButtons: TMsgDlgButtons read FMsgDlgButtons write FMsgDlgButtons;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Integer;
  published
    property About: TAboutProperty read FAbout write FAbout;
    property Text: string read FText write FText;
    property DlgType: TMsgDlgType read FDlgType write FDlgType;
    property Width: Integer read FWidth write FWidth;
    property DlgTypeCaption: TggDlgTypeCaption read FDlgTypeText write FDlgTypeText;
    property ggButtons: TggButtons read FggButtons write FggButtons;
    property DesignTimeTest: Boolean read FDesignTimeTest write SetDesignTimeTest;
  end;

procedure register;

implementation

{The TggButtons Class}

constructor TggButtons.Create;
begin
  inherited Create;
  FYes := TggButton.Create;
  FNo := TggButton.Create;
  FCancel := TggButton.Create;
  FOK := TggButton.Create;
  FHelp := TggButton.Create;
  FAbort := TggButton.Create;
  FRetry := TggButton.Create;
  FIgnore := TggButton.Create;
  FAll := TggButton.Create;
end;

destructor TggButtons.Destroy;
begin
  FYes.Free;
  FNo.Free;
  FCancel.Free;
  FOK.Free;
  FHelp.Free;
  FAbort.Free;
  FRetry.Free;
  FIgnore.Free;
  FAll.Free;
  inherited Destroy;
end;

{The TggMessageDlg Component}

constructor TggMessageDlg.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDlgTypeText := TggDlgTypeCaption.Create;
  FggButtons := TggButtons.Create;
  ggButtons.OK.Include := True;
  DlgType := mtInformation;
  {if (csAncestor in ComponentState) then
    DesignTimeTest := True;  //Does not work yet}
end;

destructor TggMessageDlg.Destroy;
begin
  FDlgTypeText.Free;
  FggButtons.Free;
  inherited Destroy;
end;

{This published property can show the designed messagebox at designtime so the developer
does not have to his program every time he changes the messagebox and want's to see what he
has made of it. Its value remains false, because there simply is no use for storing anything here.}

procedure TggMessageDlg.SetDesignTimeTest(Value: Boolean);
begin
  {There's no need to set anything here, so let's not confuse the user to much here.}
  if Value then
  begin
    if Text = '' then
      Text := 'FreeWare' + #13 + 'by' + #13 + 'Geurts Guido' + #13 + '1998' + #13 + 'Delphi 3';
    Execute;
    if Text = 'FreeWare' + #13 + 'by' + #13 + 'Geurts Guido' + #13 + '1998' + #13 + 'Delphi 3' then
      Text := '';
  end;
end;

{This public procedure still needs to be rebuild to give back the modal result of the messagebox.
Damned, why did I not think of this before. It will popup the messagebox at runtime.}

function TggMessageDlg.Execute: Integer;
begin
  Result := -1;
  MsgDlgButtons := [];
  with ggButtons do
  begin
    if YES.Include then
      MsgDlgButtons := MsgDlgButtons + [mbYes];
    if NO.Include then
      MsgDlgButtons := MsgDlgButtons + [mbNO];
    if Cancel.Include then
      MsgDlgButtons := MsgDlgButtons + [mbCancel];
    if OK.Include then
      MsgDlgButtons := MsgDlgButtons + [mbOK];
    if Help.Include then
      MsgDlgButtons := MsgDlgButtons + [mbHelp];
    if Abort.Include then
      MsgDlgButtons := MsgDlgButtons + [mbAbort];
    if Retry.Include then
      MsgDlgButtons := MsgDlgButtons + [mbRetry];
    if Ignore.Include then
      MsgDlgButtons := MsgDlgButtons + [mbIgnore];
    if All.Include then
      MsgDlgButtons := MsgDlgButtons + [mbAll];
  end;
  Result := DoggMessageDLG(Text, DlgType, MsgDlgButtons, 0);
end;

{This function is the actual motor of the component. It will change the layout of the messabox
while Delphi is creating it, to the layout speficied by the devoloper.}

function TggMessageDlg.DoggMessageDLG(const Msg: string; DlgType: TMsgDlgType;
  ggButtons: TMsgDlgButtons; HelpCtx: LongInt): Integer;
var
  I: Integer;
begin
  with CreateMessageDialog(Msg, DlgType, ggButtons) do
  try
    case DlgType of
      mtInformation:
        if DlgTypeCaption.InformationText <> '' then
          Caption := DlgTypeCaption.InformationText;
      mtWarning:
        if DlgTypeCaption.WarningText <> '' then
          Caption := DlgTypeCaption.WarningText;
      mtError:
        if DlgTypeCaption.ErrorText <> '' then
          Caption := DlgTypeCaption.ErrorText;
      mtConfirmation:
        if DlgTypeCaption.ConfirmationText <> '' then
          Caption := DlgTypeCaption.ConfirmationText;
      mtCustom:
        if DlgTypeCaption.CustomText <> '' then
          Caption := DlgTypeCaption.CustomText;
    end;
    for I := 0 to ComponentCount - 1 do
    begin
      if (Components[I]).name = 'Yes' then
      begin
        if Self.ggButtons.Yes.Caption <> '' then
          TButton(Components[I]).Caption := Self.ggButtons.Yes.Caption;
        if Self.ggButtons.Yes.Width <> 0 then
          TButton(Components[I]).Width := Self.ggButtons.Yes.Width;
      end;
      if (Components[I]).name = 'No' then
      begin
        if Self.ggButtons.NO.Caption <> '' then
          TButton(Components[I]).Caption := Self.ggButtons.NO.Caption;
        if Self.ggButtons.NO.Width <> 0 then
          TButton(Components[I]).Width := Self.ggButtons.NO.Width;
      end;
      if (Components[I]).name = 'Cancel' then
      begin
        if Self.ggButtons.Cancel.Caption <> '' then
          TButton(Components[I]).Caption := Self.ggButtons.Cancel.Caption;
        if Self.ggButtons.Cancel.Width <> 0 then
          TButton(Components[I]).Width := Self.ggButtons.Cancel.Width;
      end;
      if (Components[I]).name = 'OK' then
      begin
        if Self.ggButtons.OK.Caption <> '' then
          TButton(Components[I]).Caption := Self.ggButtons.OK.Caption;
        if Self.ggButtons.OK.Width <> 0 then
          TButton(Components[I]).Width := Self.ggButtons.OK.Width;
      end;
      if (Components[I]).name = 'Help' then
      begin
        if Self.ggButtons.Help.Caption <> '' then
          TButton(Components[I]).Caption := Self.ggButtons.Help.Caption;
        if Self.ggButtons.Help.Width <> 0 then
          TButton(Components[I]).Width := Self.ggButtons.Help.Width;
      end;
      if (Components[I]).name = 'Abort' then
      begin
        if Self.ggButtons.Abort.Caption <> '' then
          TButton(Components[I]).Caption := Self.ggButtons.Abort.Caption;
        if Self.ggButtons.Abort.Width <> 0 then
          TButton(Components[I]).Width := Self.ggButtons.Abort.Width;
      end;
      if (Components[I]).name = 'Retry' then
      begin
        if Self.ggButtons.Retry.Caption <> '' then
          TButton(Components[I]).Caption := Self.ggButtons.Retry.Caption;
        if Self.ggButtons.Retry.Width <> 0 then
          TButton(Components[I]).Width := Self.ggButtons.Retry.Width;
      end;
      if (Components[I]).name = 'Ignore' then
      begin
        if Self.ggButtons.Ignore.Caption <> '' then
          TButton(Components[I]).Caption := Self.ggButtons.Ignore.Caption;
        if Self.ggButtons.Ignore.Width <> 0 then
          TButton(Components[I]).Width := Self.ggButtons.Ignore.Width;
      end;
      if (Components[I]).name = 'All' then
      begin
        if Self.ggButtons.All.Caption <> '' then
          TButton(Components[I]).Caption := Self.ggButtons.All.Caption;
        if Self.ggButtons.All.Width <> 0 then
          TButton(Components[I]).Width := Self.ggButtons.All.Width;
      end;
    end;
    HelpContext := HelpCtx;
    {Width := Self.Width;}
    Result := ShowModal;
  finally
    Free;
  end;
end;

{TAboutProperty}

procedure TAboutProperty.Edit;
begin
  MessageBox(0, PChar('TggMessageDlg component' + #13 + #13 + 'by Geurts
    Guido - guido.geurts@advalvas.be ' + #13 + ' 10 / 03 / 1999'),
    PChar('The GuidoG utilities present...'), MB_OK);
end;

function TAboutProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly];
end;

function TAboutProperty.GetName: string;
begin
  Result := 'About';
end;

function TAboutProperty.GetValue: string;
begin
  Result := GetStrValue;
end;

{Non class related procedures and functions}

procedure register;
begin
  RegisterComponents('GuidoG', [TggMessageDlg]);
  RegisterPropertyEditor(TypeInfo(TAboutProperty), TggMessageDlg, 'About', TAboutProperty);
end;

end.