使用指定的边界在我的应用程序旁边运行Windows资源管理器

时间:2018-08-25 19:24:43

标签: api delphi vcl shellexecute

我有这个:

ShellExecute(Application.Handle, nil, PWideChar('explorer.exe'), PWideChar(ImagesDir), nil, SW_SHOWNORMAL);

其中变量ImagesDir是我想由Windows资源管理器显示的图像目录...

例如,如何在应用程序旁边以指定的界限运行Windows资源管理器?

image

2 个答案:

答案 0 :(得分:0)

当您打开任何文件资源管理器窗口(例如转到C:\)时,文件资源管理器具有一个打开的特定保存窗口大小。因此,当您在水平和/或垂直方向上调整它的大小时,将其关闭并再次重新打开,它将保存窗口的大小,
,并且在注册表中保存此信息的位置是这样的:
在我的系统上,HKCU \ Software \ Classes \ Local Settings \ Software \ Microsoft \ Windows \ Shell \ Bags \ AllFolders \ Shell \ WinPos1366x768x96(1).. position,位置在左,右,上或下,给出了窗口边框(以像素为单位)。

我认为键的名称取决于屏幕分辨率。here 代码如下:

.....
const
   AMainKey = '\Software\Classes\Local 
   Settings\Software\Microsoft\Windows\Shell\Bags\AllFolders\Shell\';

var
  FrmMain: TFrmMain;
  ImagesDir: string;
  AWinPos_left, AWinPos_Top,
  AWinPos_Right, AWinPos_Bottom: string;

implementation
  Uses
    ShellApi, Registry;
  {$R *.dfm}

procedure ExploreDir_With_Bounds(AFile_Dir: string;ALeft, ATop, AWidth, AHieght: DWORD);
  FUNCTION ExploreDirectory(CONST Dir : STRING) : BOOLEAN;
  BEGIN
    Result :=(ShellExecute(GetDesktopWindow,'open',PWideChar(Dir),'','',SW_SHOW)>32)
  END;
var
  ListNames, ListPosition: TStringList;
  I, AScreen_Width, AScreen_Hieght, APixelPI: Integer;
  AWinPos_Uses: string;
begin
  ListNames    := TStringList.Create;
  ListPosition := TStringList.Create;
  With TRegistry.Create Do
  Try
    RootKey := HKEY_CURRENT_USER;
    OpenKey(AMainKey,FALSE);
    GetValueNames(ListNames);

    AScreen_Width  := Screen.Width;
    AScreen_Hieght := Screen.Height;
    APixelPI := Screen.PixelsPerInch;
    AWinPos_Uses := 'WinPos'+AScreen_Width.ToString+'x'+AScreen_Hieght.ToString+'x'+APixelPI.ToString;

    for I := 0 to ListNames.Count - 1 do
    begin
      if Pos(AWinPos_Uses, ListNames[I]) <> 0 then
      begin
        ListPosition.Add(ListNames[I]);
      end;
    end;

    for I := 0 to ListPosition.Count - 1 do
    begin
      if (Pos('left', ListPosition[I]) <> 0) then
      begin
        AWinPos_left := ListPosition[I];
        Lbl_Left.Caption := AWinPos_left;
        Continue;
      end else
      if (Pos('top', ListPosition[I]) <> 0) then
      begin
        AWinPos_Top := ListPosition[I];
        Lbl_Top.Caption := AWinPos_Top;
        Continue;
      end else
      if (Pos('right', ListPosition[I]) <> 0) then
      begin
        AWinPos_Right := ListPosition[I];
        Lbl_Right.Caption := AWinPos_Right;
        Continue;
      end else
      if (Pos('bottom', ListPosition[I]) <> 0) then
      begin
        AWinPos_Bottom := ListPosition[I];
        Lbl_Bottom.Caption := AWinPos_Bottom;
      end;
    end;

    if (AWinPos_left <> '')and(AWinPos_Top <> '')and
      (AWinPos_Right <> '')and(AWinPos_Bottom <> '') then
    begin
      WriteInteger(AWinPos_left, ALeft);
      WriteInteger(AWinPos_Top, ATop);
      WriteInteger(AWinPos_Right, ALeft + AWidth);
      WriteInteger(AWinPos_Bottom, ATop + AHieght);
    end;

    CloseKey;
  Finally
    Free;
    ListNames.Free;
    ListPosition.Free;
  End;

  ExploreDirectory(AFile_Dir);
