2010. július 6., kedd
How to display a 'Don't ask again' checkbox in a dialog box
Problem/Question/Abstract:
I was just wondering if there is a way, either with Windows API or Delphi's VCL, to get the 'Don't ask again' checkbox in a dialog box, other than creating one from scratch.
Answer:
You have to create a form, this is not a stock windows dialog. Take a look at the following unit, especially the MessageDlgWithNoMorebox function.
{
MyDialogs: Collects modified dialog functions
Author: Dr. Peter Below
Description: Version 1.01 created 4 Juli 2001, added translation of button captions.
Last modified: 4 Juli 2001
}
unit MyDialogs;
interface
uses
Dialogs;
function DefMessageDlg(const aCaption: string; const Msg: string; DlgType:
TMsgDlgType;
Buttons: TMsgDlgButtons; DefButton: Integer; HelpCtx: Longint): Integer;
function MessageDlgWithNoMorebox(const aCaption: string; const Msg: string;
DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; DefButton: Integer;
HelpCtx: Longint; var askNoMore: Boolean): Integer;
implementation
uses
Windows, Classes, Controls, stdctrls, sysutils, forms;
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;
{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;
Result := mbHelp; {to remove warning only }
Assert(False, 'ModalResultToBtn: unknown modalresult ' + IntToStr(res));
end;
{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;
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;
if buttons.count > 1 then
btnGap := TButton(buttons[1]).Left - TButton(buttons[0]).Left -
TButton(buttons[0]).Width
else
btnGap := 0;
end;
procedure SizeButtons;
var
i: Integer;
begin
for i := 0 to buttons.count - 1 do
TButton(buttons[i]).Width := btnWidth;
end;
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;
for i := 0 to buttons.count - 1 do
begin
TButton(buttons[i]).Left := left;
Inc(left, btnWidth + btnGap);
end;
end;
begin
buttons := TList.Create;
try
CollectButtons;
if buttons.Count = 0 then
exit;
MeasureButtons;
SizeButtons;
ArrangeButtons;
finally
buttons.Free;
end;
end;
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;
{$IFNDEF STANDARDCAPTIONS}
AdjustButtons(aForm);
{$ENDIF}
end;
end;
{
DefMessageDlg:
Creates a MessageDlg with translated button captions and configurable default button and caption
Parameters:
aCaption: Caption to use for the dialog. If empty the default is used.
Msg: Message to display
DlgType: Type of dialog, see MessageDlg online help
Buttons: Buttons to display, see MessageDlg online help
DefButton: ModalResult of the button that should be the default.
HelpCtx: Help context (optional)
Returns the ModalResult of the dialog
Created 07.06.1998 by P. Below, modified 04.07.2001
}
function DefMessageDlg(const aCaption: string; const Msg: string; DlgType:
TMsgDlgType;
Buttons: TMsgDlgButtons; DefButton: Integer; HelpCtx: Longint): Integer;
var
aForm: TForm;
begin
aForm := CreateMessageDialog(Msg, DlgType, Buttons);
try
InitMsgForm(aForm, aCaption, helpCtx, DefButton);
Result := aForm.ShowModal;
finally
aForm.Free;
end;
end;
resourcestring
{$IFDEF GERMAN}
AskNoMoreCaption = 'Diesen Dialog nicht mehr anzeigen';
{$ELSE}
AskNoMoreCaption = 'Don''t show this dialog again';
{$ENDIF}
{
MessageDlgWithNoMorebox:
Creates a MessageDlg with translated button captions and configurable
default button and caption
Parameters:
aCaption: Caption to use for the dialog. If empty the default is used.
Msg: Message to display
DlgType: Type of dialog, see MessageDlg online help
Buttons: Buttons to display, see MessageDlg online help
DefButton: ModalResult of the button that should be the default.
HelpCtx: Help context (optional)
askNoMore: If this is passed in as True the function will directly return
the DefButton result.
Otherwise a checkbox is shown beneath the buttons which the user can check to
not have this dialog show up in the future. Its checked state is returned in
the parameter.
Returns the ModalResult of the dialog
Created 4.7.2001 by P. Below
}
function MessageDlgWithNoMorebox(const aCaption: string; const Msg: string; DlgType:
TMsgDlgType;
Buttons: TMsgDlgButtons; DefButton: Integer; HelpCtx: Longint; var askNoMore:
Boolean): Integer;
var
aForm: TForm;
chk: TCheckbox;
begin
if askNoMore then
Result := DefButton
else
begin
aForm := CreateMessageDialog(Msg, DlgType, Buttons);
try
InitMsgForm(aForm, aCaption, helpCtx, DefButton);
chk := TCheckbox.Create(aForm);
chk.Parent := aForm;
chk.SetBounds(16, aForm.ClientHeight, aForm.Clientwidth - 32, chk.Height);
chk.Checked := False;
chk.Caption := AskNoMoreCaption;
AForm.Height := aForm.Height + chk.Height + 8;
Result := aForm.ShowModal;
askNoMore := chk.Checked;
finally
aForm.Free;
end;
end;
end;
resourcestring
{$IFDEF GERMAN}
cmbYes = '&Ja';
cmbNo = '&Nein';
cmbOK = 'OK';
cmbCancel = 'Abbrechen';
cmbHelp = '&Hilfe';
cmbAbort = '&Abbrechen';
cmbRetry = '&Wiederholen';
cmbIgnore = '&Ignorieren';
cmbAll = '&Alle';
cmbNoToAll = 'N&ein f�r alle';
cmbYesToAll = 'Ja f�r &alle';
{$ELSE}
cmbYes = '&Yes';
cmbNo = '&No';
cmbOK = 'OK';
cmbCancel = 'Cancel';
cmbHelp = '&Help';
cmbAbort = '&Abort';
cmbRetry = '&Retry';
cmbIgnore = '&Ignore';
cmbAll = '&All';
cmbNoToAll = 'N&o to All';
cmbYesToAll = 'Yes to &All';
{$ENDIF}
procedure InitButtonCaptions;
begin
ButtonCaptions[mbYes] := cmbYes;
ButtonCaptions[mbNo] := cmbNo;
ButtonCaptions[mbOK] := cmbOK;
ButtonCaptions[mbCancel] := cmbCancel;
ButtonCaptions[mbAbort] := cmbAbort;
ButtonCaptions[mbRetry] := cmbRetry;
ButtonCaptions[mbIgnore] := cmbIgnore;
ButtonCaptions[mbAll] := cmbAll;
ButtonCaptions[mbNoToAll] := cmbNoToAll;
ButtonCaptions[mbYesToAll] := cmbYesToAll;
ButtonCaptions[mbHelp] := cmbHelp;
end;
initialization
InitButtonCaptions;
end.
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése