lazarus/lcl/include/promptdialog.inc

{%MainUnit ../dialogs.pp}

{
 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}

type

  { TPromptDialog }

  TPromptDialog = class(TCustomCopyToClipboardDialog)
  private
    FCancelKind: TBitBtnKind;
    FCreatedButtons : Array[Low(DialogButtonKind)..High(DialogButtonKind)] of TBitBtn;
    procedure CreateButtons;
  protected
    procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
      const AXProportion, AYProportion: Double); override;
    procedure FontChanged(Sender: TObject); override;
  public
    IsSmallDevice: Boolean;
  
    TheDefaultIndex : Longint;

    FImageIndex: Integer;
    MSG : AnsiString;
    NumButtons : Longint;
    Buttons : PLongint;

    TextBox : TRect;
    ImageBox: TRect;
    TextStyle : TTextStyle;

    procedure LayoutDialog;
    procedure LayoutDialogSmallDevice;
    procedure Paint; override;
    constructor CreateMessageDialog(const ACaption, aMsg: string;
      DialogType: Longint; TheButtons: PLongint; ButtonCount, DefaultIndex : Longint);
    destructor Destroy; override;
    function GetMessageText: string; override;
  end;


procedure TPromptDialog.CreateButtons;
var
  curBtn      : Longint; // variable to loop through TMsgDlgButtons
  ButtonIndex : integer;
  CurButton: TBitBtn;
  DefaultButton: TBitBtn;
begin
  ButtonIndex := -1;
  DefaultButton := nil;
  for curBtn := 0 to NumButtons - 1 do
  begin
    if (Buttons[curBtn] >= Low(DialogButtonKind)) and
       (Buttons[curBtn] <= High(DialogButtonKind)) then
    begin
      if not Assigned(FCreatedButtons[Buttons[curBtn]]) then
      begin
        inc(ButtonIndex);

        CurButton := TBitBtn.Create(Self);
        FCreatedButtons[Buttons[curBtn]] := CurButton;
        with CurButton do
        begin
          Parent:= Self;
          Layout  := blGlyphLeft;
          Kind := DialogButtonKind[Buttons[curBtn]];
          if Kind = FCancelKind then Cancel := True;

          if ButtonIndex = TheDefaultIndex then
            DefaultButton := CurButton;
        end;
      end else
        CurButton := FCreatedButtons[Buttons[curBtn]];
    end;
  end;
  if DefaultButton <> nil then
    DefaultButton.Default := True;
end;

destructor TPromptDialog.Destroy;
begin
  ReallocMem(Buttons, 0);
  inherited Destroy;
end;

procedure TPromptDialog.Paint;
var
  ATextStyle: TTextStyle;
begin
  inherited Paint;
  
  // Draws the text
  Canvas.Font := Font;
  Canvas.Font.PixelsPerInch := Font.PixelsPerInch;
  Canvas.Brush := Brush;
  ATextStyle := TextStyle;
  if Canvas.Font.PixelsPerInch<>Screen.PixelsPerInch then
    ATextStyle.SystemFont := False;

  Canvas.TextRect(TextBox, TextBox.Left, TextBox.Top, MSG, ATextStyle);

  // Draws the icon
  if (FImageIndex>=0) and not IsSmallDevice then
    DialogGlyphs.StretchDraw(Canvas, FImageIndex, ImageBox);
end;

constructor TPromptDialog.CreateMessageDialog(const ACaption, aMsg: string;
  DialogType: Longint; TheButtons: PLongint; ButtonCount, DefaultIndex: Longint
  );
var
  curBtn: Integer;
  curKind: TBitBtnKind;
