Articles How to open Windows OS dialog in Delphi? by Jitendra Kumar

emailx45 · 30 Апр 2020

How to open Windows OS dialog in Delphi?
Jitendra Kumar - October, 2019

[SHOWTOGROUPS=4,20]

Sometime it is required to open common windows dialog like Regional Settings dialog, Date Time Setting dialog, Windows About dialog etc. from our application.
So here in this blog I have created a separate unit which having functions that calls WinApi procedures to open windows common dialog.

Here I created a unit TestWinDialogs and have added function to open windows common dialog. Then I added the unit to a Delphi project.

Код:

unit TestWinDialogs;

interface

uses
  Windows, Dialogs, Messages, DDEMan, ShellAPI, SysUtils, ShlObj, ActiveX;

type

  TWindowsDialogs = (wdStartMenu,
                      wdRecycleBin,
                      wdRunFile,
                      wdUserManager,
                      wdWindowsAboutDlg,
                      wdWindowsShutdownDialog,
                      wdScreenSaver,
                      wdControlPanel,
                      wdSystemProperties,
                      wdDisplayProperties,
                      wdThemesProperties,
                      wdPasswordsProperties,
                      wdPowerManagementProperties,
                      wdDateTimeProperties,
                      wdAccessibilityProperties,
                      wdSoftwareProperties,
                      wdDialProperties,
                      wdFontsProperties,
                      wdLocalRegionProperties,
                      wdPrinterProperties,
                      wdMouseProperties,
                      wdKeyboardProperties,
                      wdNetworkProperties,
                      wdInternetProperties,
                      wdModemProperties,
                      wdMultimediaProperties,
                      wdMailProperties,
                      wdScanCamProperties,
                      wdODBCProperties,
                      wdBDEProperties);

Const
   RFF_NOOPT =                    0;
   RFF_NOBROWSE =            1;
   RFF_NODEFAULT =            2;
   RFF_CALCDIRECTORY =     4;
   RFF_NOLABEL =                8;
   RFF_NOSEPARATEMEM =   14;

//-----------Windows API functions to call windows dialogs-----------//

procedure RunFileDlg(OwnerWnd: HWND; Icon: HICON; lpstrDirectory: PChar;
          lpstrTitle: PChar; lpstrDescription: PChar; Flags: Longint); stdcall;
          external 'Shell32.dll' Index 61;

function ShowWinAbout(hwndOwner: HWND; pszApp: PAnsiChar; lpszOther: PAnsiChar;
hIcon: HICON): DWORD; stdcall; external 'Shell32.dll' name 'ShellAboutA';
//--------------------------------------------------//

function OpenRecycleBin: Boolean;
function ShowCustomRunDialog(OwnerWnd: HWND; InitialDir, Title, Description: PChar; flags: Integer; StandardCaptions: Boolean): Boolean;
function ShowFolderBrowserDialog(ParentWindow: HWND; const DisplayText, InitPath: String; const Editable, NewStyle, ShowFiles: Boolean): String;
procedure FileOpenWithDialog(const Filename: String);
procedure FilePropertiesDialog(const Filename: String);
procedure ShowWindowsSpecialDialog(const SpecialDialog: TWindowsDialogs);

implementation

function OpenRecycleBin: Boolean;
procedure FreeIDList(pidl: Pointer);
var
  allocator: IMalloc;
begin
  if Succeeded(shlobj.SHGetMalloc(allocator)) then
  begin
   allocator.Free(pidl);
   {$IFDEF VER90}
   allocator.Release;
   {$ENDIF}
  end;
end;
var
  exInfo: TShellExecuteInfo;
begin
  FillChar(exInfo, SizeOf(exInfo), 0);
  with exInfo do
  begin
    cbSize := SizeOf(exInfo);
    fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_IDLIST;
    Wnd := 0;
    nShow := SW_SHOWNORMAL;
    lpVerb := 'open';
    ShGetSpecialFolderLocation(0, CSIDL_BITBUCKET, PItemIDLIst(lpIDList));
  end;
  result:= ShellExecuteEx(@exInfo);
  FreeIDList(exinfo.lpIDList);
end;

function ShowCustomRunDialog(OwnerWnd: HWND; InitialDir, Title, Description: PChar;  flags: Integer; StandardCaptions: Boolean): Boolean;
var
  sTitle, sInitialDir, sDescription: PWideChar;
  iSize: Integer;
