unit uDialogUtils; interface uses Windows, Controls, SysUtils; type TDlgButton = (TDlgButton_SI, TDlgButton_NO, TDlgButton_CANCELAR, TDlgButton_ACEPTAR, TDlgButton_OK, TDlgButton_CERRAR, TDlgButton_REINTENTAR, TDlgButton_ABORTAR, TDlgButton_IGNORAR); 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 ShowErrorMessage(const AHeader : String; const AMessage : String; AException: Exception; const AButtonSet: TDlgButtonSet) : TModalResult; 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 = 'C&errar'; sBtnReintentar = '&Reintentar'; sBtnAbortar = 'A&bortar'; sBtnIgnorar = '&Ignorar'; 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_REINTENTAR in AButtonSet then CreateButton(sBtnReintentar, mrRetry); if TDlgButton_IGNORAR in AButtonSet then CreateButton(sBtnIgnorar, mrIgnore); if TDlgButton_ABORTAR in AButtonSet then CreateButton(sBtnAbortar, mrAbort); 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ó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('ˇAtenció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ón sobre el error'; ADialog.Expando.HideText := 'No mostrar información sobre el error'; ADialog.Expando.Visible := True; ADialog.Execute; finally FreeAndNIL(ADialog); end; end; function ShowErrorMessage(const AHeader : String; const AMessage : String; AException: Exception; const AButtonSet: TDlgButtonSet) : TModalResult; var ADialog : TJSDialog; begin ADialog := CreateTaskDialog(Application.Title, AHeader, AMessage, tdiError); try CreateCustomButtons(AButtonSet, ADialog.CustomButtons); ADialog.Expando.Lines.Text := #13#13 + AException.Message; ADialog.Expando.ShowText := 'Mostrar información sobre el error'; ADialog.Expando.HideText := 'No mostrar información sobre el error'; ADialog.Expando.Visible := True; Result := 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.