{
'*******************************************************************************
'
'   Michael Koecher/six1 & wp_xyz  https://www.lazarusforum.de/
'
'   LGPL2/Linking Exception
'   oder
'   http://creativecommons.org/licenses/by-sa/3.0/de/
'   Original nur von https://www.lazarusforum.de/
'
'*******************************************************************************
}
unit UnitQuestionDlgEx;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons
  , ExtCtrls
  , LCLIntf
  , lcltype
  , types
  ;


//AX, AY >= 0 absolut position
//AX < 0 and AY = -1
// AX=
//   -1 poDesigned,        // use bounds from the designer (read from stream)
//   -2 poDefault,         // LCL decision (normally window manager decides)
//   -3 poDefaultPosOnly,  // designed size and LCL position
//   -4 poDefaultSizeOnly, // designed position and LCL size
//   -5 poScreenCenter,    // center form on screen (depends on DefaultMonitor)
//   -6 poDesktopCenter,   // center form on desktop (total of all screens)
//   -7 poMainFormCenter,  // center form on main form (depends on DefaultMonitor)
//   -8 poOwnerFormCenter, // center form on owner form (depends on DefaultMonitor)
//   -9 poWorkAreaCenter

function QuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
  AButtons: array of const; AX: Integer = -1; AY: Integer = -1): TModalResult; overload;

function QuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
  AButtons: array of const; AHelpCtx: Integer; AX: Integer; AY: Integer): TModalResult; overload;

function QuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
  AButtons: array of const; AHelpKeyword: String; AX: Integer = -1; AY: Integer= -1): TModalResult; overload;

function CreateQuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
  AButtons: array of const; AHelpCtx: Integer; AX, AY: Integer ): TForm;

function CreateQuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
  AButtons: array of const; AHelpKeyword: String; AX, AY: Integer): TForm;

implementation

uses
  TypInfo, Math;

type TMyButton = record
     kind:integer;
     caption:string;
     end;

function GetBKType(str:string):TBitBtnKind;
var
  value: Integer;
begin
  value := GetEnumValue(TypeInfo(TBitBtnKind), 'bk' + str);
  if value > -1 then
    Result := TBitBtnKind(value)
  else
    Result := bkCancel;
end;

function GetWidthOfCaptionText(ALabel: TLabel): Integer;
var
  bmp: TBitmap;
begin
  bmp := TBitmap.Create;
  try
    bmp.Canvas.Font.Assign(ALabel.Font);
    Result := bmp.Canvas.TextWidth(ALabel.Caption);
  finally
    bmp.Free;
  end;
end;
  
function getHeightOfCaptionText(ALabel: TLabel): Integer;
var
  r: TRect;
begin
  FillChar(r, SizeOf(TRect), 0);
  r.Width := ALabel.Width;
  r.Height := ALabel.Height;
  DrawText(ALabel.Canvas.Handle, PChar(ALabel.Caption), Length(ALabel.Caption), r, DT_EDITCONTROL or DT_WORDBREAK or DT_CALCRECT);
  Result := r.Height;
end;

{ <<< wp ... }
type
  THelpClickHandler = class(TComponent)
  public
    procedure OnHelpClick(Sender: TObject);
  end;
  
  procedure THelpClickHandler.OnHelpClick(Sender: TObject);
  begin
    (Owner as TControl).ShowHelp;
  end;
{ ... wp >>> }

 
function InternalCreateQuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
  AButtons: array of const; AX, AY: Integer;  AHelpCtx: Integer; AHelpKeyword: String): TForm;
const
  MsgDlgBtnStr : array [0..11] of string = ('Yes', 'No', 'OK', 'Cancel', 'Abort', 'Retry', 'Ignore',
                                            'All', 'NoToAll', 'YesToAll', 'Help', 'Close');
var
  QForm: TForm;
  QMsg:TLabel;
  QImage:TImage;
  PreButton:array of TMyButton;
  QButtonArray: array of  TBitBtn;
  i, top, left, setfocus, minwidth, maxwidth:integer;
  IconKind:integer;
  ASize: TSize;
  helpClickHandler: THelpClickHandler = nil;
  bmp: TCustomBitmap;
  QButtonPanel: TPanel;
  QBottomPanel: TPanel;
  QTextPanel: TPanel;
  btn: TBitBtn;
  rawTextWidth: Integer;
  currWidth: Integer;
