unit mySaveFileDialog;

interface
uses
  Windows;

function gfnsFileNameGet(sFile: WideString): WideString;

function gfnbSaveFileDialog(var sFile: WideString; sDir: WideString; hHandle: HWND; iOpt: Integer): Boolean; overload;
function gfnbSaveFileDialog(var sFile: WideString; sDir: WideString): Boolean; overload;
function gfnbSaveFileDialog(var sFile: WideString; iOpt: Integer): Boolean; overload;
function gfnbSaveFileDialog(var sFile: WideString): Boolean; overload;

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


// File ------------------------------------------------------------------------
function gfnsFileNameGet(sFile: WideString): WideString;
{
パスを除いたファイル名を返す
拡張子はつく
\ はつかない
}
var
	i, li_Len, li_Pos: Integer;
begin
	Result := '';
	if (sFile <> '') then begin
		li_Len := Length(sFile);
		li_Pos := li_Len + 1;	//sFileの最後が'\'であった場合への対策
		for i := li_Len downto 1 do begin
			if (sFile[i] = '\') or (sFile[i] = '/') or(sFile[i] = ':') then begin
				Break;
			end;
			li_Pos := i;
		end;
		Result := Copy(sFile, li_Pos, MaxInt);
	end;
end;

function gfnbFolderExists(sFolder: WideString): Boolean;
//DirectoryExitsのWideString対応版
var
	lh_Handle: THandle;
	lr_Info:   TWin32FindDataW;
	li_Len:    Integer;
begin
	Result  := False;

	if (sFolder <> '') then begin
		li_Len := Length(sFolder);
		if (sFolder[li_Len] = '\') then begin
			SetLength(sFolder, li_Len -1);
		end;
	end;

	FillChar(lr_Info, SizeOf(TWin32FindDataW), 0);
	lh_Handle:= FindFirstFileW(PWideChar(sFolder), lr_Info);
	try
		if (lh_Handle<> INVALID_HANDLE_VALUE) then begin
			repeat
				if  (WideString(lr_Info.cFileName) <> '.')
				and (WideString(lr_Info.cFileName) <> '..')
				and ((lr_Info.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0)
				then begin
					Result := True;
					Break;
				end;
			until not(FindNextFileW(lh_Handle, lr_Info));
		end;
	finally
		Windows.FindClose(lh_Handle);
	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;
//ウィンドウのあるモニターのワークエリアを返す。
var
	lr_Info: TMonitorInfo;
begin
	lr_Info.cbSize := SizeOf(lr_Info);
	GetMonitorInfo(MultiMon.MonitorFromWindow(hHandle, MONITOR_DEFAULTTONEAREST), @lr_Info);
	Result := lr_Info.rcWork;
end;


//コールバック関数
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;
//SaveDialog
function gfnbSaveFileDialog(var sFile: WideString; sDir: WideString; hHandle: HWND; iOpt: Integer): Boolean;
//SaveFileDialogだけども実際はファイル名取得のためだけにも使える。
var
  lr_Info: TOpenFilenameW;
//  ls_Str: WideString;
begin
  FillChar(lr_Info, SizeOf(lr_Info), 0);  //0で初期化
  with lr_Info do begin
    lStructSize := SizeOf(lr_Info);
    hWndOwner   := hHandle;
    hInstance   := 0;
    lpstrTitle  := '';
    lpstrFilter := '';
    lpstrDefExt := '';
		if (sDir <> '') and (gfnbFolderExists(sDir)) then begin
      lpstrInitialDir := PWideChar(sDir);
    end else begin
      lpstrInitialDir := nil;
    end;
    FlagsEx := 0;
    Flags   := iOpt or OFN_EXPLORER;
    if ((Flags and OFN_ALLOWMULTISELECT) <> 0) then begin
      Flags := Flags - OFN_ALLOWMULTISELECT;
    end;
    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;  //ファイルは一つだけなのでとりあえずこれくらいで充分かなと。
    lpstrFile := AllocMem((nMaxFile + 2) * 2);
		lstrcpyW(lpstrFile,  PWideChar(gfnsFileNameGet(sFile)));
    try
      Result := GetSaveFileNameW(lr_Info);
      if (Result) then begin
        sFile := WideString(lr_Info.lpstrFile);
      end else begin
        sFile := '';
      end;
    finally
      FreeMem(lpstrFile);
    end;
  end;
end;

function gfnbSaveFileDialog(var sFile: WideString; sDir: WideString): Boolean;
begin
	Result := gfnbSaveFileDialog(sFile, sDir, Application.Handle, 0);
end;

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

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


end.