begin
  inherited CreateNew(nil, 1);
  IsSmallDevice := (Screen.Width <= 300);

  AutoScroll := False;
  //debugln('TPromptDialog.CreateMessageDialog A ButtonCount=',dbgs(ButtonCount));

  ControlStyle:= ControlStyle-[csSetCaption];
  PopupMode := pmAuto;
  BorderStyle := bsDialog;
  Position    := poScreenCenter;
  SetInitialBounds(0,0,200,100);
  MSG         := LineBreaksToSystemLineBreaks(AMSG);
  Buttons     := nil;
  FImageIndex := -1;
  case DialogType of
    idDialogConfirm,
    idDialogInfo,
    idDialogWarning,
    idDialogError,
    idDialogShield:
      begin
        FImageIndex := DialogGlyphs.DialogIcon[DialogType];

        if ACaption <> '' then
          Caption := ACaption
        else
          Caption := GetDialogCaption(DialogType);
      end;
    else
      begin
        //FImageIndex := DialogGlyphs.DialogIcon[idDialogInfo]; //Delphi does not display an Icon in this case
        if ACaption <> '' then
          Caption := ACaption
        else
          Caption := Application.Title;
      end
  end;
  NumButtons := ButtonCount;
  if NumButtons>0 then
  begin
    ReallocMem(Buttons, ButtonCount * SizeOf(Longint));
    Move(TheButtons^, Buttons^, ButtonCount * SizeOf(Longint));
  end;

  if (DefaultIndex >= ButtonCount) or (DefaultIndex < 0) then
    TheDefaultIndex := 0
  else
    TheDefaultIndex := DefaultIndex;

  //Find which button should respond to cancel (if any)
  FCancelKind := bkCustom;
  for curBtn := 0 to NumButtons - 1 do
  begin
    if (Buttons[curBtn] >= Low(DialogButtonKind)) and
       (Buttons[curBtn] <= High(DialogButtonKind)) then
    begin
      curKind := DialogButtonKind[Buttons[curBtn]];
      case curKind of
        bkCancel: FCancelKind := bkCancel;
        bkNo: if (FCancelKind <> bkCancel) then FCancelKind := bkNo;
        bkOk: if not (FCancelKind in [bkCancel, bkNo]) then FCancelkind := bkOk;
      end;
    end;
  end;
  if FCancelKind = bkCustom then FCancelKind := bkCancel; //default value if no mbCancel, mbNo or mbOk

  // Assures a minimum text size
  if MSG = '' then MSG := '   ';

  // Initialize TextStyle
  FillChar(TextStyle, SizeOf(TTextStyle), 0);

  with TextStyle do
  begin
    Clipping   := True;
    Wordbreak  := True;
    SystemFont := True;
    Opaque     := False;
  end;

  if IsSmallDevice then
    LayoutDialogSmallDevice
  else
    LayoutDialog;
end;

procedure TPromptDialog.DoAutoAdjustLayout(
  const AMode: TLayoutAdjustmentPolicy; const AXProportion,
  AYProportion: Double);
begin
  inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion);

  if IsSmallDevice then
    LayoutDialogSmallDevice
  else
    LayoutDialog;
end;

procedure TPromptDialog.FontChanged(Sender: TObject);
begin
  inherited FontChanged(Sender);

  TextStyle.SystemFont := False;
end;

function TPromptDialog.GetMessageText: string;
begin
  Result := MSG;
end;

procedure TPromptDialog.LayoutDialog;
const
  cBtnCalcWidth  = 50;
  cBtnCalcHeight = 13;
  cBtnDist = 10;
var
  curBtn      : Longint; // variable to loop through TMsgDlgButtons
  cMinLeft,
  ButtonLeft  : integer;    // left position of button(s)
  TextLeft    : integer;    // left position of text
  reqBtnWidth : integer;    // width neccessary to display buttons
  reqWidth, reqHeight : integer;    // width and height neccessary to display all
  i        : integer;
  ButtonIndex : integer;
  MinBtnWidth: Integer; // minimum width for a single button
  MinBtnHeight: Integer; // minimum height for a single button
  CurButton: TBitBtn;
  ButtonTop: Integer;
  CurBtnSize: TPoint;
  DefaultButton: TBitBtn;

  function GetButtonSize(AButton: TBitBtn): TPoint;
  begin
    AButton.HandleNeeded;

    TBitBtnAccess(AButton).CalculatePreferredSize(Result.x, Result.y, True);

    if MinBtnHeight < Result.y then
      MinBtnHeight := Result.y
    else
    if Result.y < MinBtnHeight then
      Result.y := MinBtnHeight;
    if Result.x < MinBtnWidth then
      Result.x := MinBtnWidth;
  end;
  