begin
  if (Win32Platform = VER_PLATFORM_WIN32_NT) and not StandardCaptions then
  begin
    iSize := SizeOf(WideChar) * MAX_PATH;
{    sInitialDir := nil;
    sTitle := nil;
    sDescription := nil;  }
    GetMem(sInitialDir, iSize);
    GetMem(sTitle, iSize);
    GetMem(sDescription, iSize);
    StringToWideChar(InitialDir, sInitialDir, MAX_PATH);
    StringToWideChar(Title, sTitle, MAX_PATH);
    StringToWideChar(Description, sDescription, MAX_PATH);
    try
      RunFileDlg(OwnerWnd, 0, sInitialDir, sTitle, sDescription, Flags);
    finally
      FreeMem(sInitialDir);
      FreeMem(sTitle);
      FreeMem(sDescription);
      result:= TRUE;
    end;
  end else
    try
     RunFileDlg(OwnerWnd, 0, PChar(InitialDir), PChar(Title), PChar(Description), Flags);
     result:= TRUE;
    finally
    end;
end;


function ShowFolderBrowserDialog(ParentWindow: HWND; const DisplayText, InitPath: String; const Editable, NewStyle, ShowFiles: Boolean): String;
var
   BI: TBrowseInfo;
   Flags: LongWord;
   SelectedPIDL: PItemIDList;
   RootItemIDList: PItemIDList;
   IDesktopFolder: IShellFolder;
   Dummy: LongWord;

   procedure MergeFlag(var Flag: LongWord; const Value: LongWord);
   begin
    Flag:= Flag or Value;
   end;

begin
   Result := '';
   Flags:= 0;
   if Editable  then MergeFlag(Flags, BIF_EDITBOX);
   if NewStyle  then MergeFlag(Flags, BIF_NEWDIALOGSTYLE);
   if ShowFiles  then MergeFlag(Flags, BIF_BROWSEINCLUDEFILES);
   MergeFlag(Flags, BIF_UAHINT);
   ZeroMemory(@BI, SizeOf(TBrowseInfo));

    RootItemIDList := nil;
    if InitPath <> '' then
    begin
      SHGetDesktopFolder(IDesktopFolder);
      IDesktopFolder.ParseDisplayName(0, nil, PChar(InitPath), Dummy, RootItemIDList, Dummy);
    end;

   with BI do
   begin
      hwndOwner:= ParentWindow;
      GetMem(pszDisplayName, MAX_PATH);
      lpszTitle:= PChar(DisplayText);
      ulFlags:= Flags;
      lParam := Longint(ParentWindow);
      iImage:= 0;
      pidlRoot := RootItemIDList;
   end;
   SelectedPIDL:= SHBrowseForFolder(bi);
   if SelectedPIDL <> NIL then begin
     if SHGetPathFromIDList(SelectedPIDL, BI.pszDisplayName) then
       result:= StrPas(BI.pszDisplayName);
     GlobalFreePtr(SelectedPIDL);
   end;
   FreeMem(BI.pszDisplayName);
end;

procedure FileOpenWithDialog(const Filename: String);
begin
  ShellExecute(GetCurrentProcess, 'open', PChar('rundll32.exe'),
    PChar('shell32.dll,OpenAs_RunDLL ' + FileName), nil, SW_SHOWNORMAL);
end;

procedure FilePropertiesDialog(const Filename: String);
var
  exInfo: TShellExecuteInfo;
begin
  FillChar(exInfo, SizeOf(exInfo), 0);
  exInfo.cbSize := SizeOf(exInfo);
  exInfo.lpFile := PChar(FileName);
  exInfo.lpVerb := 'properties';
  exInfo.fMask  := SEE_MASK_INVOKEIDLIST;
  ShellExecuteEx(@exInfo);
end;

