RnQ/for.RnQ/RnQDialogs.pas

{
  This file is part of R&Q.
  Under same license
}
unit RnQDialogs;
{$I ForRnQConfig.inc}
{$DEFINE usesVCL}

interface

{$IFDEF usesVCL}

uses
  Windows, Forms, StdCtrls, Graphics, Classes, Math, ExtCtrls, CommDlg, System.UITypes,
  RDGlobal, RnQStrings;
{$ELSE}

uses Windows;
{$ENDIF}
{$I NoRTTI.inc}

resourcestring
  SMsgDlgWarning = 'Warning';
  SMsgDlgError = Str_Error;
  SMsgDlgInformation = 'Information';
  SMsgDlgConfirm = 'Confirm';
  SMsgDlgBuzz = 'Buzz';
  SMsgDlgYes = '&Yes';
  SMsgDlgNo = '&No';
  SMsgDlgOK = 'OK';
  SMsgDlgCancel = 'Cancel';
  SMsgDlgHelp = '&Help';
  SMsgDlgHelpNone = 'No help available';
  SMsgDlgHelpHelp = 'Help';
  SMsgDlgAbort = '&Abort';
  SMsgDlgRetry = '&Retry';
  SMsgDlgIgnore = '&Ignore';
  SMsgDlgAll = '&All';
  SMsgDlgNoToAll = 'N&o to All';
  SMsgDlgYesToAll = 'Yes to &All';
  SMsgDlgClose = 'Close';
  SCannotOpenClipboard = 'Cannot open clipboard: %s';

var
  Captions: array [TMsgDlgType] of Pointer = (
    @SMsgDlgWarning,
    @SMsgDlgError,
    @SMsgDlgInformation,
    @SMsgDlgConfirm,
    @SMsgDlgBuzz,
    nil
  );
  IconIDs: array [RDGlobal.TMsgDlgType] of PChar = (
    IDI_EXCLAMATION,
    IDI_HAND,
    IDI_ASTERISK,
    IDI_QUESTION,
    IDI_ASTERISK,
    nil
  );
  IconNames: array [RDGlobal.TMsgDlgType] of TPicName = (
    PIC_EXCLAMATION,
    PIC_HAND,
    PIC_ASTERISK,
    PIC_QUEST,
    PIC_ASTERISK,
    ''
  );
  MsgShowTime: array [RDGlobal.TMsgDlgType] of integer = (
    60,
    99,
    30,
    60,
    15,
    60
  );
  {
    const
    mbYesNo = [mbYes, mbNo];
    mbYesNoCancel = [mbYes, mbNo, mbCancel];
    mbYesAllNoAllCancel = [mbYes, mbYesToAll, mbNo, mbNoToAll, mbCancel];
    mbOKCancel = [mbOK, mbCancel];
    mbAbortRetryIgnore = [mbAbort, mbRetry, mbIgnore];
    mbAbortIgnore = [mbAbort, mbIgnore];
  }

{$IFDEF usesVCL}

function InputQueryBig(const ACaption, APrompt: string; var Value: string): Boolean;
function InputQuery(const ACaption, APrompt: string; var Value: string): Boolean;
function MessageDlg(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint): integer; Overload;
function MessageDlg(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint;
  pDefaultButton: TMsgDlgBtn; Seconds: integer): integer; Overload;

{$ENDIF}
function OpenSaveFileDialog(ParentHandle: THandle; const DefExt, Filter, InitialDir, Title: string; var FileNames: string;
  IsOpenDialog: Boolean; Multi: Boolean = false): Boolean;

// function OpenDirDialogW(ParentHandle: THandle; Title : WideString; var DirName: WideString) : boolean;
function OpenDirDialog(ParentHandle: THandle; Title: String; var DirName: String): Boolean;
function ChooseFontDlg(ParentHandle: THandle; Title: String; var Font: TFont): Boolean;

implementation

