MessageDialogUnit.pas

////////////////////////////////////////////////////////////////////////////////
// All code below is exclusively owned by author of Chess4Net - Pavel Perminov
// (packpaul@mail.ru, packpaul1@gmail.com).
// Any changes, modifications, borrowing and adaptation are a subject for
// explicit permition from the owner.

unit MessageDialogUnit;

interface

uses
  Forms, TntForms, Dialogs, Classes;

function CreateMessageDialog(AOwner: TComponent; const Msg: WideString; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; bStayOnTopIfNoOwner: boolean = FALSE): TTntForm; overload;
function CreateMessageDialog(AOwner: TComponent; const Msg: WideString;
  DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn;
  bStayOnTopIfNoOwner: boolean = FALSE): TTntForm; overload;

implementation

uses
  Types, StdCtrls, TntStdCtrls, Graphics, Windows, TntWindows, Consts, Math,
  ExtCtrls, TntExtCtrls, Controls, SysUtils,
  // Chess4Net units
  LocalizerUnit;

type
  TMessageForm = class(TTntForm)
  private
    Message: TTntLabel;
  public
    constructor CreateNew(AOwner: TComponent; bStayOnTop: boolean); reintroduce;
  end;

////////////////////////////////////////////////////////////////////////////////
// Globals

var
//  ButtonWidths : array[TMsgDlgBtn] of integer;  // initialized to zero
{
  ButtonCaptions: array[TMsgDlgBtn] of Pointer = (
    @SMsgDlgYes, @SMsgDlgNo, @SMsgDlgOK, @SMsgDlgCancel, @SMsgDlgAbort,
    @SMsgDlgRetry, @SMsgDlgIgnore, @SMsgDlgAll, @SMsgDlgNoToAll, @SMsgDlgYesToAll,
    @SMsgDlgHelp);
}    
  IconIDs: array[TMsgDlgType] of PChar = (IDI_EXCLAMATION, IDI_HAND,
    IDI_ASTERISK, IDI_QUESTION, nil);
{
  Captions: array[TMsgDlgType] of Pointer = (@SMsgDlgWarning, @SMsgDlgError,
    @SMsgDlgInformation, @SMsgDlgConfirm, nil);
}
  ButtonNames: array[TMsgDlgBtn] of string = (
    'Yes', 'No', 'OK', 'Cancel', 'Abort', 'Retry', 'Ignore', 'All', 'NoToAll',
    'YesToAll', 'Help');
  ModalResults: array[TMsgDlgBtn] of Integer = (
    mrYes, mrNo, mrOk, mrCancel, mrAbort, mrRetry, mrIgnore, mrAll, mrNoToAll,
    mrYesToAll, 0);

function CreateMessageDialog(AOwner: TComponent; const Msg: WideString;
  DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn;
  bStayOnTopIfNoOwner: boolean = FALSE): TTntForm; overload;

  function NGetAveCharSize(Canvas: TCanvas): TPoint;
  var
    I: Integer;
    Buffer: array[0..51] of Char;
  begin
    for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
    for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
    GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
    Result.X := Result.X div 52;
  end;

  function NGetButtonCaption(MsgDlgBtn: TMsgDlgBtn): WideString;
  begin
    with TLocalizer.Instance do
    case MsgDlgBtn of
      mbYes:         Result := GetLabel(40);
      mbNo:          Result := GetLabel(41);
      mbOK:          Result := GetLabel(42);
      mbCancel:      Result := GetLabel(43);
      mbAbort:       Result := GetLabel(44);
      mbRetry:       Result := GetLabel(45);
      mbIgnore:      Result := GetLabel(46);
      mbAll:         Result := GetLabel(47);
      mbNoToAll:     Result := GetLabel(48);
      mbYesToAll:    Result := GetLabel(49);
      mbHelp:        Result := GetLabel(50);
    else
      raise Exception.Create('Unexpected MsgDlgBtn in CreateMessageDialog\NGetButtonCaption.');
    end;
  end;

  function NGetMessageCaption(MsgType: TMsgDlgType): WideString;
  begin
    case MsgType of
      mtWarning:      Result := SMsgDlgWarning;
      mtError:        Result := SMsgDlgError;
      mtInformation:  Result := SMsgDlgInformation;
      mtConfirmation: Result := SMsgDlgConfirm;
      mtCustom:       Result := '';
    else
      raise Exception.Create('Unexpected MsgType in CreateMessageDialog\NGetMessageCaption.');
    end;
  end;

const
  mcHorzMargin = 8;
  mcVertMargin = 8;
  mcHorzSpacing = 10;
  mcVertSpacing = 10;
  mcButtonWidth = 50;
  mcButtonHeight = 14;
  mcButtonSpacing = 4;
var
  bStayOnTop: boolean;
  DialogUnits: TPoint;
  HorzMargin, VertMargin, HorzSpacing, VertSpacing, ButtonWidth,
  ButtonHeight, ButtonSpacing, ButtonCount, ButtonGroupWidth,
  IconTextWidth, IconTextHeight, X, ALeft: Integer;
  B, CancelButton: TMsgDlgBtn;
  IconID: PAnsiChar;
  ATextRect: TRect;
  ThisButtonWidth: integer;
  LButton: TTntButton;
