unit myOpenFileDialog;

interface
uses
  Windows, Classes;

//複数選択
function gfnbOpenFileDialog(slFile: TStrings; sDir: WideString; hHandle: HWND; iOpt: Integer): Boolean; overload;
function gfnbOpenFileDialog(slFile: TStrings; sDir: WideString; hHandle: HWND): Boolean; overload;
function gfnbOpenFileDialog(slFile: TStrings): Boolean; overload;

//ひとつだけ選択
function gfnbOpenFileDialog(var sFile: WideString; sDir: WideString; hHandle: HWND; iOpt: Integer): Boolean; overload;
function gfnbOpenFileDialog(var sFile: WideString; sDir: WideString; hHandle: HWND): Boolean; overload;
function gfnbOpenFileDialog(var sFile: WideString; hHandle: HWND): Boolean; overload;
function gfnbOpenFileDialog(var sFile: WideString): Boolean; overload;

implementation
uses
  CommDlg,
  Dialogs,
	Forms,
  Messages,
	MultiMon,
	SysUtils;


// WideString ------------------------------------------------------------------
//UTF-16LE⇔UTF-7
function gfnsWideToUtf7(sSrc: WideString): AnsiString;
//WideStringをUTF-7にエンコードして返す
var
	li_Len:  Integer;
	lp_Buff: PAnsiChar;
begin
	//WC_COMPOSITECHECKはNG
	li_Len  := WideCharToMultiByte(CP_UTF7, 0, PWideChar(sSrc), -1, nil, 0, nil, nil);
	lp_Buff := AllocMem(li_Len + 1);
	try
		WideCharToMultiByte(CP_UTF7, 0, PWideChar(sSrc), -1, lp_Buff, li_Len, nil, nil);
		Result := AnsiString(lp_Buff);
	finally
		FreeMem(lp_Buff);
	end;
end;

function gfnsUtf7ToWide(sSrc: AnsiString): WideString;
//UTF-7でエンコードされている文字列をWideStringにして返す
var
	li_Len:  Integer;
	lp_Buff: PWideChar;
begin
	li_Len  := MultiByteToWideChar(CP_UTF7, 0, PAnsiChar(sSrc), -1, nil, 0);
	lp_Buff := AllocMem((li_Len + 1) * 2);
	try
		MultiByteToWideChar(CP_UTF7, 0, PAnsiChar(sSrc), -1, lp_Buff, li_Len);
		Result := WideString(lp_Buff);
	finally
		FreeMem(lp_Buff);
	end;
end;

function gfnsWideCopy(pStr: PWideChar; iIndex, iCount: DWORD): WideString;
var
	i: DWORD;
begin
	SetLength(Result, iCount);
	for i := 1 to iCount do begin
		Result[i] := pStr[iIndex + i -1];
	end;
end;


// Rect ------------------------------------------------------------------------
function gfniRectWidth (rtRect: TRect): Integer;
//rtRectの幅を返す
begin
	with rtRect do begin
		Result := Right - Left;
	end;
end;

function gfniRectHeight(rtRect: TRect): Integer;
//rtRectの高さを返す
begin
	with rtRect do begin
		Result := Bottom - Top;
	end;
end;

function gfnrcRectCenter(rcParent, rcChild: TRect): TRect;
//rcChildがrcParentの真ん中にくるようなRectを返す
var
	li_Left, li_Top, li_Width, li_Height: Integer;
begin
	li_Width  := gfniRectWidth (rcChild);
	li_Height := gfniRectHeight(rcChild);
	li_Left   := rcParent.Left + (gfniRectWidth (rcParent) - li_Width)  div 2;
	li_Top    := rcParent.Top  + (gfniRectHeight(rcParent) - li_Height) div 2;

	Result := Rect(li_Left, li_Top, li_Left + li_Width, li_Top + li_Height);
end;

function gfnrcMonitorWorkAreaRectGet(hHandle: HWND): TRect; overload;
//ウィンドウのあるモニターのワークエリアを返す。
var
	lr_Info: TMonitorInfo;
begin
	lr_Info.cbSize := SizeOf(lr_Info);
	GetMonitorInfo(MultiMon.MonitorFromWindow(hHandle, MONITOR_DEFAULTTONEAREST), @lr_Info);
	Result := lr_Info.rcWork;
end;


{
Unicode対応のファイル選択ダイアログ
TOpenFilename(OpenFilename構造体)について
http://homepage2.nifty.com/Mr_XRAY/Halbow/Chap18.html
コールバック関数について
http://www.vbstation.net/spec/S3_1.htm
}
//コールバック関数
function l_fniCallbackFileDialog(hHandle: HWND; iMsg: UINT; wParam: WPARAM; lParam: LPARAM): UINT stdcall;
var
  lh_Handle: HWND;
  lrc_Rect:  TRect;
begin
  if (iMsg = WM_INITDIALOG) then begin
    lh_Handle := GetParent(hHandle);  //ダイアログボックスのウィンドウハンドルを取得
    GetWindowRect(lh_Handle, lrc_Rect);
    //表示位置をモニターの真ん中に
		lrc_Rect := gfnrcRectCenter(gfnrcMonitorWorkAreaRectGet(lh_Handle), lrc_Rect);
    SetWindowPos(lh_Handle, HWND_TOP, lrc_Rect.Left, lrc_Rect.Top, 0, 0, SWP_NOSIZE or SWP_NOZORDER);
  end;
  Result := 0;
end;

