unit myDialogs;
//##############################################################################
interface
uses Dialogs,Classes;
//##############################################################################
function MessageDlgDefault(
const aCaption :
string;
const Msg :
string;
DlgType : TMsgDlgType;
Buttons : TMsgDlgButtons;
DefButton : integer;
HelpCtx : longint): integer;
//##############################################################################
implementation
uses Windows, Controls, sysutils, forms, StdCtrls, Graphics,
IniFiles;
const { Copied from Dialogs }
ModalResults :
array[TMsgDlgBtn]
of integer = (mrYes, mrNo, mrOk,
mrCancel, mrAbort, mrRetry, mrIgnore, mrAll,
mrNoToAll, mrYesToAll, 0);
var { Filled during unit initialization }
ButtonCaptions :
array[TMsgDlgBtn]
of string;
AskNoMoreCaption:
string;
//##############################################################################
{-----------------------------------------------------------------------------
Procedure: ModalResultToBtn
Arguments: res : TModalResult
Result: TMsgDlgBtn
Comment: Convert a modal result to a TMsgDlgBtn code
-----------------------------------------------------------------------------}
function ModalResultToBtn(res : TModalResult): TMsgDlgBtn;
begin
for Result := Low(Result)
to High(Result)
do
begin
if ModalResults[Result] = res
then
Exit;
end;
{ For }
Result := mbHelp;
// to remove warning only
Assert(False, '
ModalResultToBtn: unknown modalresult ' +
IntToStr(res));
end;
{ ModalResultToBtn }
{-----------------------------------------------------------------------------
Procedure: AdjustButtons
Arguments: aForm : TForm
Result: None
Comment: When the button captions on the message form are translated
the button size and as a consequence the button positions need
to be adjusted
-----------------------------------------------------------------------------}
procedure AdjustButtons(aForm : TForm);
var buttons : TList;
btnWidth : integer;
btnGap : integer;
procedure CollectButtons;
var i : integer;
begin
for i := 0
to aForm.Controlcount - 1
do
if aForm.Controls[i]
is TButton
then
buttons.Add(aForm.Controls[i]);
end;
{ CollectButtons }
procedure MeasureButtons;
var i : integer;
textrect : TRect;
w : integer;
begin
btnWidth := TButton(buttons[0]).Width;
aForm.Canvas.Font := aForm.Font;
for i := 0
to buttons.Count - 1
do
begin
TextRect := Rect(0, 0, 0, 0);
Windows.DrawText(aform.canvas.handle,
PChar(TButton(buttons[i]).Caption), - 1,
TextRect,
DT_CALCRECT
or DT_LEFT
or DT_SINGLELINE);
with TextRect
do w := Right - Left + 16;
if w > btnWidth
then btnWidth := w;
end;
{ For }
if buttons.Count > 1
then
btnGap := TButton(buttons[1]).Left -
TButton(buttons[0]).Left -
TButton(buttons[0]).Width
else
btnGap := 0;
end;
{ MeasureButtons }
procedure SizeButtons;
var i : integer;
begin
for i := 0
to buttons.Count - 1
do
TButton(buttons[i]).Width := btnWidth;
end;
{ SizeButtons }
procedure ArrangeButtons;
var i : integer;
total, left : integer;
begin
total := (buttons.Count - 1) * btnGap;
for i := 0
to buttons.Count - 1
do
Inc(total, TButton(buttons[i]).Width);
left := (aForm.ClientWidth - total)
div 2;
if left < 0
then
begin
aForm.Width := aForm.Width + 2 * Abs(left) + 16;
left := 8;
end;
{ If }
for i := 0
to buttons.Count - 1
do
begin
TButton(buttons[i]).Left := left;
Inc(left, btnWidth + btnGap);
end;
end;
{ ArrangeButtons }
begin
buttons := TList.Create;
try
CollectButtons;
if buttons.Count = 0
then
Exit;
MeasureButtons;
SizeButtons;
ArrangeButtons;
finally
buttons.Free;
end;
{ finally }
end;
{ AdjustButtons }
{-----------------------------------------------------------------------------
Procedure: InitMsgForm
Arguments: aForm : TForm; const aCaption : string; helpCtx : longint; DefButton : integer
Result: None
Comment:
-----------------------------------------------------------------------------}
procedure InitMsgForm(aForm : TForm;
const aCaption :
string;
helpCtx : longint; DefButton : integer);
var
i : integer;
btn : TButton;
begin
with aForm
do
begin
if Length(aCaption) > 0
then
Caption := aCaption;
HelpContext := HelpCtx;
for i := 0
to ComponentCount - 1
do
begin
if Components[i]
is TButton
then
begin
btn := TButton(Components[i]);
btn.
Default := btn.ModalResult = DefButton;
if btn.
Default then
ActiveControl := Btn;
{$IFNDEF STANDARDCAPTIONS}
btn.Caption :=
ButtonCaptions[ModalResultToBtn(btn.Modalresult)];
{$ENDIF}
end;
end;
{ For }
{$IFNDEF STANDARDCAPTIONS}
AdjustButtons(aForm);
{$ENDIF}
end;
end;
{ InitMsgForm }
{-----------------------------------------------------------------------------
Procedure: InitButtonCaptions
Arguments: None
Result: None
Comment:
-----------------------------------------------------------------------------}
procedure InitButtonCaptions;
var sprache:
string;
ini,language_file:TiniFile;
begin
ini:=tinifile.Create(extractFileDir(application.exeName)+'
\'+inifile);
sprache:=ini.ReadString('
Main','
Language','
Deutsch');
if fileexists(extractfiledir(application.ExeName)+'
\language\'+sprache+'
.language')
then begin
language_file:=tinifile.Create(extractfiledir(application.ExeName)+'
\language\'+sprache+'
.language');
ButtonCaptions[mbYes] := language_file.ReadString('
MessageButtons','
Yes','
&Yes');
ButtonCaptions[mbNo] := language_file.ReadString('
MessageButtons','
No','
&No');
ButtonCaptions[mbOK] := language_file.ReadString('
MessageButtons','
OK','
OK');
ButtonCaptions[mbCancel] := language_file.ReadString('
MessageButtons','
Cancel','
Cancel');
ButtonCaptions[mbAbort] := language_file.ReadString('
MessageButtons','
Abort','
&Abort');
ButtonCaptions[mbRetry] := language_file.ReadString('
MessageButtons','
Retry','
&Retry');
ButtonCaptions[mbIgnore] := language_file.ReadString('
MessageButtons','
Ignore','
&Ignore');
ButtonCaptions[mbAll] := language_file.ReadString('
MessageButtons','
All','
&All');
ButtonCaptions[mbNoToAll] := language_file.ReadString('
MessageButtons','
NoToAll','
N&o to All');
ButtonCaptions[mbYesToAll] := language_file.ReadString('
MessageButtons','
YesToAll','
Yes to &All');
ButtonCaptions[mbHelp] := language_file.ReadString('
MessageButtons','
Help','
Help');
end;
end;
{ InitButtonCaptions }
{-----------------------------------------------------------------------------
Procedure: MessageDlgDefault
Arguments: const aCaption : string; const Msg : string; DlgType : TMsgDlgType; Buttons : TMsgDlgButtons; DefButton : integer; HelpCtx : longint
Result: integer
Comment: Creates a messagedlg with translated button captions and a configurable
default button and caption.
@Param aCaption Caption to use for the dialog. If empty the
default is used.
@Param Msg message to display
@Param DlgType type of dialog, see messagedlg online help
@Param Buttons buttons to display, see messagedlg online help
@Param DefButton ModalResult of the button that should be the
default.
@Param HelpCtx help context (optional)
@Returns the ModalResult of the dialog
-----------------------------------------------------------------------------}
function MessageDlgDefault(
const aCaption :
string;
const Msg :
string;
DlgType : TMsgDlgType; Buttons : TMsgDlgButtons; DefButton : integer;
HelpCtx : longint): integer;
var aForm : TForm;
begin { Defmessagedlg }
InitButtonCaptions;
aForm := CreateMessageDialog(Msg, DlgType, Buttons);
try
InitMsgForm(aForm, aCaption, helpCtx, DefButton);
Result := aForm.ShowModal;
finally
aForm.Free;
end;
end;
{ Defmessagedlg }