begin { CreateMessageDialog }
  if (Assigned(AOwner)) then
    bStayOnTop := (AOwner.InheritsFrom(TForm) and (TForm(AOwner).FormStyle = fsStayOnTOp))
  else
    bStayOnTop := bStayOnTopIfNoOwner;

  Result := TMessageForm.CreateNew(AOwner, bStayOnTop);
  with Result do
  begin
    BorderStyle := bsDialog; // By doing this first, it will work on WINE.
    BiDiMode := Application.BiDiMode;
    Canvas.Font := Font;
    KeyPreview := True;
    Position := poDesigned;
    DialogUnits := NGetAveCharSize(Canvas);
    HorzMargin := MulDiv(mcHorzMargin, DialogUnits.X, 4);
    VertMargin := MulDiv(mcVertMargin, DialogUnits.Y, 8);
    HorzSpacing := MulDiv(mcHorzSpacing, DialogUnits.X, 4);
    VertSpacing := MulDiv(mcVertSpacing, DialogUnits.Y, 8);
    ButtonWidth := MulDiv(mcButtonWidth, DialogUnits.X, 4);
    for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
    begin
      if B in Buttons then
      begin
        ATextRect := Rect(0,0,0,0);
        Tnt_DrawTextW(Canvas.Handle,
          PWideChar(NGetButtonCaption(B)), -1,
          ATextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or
          DrawTextBiDiModeFlagsReadingOnly);
        with ATextRect do ThisButtonWidth := Right - Left + 8;
        if ThisButtonWidth > ButtonWidth then
          ButtonWidth := ThisButtonWidth;
      end;
    end;
    ButtonHeight := MulDiv(mcButtonHeight, DialogUnits.Y, 8);
    ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4);
    SetRect(ATextRect, 0, 0, Screen.Width div 2, 0);
    Tnt_DrawTextW(Canvas.Handle, PWideChar(Msg), Length(Msg) + 1, ATextRect,
      DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or
      DrawTextBiDiModeFlagsReadingOnly);
    IconID := IconIDs[DlgType];
    IconTextWidth := ATextRect.Right;
    IconTextHeight := ATextRect.Bottom;
    if IconID <> nil then
    begin
      Inc(IconTextWidth, 32 + HorzSpacing);
      if IconTextHeight < 32 then IconTextHeight := 32;
    end;
    ButtonCount := 0;
    for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
      if B in Buttons then Inc(ButtonCount);
    ButtonGroupWidth := 0;
    if ButtonCount <> 0 then
      ButtonGroupWidth := ButtonWidth * ButtonCount +
        ButtonSpacing * (ButtonCount - 1);
    ClientWidth := Max(IconTextWidth, ButtonGroupWidth) + HorzMargin * 2;
    ClientHeight := IconTextHeight + ButtonHeight + VertSpacing +
      VertMargin * 2;
    Left := (Screen.Width div 2) - (Width div 2);
    Top := (Screen.Height div 2) - (Height div 2);
    if DlgType <> mtCustom then
      Caption := NGetMessageCaption(DlgType)
    else
      Caption := TntApplication.Title;
    if IconID <> nil then
      with TTntImage.Create(Result) do
      begin
        Name := 'Image';
        Parent := Result;
        Picture.Icon.Handle := LoadIcon(0, IconID);
        SetBounds(HorzMargin, VertMargin, 32, 32);
      end;
    TMessageForm(Result).Message := TTntLabel.Create(Result);
    with TMessageForm(Result).Message do
    begin
      Name := 'Message';
      Parent := Result;
      WordWrap := True;
      Caption := Msg;
      BoundsRect := ATextRect;
      BiDiMode := Result.BiDiMode;
      ALeft := IconTextWidth - ATextRect.Right + HorzMargin;
      if UseRightToLeftAlignment then
        ALeft := Result.ClientWidth - ALeft - Width;
      SetBounds(ALeft, VertMargin,
        ATextRect.Right, ATextRect.Bottom);
    end;
    if mbCancel in Buttons then CancelButton := mbCancel else
      if mbNo in Buttons then CancelButton := mbNo else
        CancelButton := mbOk;
    X := (ClientWidth - ButtonGroupWidth) div 2;
    for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
      if B in Buttons then
      begin
        LButton := TTntButton.Create(Result);
        with LButton do
        begin
          Name := ButtonNames[B];
          Parent := Result;
          Caption := NGetButtonCaption(B);
          ModalResult := ModalResults[B];
          if B = DefaultButton then
          begin
            Default := True;
            ActiveControl := LButton;
          end;
          if B = CancelButton then
            Cancel := True;
          SetBounds(X, IconTextHeight + VertMargin + VertSpacing,
            ButtonWidth, ButtonHeight);
          Inc(X, ButtonWidth + ButtonSpacing);
        end;
      end;
  end;
end;


function CreateMessageDialog(AOwner: TComponent; const Msg: WideString; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; bStayOnTopIfNoOwner: boolean = FALSE): TTntForm;
var
  DefaultButton: TMsgDlgBtn;
begin
  if mbOk in Buttons then
    DefaultButton := mbOk
  else if mbYes in Buttons then
    DefaultButton := mbYes
  else
    DefaultButton := mbRetry;
  Result := CreateMessageDialog(AOwner, Msg, DlgType, Buttons, DefaultButton, bStayOnTopIfNoOwner);
end;

////////////////////////////////////////////////////////////////////////////////
// TMessageForm

constructor TMessageForm.CreateNew(AOwner: TComponent; bStayOnTop: boolean);
var
  NonClientMetrics: TNonClientMetrics;
begin
  if (bStayOnTop) then
    FormStyle := fsStayOnTop;
  inherited CreateNew(AOwner);
  NonClientMetrics.cbSize := sizeof(NonClientMetrics);
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
    Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
end;

end.