uses ShlObj,
  // UITypes,
  // ShellAPI, ShlObj,
{$IFDEF usesVCL}
  Controls,
{$IFDEF RNQ}
  RnQLangs, RQThemes, RnQGlobal,
{$ENDIF RNQ}
  RDUtils, RnQButtons,
{$IFDEF RNQ_PLUGIN}
  RDPlugins,
{$ENDIF RNQ_PLUGIN}
{$ENDIF}
  SysUtils, StrUtils;

function CharReplace(const Source: string; oldChar, newChar: Char): string;
var
  i: integer;
begin
  Result := Source;
  for i := 1 to Length(Result) do
    if Result[i] = oldChar then
      Result[i] := newChar
end;

function OpenSaveFileDialog(ParentHandle: THandle; const DefExt, Filter, InitialDir, Title: string; var FileNames: string;
  IsOpenDialog: Boolean; Multi: Boolean = false): Boolean;
const
  OPENFILENAME_SIZE_VERSION_400 = 76;
var
  ofn: TOpenFilename;
  szFile: array [0 .. 32000] of Char;
  szDir: array [0 .. 32000] of Char;
  vDir: String;
  i, j: integer;
  // vEnd : Boolean;
begin
  Result := false;
  FillChar(ofn, SizeOf(TOpenFilename), 0);
  with ofn do
  begin
    if Win32MajorVersion < 5 then
      lStructSize := OPENFILENAME_SIZE_VERSION_400
    else
      lStructSize := SizeOf(TOpenFilename);
    hwndOwner := ParentHandle;
    lpstrFile := szFile;
    nMaxFile := SizeOf(szFile);
    if (Title <> '') then
      lpstrTitle := PChar(Title);
    if (InitialDir <> '') then
      lpstrInitialDir := PChar(InitialDir);
    StrPCopy(lpstrFile, FileNames);
    lpstrFilter := PChar(CharReplace(Filter, '|', #0) + #0#0);
    if DefExt <> '' then
      lpstrDefExt := PChar(DefExt);
  end;
  try
    if IsOpenDialog then
    begin
      i := -1;
      try
        i := GetCurrentDirectory(Length(szDir), szDir);
        if Multi then
          ofn.Flags := ofn.Flags or OFN_ALLOWMULTISELECT or OFN_EXPLORER or OFN_LONGNAMES;
        if GetOpenFileName(ofn) then
        begin
          Result := True;
          if Multi then
          begin
            vDir := StrPas(szFile);
            j := ofn.nFileOffset;
            // j := Pos(#0, szFile);
            if j > Length(vDir) then
            begin
              repeat
                // i := PosEx(#0, szFile, j);
                // vEnd := (i=j) or (szFile[i+1] = #0);
                FileNames := FileNames + vDir + PathDelim + StrPas(szFile + j) + ';';
                // FileNames := FileNames + vDir + '\'+ Copy(szFile+j, j, i-j) + ';';
                j := j + StrLen(szFile + j) + 1;
              until szFile[j] = #0;
              SetLength(FileNames, Length(FileNames) - 1);
            end
            else
              FileNames := vDir;
          end
          else
            FileNames := StrPas(szFile);
        end;
      finally
        if i > 0 then
          SetCurrentDirectory(szDir);
      end;
    end
    else
    begin
      i := -1;
      try
        i := GetCurrentDirectory(Length(szDir), szDir);
        if GetSaveFileName(ofn) then
        begin
          Result := True;
          FileNames := StrPas(szFile);
        end;
      finally
        if i > 0 then
          SetCurrentDirectory(szDir);
      end;
    end;
  except
    Result := false;
  end;
end;

function OpenDirDialog(ParentHandle: THandle; Title: String; var DirName: String): Boolean;
{$IFNDEF BIF_NONEWFOLDERBUTTON}
const
  BIF_UAHINT = $100;
  // Add a UA hint to the dialog, in place of the edit box. May not be combined with BIF_EDITBOX
  BIF_NONEWFOLDERBUTTON = $200;
  // Do not add the "New Folder" button to the dialog.  Only applicable with BIF_NEWDIALOGSTYLE.
{$ENDIF BIF_NONEWFOLDERBUTTON}
var
  // TitleName: string;
  lpItemID: PItemIDList;
  BrowseInfo: TBrowseInfo;
  // BrowseInfo: TBrowseInfoW;
  DisplayName: array [0 .. MAX_PATH] of Char;
  TempPath: array [0 .. MAX_PATH] of Char;
  // TempPath: array[0..MAX_PATH] of WideChar;
  // TempPath : PWideChar;
begin
  FillChar(BrowseInfo, SizeOf(BrowseInfo), #0);
  BrowseInfo.hwndOwner := ParentHandle;
  BrowseInfo.pszDisplayName := @DisplayName;
  // TitleName := 'Please specify a directory';

  // BrowseInfo.lpszTitle := PWideChar(Title);
  BrowseInfo.lpszTitle := PChar(Title);
  BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE or BIF_NONEWFOLDERBUTTON or BIF_UAHINT;
  lpItemID := SHBrowseForFolder(BrowseInfo);
  // lpItemID := SHBrowseForFolderW(BrowseInfo);
  if lpItemID <> nil then
  begin
    // SHGetPathFromIDListW(lpItemID, TempPath);
    SHGetPathFromIDList(lpItemID, TempPath);
    Result := True;
    // DirName := WideCharToString(TempPath);
    DirName := StrPas(TempPath);
    GlobalFreePtr(lpItemID);
  end
  else
    Result := false;
end;

{$IFDEF usesVCL}

function GetAveCharSize(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;

{ var

  ModalResults: array[TMsgDlgBtn] of Integer = (
  mrYes, mrNo, mrOk, mrCancel, mrAbort, mrRetry, mrIgnore, mrAll, mrNoToAll,
  mrYesToAll, 0); }

function InputQuery(const ACaption, APrompt: string; var Value: string): Boolean;
var
  Form: TForm;
  Prompt: TLabel;
  Edit: TEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: integer;
begin
  Result := false;
  Form := TForm.Create(Application);
  with Form do
    try
      Canvas.Font := Font;
      DialogUnits := GetAveCharSize(Canvas);
      BorderStyle := bsDialog;
      Caption := ACaption;
      ClientWidth := MulDiv(180, DialogUnits.X, 4);
      Position := poScreenCenter;
      Prompt := TLabel.Create(Form);
      with Prompt do
      begin
        Parent := Form;
        Caption := APrompt;
        Left := MulDiv(8, DialogUnits.X, 4);
        Top := MulDiv(8, DialogUnits.Y, 8);
        Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
        WordWrap := True;
      end;
      Edit := TEdit.Create(Form);
      with Edit do
      begin
        Parent := Form;
        Left := Prompt.Left;
        Top := Prompt.Top + Prompt.Height + 5;
        Width := MulDiv(164, DialogUnits.X, 4);
        MaxLength := 255;
        Text := Value;
        SelectAll;
      end;
      ButtonTop := Edit.Top + Edit.Height + 15;
      ButtonWidth := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      // with TRnQSpeedButton.Create(Form) do
      with TRnQButton.Create(Form) do
      // with TButton.Create(Form) do
      begin
        Parent := Form;
        // Caption := getTranslation(SMsgDlgOK);
        Caption := SMsgDlgOK;
        ModalResult := mrOk;
        Default := True;
        SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth, ButtonHeight);
      end;
      // with TRnQSpeedButton.Create(Form) do
      with TRnQButton.Create(Form) do
      // with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := getTranslation(SMsgDlgCancel);
        ModalResult := mrCancel;
        Cancel := True;
        SetBounds(MulDiv(92, DialogUnits.X, 4), Edit.Top + Edit.Height + 15, ButtonWidth, ButtonHeight);
        Form.ClientHeight := Top + Height + 13;
      end;
      if ShowModal = mrOk then
      begin
        Value := Edit.Text;
        Result := True;
      end;
    finally
      Form.Free;
    end;
end;

function InputQueryBig(const ACaption, APrompt: string; var Value: string): Boolean;
var
  Form: TForm;
  Prompt: TLabel;
  memo: TMemo;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: integer;
begin
  Result := false;
  Form := TForm.Create(Application);
  with Form do
    try
      Visible := false;
      Canvas.Font := Font;
      DialogUnits := GetAveCharSize(Canvas);
      // BorderStyle := bsDialog;
      BorderStyle := bsSizeToolWin;
      Caption := ACaption;
      ClientWidth := MulDiv(180, DialogUnits.X, 4);
      Position := poScreenCenter;
      Prompt := TLabel.Create(Form);
      with Prompt do
      begin
        Parent := Form;
        Caption := APrompt;
        Left := MulDiv(8, DialogUnits.X, 4);
        Top := MulDiv(8, DialogUnits.Y, 8);
        Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
        WordWrap := True;
      end;
      memo := TMemo.Create(Form);
      with memo do
      begin
        Parent := Form;
        Left := Prompt.Left;
        Top := Prompt.Top + Prompt.Height + 5;
        Width := MulDiv(164, DialogUnits.X, 4);
        MaxLength := 1000;
        Text := Value;
        SelectAll;
      end;
      ButtonTop := memo.Top + memo.Height + 15;
      ButtonWidth := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      // with TRnQSpeedButton.Create(Form) do
      with TRnQButton.Create(Form) do
      // with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := getTranslation(SMsgDlgOK);
        // Caption := SMsgDlgOK;
        ModalResult := mrOk;
        Default := True;
        SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth, ButtonHeight);
        Form.ClientHeight := Top + Height + 13;
        Anchors := [akBottom];
      end;
      // with TRnQSpeedButton.Create(Form) do
      with TRnQButton.Create(Form) do
      // with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := getTranslation(SMsgDlgCancel);
        ModalResult := mrCancel;
        Cancel := True;
        SetBounds(MulDiv(92, DialogUnits.X, 4), memo.Top + memo.Height + 15, ButtonWidth, ButtonHeight);
        Anchors := [akBottom];
      end;
      memo.Anchors := [akLeft, akTop, akRight, akBottom];
      Form.Constraints.MinWidth := 250;
      Form.Constraints.MinHeight := 200;
      if ShowModal = mrOk then
      begin
        Value := memo.Text;
        Result := True;
      end;
    finally
      Form.Free;
    end;
end;

var
  ModalResults: array [RDGlobal.TMsgDlgBtn] of integer = (
    mrYes,
    mrNo,
    mrOk,
    mrCancel,
    mrAbort,
    mrRetry,
    mrIgnore,
    mrAll,
    mrNoToAll,
    mrYesToAll,
    0,
    mrClose
  );
  ButtonCaptions: array [RDGlobal.TMsgDlgBtn] of Pointer = (
    @SMsgDlgYes,
    @SMsgDlgNo,
    @SMsgDlgOK,
    @SMsgDlgCancel,
    @SMsgDlgAbort,
    @SMsgDlgRetry,
    @SMsgDlgIgnore,
    @SMsgDlgAll,
    @SMsgDlgNoToAll,
    @SMsgDlgYesToAll,
    @SMsgDlgHelp,
    @SMsgDlgClose
  );

type
  TMessageForm = class(TForm)
  private
    FTimer: TTimer;
    FSeconds: integer;
    DefaultButton: TMsgDlgBtn;
    // DefButton : TRnQSpeedButton;
    DefButton: TRnQButton;
    // DefButton : TButton;
    Message: TLabel;
    procedure HelpButtonClick(Sender: TObject);
  protected
    procedure CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure WriteToClipBoard(Text: String);
    function GetFormText: String;
  public
    procedure onTimer(Sender: TObject);
    constructor CreateNew(AOwner: TComponent); reintroduce;
  end;

procedure TMessageForm.onTimer(Sender: TObject);
begin
  Dec(FSeconds);
  DefButton.Caption := getTranslation(LoadResString(ButtonCaptions[DefaultButton]) + ' (%d)', [FSeconds]);
  // ' (' + IntToStr(FSeconds) + ')';
  if FSeconds <= 0 then
  begin
    ModalResult := ModalResults[DefaultButton];
    FTimer.Enabled := false
  end
end;

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

procedure TMessageForm.HelpButtonClick(Sender: TObject);
begin
  Application.HelpContext(HelpContext);
end;

procedure TMessageForm.CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (Shift = [ssCtrl]) and (Key = Word('C')) then
  begin
    Beep;
    WriteToClipBoard(GetFormText);
  end;
end;

procedure TMessageForm.WriteToClipBoard(Text: String);
var
  Data: THandle;
  DataPtr: Pointer;
begin
  if OpenClipBoard(0) then
  begin
    try
      Data := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, Length(Text) + 1);
      try
        DataPtr := GlobalLock(Data);
        try
          Move(PChar(Text)^, DataPtr^, Length(Text) + 1);
          EmptyClipBoard;
          SetClipboardData(CF_TEXT, Data);
        finally
          GlobalUnlock(Data);
        end;
      except
        GlobalFree(Data);
        raise;
      end;
    finally
      CloseClipBoard;
    end;
  end
  else
    raise Exception.CreateRes(@SCannotOpenClipboard);
end;

function TMessageForm.GetFormText: String;
var
  DividerLine, ButtonCaptions: string;
  i: integer;
begin
  DividerLine := StringOfChar('-', 27) + sLineBreak;
  for i := 0 to ComponentCount - 1 do
    // if Components[I] is TButton then
    // ButtonCaptions := ButtonCaptions + TButton(Components[I]).Caption +
    if Components[i] is TRnQButton then
      ButtonCaptions := ButtonCaptions + TRnQButton(Components[i]).Caption +
      // if Components[I] is TRnQSpeedButton then
      // ButtonCaptions := ButtonCaptions + TRnQSpeedButton(Components[I]).Caption +
        StringOfChar(' ', 3);
  ButtonCaptions := StringReplace(ButtonCaptions, '&', '', [rfReplaceAll]);
  Result := Format('%s%s%s%s%s%s%s%s%s%s', [DividerLine, Caption, sLineBreak, DividerLine, Message.Caption, sLineBreak,
    DividerLine, ButtonCaptions, sLineBreak, DividerLine]);
end;

var
  ButtonNames: array [TMsgDlgBtn] of string = (
    'Yes',
    'No',
    'OK',
    'Cancel',
    'Abort',
    'Retry',
    'Ignore',
    'All',
    'NoToAll',
    'YesToAll',
    'Help',
    'Close'
  );

var
  ButtonWidths: array [TMsgDlgBtn] of integer; // initialized to zero

function CreateMessageDialog(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; pDefaultButton: TMsgDlgBtn;
  Seconds: integer = 0): TForm;
var
  B, CancelButton: TMsgDlgBtn;

const
  mcHorzMargin = 8;
  mcVertMargin = 8;
  mcHorzSpacing = 10;
  mcVertSpacing = 10;
  mcButtonWidth = 50;
  mcButtonHeight = 14;
  mcButtonSpacing = 4;
var
  DialogUnits: TPoint;
  HorzMargin, VertMargin, HorzSpacing, VertSpacing, ButtonWidth, ButtonHeight, ButtonSpacing, ButtonCount, ButtonGroupWidth,
    IconTextWidth, IconTextHeight, X, ALeft: integer;
  IconID: PChar;
  TextRect: TRect;
  // tB : TRnQSpeedButton;
  tB: TRnQButton;
  // tB : TButton;
begin
  Result := TMessageForm.CreateNew(Application);
  with Result do
  begin
    BiDiMode := Application.BiDiMode;
    BorderStyle := bsDialog;
    Canvas.Font := Font;
    KeyPreview := True;
    Position := poDesigned;
    OnKeyDown := TMessageForm(Result).CustomKeyDown;
    DialogUnits := GetAveCharSize(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);
    if Seconds > 0 then
    begin
      TMessageForm(Result).FSeconds := Seconds;
      TMessageForm(Result).FTimer := TTimer.Create(Result);
      TMessageForm(Result).FTimer.onTimer := TMessageForm(Result).onTimer;
    end;
    for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
    begin
      if B in Buttons then
      begin
        if ButtonWidths[B] = 0 then
        begin
          TextRect := Rect(0, 0, 0, 0);
          Windows.DrawText(Canvas.Handle, PChar(LoadResString(ButtonCaptions[B])), -1, TextRect, DT_CALCRECT or DT_LEFT or
            DT_SINGLELINE or DrawTextBiDiModeFlagsReadingOnly);
          with TextRect do
            ButtonWidths[B] := Right - Left + 8;
        end;
        if ButtonWidths[B] > ButtonWidth then
          ButtonWidth := ButtonWidths[B];
      end;
    end;
    ButtonHeight := MulDiv(mcButtonHeight, DialogUnits.Y, 8);
    ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4);
    SetRect(TextRect, 0, 0, Screen.Width div 2, 0);
    DrawText(Canvas.Handle, PChar(Msg), Length(Msg) + 1, TextRect, DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or
      DrawTextBiDiModeFlagsReadingOnly);
    IconID := IconIDs[DlgType];
    IconTextWidth := TextRect.Right;
    IconTextHeight := TextRect.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;
    { begin
      GlassFrame.Enabled := True;
      GlassFrame.SheetOfGlass := True;
      DoubleBuffered := True;
      end; }
    Left := (Screen.Width div 2) - (Width div 2);
    Top := (Screen.Height div 2) - (Height div 2);
    if DlgType <> mtCustom then
      Caption := getTranslation(LoadResString(Captions[DlgType]))
    else
      Caption := Application.Title;
{$IFDEF RNQ}
    if rnqUser > '' then
      Caption := Caption + '( ' + rnqUser + ' )';
{$ENDIF RNQ}
    if IconID <> nil then
      with TImage.Create(Result) do
      begin
        Name := 'Image';
        Parent := Result;
        Picture.Icon.Handle := LoadIcon(0, IconID);
        SetBounds(HorzMargin, VertMargin, 32, 32);
      end;
    TMessageForm(Result).Message := TLabel.Create(Result);
    with TMessageForm(Result).Message do
    begin
      Name := Str_message;
      Parent := Result;
      WordWrap := True;
      // GlowSize := 5;
      Caption := getTranslation(Msg);
      BoundsRect := TextRect;
      BiDiMode := Result.BiDiMode;
      ALeft := IconTextWidth - TextRect.Right + HorzMargin;
      if UseRightToLeftAlignment then
        ALeft := Result.ClientWidth - ALeft - Width;
      SetBounds(ALeft, VertMargin, TextRect.Right, TextRect.Bottom);
    end;
    if mbOk in Buttons then
      TMessageForm(Result).DefaultButton := mbOk
    else if mbYes in Buttons then
      TMessageForm(Result).DefaultButton := mbYes
    else
      TMessageForm(Result).DefaultButton := mbRetry;
    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
        // tB := TRnQSpeedButton.Create(Result);
        tB := TRnQButton.Create(Result);
        // tB := TButton.Create(Result);
        with tB do
        begin
          Name := ButtonNames[B];
          Parent := Result;
          Caption := getTranslation(LoadResString(ButtonCaptions[B]));
          ModalResult := ModalResults[B];
          if B = TMessageForm(Result).DefaultButton then
          begin
            Default := True;
            TMessageForm(Result).DefButton := tB;
          end;
          if B = CancelButton then
            Cancel := True;
          SetBounds(X, IconTextHeight + VertMargin + VertSpacing, ButtonWidth, ButtonHeight);
          Inc(X, ButtonWidth + ButtonSpacing);
          if B = mbHelp then
            OnClick := TMessageForm(Result).HelpButtonClick;
          ParentDoubleBuffered := false;
          DoubleBuffered := false;
        end;
      end;
  end;