begin
  // calculate the width & height we need to display the Message

  // calculate the needed size for the text
  TextBox := Rect(0, 0, Screen.Width div 2, Screen.Height - 100);
  // SelectObject(Canvas.Handle, Screen.SystemFont.Reference.Handle);
  DrawText(Canvas.Handle, PChar(MSG), Length(MSG),
    TextBox, DT_WORDBREAK or DT_CALCRECT or DT_NOPREFIX);

  // calculate the width we need to display the buttons
  MinBtnWidth:=Scale96ToFont(Max(25,MinimumDialogButtonWidth));
  MinBtnHeight:=Scale96ToFont(Max(15,MinimumDialogButtonHeight));
  reqBtnWidth := 0;

  // create the buttons, without positioning
  CreateButtons;

  // calculate the height of the text+icon
  reqHeight:= max(TextBox.Bottom, Scale96ToFont(32));
  ButtonTop := reqHeight + 2*Scale96ToFont(cLabelSpacing);

  // position buttons and activate default
  ButtonLeft := 0;
  for i := 0 to ComponentCount-1 do
  begin
    if (Components[i] is TBitBtn) then
    begin
      CurButton := TBitBtn(Components[i]);
      CurBtnSize := GetButtonSize(CurButton);
      CurButton.SetBounds(ButtonLeft, ButtonTop, CurBtnSize.X, CurBtnSize.Y);
      inc(ButtonLeft, CurButton.Width + Scale96ToFont(cBtnDist));

      if (CurButton.Default) then
      begin
        ActiveControl := CurButton;
        DefaultControl := CurButton;
      end;
    end;
  end;
  reqBtnWidth := ButtonLeft-Scale96ToFont(cBtnDist);

  // calculate the minimum text offset from left
  if FImageIndex >= 0 then
  begin
    ImageBox := Rect(Scale96ToFont(cBitmapX), Scale96ToFont(cBitmapY), 0, 0);
    ImageBox.Size := DialogGlyphs.SizeForPPI[32, Font.PixelsPerInch];
  end else
    ImageBox := Rect(0, 0, 0, 0);
  cMinLeft := ImageBox.Right + Scale96ToFont(cLabelSpacing);

  // calculate required width for the text
  reqWidth := cMinLeft + TextBox.Right;

  // if buttons require more space than the text, center the text
  // as much as possible
  if reqWidth < reqBtnWidth then
  begin
    reqWidth := reqBtnWidth;
    TextLeft := max(cMinLeft, Scale96ToFont(cLabelSpacing) + (reqWidth - TextBox.Right) div 2);
  end
  else
    TextLeft := (cMinLeft + reqWidth - TextBox.Right) div 2;

  // position the text
  Types.OffsetRect(TextBox, TextLeft, Scale96ToFont(cLabelSpacing));

  // set size of form
  ClientWidth := reqWidth + 2 * Scale96ToFont(cLabelSpacing);
  ClientHeight := 3 * Scale96ToFont(cLabelSpacing) + reqHeight + MinBtnHeight;

  // calculate the left of the buttons
  ButtonLeft := ((ClientWidth - reqBtnWidth) div 2);
  // center buttons
  for i := 0 to ComponentCount-1 do
  begin
    if (Components[i] is TBitBtn) then
    begin
      CurButton := TBitBtn(Components[i]);
      CurButton.Left := ButtonLeft;
      inc(ButtonLeft, CurButton.Width + Scale96ToFont(cBtnDist));
    end;
  end;
end;

{
  Executes the layout of TPromptDialog for small devices

  Two layout options are present, both to optimize space if
  only 1 button is present and also to allow many buttons.

  If only 1 button is present:

  ====================
  Caption
  ====================
        Button 1        > button in the middle
   Some text and so on
   ...       ...
   ...       ...
  ====================

  If more buttons are present:

  ====================
  Caption
  ====================
   Icon      Button 1
   Some text Button 2
   ...       ...
   ...       ...
  ====================

   <       >           cTextWidth
             <      >  cButtonWidth
            <>         cSpacing
}
procedure TPromptDialog.LayoutDialogSmallDevice;
Const
  cDialogWidth = 200;
  cDialogHalfWidth = cDialogWidth div 2;
  cTextWidth = 100;
  cHorizontalSpacing = 5;
  cVerticalSpacing = 5;
  cButtonWidth = cDialogWidth - cTextWidth - 3 * cHorizontalSpacing;
  cOneButtonTextWidth = cTextWidth + cHorizontalSpacing + cButtonWidth;
var
  i        : integer;
  CurButton: TBitBtn;

  ButtonLeft, ButtonTop: Integer;

  MinHeightForText,
   MinHeightForButtons,
   reqHeight: Integer;
