Tecsitel_FactuGES2/Source/Base/Utiles/uDialogUtils.pas

unit uDialogUtils;

interface

uses
  Windows, Controls, SysUtils;

type
  TDlgButton = (TDlgButton_SI, TDlgButton_NO, TDlgButton_CANCELAR,
      TDlgButton_ACEPTAR, TDlgButton_OK, TDlgButton_CERRAR);
  TDlgButtonSet = set of TDlgButton;


//For example:
//1. to display the "OpenDialog" for text files
//
//  s := 'aaa.txt';
//  if OpenFileDialog(Application.Handle, 'txt', 'Text Files|*.txt', 'c:\', 'Select text file', s) then
//    ShowMessage(s + ' file was selected for open')
//
//2. to display the "Save dialog":
//
//  s := 'data.dbf';
//  if SaveFileDialog(Application.Handle, 'dbf', 'dBase tables|*.dbf|All files|*.*', 'c:\', 'Select table', s) then
//    ShowMessage(s + ' table was selected for save')

function OpenFileDialog(ParentHandle: THandle; const DefExt, Filter, InitialDir, Title: string; var FileName: string): Boolean;
function SaveFileDialog(ParentHandle: THandle; const DefExt, Filter, InitialDir, Title: string; var FileName: string): Boolean;




procedure ShowInfoMessage(const AMessage : String); overload;
procedure ShowInfoMessage(const AHeader : String; const AMessage : String); overload;
procedure ShowWarningMessage(const AMessage : String); overload;
procedure ShowWarningMessage(const AHeader : String; const AMessage : String); overload;
procedure ShowErrorMessage(const AHeader : String; const AMessage : String); overload;
procedure ShowErrorMessage(const AHeader : String; const AMessage : String; AException: Exception); overload;

function ShowConfirmMessage(const AHeader : String;
  const AMessage : String) : TModalResult; overload;

function ShowConfirmMessage(const ATitle : String;
  const AHeader : String;
  const AMessage : String;
  const AButtonSet: TDlgButtonSet) : TModalResult; overload;

implementation

uses
  Forms,
  CommDlg,
  JSDialog,
  JSDialogs,
  Classes,
  StrUtils;

const
  sBtnSi = '&Si';
  sBtnNo = '&No';
  sBtnCancelar = '&Cancelar';
  sBtnAceptar = '&Aceptar';
  sBtnOK = '&OK';
  sBtnCerrar = '&Cerrar';  


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 FileName: string;
  MustExist, OverwritePrompt, NoChangeDir, DoOpen: Boolean): Boolean;
var
  ofn: TOpenFileName;
  szFile: array[0..MAX_PATH] of Char;
