unit uOpenDialog;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, TntDialogs, TntComCtrls, TntStdCtrls, CommDlg,
  WideStrings, CommCtrl, TntSysUtils, Dlgs;

{$M+}

type
  TOpenDialogType = (dtSingleFile, dtSingleFolder, dtAllFilesAndFolders);     // --- Poslednje je multiselect

type
  TSNOpenDialog = class
  private
    FXPDlg: TTntOpenDialog;
    FXPDlgWnd: HWND;
    FOldDlgWndProc: TFNWndProc;

    FFiles: TWideStrings;
    FFilter: WideString;
    FDefPath: WideString;
    FDialogType: TOpenDialogType;
    FTitle: WideString;

    function ExecuteVistaPlusDlg: Boolean;
    function ExecuteXPDlg: Boolean;

    procedure SetFilter(const Value: WideString);

    procedure OpenDialogSelectionChange(Sender: TObject);
    procedure OpenDialogShow(Sender: TObject);
    procedure DlgWindowProc(var Message: TMessage);
    procedure ReleaseDlgWndProc;
  public
    function Execute: Boolean;

    property DefPath: WideString read FDefPath write FDefPath;
    property DialogType: TOpenDialogType read FDialogType write FDialogType;
    property Filter: WideString read FFilter write SetFilter;
    property Files: TWideStrings read FFiles write FFiles;
    property Title: WideString read FTitle write FTitle;
  published

  end;

procedure ShowOpenDialog(ATitle: WideString; APath: WideString; ADialogType: TOpenDialogType; AFilter: WideString; var AFiles: TWideStrings);

implementation

procedure ShowOpenDialog(ATitle: WideString; APath: WideString; ADialogType: TOpenDialogType; AFilter: WideString; var AFiles: TWideStrings);
var
  snOpenDialog: TSNOpenDialog;
begin
  snOpenDialog := TSNOpenDialog.Create;
  try
    snOpenDialog.Title := ATitle;
    snOpenDialog.DialogType := ADialogType;
    snOpenDialog.DefPath := APath;
    snOpenDialog.Filter := AFilter;
    snOpenDialog.Files := AFiles;
    snOpenDialog.Execute;
  finally
    snOpenDialog.Free;
  end;
end;

{ TSNOpenDialog }

procedure TSNOpenDialog.DlgWindowProc(var Message: TMessage);
begin
  if Message.Msg = WM_COMMAND then
  begin
    case LoWord(Message.WParam) of
      IDOK: // Is this from OK btn
      begin
        ReleaseDlgWndProc;
        Message.Result := 0;
        Exit;
      end;

      IDCANCEL:
      begin
        FFiles.Clear;
        ReleaseDlgWndProc;
        Message.Result := 0;
        Exit;
      end;
    end;
  end;

  Message.Result := CallWindowProc(FOldDlgWndProc, FXPDlgWnd, Message.Msg, Message.wParam, Message.lParam);
end;

function TSNOpenDialog.Execute: Boolean;
begin
  if Win32MajorVersion >= 6 then
    Result := ExecuteVistaPlusDlg
  else
    Result := ExecuteXPDlg;
end;

function TSNOpenDialog.ExecuteVistaPlusDlg: Boolean;
var
  dlg: TFileOpenDialog;
  mask: TFileTypeItem;
  i: Integer;