begin
  FImageIndex := -1;
  // Create buttons without positioning and
  // Calculate the minimum size for the buttons
  // First thing so that ComponentCount is updated
  CreateButtons;
  MinHeightForButtons := 100;

  // calculate the width & height we need to display the Message

  // calculate the needed size for the text
  if ComponentCount = 1 then { one button layout }
    TextBox := Rect(0, 0, Scale96ToFont(cOneButtonTextWidth), Screen.Height - 100)
  else
    TextBox := Rect(0, 0, Scale96ToFont(cTextWidth), Screen.Height - 100);

  Canvas.Font.PixelsPerInch := Font.PixelsPerInch;
  DrawText(Canvas.Handle, PChar(MSG), Length(MSG),
    TextBox, DT_WORDBREAK or DT_CALCRECT);

  // calculate the height of the text+icon
  MinHeightForText := TextBox.Bottom;

  if ComponentCount = 1 then { one button layout }
  begin
    MinHeightForButtons := TBitBtn(Components[0]).Height;
    TextBox.Top := 2*Scale96ToFont(cVerticalSpacing) + MinHeightForButtons;
    Inc(TextBox.Bottom, TextBox.Top);
    TextBox.Left := Scale96ToFont(cHorizontalSpacing);
    TextBox.Right := Scale96ToFont(cOneButtonTextWidth) + TextBox.Left;

    // position buttons and activate default
    if (Components[0] is TBitBtn) then
    begin
      CurButton:=TBitBtn(Components[0]);
      CurButton.Left := Scale96ToFont(cDialogHalfWidth) - Scale96ToFont(cButtonWidth) div 2;
      CurButton.Top := Scale96ToFont(cVerticalSpacing);
      CurButton.Width := Scale96ToFont(cButtonWidth);
      if (CurButton.Default) then
      begin
        ActiveControl:=CurButton;
        DefaultControl:=CurButton;
      end;
    end;
  end
  else
  begin
    // calculate the left of the buttons
    ButtonLeft := Scale96ToFont(cTextWidth + 2 * cHorizontalSpacing);
    ButtonTop := Scale96ToFont(cVerticalSpacing);

    // position buttons and activate default
    for i:=0 to ComponentCount-1 do
    begin
      if (Components[i] is TBitBtn) then
      begin
        CurButton:=TBitBtn(Components[i]);
        CurButton.Left := ButtonLeft;
        CurButton.Top := ButtonTop;
        CurButton.Width := Scale96ToFont(cButtonWidth);

        inc(ButtonTop, CurButton.Height + Scale96ToFont(cVerticalSpacing));

        if (CurButton.Default) then
        begin
          ActiveControl:=CurButton;
          DefaultControl:=CurButton;
        end;
      end;
    end;

    TextBox.Top := Scale96ToFont(cVerticalSpacing);
    Inc(TextBox.Bottom, TextBox.Top);
    TextBox.Left := cHorizontalSpacing;
    TextBox.Right := cTextWidth + TextBox.Left;
    MinHeightForButtons := ButtonTop - Scale96ToFont(cVerticalSpacing);
  end;

  reqHeight := Max(MinHeightForText, MinHeightForButtons);

  if ComponentCount = 1 then { one button layout }
  begin
    // set size of form
    Height := (TextBox.Bottom - TextBox.Top) + 3*Scale96ToFont(cVerticalSpacing) + MinHeightForButtons;
    Width := Scale96ToFont(200);
  end else
  begin
    // set size of form
    ClientHeight := reqHeight + Scale96ToFont(cVerticalSpacing);
    ClientWidth := Scale96ToFont(200);
  end;

  // We need to avoid a too high dialog which would go out
  // of the screen and be maybe impossible to close
  if Height > Screen.Height - 50 then
    Height := Screen.Height - 50;
end;


function DefaultPromptDialog(const DialogCaption,
  DialogMessage: String;
  DialogType: longint; Buttons: PLongint;
  ButtonCount, DefaultIndex, EscapeResult: Longint;
  UseDefaultPos: boolean;
  X, Y: Longint): Longint;
var
  theModalResult: longint;
begin
  with TPromptDialog.CreateMessageDialog (DialogCaption, DialogMessage,
    DialogType, Buttons, ButtonCount, DefaultIndex)
  do
    try
      if not UseDefaultPos then
      begin
        Position := poDesigned;
        Left := X;
        Top := Y;
      end;
      theModalResult := ShowModal;
      case theModalResult of
        -1 : Result := EscapeResult
      else
        Result := DialogResult[theModalResult];
      end;
    finally
      Free;
    end;
end;

function CreateMessageDialog(const aMsg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons): TForm;
begin
  Result := CreateMessageDialog('', aMsg, DlgType, Buttons);
end;

function CreateMessageDialog(const aCaption, aMsg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): TForm;
var
  PDlg: TPromptDialog;
  Btns: PLongInt;
  CancelValue, DefaultIndex, ButtonCount: Longint;
begin
  Btns := GetPromptUserButtons(Buttons, CancelValue, DefaultIndex, ButtonCount, False, mbOk);
  PDlg := TPromptDialog.CreateMessageDialog(aCaption, aMsg, DialogIds[DlgType], Btns, ButtonCount, DefaultIndex);
  Result := TForm(PDlg);
  ReallocMem(Btns, 0);
