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.

Nincsenek megjegyzések:

Megjegyzés küldése