procedure ShowWindowsSpecialDialog(const SpecialDialog: TWindowsDialogs);
    procedure OpenCPLDialogs(const cpl: string);
    begin
       shellexecute(GetCurrentProcess,'open','rundll32.exe',
          pchar('shell32.dll,Control_RunDLL'+#32+cpl),nil,sw_shownormal);
    end;
begin
  case SpecialDialog of
    wdStartMenu:
      begin
        keybd_event(VK_LWIN, MapVirtualKey(VK_LWIN, 0), 0, 0);
     keybd_event(VK_LWIN, MapVirtualKey(VK_LWIN, 0), KEYEVENTF_KEYUP, 0)
      end;
    wdRecycleBin:
     begin
       OpenRecycleBin;
      end;
    wdRunFile:
     begin
        ShowCustomRunDialog(FindWindow('Shell_TrayWnd', NIL), NIL, NIL, NIL,
                              RFF_NOOPT, TRUE);
      end;
    wdUserManager:
      begin
        ShellExecute(0, 'open', 'musrmgr.exe', '', '', SW_SHOW);
      end;
    wdWindowsAboutDlg:
     begin
       ShowWinAbout(0, PAnsiChar(''), PAnsiChar(''), 0);
      end;
    wdWindowsShutdownDialog:
      begin
         PostMessage(FindWindow('Progman',nil), WM_CLOSE, 0, 0);
      end;
    wdScreenSaver:
     begin
         SendMessage(GetDesktopWindow, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
      end;
    wdControlPanel:
      begin
         ShellExecute(GetCurrentProcess, 'open','rundll32.exe',
                         'shell32,Control_RunDLL', nil, SW_SHOWNORMAL);
      end;
    wdSystemProperties:
      begin
         OpenCPLDialogs('SYSDM.CPL');
      end;
    wdDisplayProperties:
      begin
         OpenCPLDialogs('DESK.CPL');
      end;
    wdThemesProperties:
      begin
         OpenCPLDialogs('THEMES.CPL');
      end;
    wdPasswordsProperties:
      begin
         OpenCPLDialogs('PASSWORD.CPL');
      end;
    wdPowerManagementProperties:
      begin
         OpenCPLDialogs('POWERCFG.CPL');
      end;
    wdDateTimeProperties:
      begin
         ShellExecute(GetCurrentProcess, 'open', 'control',
                        'date/time', nil, SW_SHOW)
      end;
    wdAccessibilityProperties:
      begin
         OpenCPLDialogs('ACCESS.CPL');
      end;
    wdSoftwareProperties:
      begin
         OpenCPLDialogs('APPWIZ.CPL');
      end;
    wdDialProperties:
      begin
         OpenCPLDialogs('TELEPHON.CPL');
      end;
    wdFontsProperties:
      begin
         OpenCPLDialogs('MAIN.CPL @3');
      end;
    wdLocalRegionProperties:
      begin
         OpenCPLDialogs('INTL.CPL');
      end;
    wdPrinterProperties:
      begin
         OpenCPLDialogs('MAIN.CPL @2');
      end;
    wdMouseProperties:
      begin
         OpenCPLDialogs('MAIN.CPL @0');
      end;
    wdKeyboardProperties:
      begin
         OpenCPLDialogs('MAIN.CPL @1');
      end;
    wdNetworkProperties:
      begin
          OpenCPLDialogs('NETCPL.CPL');
      end;
    wdInternetProperties:
      begin
         OpenCPLDialogs('INETCPL.CPL');
      end;
    wdModemProperties:
      begin
         OpenCPLDialogs('MODEM.CPL');
      end;
    wdMultimediaProperties:
      begin
         OpenCPLDialogs('MMSYS.CPL');
      end;
    wdMailProperties:
      begin
         OpenCPLDialogs('MLCFG32.CPL');
      end;
    wdScanCamProperties:
      begin
         OpenCPLDialogs('STICPL.CPL');
      end;
    wdODBCProperties:
      begin
         OpenCPLDialogs('ODBCCP32.CPL');
      end;
    wdBDEProperties:
      begin
         OpenCPLDialogs('BDEADMIN.CPL');
      end;
  end;
end;

end.

[/SHOWTOGROUPS]

emailx45 · 30 Апр 2020

[SHOWTOGROUPS=4,20]
Now call the functions we have written above in TestWinDialogs unit .

Код:

uses
  TestWinDialogs;

................

procedure TForm1.btnRecycleBin1Click(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdRecycleBin);
end;

procedure TForm1.btnRecycleBinClick(Sender: TObject);
begin
  OpenRecycleBin;
end;

procedure TForm1.btnRunClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdRunFile);
end;

procedure TForm1.btnFileOpenDialogClick(Sender: TObject);
begin
  FileOpenWithDialog('C:\Clock.png');
end;

procedure TForm1.btnFilePropertiesDialogClick(Sender: TObject);
begin
  FilePropertiesDialog('C:\Clock.png');
end;

procedure TForm1.btnFolderBroswerDialogClick(Sender: TObject);
begin
  ShowMessage(ShowFolderBrowserDialog(Handle, 'Select a Folder :', 'C:\', True,
                        True, True));
end;

procedure TForm1.btnFontsPropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdFontsProperties);
end;

procedure TForm1.btnPasswordPropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdPasswordsProperties);
end;

procedure TForm1.btnPowerManagementPropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdPowerManagementProperties);
end;

procedure TForm1.btnScanCamPropertiesContextPopup(Sender: TObject;
  MousePos: TPoint; var Handled: Boolean);
