2011. március 17., csütörtök

How to implement custom button captions in a MessageDlg


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.


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;


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

  TAboutProperty = class(TPropertyEditor)
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetName: string; override;
    function GetValue: string; override;

  {This class can hold the different values for the caption used in the messagebox}
  TggDlgTypeCaption = class(TPersistent)
    FInformationText: string;
    FWarningText: string;
    FErrorText: string;
    FConfirmationText: string;
    FCustomText: string;
    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;

  {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)
    FInclude: Boolean;
    FCaption: string;
    FWidth: Integer;
    property Include: Boolean read FInclude write FInclude;
    property Caption: string read FCaption write FCaption;
    property Width: Integer read FWidth write FWidth;

  {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)
    FYes: TggButton;
    FNO: TggButton;
    FCancel: TggButton;
    FOK: TggButton;
    FHelp: TggButton;
    FAbort: TggButton;
    FRetry: TggButton;
    FIgnore: TggButton;
    FAll: TggButton;
    constructor Create;
    destructor Destroy; override;
    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;

  {This is the actual ggMessageBox Component. This is the only registed class of this unit.}
  TggMessageDlg = class(TComponent)
    FAbout: TAboutProperty;
    FDlgType: TMsgDlgType;
    FDlgTypeText: TggDlgTypeCaption;
    FMsgDlgButtons: TMsgDlgButtons;
    FText: string;
    FWidth: Integer;
    FggButtons: TggButtons;
    FDesignTimeTest: Boolean;
    function DoggMessageDLG(const Msg: string; DlgType: TMsgDlgType;
      ggButtons: TMsgDlgButtons; HelpCtx: LongInt): Integer;
    procedure SetDesignTimeTest(Value: Boolean);
    property MsgDlgButtons: TMsgDlgButtons read FMsgDlgButtons write FMsgDlgButtons;
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Integer;
    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;

procedure register;


{The TggButtons Class}

constructor TggButtons.Create;
  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;

destructor TggButtons.Destroy;
  inherited Destroy;

{The TggMessageDlg Component}

constructor TggMessageDlg.Create(AOwner: TComponent);
  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}

destructor TggMessageDlg.Destroy;
  inherited Destroy;

{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);
  {There's no need to set anything here, so let's not confuse the user to much here.}
  if Value then
    if Text = '' then
      Text := 'FreeWare' + #13 + 'by' + #13 + 'Geurts Guido' + #13 + '1998' + #13 + 'Delphi 3';
    if Text = 'FreeWare' + #13 + 'by' + #13 + 'Geurts Guido' + #13 + '1998' + #13 + 'Delphi 3' then
      Text := '';

{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;
  Result := -1;
  MsgDlgButtons := [];
  with ggButtons do
    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];
  Result := DoggMessageDLG(Text, DlgType, MsgDlgButtons, 0);

{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;
  I: Integer;
  with CreateMessageDialog(Msg, DlgType, ggButtons) do
    case DlgType of
        if DlgTypeCaption.InformationText <> '' then
          Caption := DlgTypeCaption.InformationText;
        if DlgTypeCaption.WarningText <> '' then
          Caption := DlgTypeCaption.WarningText;
        if DlgTypeCaption.ErrorText <> '' then
          Caption := DlgTypeCaption.ErrorText;
        if DlgTypeCaption.ConfirmationText <> '' then
          Caption := DlgTypeCaption.ConfirmationText;
        if DlgTypeCaption.CustomText <> '' then
          Caption := DlgTypeCaption.CustomText;
    for I := 0 to ComponentCount - 1 do
      if (Components[I]).name = 'Yes' then
        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;
      if (Components[I]).name = 'No' then
        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;
      if (Components[I]).name = 'Cancel' then
        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;
      if (Components[I]).name = 'OK' then
        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;
      if (Components[I]).name = 'Help' then
        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;
      if (Components[I]).name = 'Abort' then
        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;
      if (Components[I]).name = 'Retry' then
        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;
      if (Components[I]).name = 'Ignore' then
        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;
      if (Components[I]).name = 'All' then
        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;
    HelpContext := HelpCtx;
    {Width := Self.Width;}
    Result := ShowModal;


procedure TAboutProperty.Edit;
  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);

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

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

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

{Non class related procedures and functions}

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


Nincsenek megjegyzések:

Megjegyzés küldése