You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
503 lines
14 KiB
Plaintext
503 lines
14 KiB
Plaintext
{
|
|
This file is part of R&Q.
|
|
Under same license
|
|
}
|
|
unit RnQDialogs;
|
|
{$I ForRnQConfig.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Forms, StdCtrls, Graphics, Classes, Math, ExtCtrls, CommDlg, System.UITypes,
|
|
RDGlobal, RnQStrings;
|
|
|
|
{$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];
|
|
}
|
|
|
|
function MessageDlg(const Msg: String; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; Seconds: Integer = 0): Integer;
|
|
|
|
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; const Title: String; var DirName: String): Boolean;
|
|
function ChooseFontDlg(ParentHandle: THandle; var Font: TFont): Boolean;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Controls, SysUtils, StrUtils, ShlObj, IniLib,
|
|
SciterLib, RnQLangs, RQThemes, RnQGlobal, RDUtils;
|
|
|
|
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);
|
|
ofn.Flags := ofn.Flags or OFN_OVERWRITEPROMPT;
|
|
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; const 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;
|
|
|
|
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 [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
|
|
);
|
|
|
|
ButtonNames: array [TMsgDlgBtn] of string = (
|
|
'Yes',
|
|
'No',
|
|
'OK',
|
|
'Cancel',
|
|
'Abort',
|
|
'Retry',
|
|
'Ignore',
|
|
'All',
|
|
'NoToAll',
|
|
'YesToAll',
|
|
'Help',
|
|
'Close'
|
|
);
|
|
|
|
function MessageDlg(const Msg: String; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; Seconds: Integer = 0): Integer;
|
|
begin
|
|
Result := UI.CreateDialog(Msg, DlgType, Buttons, Seconds);
|
|
end;
|
|
|
|
function ChooseFontDlg(ParentHandle: THandle; 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; const 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);
|
|
end;
|
|
end;
|
|
|
|
end.
|