Bläddra i källkod

IDE: Add common function for launching files and URLs.

Jordan Russell 8 månader sedan
förälder
incheckning
8df2d0b840
2 ändrade filer med 34 tillägg och 19 borttagningar
  1. 28 6
      Projects/Src/IDE.HelperFunc.pas
  2. 6 13
      Projects/Src/IDE.MainForm.pas

+ 28 - 6
Projects/Src/IDE.HelperFunc.pas

@@ -43,6 +43,7 @@ function IsWindows11: Boolean;
 function GetDefaultThemeType: TThemeType;
 function GetDefaultKeyMappingType: TKeyMappingType;
 function GetDefaultMemoKeyMappingType: TIDEScintKeyMappingType;
+procedure LaunchFileOrURL(const AFilename: String; const AParameters: String = '');
 procedure OpenDonateSite;
 procedure OpenMailingListSite;
 procedure ClearMRUList(const MRUList: TStringList; const Section: String);
@@ -84,7 +85,7 @@ implementation
 uses
   ActiveX, ShlObj, ShellApi, CommDlg, SysUtils, IOUtils, StrUtils,
   Messages, DwmApi, Consts,
-  Shared.CommonFunc, PathFunc, Shared.FileClass, NewUxTheme,
+  Shared.CommonFunc, Shared.CommonFunc.Vcl, PathFunc, Shared.FileClass, NewUxTheme,
   IDE.MainForm, IDE.Messages, Shared.ConfigIniFile;
 
 procedure InitFormFont(Form: TForm);
@@ -282,16 +283,37 @@ begin
   Result := kmtDefault;
 end;
 
+procedure LaunchFileOrURL(const AFilename: String; const AParameters: String = '');
+begin
+  { SEE_MASK_FLAG_NO_UI isn't used, so error dialogs are possible }
+  const OwnerWnd = GetOwnerWndForMessageBox;
+  const WindowList = DisableTaskWindows(OwnerWnd);
+  try
+    const Dir = GetSystemDir;
+    var Info: TShellExecuteInfo;
+    FillChar(Info, SizeOf(Info), 0);
+    Info.cbSize := SizeOf(Info);
+    Info.fMask := SEE_MASK_NOASYNC;
+    Info.Wnd := OwnerWnd;
+    Info.lpVerb := 'open';
+    Info.lpFile := PChar(AFilename);
+    Info.lpParameters := PChar(AParameters);
+    Info.lpDirectory := PChar(Dir);
+    Info.nShow := SW_SHOWNORMAL;
+    ShellExecuteEx(@Info);
+  finally
+    EnableTaskWindows(WindowList);
+  end;
+end;
+
 procedure OpenDonateSite;
 begin
-  ShellExecute(Application.Handle, 'open', 'https://jrsoftware.org/isdonate.php', nil,
-    nil, SW_SHOWNORMAL);
+  LaunchFileOrURL('https://jrsoftware.org/isdonate.php');
 end;
 
 procedure OpenMailingListSite;
 begin
-  ShellExecute(Application.Handle, 'open', 'https://jrsoftware.org/ismail.php', nil,
-    nil, SW_SHOWNORMAL);
+  LaunchFileOrURL('https://jrsoftware.org/ismail.php');
 end;
 
 procedure ClearMRUList(const MRUList: TStringList; const Section: String);
@@ -470,7 +492,7 @@ end;
 function NewShortCutToText(const ShortCut: TShortCut): String;
 { This function is better than Delphi's ShortCutToText function because it works
   for dead keys. A dead key is a key which waits for the user to press another
-  key so it can be combined. For example `+e=è. Pressing space after a dead key
+  key so it can be combined. For example `+e=è. Pressing space after a dead key
   produces the dead key char itself. For example `+space=`. }
 const
   { List of chars ShortCutToText knows about and doesn't rely on Win32's

+ 6 - 13
Projects/Src/IDE.MainForm.pas

@@ -3460,12 +3460,9 @@ begin
 end;
 
 procedure TMainForm.BOpenOutputFolderClick(Sender: TObject);
-var
-  Dir: String;
 begin
-  Dir := GetWinDir;
-  ShellExecute(Application.Handle, 'open', PChar(AddBackslash(Dir) + 'explorer.exe'),
-    PChar(Format('/select,"%s"', [FCompiledExe])), PChar(Dir), SW_SHOWNORMAL);
+  LaunchFileOrURL(AddBackslash(GetSystemWinDir) + 'explorer.exe',
+    Format('/select,"%s"', [FCompiledExe]));
 end;
 
 procedure TMainForm.HShortcutsDocClick(Sender: TObject);
@@ -3488,26 +3485,22 @@ end;
 
 procedure TMainForm.HExamplesClick(Sender: TObject);
 begin
-  ShellExecute(Application.Handle, 'open',
-    PChar(PathExtractPath(NewParamStr(0)) + 'Examples'), nil, nil, SW_SHOWNORMAL);
+  LaunchFileOrURL(PathExtractPath(NewParamStr(0)) + 'Examples');
 end;
 
 procedure TMainForm.HFaqClick(Sender: TObject);
 begin
-  ShellExecute(Application.Handle, 'open',
-    PChar(PathExtractPath(NewParamStr(0)) + 'isfaq.url'), nil, nil, SW_SHOWNORMAL);
+  LaunchFileOrURL(PathExtractPath(NewParamStr(0)) + 'isfaq.url');
 end;
 
 procedure TMainForm.HWhatsNewClick(Sender: TObject);
 begin
-  ShellExecute(Application.Handle, 'open',
-    PChar(PathExtractPath(NewParamStr(0)) + 'whatsnew.htm'), nil, nil, SW_SHOWNORMAL);
+  LaunchFileOrURL(PathExtractPath(NewParamStr(0)) + 'whatsnew.htm');
 end;
 
 procedure TMainForm.HWebsiteClick(Sender: TObject);
 begin
-  ShellExecute(Application.Handle, 'open', 'https://jrsoftware.org/isinfo.php', nil,
-    nil, SW_SHOWNORMAL);
+  LaunchFileOrURL('https://jrsoftware.org/isinfo.php');
 end;
 
 procedure TMainForm.HMailingListClick(Sender: TObject);