begin
  maxwidth:=500;
  minwidth:=250;

  QForm:=TForm.Create(Screen.ActiveCustomForm);
  QForm.SetBounds(0-maxwidth, AY, 220, 150);
  QForm.Caption:=ACaption;
  QForm.BorderStyle:=bsSingle;
  QForm.BorderIcons:=[];
  QForm.Color:=clwhite;
  QForm.Visible:=false;
  if AHelpKeyword <> '' then
    QForm.HelpKeyword := AHelpKeyword
  else
    QForm.HelpContext := AHelpCtx;

  helpClickHandler := THelpClickHandler.Create(QForm);

  top:=10;
  left:=10;
  setlength(QButtonArray, 0);
  setfocus:=-1;

  // translate given Buttons into Array
  setlength(PreButton, 0);
  for i := 0 to high(AButtons) do
  begin
     if AButtons[i].VType = 11 then //text
     begin
        if lowercase(AButtons[i].VPChar) <>  lowercase('IsDefault') then
        begin
           PreButton[ high(PreButton)].Caption:=AButtons[i].VPChar;
        end else
        begin
           setfocus:=high(PreButton);
        end;
     end else
     if AButtons[i].VType = 0 then
     begin
        setlength(PreButton, high(PreButton)+2);
        PreButton[ high(PreButton)].Kind:=AButtons[i].VInteger;
     end;
  end;

  QBottomPanel := TPanel.Create(QForm);
  QBottomPanel.Align := alBottom;
  QBottomPanel.BevelOuter := bvNone;
  QBottomPanel.Caption := '';
  QBottomPanel.Color := clBtnFace;
  QBottomPanel.Parent := QForm;
  
  // Panel for the BitBtn's
  QButtonPanel := TPanel.Create(QForm);
  QButtonPanel.AnchorSideLeft.Control := QBottomPanel;
  QButtonPanel.AnchorSideLeft.Side := asrCenter;
  QButtonPanel.AnchorSideBottom.Control := QBottomPanel;
  QButtonPanel.AnchorSideBottom.Side := asrBottom;
  QButtonPanel.Anchors := [akLeft, akRight, akBottom];
  QButtonPanel.BevelOuter := bvNone;
  QButtonPanel.Caption := '';
  QButtonPanel.Parent := QBottomPanel;
  
  // create BitBtn's
  SetLength(QButtonArray, Length(PreButton));
  for i := 0 to high(PreButton) do
  begin
     btn := TBitBtn.Create(QForm);
     btn.Parent := QButtonPanel;
     btn.Kind := GetBKType(MsgDlgBtnStr[PreButton[i].Kind]);
     if btn.Kind = bkHelp then
       btn.OnClick := @helpClickHandler.OnHelpClick;
     if trim(PreButton[i].Caption) <> '' then
       btn.Caption := PreButton[i].Caption;   
     btn.AutoSize := true;
     btn.BorderSpacing.Around := 6;
     if i = 0 then
     begin
       btn.AnchorSideLeft.control := QButtonPanel;
       btn.AnchorSideLeft.Side := asrTop;
       btn.BorderSpacing.Left := 12;
     end else
     begin
       btn.AnchorSideLeft.Control := QButtonArray[i-1];
       btn.AnchorSideLeft.Side := asrBottom;
       if i = High(PreButton) then
         btn.BorderSpacing.Right := 12;
     end;
     btn.AnchorSideTop.Side := asrCenter;
     QButtonArray[i] := btn;
     if setfocus = i then
        QForm.ActiveControl:=btn;
  end;
  QButtonPanel.AutoSize := true;
  QBottomPanel.AutoSize := true;

  // Panel for image and text
  QTextPanel := TPanel.Create(QForm);
  QTextPanel.Align := alClient;
  QTextPanel.BevelOuter := bvNone;
  QTextPanel.Caption := '';
  QTextPanel.Color := clWindow;
  QTextPanel.Parent := QForm;
  QTextPanel.AutoSize := true;

  // Icon
  ASize.cx := GetSystemMetrics(SM_CXICON);
  ASize.cy := GetSystemMetrics(SM_CYICON);
  QImage:=TImage.Create(Qform);
  QImage.Parent:=QTextPanel;
  QImage.AnchorSideLeft.Control := QTextPanel;
  QImage.AnchorSideLeft.Side := asrTop;
  QImage.AnchorSideTop.Control := QTextPanel;
  QImage.AnchorSideTop.Side := asrTop;
  QImage.BorderSpacing.Left := 10;
  QImage.BorderSpacing.Top := 5;
  QImage.Width:= Min(32, ASize.CY);
  QImage.Height:= Min(32, ASize.CY);
  QImage.Transparent:=true;
  QImage.Proportional:=true;
  QImage.AntialiasingMode:=amON;
  QImage.Center:=true;
  if ASize.cx > QImage.Width then
    QImage.Stretch:=true;
  case ADlgType of
    mtWarning :      IconKind:=idDialogWarning;
    mtError :        IconKind:=idDialogError;
    mtInformation :  IconKind:=idDialogInfo;
    mtConfirmation : IconKind:=idDialogConfirm;
    otherwise IconKind:=idDialogInfo;
  end;

  bmp := GetDialogIcon(IconKind);
  QImage.Picture.Assign(bmp);
  bmp.Free;

  QMsg:=TLabel.Create(Qform);
  QMsg.Parent:=QTextPanel;
  QMsg.Anchors := [akLeft, akRight, akTop];
  QMsg.AnchorSideLeft.Control := QImage;
  QMsg.AnchorSideLeft.Side := asrBottom;
  QMsg.AnchorSideTop.Control := QTextPanel;
  QMsg.AnchorSideTop.Side := asrTop;
  QMsg.AnchorSideRight.Control := QTextPanel;
  QMsg.AnchorSideRight.Side := asrBottom;
  QMsg.BorderSpacing.Around := 10;
  QMsg.Caption:=AMsg;
  QForm.Visible:=true;
  rawTextWidth := GetWidthOfCaptionText(QMsg);
  QForm.Visible:=false;
  QMsg.WordWrap := true;
  QMsg.Transparent:=true;


  // Use autosizing for form size. 
  // Use Constraints to avoid too small and too large forms.
  currWidth := QMsg.Left + rawTextWidth + QMsg.BorderSpacing.Right;
  if currWidth > MinWidth then
    QForm.Constraints.MinWidth := Max(currWidth, QButtonPanel.Width)
  else
    QForm.Constraints.MinWidth := Max(MinWidth, QButtonPanel.Width);
  QForm.Constraints.MaxWidth := Max(MaxWidth, QButtonPanel.Width);
  QForm.Constraints.MinHeight := 100;
  QForm.AutoSize := true;


  if (AX < 0) and (AY = -1) then
  begin
     QForm.Position := TPosition(-AX-1);
  end else
  begin
    if AY = -1 then // Screen Center  Y
      QForm.Top:=trunc(QForm.Monitor.WorkareaRect.Bottom/2)-trunc(QForm.Height/2)
    else
    if (AY+QForm.Height)<=(QForm.Monitor.WorkareaRect.Bottom-30) then
      QForm.top:=AY
    else // prevent displaying outside bottom screen border
      QForm.top:=QForm.Monitor.WorkareaRect.Bottom-QForm.Height-30;

    if Ax = -1 then // Screen Center  X
      QForm.left:=trunc(QForm.Monitor.WorkareaRect.Right/2)-trunc(QForm.Width/2)
    else
    if (AX+QForm.Width)<=QForm.Monitor.WorkareaRect.Right then
      QForm.left:=AX
    else // prevent displaying outside right screen border
      QForm.left:=QForm.Monitor.WorkareaRect.Right-QForm.Width;
  end;

  result:=QForm;
