Как добавить в FileOpenDialog чекбоксы к файлам/каталогам?

Страдалецъ
Дата: 21.06.2019 22:09:21
Есть ли возможность более удобно выделять файлы и каталоги в стандартном TFileOpenDialog через чекбоксы?
Кроик Семён
Дата: 22.06.2019 20:08:26
Нужно самому написать диалог, внешне очень похожий на стандартный
Страдалецъ
Дата: 22.06.2019 22:24:48
Как-то не хотелось бы изобретать велосипед, скорее всего решение уже есть.
Aniskin
Дата: 22.06.2019 22:47:32
uses
  ActiveX, CommDlg, ShlObj;

type
  TOpenDialogWithCheckBox = class(TOpenDialog)
  public
    function Execute(ParentWnd: HWND): Boolean; override;
  protected
    procedure WndProc(var AMessage: TMessage); override;
  private
    FSaveOnShow: TNotifyEvent;
    procedure HackOnShow(Sender: TObject);
  end;

const
  WM_GETISHELLBROWSER = WM_USER + 7;

function TOpenDialogWithCheckBox.Execute(ParentWnd: HWND): Boolean;
begin
  FSaveOnShow := OnShow;
  OnShow := HackOnShow;
  try
    inherited Execute(ParentWnd);
  finally
    OnShow := FSaveOnShow;
  end;
end;

procedure TOpenDialogWithCheckBox.WndProc(var AMessage: TMessage);
var
  LOFNotify: POFNotify;
  ShellBrowser: IShellBrowser;
  ShellView: IShellView;
  FolderView2: IFolderView2;
begin
  inherited WndProc(AMessage);
  if (AMessage.Msg = WM_NOTIFY) then
    begin
      LOFNotify := POFNotify(AMessage.LParam);
      case (LOFNotify.hdr.code) of
        CDN_FOLDERCHANGE:
          if LOFNotify.hdr.hwndFrom <> 0 then
            begin
              ShellBrowser := IShellBrowser(SendMessage(LOFNotify.hdr.hwndFrom, WM_GETISHELLBROWSER, 0, 0));
              if Assigned(ShellBrowser) then
                begin
                  if Succeeded(ShellBrowser.QueryActiveShellView(ShellView)) then
                    begin
                      if Succeeded(ShellView.QueryInterface(IFolderView2, FolderView2)) then
                        FolderView2.SetCurrentFolderFlags(FWF_CHECKSELECT, FWF_CHECKSELECT);
                      ShellView := nil;
                    end;
                  Pointer(ShellBrowser) := nil;
                end;
            end;
      end;
    end;
end;

procedure TOpenDialogWithCheckBox.HackOnShow(Sender: TObject);
begin
  if Assigned(FSaveOnShow) then
    FSaveOnShow(Sender);
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
  with TOpenDialogWithCheckBox.Create(Self) do
    try
      Execute(Handle);
    finally
      Free;
    end;
end;
alekcvp
Дата: 23.06.2019 01:35:37
Aniskin,

А зачем танцы с HackOnShow() ?..
Aniskin
Дата: 23.06.2019 02:40:19
alekcvp,

Что бы приходил WM_NOTIFY.
Страдалецъ
Дата: 23.06.2019 08:51:21
Ага, добавились чекбоксы, но где теперь читать информацию о том что отмечено?
Aniskin
Дата: 23.06.2019 13:37:15
+

uses
  ActiveX, CommDlg, ShlObj;

type
  TOpenDialogWithCheckBox = class(TOpenDialog)
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute(ParentWnd: HWND): Boolean; override;
  protected
    procedure WndProc(var AMessage: TMessage); override;
  private
    FSaveOnShow: TNotifyEvent;
    procedure HackOnShow(Sender: TObject);
  private
    FItems: TStrings;
  public
    property Items: TStrings read FItems;
  end;

const
  WM_GETISHELLBROWSER = WM_USER + 7;

constructor TOpenDialogWithCheckBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FItems := TStringList.Create;
end;

destructor TOpenDialogWithCheckBox.Destroy;
begin
  FreeAndNil(FItems);
  inherited Destroy;
end;

function TOpenDialogWithCheckBox.Execute(ParentWnd: HWND): Boolean;
begin
  FItems.Clear;
  FSaveOnShow := OnShow;
  OnShow := HackOnShow;
  try
    Result := inherited Execute(ParentWnd);
  finally
    OnShow := FSaveOnShow;
  end;
end;