end;

function MessageDlg(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint): integer;
begin
  with CreateMessageDialog(Msg, DlgType, Buttons, mbAll) do
    try
      HelpContext := HelpCtx;
      // HelpFile := HelpFileName;
      // if X >= 0 then Left := X;
      // if Y >= 0 then Top := Y;
      // if (Y < 0) and (X < 0) then
      Position := poScreenCenter;
      Result := ShowModal;
    finally
      Free;
    end;
  // Result := MessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx, -1, -1, '');
end;

function MessageDlg(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint;
  pDefaultButton: TMsgDlgBtn; Seconds: integer): integer;
begin
  with CreateMessageDialog(Msg, DlgType, Buttons, pDefaultButton, Seconds) do
    try
      HelpContext := HelpCtx;
      Position := poScreenCenter;
      Result := ShowModal;
    finally
      Free;
    end;
end;
{$ENDIF}

function ChooseFontDlg(ParentHandle: THandle; Title: String; var Font: TFont): Boolean;
var
  vCF: TChooseFont;
  ff: LOGFONT;
begin
  ff.lfCharSet := Font.Charset;
  // ff.lfHeight  := Font.Height;
  StrPCopy(ff.lfFaceName, Font.Name);
  ff.lfPitchAndFamily := DEFAULT_PITCH; // or FF_SWISS;

  if fsBold in Font.Style then
  begin
    ff.lfWeight := FW_BOLD
  end
  else
    // ff.lfWeight := FW_NORMAL;
    ff.lfWeight := FW_REGULAR;
  ff.lfItalic := -byte(fsItalic in Font.Style);
  ff.lfUnderline := -byte(fsUnderline in Font.Style);
  ff.lfEscapement := 0;
  ff.lfStrikeOut := -byte(fsStrikeOut in Font.Style);
  ff.lfQuality := DEFAULT_QUALITY;
  ff.lfHeight := Font.Height;
  ff.lfOrientation := Font.Orientation;
  // ff.lfItalic := Font.
  With vCF do
  begin
    lStructSize := SizeOf(TChooseFont);
    hwndOwner := ParentHandle;
    // hInstance := CF_ENABLETEMPLATE;
    nFontType := SCREEN_FONTTYPE; // SIMULATED_FONTTYPE;
    if fsBold in Font.Style then
      nFontType := nFontType or BOLD_FONTTYPE;
    if fsItalic in Font.Style then
      nFontType := nFontType or ITALIC_FONTTYPE;

    rgbColors := ColorToRGB(Font.Color);
    lpLogFont := @ff;
    vCF.iPointSize := Font.Size;
    // Flags := (CF_SCREENFONTS or CF_SCRIPTSONLY);
    Flags := CF_SCREENFONTS or CF_EFFECTS { or CF_NOSTYLESEL } or CF_INITTOLOGFONTSTRUCT;
  end;
  try
    Result := ChooseFont(vCF);
  except
    Result := false;
  end;
  if Result then
  begin
    Font.Handle := CreateFontIndirect(ff);
    // Font.Name := ff.lfFaceName;
    Font.Color := vCF.rgbColors;
    if ff.lfItalic <> 0 then
      Font.Style := Font.Style + [fsItalic];
    // if ff.lfWeight > 1 then
    // Font.Style :=
    Font.Size := vCF.iPointSize div 10;
    if ff.lfWeight = FW_BOLD then
      Font.Style := Font.Style + [fsBold];
  end;
  // cnv := TCanvas.Create;
  // cnv.Font := Font;
  // vCF.hDC := cnv.Handle;
  // font := cnv.Font;
  // cnv.Free;