end;

type

  { TQuestionDlg }

  TQuestionDlg = class(TCustomCopyToClipboardDialog)
  private
    FButtons: TList;
    FBitmap: TCustomBitmap;
    FBitmapX, FBitmapY: Integer;
    FMsgMemo: TMemo;
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure WMCloseQuery(var message: TLMessage); message LM_CLOSEQUERY;
  public
    TextBox: TRect;
    TextStyle: TTextStyle;
    MessageTxt: String;
    constructor CreateQuestionDlg(const aCaption, aMsg: string;
      DlgType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint);
    destructor Destroy; override;
    procedure Paint; override;
    procedure LayoutDialog;
    function ShowModal: TModalResult; override;
    function GetMessageText: string; override;
  end;

{ TQuestionDlg }

procedure TQuestionDlg.Paint;
var
  UseMaskHandle: HBitmap;
begin
  inherited Paint;
  // draw the text
  if FMsgMemo=nil then
  begin
    Canvas.Brush := Brush;
    Canvas.TextRect(TextBox, TextBox.Left, TextBox.Top, MessageTxt, TextStyle);
  end;
  // draw the icon
  if Assigned (FBitmap) then
  begin
    UseMaskHandle := FBitmap.MaskHandle;
    MaskBlt(Canvas.GetUpdatedHandle([csHandleValid]),
            cBitmapX, cBitmapY, FBitmap.Width, FBitmap.Height,
            FBitmap.Canvas.GetUpdatedHandle([csHandleValid]),
            0, 0, UseMaskHandle, 0, 0);
  end;
end;

procedure TQuestionDlg.LayoutDialog;
const
  cBtnDist = 10; // distance between buttons
  cLabelSpacing = 8; // space around label
var
  Flags: Cardinal;
  i: Integer;
  CurButton: TBitBtn;
  reqBtnWidth, reqBtnHeight: Integer;
  reqWidth, reqHeight: Integer;
  cMinLeft: Integer;
  ButtonLeft: Integer;
  CurBtnPos: Integer;
  CurBtnSize: TPoint;
  MinBtnWidth: Integer; // minimum width for a single button
  MinBtnHeight, MaxHeight, cBtnYSpacing,
    ScrollBarWidth, cBorderWidth: Integer; // minimum height for a single button

  function GetButtonSize(AButton: TBitBtn): TPoint;
  begin
    AButton.HandleNeeded;
    TBitBtnAccess(AButton).CalculatePreferredSize(Result.x, Result.y, True);
    if MinBtnHeight < Result.y then
      MinBtnHeight := Result.y
    else
    if Result.y < MinBtnHeight then
      Result.y := MinBtnHeight;
    if Result.x < MinBtnWidth then
      Result.x := MinBtnWidth;
  end;