procedure FreeStrRet(var AStrRet: TStrRet);
begin
  case AStrRet.uType of
    STRRET_WSTR:
      begin
        CoTaskMemFree(AStrRet.pOleStr);
        AStrRet.pOleStr := nil;
      end;
  end;
end;

function StrRetToString(AItemIdList: PItemIdList; var AStrRet: TStrRet; AFree: Boolean = True): string;
begin
  case AStrRet.uType of
    STRRET_WSTR:
      Result := string(AStrRet.pOleStr);
    STRRET_OFFSET:
      if Assigned(AItemIdList) then
        begin
          Inc(PByte(AItemIdList), AStrRet.uOffset);
          Result := string(PAnsiChar(AItemIdList));
        end
      else
        Result := '';
    STRRET_CSTR:
      Result := string(AnsiString(AStrRet.cStr));
  else
    Result := '';
  end;

  if AFree then
    FreeStrRet(AStrRet);
end;

procedure TOpenDialogWithCheckBox.WndProc(var AMessage: TMessage);
var
  LOFNotify: POFNotify;
  ShellBrowser: IShellBrowser;
  ShellView: IShellView;
  FolderView2: IFolderView2;
  Folder: IShellFolder;
  Count: Integer;
  IDList: IEnumIDList;
  Item: PItemIDList;
  Fetched: Cardinal;
  StrRet: TStrRet;
begin
  inherited WndProc(AMessage);
  if (AMessage.Msg = WM_NOTIFY) then
    begin
      LOFNotify := POFNotify(AMessage.LParam);
      case (LOFNotify.hdr.code) of
        CDN_FOLDERCHANGE:
          if LOFNotify.hdr.hwndFrom <> 0 then
            begin
              ShellBrowser := IShellBrowser(SendMessage(LOFNotify.hdr.hwndFrom, WM_GETISHELLBROWSER, 0, 0));
              if Assigned(ShellBrowser) then
                begin
                  if Succeeded(ShellBrowser.QueryActiveShellView(ShellView)) then
                    begin
                      if Succeeded(ShellView.QueryInterface(IFolderView2, FolderView2)) then
                        begin
                          FolderView2.SetCurrentFolderFlags(FWF_CHECKSELECT, FWF_CHECKSELECT);
                          FolderView2 := nil;
                        end;
                      ShellView := nil;
                    end;
                  Pointer(ShellBrowser) := nil;
                end;
            end;
        CDN_FILEOK:
          begin
              ShellBrowser := IShellBrowser(SendMessage(LOFNotify.hdr.hwndFrom, WM_GETISHELLBROWSER, 0, 0));
              if Assigned(ShellBrowser) then
                begin
                  if Succeeded(ShellBrowser.QueryActiveShellView(ShellView)) then
                    begin
                      if Succeeded(ShellView.QueryInterface(IFolderView2, FolderView2)) then
                        begin
                          if Succeeded(FolderView2.GetFolder(IShellFolder, Folder)) then
                            begin
                              if Succeeded(FolderView2.ItemCount(SVGIO_CHECKED, Count)) and (Count > 0) then
                                if Succeeded(FolderView2.Items(SVGIO_CHECKED, IEnumIDList, IDList)) then
                                  begin
                                    while IDList.Next(1, Item, Fetched) = S_OK do
                                      begin
                                        if Succeeded(Folder.GetDisplayNameOf(Item, SHGDN_FORPARSING, StrRet)) then
                                          FItems.Add(StrRetToString(Item, StrRet, True));
                                        CoTaskMemFree(Item);
                                      end;
                                    IDList := nil;
                                  end;
                              Folder := nil;
                            end;
                          FolderView2 := nil;
                        end;
                      ShellView := nil;
                    end;
                  Pointer(ShellBrowser) := nil;
                end;
          end;
      end;
    end;
end;

procedure TOpenDialogWithCheckBox.HackOnShow(Sender: TObject);
begin
  if Assigned(FSaveOnShow) then
    FSaveOnShow(Sender);
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
  with TOpenDialogWithCheckBox.Create(Self) do
    try
      if Execute(Self.Handle) then
        lst1.Items.Assign(Items);
    finally
      Free;
    end;
end;

ёёёёё
Дата: 23.06.2019 16:24:41
+1000!

Хороший топик, и тема, и решение.
Страдалецъ
Дата: 23.06.2019 18:37:35
Да, весьма интересно. Некоторые вещи впервые вижу. Респект.
Не сочтите за наглость, но может и для TFileOpenDialog тоже самое можно сделать? Уж очень полезная функция выделения каталогов там есть, а в OpenDialog этот функционал не реализован.