function gfnbOpenFileDialog(slFile: TStrings; sDir: WideString; hHandle: HWND; iOpt: Integer): Boolean;
{
Unicode対応のファイル選択ダイアログ。
http://delwiki.info/?%A5%B3%A1%BC%A5%C9%C1%D2%B8%CB%2FUnicode%C2%D0%B1%FE%B0%C6%A4%BD%A4%CE%A3%B2
上記サイトとDialogsのTOpenDialog.DoExecuteを参考。

複数選択版も一つだけ選択版も最終的にこの関数を呼び出す。
}
const
  lcs_SEP = #0;
var
  lr_Info: TOpenFilenameW;
  ls_Path, ls_Item: WideString;
  i, li_Start: DWORD;
begin
  FillChar(lr_Info, SizeOf(lr_Info), 0);  //0で初期化
  with lr_Info do begin
    lStructSize := SizeOf(lr_Info);
    hWndOwner   := hHandle;
    if (hWndOwner = 0) then hWndOwner := Application.Handle;
    lpstrInitialDir := PWideChar(sDir);
    FlagsEx := 0;
    Flags   := iOpt or OFN_EXPLORER;  //エクスプローラ風は必須(古いタイプのとでは区切りが違うので)
    if (hHandle = Application.Handle) then begin
      //Application.Handleだとダイアログが右下に表示されるのでフックを行って真ん中にする
      Flags    := Flags or OFN_ENABLEHOOK;
      lpfnHook := l_fniCallbackFileDialog;
    end else begin
      if ((Flags and OFN_ENABLEHOOK) <> 0) then begin
        Flags := Flags - OFN_ENABLEHOOK;
      end;
      lpfnHook := nil;
    end;
//		nMaxFile := 1024 * 1024; //1MB。場合によっては不具合があるかもしれない。
		nMaxFile := 1024 * 32; //とりあえずこれだけあればまぁ大丈夫だろうと。
		lpstrFile := AllocMem((nMaxFile+2) * 2);  //Unicodeなので2倍。
		try
      Result := GetOpenFileNameW(lr_Info);
      if (Result) then begin
        slFile.Clear;
        if ((iOpt and OFN_ALLOWMULTISELECT) = 0) then begin
          //一つだけ選択
					slFile.Add(gfnsWideToUtf7(WideString(lpstrFile)));
				end else begin
          {
          lpstrFileには'Path#0File1#0File2#0..File(n)#0#0'というように#0を区切り子として
          最初にパス、次から選択ファイルのファイル名のみが格納されるので分解して取り出す。
          ただしひとつだけしか選択していないときはフルパスで格納されることに注意。
          }
          li_Start := 0;
          ls_Path  := '';
          for i := 0 to (nMaxFile -1) do begin
            if (lpstrFile[i] = lcs_SEP) then begin
              ls_Item := gfnsWideCopy(lpstrFile, li_Start, i - li_Start);
              if (ls_Path = '') then begin
                ls_Path := ls_Item;
              end else begin
								slFile.Add(gfnsWideToUtf7(ls_Path + '\' + ls_Item))
              end;
              if (i < nMaxFile) and (lpstrFile[i + 1] = lcs_SEP) then begin
                //#0が二つ続くので終了
                Break;
              end;
              li_Start := i + 1; //区切りの次のインデックス
            end;
          end;
        end;
        if (slFile.Count = 0) then begin
					slFile.Add(gfnsWideToUtf7(ls_Path));  //ひとつだけしか選択していない場合。
        end;
      end;
    finally
      FreeMem(lpstrFile);
    end;
  end;
end;

//複数選択
function gfnbOpenFileDialog(slFile: TStrings; sDir: WideString; hHandle: HWND): Boolean;
begin
  Result := gfnbOpenFileDialog(slFile, sDir, hHandle, OFN_PATHMUSTEXIST or OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or OFN_ALLOWMULTISELECT or OFN_EXPLORER);
end;

function gfnbOpenFileDialog(slFile: TStrings): Boolean;
begin
  Result := gfnbOpenFileDialog(slFile, '', Application.Handle, OFN_PATHMUSTEXIST or OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or OFN_ALLOWMULTISELECT or OFN_EXPLORER);
end;


//シングル選択
function gfnbOpenFileDialog(var sFile: WideString; sDir: WideString; hHandle: HWND; iOpt: Integer): Boolean;
//Unicode対応ファイル選択ダイアログのひとつだけ版。
var
  lsl_List: TStrings;
begin
  lsl_List := TStringList.Create;
  try
    //複数選択のオプションがあれば取り除く
    if Boolean(iOpt and OFN_ALLOWMULTISELECT) then Dec(iOpt, OFN_ALLOWMULTISELECT);

    Result := gfnbOpenFileDialog(lsl_List, sDir, hHandle, iOpt);
    if (lsl_List.Count > 0) then begin
			//リストにはUTF-7に変換されたWideStringが入っているので戻す
			sFile := gfnsUtf7ToWide(lsl_List.Strings[0]);
    end else begin
      sFile := '';
    end;
  finally
    lsl_List.Free;
  end;
end;

function gfnbOpenFileDialog(var sFile: WideString): Boolean;
begin
  Result := gfnbOpenFileDialog(sFile, '', Application.Handle);
end;

function gfnbOpenFileDialog(var sFile: WideString; hHandle: HWND): Boolean;
begin
  Result := gfnbOpenFileDialog(sFile, '', hHandle);
end;

function gfnbOpenFileDialog(var sFile: WideString; sDir: WideString; hHandle: HWND): Boolean;
begin
  Result := gfnbOpenFileDialog(sFile, sDir, hHandle, OFN_PATHMUSTEXIST or OFN_FILEMUSTEXIST or OFN_HIDEREADONLY);
end;end.