begin
  Result := False;
  FillChar(ofn, SizeOf(TOpenFileName), 0);
  FillChar(szFile, SizeOf(szFile), 0);
  with ofn do
  begin
    lStructSize := SizeOf(TOpenFileName);
    hwndOwner := ParentHandle;
    lpstrFile := szFile;
    nMaxFile := SizeOf(szFile);
    if (Title <> '') then
      lpstrTitle := PChar(Title);
    if (InitialDir <> '') then
      lpstrInitialDir := PChar(InitialDir);
    StrPCopy(lpstrFile, FileName);
    lpstrFilter := PChar(ReplaceStr(Filter, '|', #0)+#0#0);
    if DefExt <> '' then
      lpstrDefExt := PChar(DefExt);
  end;

  if MustExist then
    ofn.Flags := ofn.Flags or OFN_FILEMUSTEXIST;

  if OverwritePrompt then
    ofn.Flags := ofn.Flags or OFN_OVERWRITEPROMPT;

  if NoChangeDir then
    ofn.Flags := ofn.Flags or OFN_NOCHANGEDIR;

  if DoOpen then
  begin
    if GetOpenFileName(ofn) then
    begin
      Result := True;
      FileName := StrPas(szFile);
    end;
  end
  else
  begin
    if GetSaveFileName(ofn) then
    begin
      Result := True;
      FileName := StrPas(szFile);
    end;
  end
end;

function OpenFileDialog(ParentHandle: THandle; const DefExt, Filter, InitialDir, Title: string; var FileName: string): Boolean;
begin
  Result := OpenSaveFileDialog(ParentHandle, DefExt, Filter, InitialDir, Title, FileName, True, False, False, True);
end;

function SaveFileDialog(ParentHandle: THandle; const DefExt, Filter, InitialDir, Title: string; var FileName: string): Boolean;
begin
  Result := OpenSaveFileDialog(ParentHandle, DefExt, Filter, InitialDir, Title, FileName, False, True, True, False);
end;


function CreateTaskDialog(const ATitle: String;
  const AInstruction: String;
  const AMessage: String;
  const AIcon: TTaskDialogIcon): TJSDialog;
var
  ADialog : TJSDialog;
begin
  ADialog := TJSDialog.Create(NIL);
  with ADialog do
  begin
    Position := dpScreenCenter;
    ButtonBar.Buttons := [];
    DialogOptions := [doModal, doTopMost];

    Title := ATitle;
    Instruction.Text := AInstruction;
    Content.Text := AMessage;
    MainIcon := AIcon;
  end;
  Result := ADialog;
end;

procedure CreateCustomButtons(const AButtonSet: TDlgButtonSet;
  ACustomButtons : TJSCustomButtons);

  function CreateButton(const ACaption: String; const AModalResult: TModalResult): TJSCustomButtonItem;
  begin
    Result := ACustomButtons.Add;
    Result.Caption := ACaption;
    Result.ModalResult := AModalResult;
  end;

begin
  with ACustomButtons do
  begin
    Clear;

    if TDlgButton_SI in AButtonSet then
      CreateButton(sBtnSi, mrYes);

    if TDlgButton_NO in AButtonSet then
      CreateButton(sBtnNo, mrNo);

    if TDlgButton_CANCELAR in AButtonSet then
      CreateButton(sBtnCancelar, mrCancel);

    if TDlgButton_ACEPTAR in AButtonSet then
      CreateButton(sBtnAceptar, mrOk);

    if TDlgButton_OK in AButtonSet then
      CreateButton(sBtnOK, mrOk);

    if TDlgButton_CERRAR in AButtonSet then
      CreateButton(sBtnCerrar, mrNone);
  end;
end;

procedure ShowInfoMessage(const AHeader : String; const AMessage : String); overload;
var
  ADialog : TJSDialog;
begin
  ADialog := CreateTaskDialog('Informaci<63>n', AHeader, AMessage, tdiInformation);
  try
    CreateCustomButtons([TDlgButton_CERRAR], ADialog.CustomButtons);
    ADialog.Execute;
  finally
    FreeAndNIL(ADialog);
  end;
end;

procedure ShowInfoMessage(const AMessage : String);
begin
  ShowInfoMessage('', AMessage);
end;

procedure ShowWarningMessage(const AHeader : String; const AMessage : String); overload;
var
  ADialog : TJSDialog;
begin
  ADialog := CreateTaskDialog('<27>Atenci<63>n!', AHeader, AMessage, tdiWarning);
  try
    CreateCustomButtons([TDlgButton_CERRAR], ADialog.CustomButtons);
    ADialog.Execute;
  finally
    FreeAndNIL(ADialog);
  end;
end;

procedure ShowWarningMessage(const AMessage : String);
begin
  ShowWarningMessage('', AMessage);	
end;

procedure ShowErrorMessage(const AHeader : String; const AMessage : String); 
var
  ADialog : TJSDialog;
begin
  ADialog := CreateTaskDialog(Application.Title, AHeader, AMessage, tdiError);
  try
    CreateCustomButtons([TDlgButton_CERRAR], ADialog.CustomButtons);
    ADialog.Execute;
  finally
    FreeAndNIL(ADialog);
  end;
end;

procedure ShowErrorMessage(const AHeader : String; const AMessage : String; AException: Exception);
var
  ADialog : TJSDialog;
begin
  ADialog := CreateTaskDialog(Application.Title, AHeader, AMessage, tdiError);
  try
    CreateCustomButtons([TDlgButton_CERRAR], ADialog.CustomButtons);
    ADialog.Expando.Lines.Text := #13#13 + AException.Message;
    ADialog.Expando.ShowText := 'Mostrar informaci<63>n sobre el error';
    ADialog.Expando.HideText := 'No mostrar informaci<63>n sobre el error';
    ADialog.Expando.Visible := True;
    ADialog.Execute;
  finally
    FreeAndNIL(ADialog);
  end;
end;

function ShowConfirmMessage(const AHeader : String;
  const AMessage : String) : TModalResult;
begin
  Result := ShowConfirmMessage(Application.Title, AHeader,
                AMessage, [TDlgButton_SI, TDlgButton_NO]);
end;

function ShowConfirmMessage(const ATitle : String;
  const AHeader : String;
  const AMessage : String;
  const AButtonSet: TDlgButtonSet) : TModalResult;
var
  ADialog : TJSDialog;
begin
  ADialog := CreateTaskDialog(Application.Title, AHeader, AMessage, tdiConfirmation);
  try
    CreateCustomButtons(AButtonSet, ADialog.CustomButtons);
    Result := ADialog.Execute;
  finally
    FreeAndNIL(ADialog);
  end;
end;

end.