Запустите Windows Explorer рядом с моим приложением с указанными границами - PullRequest
0 голосов
/ 25 августа 2018

У меня есть это:

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

, где переменная ImagesDir - это каталог изображений, которые я хочу показать в проводнике Windows ...

Как запуститьПроводник Windows рядом с моим приложением в указанных границах, например, как это?

image

Ответы [ 2 ]

0 голосов
/ 26 августа 2018

когда вы открываете какое-либо окно Проводника (например, переходите к C: \), Проводник имеет определенный размер сохраненного окна, с которым он открывается. Поэтому, когда вы изменяете размер по горизонтали и / или по вертикали, закрываете его и снова открываете снова, он сохраняет размер окна,
и место в реестре, где сохраняется эта информация:
В моей системе HKCU \ Software \ Classes \ Local Settings \ Software \ Microsoft \ Windows \ Shell \ Bags \ AllFolders \ Shell \ WinPos1366x768x96 (1) .. позиция, где позиция слева, справа, сверху или снизу, дает позицию граница окна в пикселях.

Я предполагаю, что имя клавиши зависит от разрешения экрана. здесь и код будет таким:

.....
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.

Результат здесь

0 голосов
/ 26 августа 2018

Вы можете использовать следующую функцию, чтобы открыть окно проводника и указать, что оно указывает на определенный каталог.

USES Windows,ShellAPI;

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

Обратите внимание, однако, что вы не можете (с этим кодом) создать окно проводника«следовать» вашей программе, т.е.открытое окно является полностью автономным окном, которое не имеет ссылки на вашу программу, как если бы пользователь сам просматривал каталог.Если вы снова вызовете эту функцию с новым каталогом, Explorer откроет новое окно с этим каталогом (и оставит старый открытым).

ОБНОВЛЕНИЕ: Если вы хотите иметь возможность манипулировать окном проводника после негооткрыт, вам нужно использовать различные интерфейсы, которые предоставляет Explorer.Я сделал БЛОК, который позволяет вам делать то, что вы ищете, а также возвращать интерфейс, необходимый для того, чтобы впоследствии иметь возможность манипулировать окном.Это в значительной степени основано на коде, найденном в этом ответе:

Проверьте, не открылся ли проводник Windows по указанному пути

по Виктория

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 в своем вопросе), вам может потребоваться адаптировать список USES для соответствия.

...