end;  

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  ImagesDir := TDirectory.GetParent(TDirectory.GetParent(ExtractFileDir(ParamStr(0))))+ '\My Images To Test';

  ExploreDir_With_Bounds(ImagesDir, (50 + Width)+10{Left}, 50{TOP},
                         Screen.Width - (Left + Width +20){width},
                         Screen.Height - 150{hieght});
end;

procedure TFrmMain.FormShow(Sender: TObject);
begin
  Left := 0;
  Top  := (Screen.WorkAreaHeight div 2)-(Height div 2);
end;  

end.

the Result here

答案 1 :(得分:-1)

您可以使用以下功能打开资源管理器窗口并将其指向特定目录。

USES Windows,ShellAPI;

FUNCTION ExploreDirectory(CONST Dir : STRING) : BOOLEAN;
  BEGIN
    Result:=(ShellExecute(GetDesktopWindow,'open',PChar(Dir),'','',SW_SHOW)>32)
  END;

但是请注意,您不能(使用此代码)使“资源管理器”窗口“跟随”您的程序,即。打开的窗口是一个完全自主的窗口,它没有链接到您的程序,就像用户自己浏览到该目录一样。如果您在新目录下再次调用此函数,资源管理器将打开一个包含该目录的新窗口(并保持旧目录打开)。

更新: 如果要在打开浏览器窗口后能够对其进行操作,则需要使用资源管理器公开的各种界面。我制作了一个UNIT,它使您可以执行自己想做的事情,以及返回以后可以操纵窗口所需的界面。它很大程度上取决于此答案中的代码:

Check if windows explorer already opened on given path

Victoria

UNIT WindowsExplorer;

INTERFACE

USES Types,ShDocVw;

FUNCTION ExploreDirectory(CONST Dir : STRING) : BOOLEAN;
FUNCTION OpenFolder(CONST Dir : STRING) : IWebBrowserApp; OVERLOAD;
FUNCTION OpenFolderAt(CONST Dir : STRING ; Left,Top,Width,Height : INTEGER) : IWebBrowserApp; OVERLOAD;
FUNCTION OpenFolderAt(CONST Dir : STRING ; CONST Rect : TRect) : IWebBrowserApp; OVERLOAD; INLINE;

IMPLEMENTATION

USES Windows,Variants,ShlObj,Ole2,OleAuto,ShellAPI,ActiveX,SysUtils;

FUNCTION ExploreDirectory(CONST Dir : STRING) : BOOLEAN;
  BEGIN
    Result:=(ShellExecute(GetDesktopWindow,'open',PChar(Dir),'','',SW_SHOW)>32)
  END;

FUNCTION GetFolderIDList(CONST Dir : STRING) : PItemIDList;
  VAR
    ShellFolder : IShellFolder;
    Attributes  : ULONG;
    Count       : ULONG;

  BEGIN
    OleCheck(SHGetDesktopFolder(ShellFolder));
    Attributes:=SFGAO_FOLDER or SFGAO_STREAM;
    OleCheck(ShellFolder.ParseDisplayName(0,NIL,PWideChar(WideString(Dir)),Count,Result,Attributes));
    IF NOT ((Attributes AND SFGAO_FOLDER=SFGAO_FOLDER) AND (Attributes AND SFGAO_STREAM<>SFGAO_STREAM)) THEN BEGIN
      CoTaskMemFree(Result);
      Result:=NIL
    END
  END;