end;

const
  TD_ICON_BLANK = 100;
  TD_ICON_WARNING = 101;
  TD_ICON_QUESTION = 102;
  TD_ICON_ERROR = 103;
  TD_ICON_INFORMATION = 104;
  TD_ICON_BLANK_AGAIN = 105;
  TD_ICON_SHIELD = 106;

  TD_OK = 1;
  TD_YES = 2;
  TD_NO = 4;
  TD_CANCEL = 8;
  TD_RETRY = 16;
  TD_CLOSE = 32;

  DLGRES_OK = 1;
  DLGRES_CANCEL = 2;
  DLGRES_RETRY = 4;
  DLGRES_YES = 6;
  DLGRES_NO = 7;
  DLGRES_CLOSE = 8;

  { Example:
    HRESULT TaskDialog(HWND hWndParent,
    HINSTANCE hInstance,
    PCWSTR pszWindowTitle,
    PCWSTR pszMainInstruction,
    PCWSTR pszContent,
    TASKDIALOG_COMMON_BUTTON_FLAGS dwCommonButtons,
    PCWSTR pszIcon,
    int *pnButton
    );

    this translates in Delphi to a function:

    TaskDialog: function(HWND: THandle; hInstance: THandle; cTitle, cDescription, cContent: pwidechar; Buttons: Integer; Icon: integer; ResButton: pinteger): integer;
    procedure TaskMessage(AForm: TCustomForm; AMessage: string);
    begin
    TaskDialog(AForm, '', '', AMessage, TD_OK, 0);
    end;
    if TaskDialog(self, 'Hello world','Ready to enjoy the new Vista task dialog ?',
    'The new Vista task dialog presents an easy to use and user-friendly replacement for messageboxes.',
    TD_YES + TD_NO, TD_ICON_QUESTION) = mrYes then
    TaskMessage(self,'yes');
  }