begin
  dlg := TFileOpenDialog.Create(nil);
  try
    dlg.Title := FTitle;
    case FDialogType of
      dtSingleFolder:       dlg.Options := [fdoPickFolders, fdoPathMustExist, fdoForceFileSystem];
      dtSingleFile:         dlg.Options := [fdoForceFileSystem];
      dtAllFilesAndFolders: dlg.Options := [fdoAllowMultiSelect{fdoPickFolders{, fdoNoValidate, fdoForceFileSystem}];
    end;


    mask := dlg.FileTypes.Add;
    mask.DisplayName := Copy(FFilter, 1, Pos('|', FFilter) - 1);
    mask.FileMask := Copy(FFilter, Pos('|', FFilter) + 1, Length(FFilter));

    dlg.OkButtonLabel := 'Select';
    dlg.DefaultFolder := FDefPath;
    dlg.FileName := '';//FDir;
    FFiles.Clear;
    Result := dlg.Execute;
    if Result then
    begin
      case FDialogType of
        dtSingleFile, dtSingleFolder: FFiles.Add(dlg.FileName);
        dtAllFilesAndFolders:
        begin
          for i := 0 to dlg.Files.Count - 1 do
            FFiles.Add(dlg.Files[i]);
        end;
      end;
    end;
  finally
    dlg.Free;
  end
end;

function TSNOpenDialog.ExecuteXPDlg: Boolean;
begin
  FXPDlg:= TTntOpenDialog.Create(nil);
  try
    FXPDlg.OnSelectionChange := OpenDialogSelectionChange;
    FXPDlg.OnShow := OpenDialogShow;

    FXPDlg.Title := FTitle;
    FXPDlg.InitialDir := FDefPath;
    FXPDlg.Options := [ofReadOnly, ofFileMustExist, ofDontAddToRecent, ofForceShowHidden];
    FXPDlg.Filter := FFilter;

    case FDialogType of
      dtSingleFile: ;

      dtSingleFolder: FXPDlg.Filter := 'none|_.?_2322'; // Add some crazy filter that will show no file

      dtAllFilesAndFolders: FXPDlg.Options := FXPDlg.Options + [ofAllowMultiSelect];
    end;

    FXPDlg.Execute;
    Result := FFiles.Count > 0;
  finally
    FXPDlg.Free;
  end;
end;

procedure TSNOpenDialog.OpenDialogSelectionChange(Sender: TObject);

  function ListView_GetItemTextW(hwndLV: HWND; i, iSubItem: Integer; pszText: PWideChar; cchTextMax: Integer): Integer;
  var
    Item: TLVItemW;
  begin
    Item.iSubItem := iSubItem;
    Item.cchTextMax := cchTextMax;
    Item.pszText := pszText;
    Result := SendMessage(hwndLV, LVM_GETITEMTEXTW, i, Longint(@Item));
  end;

  procedure GetSelectedList(const AListHandle: HWND);
  var
    SelCount, i, ItemIndex: Integer;
    Path: array[0..MAX_PATH] of WideChar;
    BaseDir: WideString;
  begin
    FFiles.Clear;
    BaseDir := WideExtractFilePath(FXPDlg.FileName);
    SelCount := ListView_GetSelectedCount(AListHandle);
    ItemIndex := -1;

    for i := 0 to SelCount - 1 do
    begin
      ItemIndex := ListView_GetNextItem(AListHandle, ItemIndex, LVNI_SELECTED);
      if ItemIndex <> -1 then
      begin
        Path[0] := #0;
        if ListView_GetItemTextW(AListHandle, ItemIndex, 0, @Path[0], SizeOf(Path) div 2) > 0 then
          FFiles.Add(BaseDir + Path);
      end;
    end;
  end;

  procedure AnalyzeWindow(const AWnd: HWND);
  var
    Buf: array[0..255] of Char;
    ClassName: string;
    hFirst, hCurr: HWND;
  begin
    hFirst := GetWindow(AWnd, GW_CHILD);
    if hFirst = 0 then
      Exit;

    hCurr := hFirst;
    repeat
      GetClassname(hCurr, Buf, SizeOf(Buf));
      ClassName := Buf;
      if ClassName = 'SysListView32' then
      begin
        GetSelectedList(hCurr);
        Break;
      end
      else
        AnalyzeWindow(hCurr);

      hCurr := GetWindow(hCurr, GW_HWNDNEXT);
    until ((hCurr = 0) or (hCurr = hFirst));
  end;
begin
  AnalyzeWindow(GetParent(FXPDlg.Handle));
end;

procedure TSNOpenDialog.OpenDialogShow(Sender: TObject);
begin
  FXPDlgWnd := GetParent(FXPDlg.Handle);
  SendMessage(FXPDlgWnd, CDM_HIDECONTROL, cmb1, 0);
  SendMessage(FXPDlgWnd, CDM_HIDECONTROL, stc2, 0);

  SendMessage(FXPDlgWnd, CDM_HIDECONTROL, cmb13, 0);
  SendMessage(FXPDlgWnd, CDM_HIDECONTROL, stc3, 0);
  SendMessage(FXPDlgWnd, CDM_SETCONTROLTEXT, IDOK, LongInt(PWideChar(WideString('OK'))));

  FOldDlgWndProc := TFNWndProc(SetWindowLong(FXPDlgWnd, GWL_WNDPROC, LongInt(Classes.MakeObjectInstance(DlgWindowProc))));
end;

procedure TSNOpenDialog.ReleaseDlgWndProc;
var
  Instance: TFNWndProc;
begin
  if FOldDlgWndProc = nil then
    Exit;
  // Restore original WndProc and release created object instance
  SendMessage(FXPDlgWnd, WM_CLOSE, 0, 0);
  Instance := TFNWndProc(SetWindowLong(FXPDlgWnd, GWL_WNDPROC, LongInt(FOldDlgWndProc)));
  Classes.FreeObjectInstance(Instance);
  FOldDlgWndProc := nil;
end;

procedure TSNOpenDialog.SetFilter(const Value: WideString);
begin
  FFilter := Value;
  // Filter must have name, otherwise it's considered inactive
  if Pos('|', FFilter) = 0 then
    FFilter := 'selection|' + FFilter;
end;

end.