FUNCTION OpenFolder(CONST Dir : STRING ; OpenIfNotFound : BOOLEAN) : IWebBrowserApp; OVERLOAD;
  CONST
    IID_IServiceProvider: System.TGUID = '{6D5140C1-7436-11CE-8034-00AA006009FA}';

  VAR
    FolderID        : PItemIDList;
    ShellWindows    : IShellWindows;
    I               : INTEGER;
    WndIFace        : System.IDispatch;
    WebBrowserApp   : IWebBrowserApp;
    ServiceProvider : IServiceProvider;
    ShellBrowser    : IShellBrowser;
    ShellView       : IShellView;
    FolderView      : IFolderView;
    PersistFolder   : IPersistFolder2;
    CurFolderID     : PItemIDList;

  BEGIN
    FolderID:=GetFolderIDList(Dir);
    IF Assigned(FolderID) THEN TRY
      OleCheck(CoCreateInstance(CLASS_ShellWindows,NIL,CLSCTX_LOCAL_SERVER,IID_IShellWindows,ShellWindows));
      FOR I:=0 TO PRED(ShellWindows.Count) DO BEGIN
        WndIface:=ShellWindows.Item(VarAsType(I,VT_I4));
        IF Assigned(WndIface) AND
           Succeeded(WndIface.QueryInterface(IID_IWebBrowserApp,WebBrowserApp)) AND
           Succeeded(WebBrowserApp.QueryInterface(IID_IServiceProvider,ServiceProvider)) AND
           Succeeded(ServiceProvider.QueryService(SID_STopLevelBrowser,IID_IShellBrowser,ShellBrowser)) AND
           Succeeded(ShellBrowser.QueryActiveShellView(ShellView)) AND
           Succeeded(ShellView.QueryInterface(IID_IFolderView,FolderView)) AND
           Succeeded(FolderView.GetFolder(IID_IPersistFolder2,PersistFolder)) AND
           Succeeded(PersistFolder.GetCurFolder(CurFolderID)) AND
           ILIsEqual(FolderID,CurFolderID) THEN BEGIN
          IF IsIconic(WebBrowserApp.HWnd) THEN Win32Check(ShowWindow(WebBrowserApp.HWnd,SW_RESTORE));
          Win32Check(SetForegroundWindow(WebBrowserApp.HWnd));
          Exit(WebBrowserApp)
        END
      END
    FINALLY
      CoTaskMemFree(FolderID)
    END;
    Result:=NIL;
    IF OpenIfNotFound THEN BEGIN
      IF NOT ExploreDirectory(Dir) THEN EXIT;
      FOR I:=1 TO 20 DO BEGIN
        Result:=OpenFolder(Dir,FALSE);
        IF Assigned(Result) THEN EXIT;
        Sleep(100)
      END
    END
  END;

FUNCTION OpenFolder(CONST Dir : STRING) : IWebBrowserApp;
  BEGIN
    Result:=OpenFolder(Dir,TRUE)
  END;

FUNCTION OpenFolderAt(CONST Dir : STRING ; Left,Top,Width,Height : INTEGER) : IWebBrowserApp;
  BEGIN
    Result:=OpenFolder(Dir);
    IF Assigned(Result) THEN BEGIN
      Result.Left:=Left; Result.Top:=Top; Result.Width:=Width; Result.Height:=Height
    END
  END;

FUNCTION OpenFolderAt(CONST Dir : STRING ; CONST Rect : TRect) : IWebBrowserApp;
  BEGIN
    Result:=OpenFolderAt(Dir,Rect.Left,Rect.Top,Rect.Width,Rect.Height)
  END;

END.

它是与Delphi Tokyo 10.2.3一起使用的,因此,如果您使用的是较早版本(未在问题中指定Delphi版本),则可能需要调整“使用”列表以匹配。