begin
  BeginAutoSizing;
  try
    FillChar(TextStyle, SizeOf(TTextStyle), 0);

    with TextStyle do
    begin
      Clipping   := True;
      Wordbreak  := True;
      SystemFont := True;
      Opaque     := False;
    end;

    // calculate the width & height we need to display the Message
    if MessageTxt = '' then
      MessageTxt := '   ';
    TextBox := Rect(0, 0, Screen.Width div 2, Screen.Height);
    Flags := DT_CalcRect or DT_WordBreak;
    SelectObject(Canvas.Handle, Screen.SystemFont.Reference.Handle);
    DrawText(Canvas.Handle, PChar(MessageTxt), Length(MessageTxt), TextBox, Flags);

    MaxHeight:=Monitor.WorkareaRect.Bottom-Monitor.WorkareaRect.Top
      -GetSystemMetrics(SM_CYCAPTION)-GetSystemMetrics(SM_CYSIZEFRAME)*2
      -GetSystemMetrics(SM_CYDLGFRAME)*2; // LCL needs client size of form

    // calculate the width we need to display the buttons
    MinBtnWidth:=Max(25,MinimumDialogButtonWidth);
    MinBtnHeight:=Max(15,MinimumDialogButtonHeight);
    reqBtnWidth := 0;
    reqBtnHeight := 0;
    if (FButtons <> nil) and (FButtons.Count > 0) then
      for i := 0 to FButtons.Count - 1 do
      begin
        CurButton := TBitBtn(FButtons[i]);
        CurBtnSize:=GetButtonSize(CurButton);
        if i > 0 then Inc(reqBtnWidth, cBtnDist);
        Inc(reqBtnWidth, CurBtnSize.X);
        reqBtnHeight:=Max(reqBtnHeight, CurBtnSize.Y);
      end;

    cBtnYSpacing := reqBtnHeight + 3 * cLabelSpacing;
    if TextBox.Bottom>(MaxHeight-cBtnYSpacing) then
    begin
      // does not fit onto the screen => use a TMemo
      TextBox.Bottom:=MaxHeight;
      if FMsgMemo=nil then
      begin
        FMsgMemo:=TMemo.Create(Self);
        with FMsgMemo do
        begin
          WordWrap:=true;
          ReadOnly:=true;
          ScrollBars:=ssAutoBoth;
          Text:=MessageTxt;
          Anchors:=[akLeft,akTop,akRight,akBottom];
          Parent:=Self;
          BorderStyle:=bsNone;
          Color:=ColorToRGB(clBtnFace); // Gtk2 needs ColorToRGB
        end;
      end;
      ScrollBarWidth:=LCLIntf.GetSystemMetrics(SM_CXVSCROLL);
      cBorderWidth:=LCLIntf.GetSystemMetrics(SM_CXBORDER)*12; // there is some memo text padding I don't know how to exactly get - use approximate border (better more then less)
      inc(TextBox.Right,ScrollBarWidth+cBorderWidth);
      FMsgMemo.Visible:=true;
      BorderStyle := bsSizeable;
    end else if FMsgMemo<>nil then
    begin
      FMsgMemo.Visible:=false;
      BorderStyle := bsDialog;
    end;

    // calculate the width of the dialog
    if FBitmap <> nil then
      cMinLeft := cLabelSpacing + max(20, FBitmap.Width) + cLabelSpacing
    else
      cMinLeft := cLabelSpacing;
    reqWidth:= reqBtnWidth + 2 * cBtnDist;
    if reqWidth < (TextBox.Right + cMinLeft + cLabelSpacing) then
      reqWidth:= TextBox.Right + cMinLeft + cLabelSpacing
    else
      TextBox.Right := reqWidth - cMinLeft - cLabelSpacing;
    ButtonLeft := ((reqWidth - reqBtnWidth) div 2);

    // calculate the height of the dialog
    reqHeight:= TextBox.Bottom;
    if (FBitmap <> nil) and (FBitmap.Height > reqHeight) then
      reqHeight := FBitmap.Height;

    inc(reqHeight, cBtnYSpacing);
    if reqHeight > MaxHeight then
    begin
      Dec(TextBox.Bottom, reqHeight-MaxHeight);
      reqHeight := MaxHeight;
    end;

    // calculate the text position
    Types.OffsetRect(TextBox,
               ((reqWidth-cMinLeft-TextBox.Right-cLabelSpacing) div 2) + cMinLeft,
               cLabelSpacing);

    // calculate the icon position
    if FBitmap <> nil then
    begin
      FBitmapX := cLabelSpacing;
      FBitmapY := (reqHeight - CurBtnSize.Y - FBitmap.Height - cLabelSpacing) div 2;
    end;

    // set size&position of form
    SetBounds(
      (Monitor.WorkareaRect.Left + Monitor.WorkareaRect.Right - reqWidth) div 2,
      Monitor.WorkareaRect.Top + (MaxHeight - reqHeight) div 2,
      reqWidth, reqHeight);

    // position memo
    if (FMsgMemo<>nil) and FMsgMemo.Visible then
      FMsgMemo.BoundsRect:=TextBox;

    // position buttons
    CurBtnPos := ButtonLeft;
    if FButtons <> nil then
      for i := 0 to FButtons.Count-1 do
      begin
        CurButton := TBitBtn(Components[i]);
        CurBtnSize := GetButtonSize(CurButton);
        CurButton.SetBounds(CurBtnPos, ClientHeight - CurBtnSize.Y - cLabelSpacing,
                            CurBtnSize.X, CurBtnSize.Y);
        inc(CurBtnPos, CurButton.Width + cBtnDist);
      end;
  finally
    EndAutoSizing;
  end;
end;

function TQuestionDlg.ShowModal: TModalResult;
begin
  LayoutDialog;
  Result := inherited ShowModal;
end;

procedure TQuestionDlg.WMCloseQuery(var message: TLMessage);
begin
  if fsModal in FFormState then
  begin
    if CancelControl <> nil then
      CancelControl.ExecuteCancelAction
    else
      ModalResult := mrCancel;
  end else
    Close;
  // Always return 0, because we destroy the window ourselves
  Message.Result := 0;