begin
  ShowWindowsSpecialDialog(wdScanCamProperties);
end;

procedure TForm1.btnScreenSaverClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdScreenSaver);
end;

procedure TForm1.btnShutDownClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdWindowsShutdownDialog);
end;

procedure TForm1.btnSoftwarePropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdSoftwareProperties);
end;

procedure TForm1.btnStartMenuClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdStartMenu);
end;

procedure TForm1.btnSystemPropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdSystemProperties);
end;

procedure TForm1.btnThemePropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdThemesProperties);
end;

procedure TForm1.btnWindowsAboutClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdWindowsAboutDlg);
end;

procedure TForm1.btnODBCPropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdODBCProperties);
end;

procedure TForm1.btnDialPropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdDialProperties);
end;

procedure TForm1.btnKeyboardPropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdKeyboardProperties);
end;

procedure TForm1.btnLocalRegionClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdLocalRegionProperties);
end;

procedure TForm1.btnModemPropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdModemProperties);
end;

procedure TForm1.btnMousePropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdMouseProperties);
end;

procedure TForm1.btnMultimediaPropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdMultimediaProperties);
end;

procedure TForm1.btnNetWorkPropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdNetworkProperties);
end;

procedure TForm1.btnMailPropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdMailProperties);
end;

procedure TForm1.btnInternetPropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdInternetProperties);
end;

procedure TForm1.btnAccessibilityPropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdAccessibilityProperties);
end;

procedure TForm1.btnBDEPropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdBDEProperties);
end;

procedure TForm1.btnControlPanelClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdControlPanel);
end;

procedure TForm1.btnCustomRunDialogClick(Sender: TObject);
begin

  ShowCustomRunDialog(Handle, PWideChar('C:\'), PWideChar('Open File'),
      PWideChar('Description'), 0, False);
end;

procedure TForm1.btnDateTimePropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdDateTimeProperties);
end;

procedure TForm1.btnDisplayPropertiesClick(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdDisplayProperties);
end;

NOW, try this... it's crazyyyyyyy!

Код:

implementation

{$R *.dfm}

uses
  TestWinDialogs;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowWindowsSpecialDialog(wdRecycleBin);
  OpenRecycleBin;
  ShowWindowsSpecialDialog(wdRunFile);
  FileOpenWithDialog('C:\Clock.png');
  FilePropertiesDialog('C:\Clock.png');
  ShowMessage(ShowFolderBrowserDialog(Handle, 'Select a Folder :', 'C:\', True, True, True));
  ShowWindowsSpecialDialog(wdFontsProperties);
  ShowWindowsSpecialDialog(wdPasswordsProperties);
  ShowWindowsSpecialDialog(wdPowerManagementProperties);
  ShowWindowsSpecialDialog(wdScanCamProperties);
  ShowWindowsSpecialDialog(wdScreenSaver);
  ShowWindowsSpecialDialog(wdWindowsShutdownDialog);
  ShowWindowsSpecialDialog(wdSoftwareProperties);
  ShowWindowsSpecialDialog(wdStartMenu);
  ShowWindowsSpecialDialog(wdSystemProperties);
  ShowWindowsSpecialDialog(wdThemesProperties);
  ShowWindowsSpecialDialog(wdWindowsAboutDlg);
  ShowWindowsSpecialDialog(wdODBCProperties);
  ShowWindowsSpecialDialog(wdDialProperties);
  ShowWindowsSpecialDialog(wdKeyboardProperties);
  ShowWindowsSpecialDialog(wdLocalRegionProperties);
  ShowWindowsSpecialDialog(wdModemProperties);
  ShowWindowsSpecialDialog(wdMouseProperties);
  ShowWindowsSpecialDialog(wdMultimediaProperties);
  ShowWindowsSpecialDialog(wdNetworkProperties);
  ShowWindowsSpecialDialog(wdMailProperties);
  ShowWindowsSpecialDialog(wdInternetProperties);
  ShowWindowsSpecialDialog(wdAccessibilityProperties);
  ShowWindowsSpecialDialog(wdBDEProperties);
  ShowWindowsSpecialDialog(wdControlPanel);
  ShowCustomRunDialog(Handle, PWideChar('C:\'), PWideChar('Open File'), PWideChar('Description'), 0, False);
  ShowWindowsSpecialDialog(wdDateTimeProperties);
  ShowWindowsSpecialDialog(wdDisplayProperties);
end;

[/SHOWTOGROUPS]

Articles How to open Windows OS dialog in Delphi? by Jitendra Kumar

emailx45

emailx45

Похожие темы