end;

function CreateQuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
  AButtons: array of const; AHelpCtx: Integer; AX, AY: Integer): TForm;
begin
  Result := InternalCreateQuestionDlgEx(ACaption, AMsg, ADlgType, AButtons, AX, AY, AHelpCtx, '');
end;
  
function CreateQuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
  AButtons: array of const; AHelpKeyword: String; AX, AY: Integer): TForm;
begin
  Result := InternalCreateQuestionDlgEx(ACaption, AMsg, ADlgType, AButtons, AX, AY, -1, AHelpKeyword);
end;

function QuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
  AButtons: array of const; AX: Integer = -1; AY: Integer = -1): TModalResult; overload;
var
  QForm: TForm;
begin
  QForm:= CreateQuestionDlgEx( ACaption, AMsg, ADlgType, AButtons, 0, AX, AY);
  try
    result:=QForm.ShowModal;
  finally
    FreeAndNil(QForm);
  end;
end;

function QuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
  AButtons: array of const; AHelpCtx: Integer; AX: Integer; AY: Integer): TModalResult; overload;
var
  QForm: TForm;
  i:integer;
begin
  QForm:=CreateQuestionDlgEx( ACaption, AMsg, ADlgType, AButtons, AHelpCtx, AX, AY);
  try
    for i := 0 to QForm.ComponentCount-1 do
    begin
      if QForm.Components[i].ClassType = TBitBtn then
      begin
        if (QForm.Components[i] as TBitBtn).Kind = bkHelp then
        begin
          (QForm.Components[i] as TBitBtn).HelpContext:=AHelpCtx;
          break;
        end;
      end;
    end;
    result:=QForm.ShowModal;
  finally
    FreeAndNil(QForm);
  end;
end;

function QuestionDlgEx(const ACaption, AMsg: string; ADlgType: TMsgDlgType;
  AButtons: array of const; AHelpKeyword: String; AX: Integer = -1; AY: Integer= -1): TModalResult; overload;
var
  QForm: TForm;
  i:integer;
begin
  QForm:=CreateQuestionDlgEx( ACaption, AMsg, ADlgType, AButtons, AHelpKeyword, AX, AY);
  try
    for i := 0 to QForm.ComponentCount-1 do
    begin
      if QForm.Components[i].ClassType = TBitBtn then
      begin
        if (QForm.Components[i] as TBitBtn).Kind = bkHelp then
        begin
          (QForm.Components[i] as TBitBtn).HelpKeyword:=AHelpKeyword;
          break;
        end;
      end;
    end;
    result:=QForm.ShowModal;
  finally
    FreeAndNil(QForm);
  end;
end;


end.