end;

constructor TQuestionDlg.CreateQuestionDlg(const aCaption, aMsg: string;
  DlgType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint);
var
  i: integer;
  CurBtn: TDialogButton;
  NewButton: TBitBtn;
  NewKind: TBitBtnKind;
  NewCaption: String;
begin
  inherited CreateNew(nil, 1);
  PopupMode := pmAuto;
  BorderStyle := bsDialog;
  Position := poDesigned;
  MessageTxt := LineBreaksToSystemLineBreaks(aMsg);
  HelpContext := HelpCtx;
  KeyPreview := True;

  // Initialize TextStyle
  FillChar(TextStyle, SizeOf(TTextStyle), 0);
  with TextStyle do
  begin
    Clipping   := True;
    Wordbreak  := True;
    SystemFont := True;
    Opaque     := False;
  end;

  FBitmap := nil;
  NewCaption := ACaption;
  case DlgType of
    idDialogConfirm, idDialogInfo, idDialogWarning, idDialogError, idDialogShield:
      begin
        FBitmap := GetDialogIcon(DlgType);
        if NewCaption = '' then
          NewCaption := GetDialogCaption(DlgType);
      end;
    else
      FBitmap := GetDialogIcon(idDialogInfo);
  end;
  if NewCaption = '' then
    NewCaption := Application.Title;
  Caption := NewCaption;

  for i := 0 to Buttons.Count - 1 do
  begin
    CurBtn := Buttons[i];
    // get button kind
    case CurBtn.ModalResult of
      mrOk:       NewKind := bkOK;
      mrCancel:   NewKind := bkCancel;
      mrYes:      NewKind := bkYes;
      mrNo:       NewKind := bkNo;
      mrAbort:    NewKind := bkAbort;
      mrRetry:    NewKind := bkRetry;
      mrIgnore:   NewKind := bkIgnore;
      mrAll:      NewKind := bkAll;
      mrNoToAll:  NewKind := bkNoToAll;
      mrYesToAll: NewKind := bkYesToAll;
    else
      NewKind := bkCustom;
    end;

    NewButton := TBitBtn.Create(Self);
    with NewButton do
    begin
      AutoSize := False;
      Anchors := [akLeft, akBottom];
      ModalResult := CurBtn.ModalResult;
      Layout := blGlyphLeft;
      Kind := NewKind;
      Caption := CurBtn.Caption;
      Parent := Self;
      Default := CurBtn.Default;
      if Default then
        ActiveControl := NewButton;
      Cancel := CurBtn.Cancel;
    end;
    if FButtons = nil then
      FButtons := TList.Create;
    FButtons.Add(NewButton);
  end;
end;

destructor TQuestionDlg.Destroy;
begin
  FreeAndNil(FButtons);
  FreeAndNil(FBitmap);
  inherited Destroy;
end;

function TQuestionDlg.GetMessageText: string;
begin
  Result := MessageTxt;
end;

procedure TQuestionDlg.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if (Key = VK_ESCAPE) and (CancelControl = nil) then
  begin
    ModalResult := mrCancel;
    Key := 0;
  end;

  inherited KeyDown(Key, Shift);
end;


function DefaultQuestionDialog(const aCaption, aMsg: string; DlgType: LongInt;
  Buttons: TDialogButtons; HelpCtx: Longint): LongInt;
{ Show a dialog with aCaption as Title, aMsg as Text, DlgType as Icon,
  HelpCtx as Help context and Buttons to define the shown buttons and their
  TModalResult.
  Buttons is a list of TModalResult and strings. For each number a button is
  created. To set a custom caption, add a string after a button.
  The default TModalResults defined in controls.pp (mrNone..mrLast) don't need
  a caption. The default captions will be used.

  Examples for Buttons:
    [mrOk,mrCancel,'Cancel now',mrIgnore,300,'Do it','IsDefault']
    This will result in 4 buttons:
      'Ok' returning mrOk
      'Cancel now' returning mrCancel
      'Ignore' returning mrIgnore
      'Do it' returning 300. This will be the default button (focused)

}
var
  QuestionDialog: TQuestionDlg;
begin
  QuestionDialog := TQuestionDlg.CreateQuestionDlg(aCaption, aMsg, DlgType, Buttons, HelpCtx);
  try
    Result := QuestionDialog.ShowModal;
  finally
    QuestionDialog.Free;
  end;
end;

function QuestionDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
            Buttons: array of const; HelpCtx: Longint): TModalResult;

  function GetNextCaption(var i: integer; out aCaption: string): boolean;
  begin
    aCaption:='';
    if (i > High(Buttons)) then exit(false);
    Result:=true;
    case Buttons[i].VType of
      vtString: aCaption := Buttons[i].VString^;
      vtAnsiString: aCaption := AnsiString(Buttons[i].VAnsiString);
      vtChar: aCaption := Buttons[i].VChar;
      vtPChar: aCaption := Buttons[i].VPChar;
      vtPWideChar: aCaption := Buttons[i].VPWideChar;
      vtWideChar: aCaption := AnsiString(Buttons[i].VWideChar);
      vtWidestring: aCaption := AnsiString(WideString(Buttons[i].VWideString));
    else
      Result:=false;
    end;
    if Result then
      inc(i);
  end;

var
  DialogButtons: TDialogButtons;
  i: integer;
  CurBtnValue: TModalResult;
  BtnCaption, s: String;
  IsDefault, IsCancel, UseDefaultCaption: Boolean;
  NewButton: TDialogButton;
begin
  DialogButtons := TDialogButtons.Create(TDialogButton);
  try
    i := Low(Buttons);
    while i <= High(Buttons) do
    begin
      if Buttons[i].VType <> vtInteger then
        raise Exception.Create('TQuestionDlg.CreateQuestionDlg integer expected at '
          +IntToStr(i)+' but VType='+IntToStr(ord(Buttons[i].VType))+' found.');
      if Buttons[i].VType = vtInteger then
      begin
        // get TModalResult
        CurBtnValue := Buttons[i].VInteger;
        inc(i);

        // get button caption and flags
        BtnCaption := '';
        UseDefaultCaption := true;
        IsDefault := False;
        IsCancel := False;
        while GetNextCaption(i,s) do
        begin
          if (SysUtils.CompareText(s,'isdefault')=0) then begin
            if DialogButtons.DefaultButton <> nil then
              raise Exception.Create('TQuestionDlg.CreateQuestionDlg only one button can be default');
            IsDefault:=true;
          end
          else if (SysUtils.CompareText(s,'iscancel')=0) then begin
            if DialogButtons.CancelButton <> nil then
              raise Exception.Create('TQuestionDlg.CreateQuestionDlg only one button can be cancel');
            IsCancel:=true
          end
          else if UseDefaultCaption then begin
            UseDefaultCaption:=false;
            BtnCaption:=s;
          end else
            raise Exception.Create('TQuestionDlg.CreateQuestionDlg option expected at '+IntToStr(i)+', but found "'+s+'"');
        end;

        if UseDefaultCaption then
        begin
          // find default caption
          case CurBtnValue of
            mrOk       : BtnCaption := rsmbOk;
            mrCancel   : BtnCaption := rsmbCancel;
            mrYes      : BtnCaption := rsmbYes;
            mrNo       : BtnCaption := rsmbNo;
            mrAbort    : BtnCaption := rsmbAbort;
            mrRetry    : BtnCaption := rsmbRetry;
            mrIgnore   : BtnCaption := rsmbIgnore;
            mrAll      : BtnCaption := rsmbAll;
            mrYesToAll : BtnCaption := rsmbYesToAll;
            mrNoToAll  : BtnCaption := rsmbNoToAll;
          end;
        end;
        if BtnCaption = '' then
          raise Exception.Create('TQuestionDlg.Create: missing Button caption '+dbgs(i-1));
        NewButton := DialogButtons.Add;
        with NewButton do
        begin
          Caption := BtnCaption;
          ModalResult := CurBtnValue;
        end;
        if IsDefault then
          DialogButtons.DefaultButton := NewButton;
        if IsCancel then
          DialogButtons.CancelButton := NewButton;
      end
      else
        raise Exception.Create('TQuestionDlg.Create: invalid Buttons parameter '+dbgs(i));
    end;
    if DialogButtons.DefaultButton = nil then
      DialogButtons.DefaultButton := DialogButtons.FindButton([mrYes, mrOk, mrYesToAll, mrAll, mrRetry, mrCancel, mrNo, mrNoToAll, mrAbort, mrIgnore]);
    Result := WidgetSet.AskUser(aCaption, LineBreaksToSystemLineBreaks(aMsg),
      DialogIds[DlgType], DialogButtons, HelpCtx);
  finally
    DialogButtons.Free;
  end;
end;

function QuestionDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
  Buttons: array of const; const HelpKeyword: string): TModalResult;
begin
  // TODO: handle HelpKeyword
  Result := QuestionDlg(aCaption, aMsg, DlgType, Buttons, 0);
end;

// included by dialogs.pp