function TaskDialog(AForm: TCustomForm; ATitle, ADescription, AContent: string; Buttons, Icon: integer): integer;
var
  VerInfo: TOSVersioninfo;
  DLLHandle: THandle;
  res: integer;
  wTitle, wDescription, wContent: array [0 .. 1024] of widechar;
  Btns: TMsgDlgButtons;
  DlgType: TMsgDlgType;
  TaskDialogProc: function(HWND: THandle; hInstance: THandle; cTitle, cDescription, cContent: pwidechar; Buttons: integer;
    Icon: integer; ResButton: pinteger): integer;
cdecl stdcall;

begin
  Result := 0;

  VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersioninfo);
  GetVersionEx(VerInfo);

  if (VerInfo.dwMajorVersion >= 6) then
  begin
    DLLHandle := LoadLibrary(comctl32); // 'comctl32.dll');
    if DLLHandle >= 32 then
    begin
      @TaskDialogProc := GetProcAddress(DLLHandle, 'TaskDialog');

      if Assigned(TaskDialogProc) then
      begin
        StringToWideChar(ATitle, wTitle, SizeOf(wTitle));
        StringToWideChar(ADescription, wDescription, SizeOf(wDescription));
        StringToWideChar(AContent, wContent, SizeOf(wContent));
        TaskDialogProc(AForm.Handle, 0, wTitle, wDescription, wContent, Buttons, Icon, @res);

        Result := mrOk;

        case res of
          DLGRES_CANCEL:
            Result := mrCancel;
          DLGRES_RETRY:
            Result := mrRetry;
          DLGRES_YES:
            Result := mrYes;
          DLGRES_NO:
            Result := mrNo;
          DLGRES_CLOSE:
            Result := mrAbort;
        end;
      end;
      FreeLibrary(DLLHandle);
    end;
  end
  else
  begin
    Btns := [];
    if Buttons and TD_OK = TD_OK then
      Btns := Btns + [mbOk];

    if Buttons and TD_YES = TD_YES then
      Btns := Btns + [mbYes];

    if Buttons and TD_NO = TD_NO then
      Btns := Btns + [mbNo];

    if Buttons and TD_CANCEL = TD_CANCEL then
      Btns := Btns + [mbCancel];

    if Buttons and TD_RETRY = TD_RETRY then
      Btns := Btns + [mbRetry];

    if Buttons and TD_CLOSE = TD_CLOSE then
      Btns := Btns + [MBABORT];

    DlgType := mtCustom;

    case Icon of
      TD_ICON_WARNING:
        DlgType := mtWarning;
      TD_ICON_QUESTION:
        DlgType := mtConfirmation;
      TD_ICON_ERROR:
        DlgType := mtError;
      TD_ICON_INFORMATION:
        DlgType := mtInformation;
    end;

    Result := MessageDlg(AContent, DlgType, Btns, 0);
  end;
end;

end.