How to implement custom button captions in a MessageDlg (Views: 30)
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. |