Articles - How to open Windows OS dialog in Delphi? by Jitendra Kumar | BESK.SU - программирование без границ (c) 2025

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

emailx45

emailx45

Местный
Credits
513
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.

1588199447873.png

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

emailx45

Местный
Credits
513
[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]
 
Войдите или зарегистрируйтесь для ответа.
Сверху