unit myFileDialog;
{
ファイル選択、名前をつけて保存ダイアログ
2011-08-18:
　閉じるとカスタムパネル上のTWinControlのテキストがクリアされてしまうことへの対処
　をExecute内で行うようにした。
}
//{$DEFINE DEBUG}
{$DEFINE MYLIB}

interface
uses
	Classes,
	Controls,
	Dialogs,
	ExtCtrls,
	Messages,
	Windows,
	myWStrings;

{ファイル選択}
type
	{ TMyOpenFileDialog }
	TMyOpenFileDialog = class(TOpenDialog)
	private
		F_hHandle: HWND;
		F_bFilterUnicode: Boolean;
		F_bPosCenter: Boolean;
		F_sDefaultExt, F_sFileName, F_sInitialDir, F_sTitle: WideString;
		F_slFiles: TMyWStrings;
		F_Owner: TWinControl;

		//カスタムダイアログ
		F_sCustomTemplate     : WideString;
		F_CustomBasePanel     : TPanel;
//		F_iCustomCaptionIndex : Integer;
//		F_slCustomCaption     : TMyWStrings; //閉じるとキャプション(テキスト)が消えてしまうのでそのバックアップ用

		procedure F_SetCustomBasePanel(BasePanel: TPanel);
//		Ansi版メッセージフック
//		F_DefWndProc, F_ChangeWndProcInstance: Pointer;
//		procedure F_ChangeWndProc(var Message: TMessage);

		procedure F_SetFileName(sFile: WideString);
		function  F_GetCount: Integer;
	protected
		procedure DoClose; override;
		function  DoExecute : Boolean; virtual;
		procedure DoShow; override;
		function  GetStaticRect: TRect; override;
		function  F_GetFiles(const pBuff: PWideChar; iLen: DWORD; slFiles: TMyWStrings): WideString;
		property  Template: WideString read F_sCustomTemplate write F_sCustomTemplate;
	public
		constructor Create(AOwner: TComponent); override;
		destructor  Destroy; override;
		function  Execute: Boolean; override;
		function  ShortFileName: WideString;
		function  ShortFileNames(iIndex: Integer): WideString;
		procedure ShowMonitorCenter; overload;
		procedure ShowMonitorCenter(ptPos: TPoint); overload;

		property Count:  Integer     read F_GetCount;
		property Files:  TMyWStrings read F_slFiles;
		property Handle: HWND        read F_hHandle; //ダイアログそのもののハンドルではない
	published
		property CustomBasePanel: TPanel      read F_CustomBasePanel write F_SetCustomBasePanel;
		property CustomTemplate:  WideString  read F_sCustomTemplate write F_sCustomTemplate;
		property DefaultExt:      WideString  read F_sDefaultExt     write F_sDefaultExt;
		property FileName:        WideString  read F_sFileName       write F_SetFileName;
		property InitialDir:      WideString  read F_sInitialDir     write F_sInitialDir;
		property PosCenter:       Boolean     read F_bPosCenter      write F_bPosCenter     default False;
		property FilterUnicode:   Boolean     read F_bFilterUnicode  write F_bFilterUnicode default False;
		property Owner:           TWinControl read F_Owner           write F_Owner;
		property Title:           WideString  read F_sTitle          write F_sTitle;
	end;

//複数選択
function gfnbOpenFileDialog(slFiles: TMyWStrings; sDir: WideString; Opt: TOpenOptions): Boolean; overload;
function gfnbOpenFileDialog(slFiles: TMyWStrings; sDir: WideString): Boolean; overload;
function gfnbOpenFileDialog(slFiles: TMyWStrings): Boolean; overload;
//ひとつだけ選択
function gfnbOpenFileDialog(var sFile: WideString; sDir: WideString; Opt: TOpenOptions): Boolean; overload;
function gfnbOpenFileDialog(var sFile: WideString; sDir: WideString): Boolean; overload;
function gfnbOpenFileDialog(var sFile: WideString): Boolean; overload;


//------------------------------------------------------------------------------
//名前をつけて保存
{TMySaveFileDialog}
type
	TMySaveFileDialog = class(TMyOpenFileDialog)
	protected
		function DoExecute: Boolean; override;
	end;

function gfnbSaveFileDialog(var sFile: WideString; sDir: WideString; Opt: TOpenOptions): Boolean; overload;
function gfnbSaveFileDialog(var sFile: WideString; sDir: WideString): Boolean; overload;
function gfnbSaveFileDialog(var sFile: WideString; Opt: TOpenOptions): Boolean; overload;
function gfnbSaveFileDialog(var sFile: WideString): Boolean; overload;


procedure gpcDialogFilterToStrings    (sFilter: WideString; AList: TStrings);    overload;
procedure gpcDialogFilterToStrings    (sFilter: WideString; AList: TMyWStrings); overload;
procedure gpcDialogFilterKindToStrings(sFilter: WideString; AList: TStrings);    overload;
procedure gpcDialogFilterKindToStrings(sFilter: WideString; AList: TMyWStrings); overload;
procedure gpcDialogFilterExtToStrings (sFilter: WideString; AList: TStrings);    overload;
procedure gpcDialogFilterExtToStrings (sFilter: WideString; AList: TMyWStrings); overload;
function  gfnsDialogFileterExtAddAllKind(sFilter: WideString; sKind: WideString): WideString;

function gfnsDialogFilterStringsGet(sTitle: WideString; AExtList: TMyWStrings): WideString;
function gfnsDialogStringsToFilter(AList: TMyWStrings): WideString;


//拡張子が含まれるフィルタのインデックスを得る
function gfniFilterIndexGet(sFilter, sExt: WideString): Integer;
//iIndex番目のフィルタの拡張子を取得
function gfnsFilterExtGet(sFilter : WideString; iIndex : Integer) : WideString;


//------------------------------------------------------------------------------
procedure Register;


//==============================================================================
implementation
uses
{$IFDEF DEBUG}
	myDebug,
{$ENDIF}
	CommDlg,
	Dlgs,
	Forms,
	MultiMon,
	StdCtrls,
{$IFDEF MYLIB}
	myFile,
	myMonitor,
	mySize,
	myString,
	myWindow,
	myComboBox,
{$ENDIF}
	SysUtils;


{$IFNDEF MYLIB}
//------------------------------------------------------------------------------
//myFile.pas
function gfnbFolderExists(sFolder: WideString): Boolean;
//Unicode対応DirectoryExits。
var
	li_Attr: DWORD;
begin
	li_Attr := GetFileAttributesW(PWideChar(sFolder));
	Result  := ((li_Attr <> $FFFFFFFF) and ((li_Attr and FILE_ATTRIBUTE_DIRECTORY) <> 0));
end;

function gfnbFileExists(sFile: WideString): Boolean;
//FileExistsのUnicode対応版。
var
	li_Attr: DWORD;
begin
	li_Attr := GetFileAttributesW(PWideChar(sFile));
	Result  := (li_Attr <> $FFFFFFFF) and ((li_Attr and FILE_ATTRIBUTE_DIRECTORY) = 0);
end;

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 gfnsFileExtGet(sFile: WideString): WideString;
{2007-08-05,2008-12-27:
Unicode対応ExtractFileExt。
'.'は返る
}
var
	i: Integer;
begin
	Result := '';
	for i := Length(sFile) downto 1 do begin
		if (sFile[i] = '\') or (sFile[i] = '/') or (sFile[i] = ':') then begin
			//拡張子なし
			Break;
		end else if (sFile[i] = '.') then begin;
			//拡張子あり
			Result := Copy(sFile, i, MaxInt);
			Break;
		end;
	end;
end;

function gfnsShortFileNameGet(sFile: WideString): WideString;
{
Unicode対応の短いファイル名を返す。
戻り値がStringでないことに注意。
Unicode非対応のコンポーネントにファイルを渡すときの（完全ではないけれど）逃げ道。
}
var
	lp_Buff: PWideChar;
begin
	lp_Buff := AllocMem((MAX_PATH +1) *2);
	try
		if (GetShortPathNameW(PWideChar(sFile), lp_Buff, (MAX_PATH + 1) * 2) > 0) then begin
			Result := WideString(lp_Buff);
		end else begin
			Result := sFile;
		end;
	finally
		FreeMem(lp_Buff);
	end;
end;


//myMonitor.pas
function gfnrcMonitorWorkAreaRectGet(ptPos: TPoint): TRect;
var
	lh_Handle: HMONITOR;
	lr_Info: TMonitorInfo;
begin
	lh_Handle := MultiMon.MonitorFromPoint(ptPos, MONITOR_DEFAULTTONEAREST);
	FillChar(lr_Info, SizeOf(lr_Info), 0);
	lr_Info.cbSize := SizeOf(lr_Info);
	GetMonitorInfo(lh_Handle, @lr_Info);
	Result := lr_Info.rcWork;
end;


//mySize.pas
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;


//myWindow.pas
function gfnsWindowTextGet(hHandle: HWND): WideString;
//ウィンドウハンドルhHandleのテキスト(キャプション)を返す
var
	li_Len: Integer;
	lp_Text: PWideChar;
begin
	Result := '';
	li_Len := GetWindowTextLengthW(hHandle) + 1;
	if (li_Len > 0) then begin
		lp_Text := AllocMem(li_Len * 2);
		try
			GetWindowTextW(hHandle, lp_Text, li_Len);
			Result := WideString(lp_Text);
		finally
			FreeMem(lp_Text);
		end;
	end;
end;

procedure gpcWindowTextSet(hHandle: HWND; sText: WideString);
begin
	SetWindowTextW(hHandle, PWideChar(sText));
end;


//myString.pas
function gfnsStrEndFit(sSrc, sEnd: WideString): WideString;
{2007-07-26:
sSrcの末尾がsEndでなければsEndを足して返す。
}
begin
	if (Copy(sSrc, Length(sSrc) - Length(sEnd) +1, Length(sEnd)) <> sEnd) then begin
		Result := sSrc + sEnd;
	end else begin
		Result := sSrc;
	end;
end;
{$ENDIF}

//------------------------------------------------------------------------------
//ファイル選択ダイアログ
{TMyOpenFileDialog}
var
	My_Dialog: TMyOpenFileDialog = nil;

constructor TMyOpenFileDialog.Create(AOwner: TComponent);
begin
	inherited;

//	Ansi版メッセージフック用
//	F_ChangeWndProcInstance := Classes.MakeObjectInstance(F_ChangeWndProc);

	F_slFiles     := TMyWStrings.Create;
	F_sFileName   := '';
	F_sInitialDir := '';
	F_sTitle      := '';
	F_bPosCenter  := False;
//	F_slCustomCaption := nil;

	if (AOwner is TWinControl) then begin
		F_Owner := (AOwner as TWinControl);
	end else begin
		F_Owner := nil;
	end;
end;

destructor TMyOpenFileDialog.Destroy;
begin
	F_slFiles.Free;
//	F_slCustomCaption.Free;

	inherited;
end;

function TMyOpenFileDialog.F_GetCount: Integer;
begin
	Result := F_slFiles.Count;
end;

function TMyOpenFileDialog.GetStaticRect: TRect;
//http://www.vbstation.net/spec/S3_1.htm
begin
	if (F_hHandle <> 0) then begin
		GetWindowRect(GetDlgItem(F_hHandle, stc32), Result);
		Result := Rect(0, 0, gfniRectWidth(Result), gfniRectHeight(Result));
	end else begin
		Result := Rect(0,0,0,0);
	end;
end;

procedure TMyOpenFileDialog.F_SetCustomBasePanel(BasePanel: TPanel);
{
	procedure _SetAllCaption(Panel: TPanel; slList: TMyWStrings);
		procedure _SetCaption(AWinControl: TWinControl; slList: TMyWStrings);
		var
			i: Integer;
			l_WinControl: TWinControl;
		begin
			F_slCustomCaption.Add(gfnsWindowTextGet(AWinControl.Handle));
			for i := 0 to AWinControl.ControlCount -1 do begin
				if (AWinControl.Controls[i] is TWinControl) then begin
					l_WinControl := TWinControl(AWinControl.Controls[i]);
					_SetCaption(l_WinControl, slList);
				end;
			end;
		end;
	begin
		_SetCaption(Panel, slList);
	end;
}
begin
	F_CustomBasePanel := BasePanel;
{
	if (F_slCustomCaption = nil) then begin
		F_slCustomCaption := TMyWStrings.Create;
	end else begin
		F_slCustomCaption.Clear;
	end;
	F_iCustomCaptionIndex := 0;
	_SetAllCaption(F_CustomBasePanel, F_slCustomCaption);
}
end;

procedure TMyOpenFileDialog.DoShow;
	//カスタムダイアログ用
	procedure _ShowAllControl(Panel: TPanel);
		procedure _ShowControl(AWinControl: TWinControl);
		var
			i: Integer;
			l_WinControl: TWinControl;
		begin
			if (AWinControl.Visible) then begin
				ShowWindow(AWinControl.Handle, SW_SHOW);
			end;
{
			gpcWindowTextSet(AWinControl.Handle, F_slCustomCaption[F_iCustomCaptionIndex]);
			Inc(F_iCustomCaptionIndex);
}
			for i := 0 to AWinControl.ControlCount -1 do begin
				if (AWinControl.Controls[i] is TWinControl) then begin
					l_WinControl := TWinControl(AWinControl.Controls[i]);
					_ShowControl(l_WinControl);
				end;
			end;
		end;
	begin
		_ShowControl(Panel);
	end;
var
	lrc_Template   : TRect;
	lrc_DialogRect : TRect;
begin
	//カスタムダイアログ
	if  (F_sCustomTemplate <> '')
	and (F_CustomBasePanel <> nil)
	then begin
		GetClientRect(F_hHandle, lrc_Template);
		lrc_DialogRect   := GetStaticRect;
		lrc_Template.Top := lrc_DialogRect.Top + gfniRectHeight(lrc_DialogRect) -1;
		Windows.SetParent(F_CustomBasePanel.Handle, F_hHandle);
		F_CustomBasePanel.BoundsRect := lrc_Template;
		F_CustomBasePanel.Show;
		{
		ダイアログを閉じると、ダイアログを親にしたコントロールは非可視ウィンドウになり
		更にウィンドウテキストが空になってしまうので戻す。
		}
		_ShowAllControl(F_CustomBasePanel);
//		F_iCustomCaptionIndex := 0;
	end;

//	inherited DoShow; いらない。
	if Assigned(@OnShow) then begin
		OnShow(Self);
	end;
end;

procedure TMyOpenFileDialog.ShowMonitorCenter(ptPos: TPoint);
var
	lh_Handle  : HWND;
	lrc_Rect   : TRect;
	lrc_Center : TRect;
	li_Width   : Integer;
	li_Height  : Integer;
	lb_Bool    : LongBool;
	lh_Button  : HWND;
	lrc_Cursor : TRect;
begin
	//ダイアログをモニターの真ん中に
	lh_Handle := GetParent(F_hHandle);
	GetWindowRect(lh_Handle, lrc_Rect);
	li_Width   := gfniRectWidth(lrc_Rect);
	li_Height  := gfniRectHeight(lrc_Rect);
	lrc_Center := gfnrcRectCenter(gfnrcMonitorWorkAreaRectGet(ptPos), lrc_Rect);
	SetWindowPos(lh_Handle, 0, lrc_Center.Left, lrc_Center.Top, li_Width, li_Height, SWP_NOZORDER or SW_SHOW);
	SetWindowPos(lh_Handle, HWND_TOPMOST,   lrc_Center.Left, lrc_Center.Top, li_Width, li_Height, 0);
	SetWindowPos(lh_Handle, HWND_NOTOPMOST, lrc_Center.Left, lrc_Center.Top, li_Width, li_Height, 0);

{
http://mrxray.on.coocan.jp/Delphi/plSamples/A_SystemParametersInfo.htm
http://74.125.153.132/search?q=cache:aF9pFTvLGn4J:www.activebasic.com/help_center/Pages/API/SystemService/SystemInformation/SystemParametersInfo.htm+SPI_GETSNAPTODEFBUTTON&cd=3&hl=ja&ct=clnk&gl=jp&client=opera
}
	//カーソルをOKボタンの上へ
	SystemParametersInfo(SPI_GETSNAPTODEFBUTTON, 0, @lb_Bool, 0);
	if (lb_Bool) then begin
		lh_Button := GetDlgItem(lh_Handle, IDOK);
		GetWindowRect(lh_Button, lrc_Cursor);
		lrc_Cursor := gfnrcRectCenter(lrc_Cursor, Rect(0,0,0,0));
		SetCursorPos(lrc_Cursor.Left, lrc_Cursor.Top);
	end;
end;

procedure TMyOpenFileDialog.ShowMonitorCenter;
var
	lpt_Pos: TPoint;
begin
	//ダイアログをモニターの真ん中に
	GetCursorPos(lpt_Pos);
	ShowMonitorCenter(lpt_Pos);
end;

procedure TMyOpenFileDialog.DoClose;
begin
	My_Dialog := nil;

	inherited DoClose;
end;

procedure TMyOpenFileDialog.F_SetFileName(sFile: WideString);
var
	i: Integer;
	ls_Cmp: WideString;
begin
	F_sFileName := sFile;
	ls_Cmp := WideUpperCase(sFile);
	for i := Files.Count-1 downto 0 do begin
		if (WideUpperCase(Files[i]) = ls_Cmp) then begin
			Files.Move(i, 0);
Exit;
		end;
	end;
	Files.Insert(0, sFile);
end;

function TMyOpenFileDialog.F_GetFiles(const pBuff: PWideChar; iLen: DWORD; slFiles: TMyWStrings): WideString;
const
	lcs_SEP = #0;
var
	ls_Path, ls_Item: WideString;
	i, li_Start: DWORD;
	lp_Buff: PWideChar;
begin
	slFiles.Clear;
	if not(ofAllowMultiSelect in Options) then begin
		//一つだけ選択
		slFiles.Add(WideString(pBuff));
	end else begin
		//複数ファイル選択
		//分解
		ls_Path  := '';
		li_Start := 0;
		for i := 0 to iLen -1 do begin
			if (pBuff[i] = lcs_SEP) then begin
//				ls_Item := Copy(WideString(@pBuff[li_Start]), 1, i - li_Start);
				//2009-10-03:↑だと長いファイル名で尻が切れることがある不具合あり
				lp_Buff := AllocMem((i - li_Start +1) *2);
				try
					lstrcpynw(lp_Buff, @pbuff[li_Start], i - li_Start +1);
					ls_Item := WideString(lp_Buff);
				finally
					FreeMem(lp_Buff);
				end;
				if (ls_Path = '') then begin
					ls_Path := ls_Item;
				end else begin
					slFiles.Add(gfnsStrEndFit(ls_Path, '\') + ls_Item);
				end;
				if (i < iLen) and (pBuff[i+1] = lcs_SEP) then begin
					//#0が二つ続くので終了
					Break;
				end;
				li_Start := i+1; //区切りの次のインデックス
			end;
		end;
		if (slFiles.Count = 0) then begin
			slFiles.Add(ls_Path);
		end;
	end;

	if (slFiles.Count > 0) then begin
		Result := slFiles[0];
	end else begin
		Result := '';
	end;
end;

(*
Ansi版メッセージフック
procedure TMyOpenFileDialog.F_ChangeWndProc(var Message: TMessage);
begin
	try
		WndProc(Message);
	except
		Application.HandleException(Self);
	end;
end;
*)


//コールバック関数
var
	lbShowCenter:  Boolean = False;
	liWmSetRedraw: Integer = 0;
	liWmNotify:    Integer = 0;
{
TOpenFilename(OpenFilename構造体)については↓に詳しい
http://mrxray.on.coocan.jp/Halbow/Chap18.html
http://yokohama.cool.ne.jp/chokuto/urawaza/struct/OPENFILENAME.html
コールバック関数について
http://www.vbstation.net/spec/S3_1.htm
}
function l_fniCallbackFileDialog(hHandle: HWND; iMsg: UINT; iWParam: WPARAM; iLParam: LPARAM): UINT stdcall;
//hHandleはダイアログのハンドルではなくダイアログの子ウィンドウのハンドル
const
	lci_MSGFILEKIND = $C06F; //ファイルの種類で選択行を変えた
var
//	l_Dialog: TMyOpenFileDialog;
	lp_Info : POpenFilenameW;
	Msg     : TMessage;
	lpt_Pos : TPoint;
//	lh_Cbx  : HWND;
begin
{
case iMsg of
	WM_MOUSEFIRST or WM_MOUSEMOVE,
	WM_SETCURSOR,
	WM_NCHITTEST
	:begin
	end;
	else begin
myDebug.gpcDebugWM_Message(iMsg);
myDebug.gpcDebug(iWParam);
	end;
end;
}
	Result := 0;
	if (iMsg = WM_INITDIALOG) then
	begin
		lp_Info := POpenFilenameW(iLParam);	//WM_INITDIALOGの時にはiLParamにはTOpenFilenameW構造体のアドレスが入っている
		My_Dialog := TMyOpenFileDialog(lp_Info^.lCustData);
		My_Dialog.F_hHandle := hHandle; //ダイアログのウィンドウハンドルではないことに注意
																		//ダイアログのウィンドウハンドルを得るにはGetParent(Handle)とする
		lbShowCenter  := My_Dialog.PosCenter;
		liWmSetRedraw := 0;
		liWmNotify    := 0;

(*
		Ansi版はこれでOK
		Unicode版はこれだと固まる
		l_Dialog := TMyOpenFileDialog(lp_Info^.lCustData);
		with l_Dialog do begin
			F_hHandle := hHandle;
			//http://www2.big.or.jp/~osamu/Delphi/Tips/edit.cgi?file=0201.txt&rev=1.3
			F_DefWndProc := Pointer(GetWindowLongW(F_hHandle, GWL_WNDPROC));
			//新しいWndProcとして設定
			SetWindowLong(F_hHandle, GWL_WNDPROC, Longint(F_ChangeWndProcInstance));
		end;
*)
	end else
	if (My_Dialog <> nil) then
	begin
		//unit内グローバル変数を使って逃げる苦肉の策。
		Msg.Msg    := iMsg;
		Msg.WParam := iWParam;
		Msg.LParam := iLParam;
		My_Dialog.WndProc(Msg);

		if  ((iMsg = $B) or (iMsg = $4E))
		and (My_Dialog.PosCenter)
		then begin
			if (iMsg = $B) then
			begin
				Inc(liWmSetRedraw);
			end else
			if (iMsg = $4E) then
			begin
				Inc(liWmNotify);
			end;

			if  (lbShowCenter)
			and (liWmSetRedraw = 2)
			and (liWmNotify    = 2)
			then
			begin
				lbShowCenter  := False;
				liWmSetRedraw := 0;
				liWmNotify    := 0;
				GetCursorPos(lpt_Pos);
				My_Dialog.ShowMonitorCenter(lpt_Pos);
//				PostMessage(Application.MainForm.Handle, WM_APP, WPARAM(hHandle), LPARAM(DWORD(lpt_Pos.X) shl (SizeOf(Word) * 8) + Word(lpt_Pos.Y)));
//				My_Dialog := nil; NG
			end;
		end else
		if (iMsg = lci_MSGFILEKIND) then
		begin
//lh_Cbx := GetDlgItem(gfnhToplevelWindowGet(hHandle), iWParam);
//myDebug.gpcDebug([gfniComboBox_GetItemIndex(lh_Cbx), gfniComboBox_GetCount(lh_Cbx)]);
//myDebug.gpcDebug(gfnsFilterExtGet(My_Dialog.Filter, gfniComboBox_GetItemIndex(GetDlgItem(gfnhToplevelWindowGet(hHandle), iWParam))));
		end;
	end;
end;

function TMyOpenFileDialog.DoExecute : Boolean;
{2011-08-18:
GetOpenFileNameWを呼んだ後カスタムパネル上のTWinControlのテキストが空になってしま
うことへ対処するためExecuteから呼ばれるような仕様に変更。
ExecuteでDoExecuteを呼ぶ前後にカスタムパネル上のTWinControlのテキストをバックアッ
プして戻す処置を行う。
}
var
	lr_Info: TOpenFilenameW;
begin
	FillChar(lr_Info, SizeOf(lr_Info), 0);  //0で初期化
	with lr_Info do
	begin
		lStructSize := SizeOf(lr_Info);
		//オーナーウィンドウ
		if (F_Owner = nil) then begin
			hwndOwner := Application.Handle;
		end else begin
			hwndOwner := F_Owner.Handle;
		end;
		hInstance  := SysInit.HInstance; //カスタムダイアログで必要。
		//タイトル
		lpstrTitle := PWideChar(F_sTitle);
		//フィルタ
		if (Filter <> '') then
		begin
			if (F_bFilterUnicode) then
			begin
				lpstrFilter := PWideChar(gfnsAnsiToWideEx(StringReplace(Filter, '|', #0, [rfReplaceAll]) + #0#0));
			end else
			begin
				lpstrFilter := PWideChar(WideString(StringReplace(Filter, '|', #0, [rfReplaceAll]) + #0#0));
			end;
		end;
		nFilterIndex := FilterIndex;
		//デフォルト拡張子
		if (F_sDefaultExt <> '') then
		begin
			lpstrDefExt  := PWideChar(F_sDefaultExt);
		end else
		begin
			lpstrDefExt := nil;
		end;
		//デフォルトフォルダ
		if  (F_sInitialDir <> '')
		and (gfnbFolderExists(F_sInitialDir))
		then
		begin
			lpstrInitialDir := PWideChar(gfnsStrEndTrim(F_sInitialDir, '\'));
		end else
		begin
			lpstrInitialDir := nil;
		end;

		//フラグ
		if (ofReadOnly            in Options) then Flags := Flags or OFN_READONLY;
		if (ofOverwritePrompt     in Options) then Flags := Flags or OFN_OVERWRITEPROMPT;
		if (ofHideReadOnly        in Options) then Flags := Flags or OFN_HIDEREADONLY;
    if (ofNoChangeDir         in Options) then Flags := Flags or OFN_NOCHANGEDIR;
		if (ofShowHelp            in Options) then Flags := Flags or OFN_SHOWHELP;
		if (ofNoValidate          in Options) then Flags := Flags or OFN_NOVALIDATE;
		if (ofAllowMultiSelect    in Options) then Flags := Flags or OFN_ALLOWMULTISELECT;
		if (ofExtensionDifferent  in Options) then Flags := Flags or OFN_EXTENSIONDIFFERENT;
		if (ofPathMustExist       in Options) then Flags := Flags or OFN_PATHMUSTEXIST;
		if (ofFileMustExist       in Options) then Flags := Flags or OFN_FILEMUSTEXIST;
		if (ofCreatePrompt        in Options) then Flags := Flags or OFN_CREATEPROMPT;
		if (ofShareAware          in Options) then Flags := Flags or OFN_SHAREAWARE;
		if (ofNoReadOnlyReturn    in Options) then Flags := Flags or OFN_NOREADONLYRETURN;
		if (ofNoTestFileCreate    in Options) then Flags := Flags or OFN_NOTESTFILECREATE;
//古いタイプは無効
//		if (ofNoNetworkButton     in Options) then Flags := Flags or OFN_NONETWORKBUTTON;
//    if (ofNoLongNames         in Options) then Flags := Flags or OFN_NOLONGNAMES;
//    if (ofOldStyleDialog      in Options) then Flags := Flags or OFN_EXPLORER;
		if (ofNoDereferenceLinks  in Options) then Flags := Flags or OFN_NODEREFERENCELINKS;
		if (ofEnableIncludeNotify in Options) then Flags := Flags or OFN_ENABLEINCLUDENOTIFY;
		if (ofEnableSizing        in Options) then Flags := Flags or OFN_ENABLESIZING;
		if (ofDontAddToRecent     in Options) then Flags := Flags or OFN_DONTADDTORECENT;
		if (ofForceShowHidden     in Options) then Flags := Flags or OFN_FORCESHOWHIDDEN;
		//エクスプローラ風は必須(古いタイプのとでは区切りが違うので)
		Flags := Flags or OFN_EXPLORER;

		//コールバック
		//メッセージを横取りするためコールバック関数を使う
		Flags     := Flags or OFN_ENABLEHOOK;
		lpfnHook  := l_fniCallbackFileDialog;
		lCustData := LPARAM(Self); //自身のアドレスを代入

		if (ofExNoPlacesBar in OptionsEx) then
		begin
			FlagsEx := FlagsEx or OFN_EX_NOPLACESBAR;
		end;

		//カスタムダイアログ。
		if  (F_sCustomTemplate <> '')
		and (F_CustomBasePanel <> nil)
		then
		begin
			Flags := Flags or OFN_ENABLETEMPLATE;
			lpTemplateName := PWideChar(F_sCustomTemplate);
		end;

		//ファイル名
//		nMaxFile := 1024 * 64 -1;	//一応この数値が限界のよう。これ以上だと一つだけ選択のときにエラーになることがあった
		nMaxFile  := 1024 * 32;
		lpstrFile := AllocMem((nMaxFile +2) * 2);
		try
			//存在しないファイルを指定するとエラーが返る
			if  (F_sFileName <> '')
			and (gfnbFileExists(F_sFileName))
			then
			begin
				lstrcpyW(lpstrFile, PWideChar(F_sFileName));
			end;
//myDebug.gpcDebug(WideString(lpstrFile));
			Result := GetOpenFileNameW(lr_Info);
			if (Result) then
			begin
				FilterIndex := lr_Info.nFilterIndex;

				if ((Flags and OFN_READONLY) <> 0) then
				begin
					//読み取り専用を選択
					if not(ofReadOnly in Options) then
					begin
						Options := Options + [ofReadOnly];
					end;
				end else
				begin
					//読み取り専用は非選択
					if (ofReadOnly in Options) then
					begin
						Options := Options - [ofReadOnly];
					end;
				end;
				F_sFileName := F_GetFiles(lpstrFile, nMaxFile, F_slFiles);
			end;
		finally
			FreeMem(lpstrFile);
		end;
	end;
end;

type
	T_Caption = class(TObject)
	private
		FWinControl : TWinControl;
		FsText      : WideString;
		FList       : TMyWStrings;
		FbVisible   : Boolean;
		FiItemIndex : Integer;
	public
		constructor Create(AWinControl : TWinControl); virtual;
		destructor  Destroy; override;
		function Restore(AWinControl : TWinControl) : Boolean;
	end;

constructor T_Caption.Create(AWinControl : TWinControl);
begin
	FWinControl := AWinControl;
	FbVisible   := AWinControl.Visible;
	FsText      := gfnsWindowTextGet(FWinControl.Handle);

	if (FWinControl is TCustomComboBox)
	then
	begin
		FList := TMyWStrings.Create;
		FList.Assign(TCustomComboBox(FWinControl).Items);
		FiItemIndex := TCustomComboBox(FWinControl).ItemIndex;
	end else
	begin
		FList := nil;
	end;
end;
destructor T_Caption.Destroy;
begin
	if (FList <> nil) then
	begin
		FreeAndNil(FList);
	end;
end;
function T_Caption.Restore(AWinControl : TWinControl) : Boolean;
begin
	Result := (AWinControl = FWinControl);
	if not(Result) then
	begin
Exit;
	end;

	gpcWindowTextSet(AWinControl.Handle, FsText);
	if (AWinControl is TCustomComboBox)
	then
	begin
		TCustomComboBox(AWinControl).Items.Assign(FList.AnsiExStrings);
		TCustomComboBox(AWinControl).ItemIndex := FiItemIndex;
	end;

	if (FbVisible) then
	begin
		//閉じるとき非表示になるので表示させる
//		AWinControl.Show;
//		if not(IsWindowVisible(AWinControl.Handle)) then begin
//			ShowWindow(AWinControl.Handle, SW_SHOW);
//		end;
	end;
end;

function TMyOpenFileDialog.Execute: Boolean;
{
2011-08-18:
　DoExecuteを呼ぶように変更。
　GetOpenFileNameWを呼んだ後カスタムパネル上のTWinControlのテキストが空になって
　しまうことへ対処するため。
2008-12-28:lpstrFileまわりを簡素化。選択ファイル分解ルーチンの書き直し。
2008-07-19:一つだけ選択の時にFileNameを指定するとおかしな動作になってしまうことがあることへ対処
}
	procedure _BackupCaption(AWinControl : TWinControl; AList : TList);
	var
		i         : Integer;
		l_Caption : T_Caption;
	begin
		l_Caption := T_Caption.Create(AWinControl);
		AList.Add(l_Caption);
		for i := 0 to AWinControl.ControlCount -1 do begin
			if (AWinControl.Controls[i] is TWinControl) then begin
				_BackupCaption(TWinControl(AWinControl.Controls[i]), AList);
			end;
		end;
	end;
	procedure _RestoreCaption(AWinControl : TWinControl; AList : TList);
	var
		k : Integer;
		i : Integer;
	begin
		for k := 0 to AList.Count -1 do begin
			if (T_Caption(AList[k]).Restore(AWinControl)) then begin
		Break;
			end;
		end;

		for i := 0 to AWinControl.ControlCount -1 do begin
			if (AWinControl.Controls[i] is TWinControl) then begin
				_RestoreCaption(TWinControl(AWinControl.Controls[i]), AList);
			end;
		end;
	end;
var
	l_CaptionList : TList;
	i : Integer;
begin
	if  (F_CustomBasePanel <> nil)
	and (F_sCustomTemplate <> '')
	then begin
		l_CaptionList := TList.Create;
		try
			F_CustomBasePanel.Show;
			_BackupCaption(F_CustomBasePanel, l_CaptionList);

			Result := DoExecute;

			_RestoreCaption(F_CustomBasePanel, l_CaptionList);
			for i := l_CaptionList.Count -1 downto 0
			do begin
				T_Caption(l_CaptionList.Items[i]).Free;
			end;
			F_CustomBasePanel.Hide;
//			ShowWindow(F_CustomBasePanel.Handle, SW_HIDE);
		finally
			l_CaptionList.Free;
		end;
	end
	else
	begin
		Result := DoExecute;
	end;
end;

//短いファイル名
function TMyOpenFileDialog.ShortFileName: WideString;
begin
	Result := gfnsShortFileNameGet(Self.F_sFileName);
end;

function TMyOpenFileDialog.ShortFileNames(iIndex: Integer): WideString;
begin
	Result := gfnsShortFileNameGet(F_slFiles[iIndex]);
end;


//------------------------------------------------------------------------------
//複数選択版
function gfnbOpenFileDialog(slFiles: TMyWStrings; sDir: WideString; Opt: TOpenOptions): Boolean; overload;
{2007-08-27,11-19,2008-07-13:
WideString対応のファイル選択ダイアログ
http://delwiki.info/?%E3%82%B3%E3%83%BC%E3%83%89%E5%80%89%E5%BA%AB%2FUnicode%20%E5%AF%BE%E5%BF%9C%E3%83%80%E3%82%A4%E3%82%A2%E3%83%AD%E3%82%B0%E6%A1%88
2007-11-19:オプションにOFN_EXPLORERを必須にした(呼び出し側では指定してもしなくても良い)
2008-07-13:コンポーネント化によりTMyOpenFileDialogのラッパー関数化。
					 それに伴い引数からHWNDのhHandleを削除。UINTのiOptをTOpenOptionsのOoptionsに変更。
}
var
	l_OpenFileDialog: TMyOpenFileDialog;
begin
	l_OpenFileDialog := TMyOpenFileDialog.Create(nil);
	with l_OpenFileDialog do begin
		try
			if (slFiles.Count > 0) then FileName := slFiles[0];
			InitialDir := sDir;
			Options    := Opt;
			Result     := Execute;
			if (Result) then begin
				slFiles.Assign(Files);
			end;
		finally
			Free;
		end;
	end;
end;

function gfnbOpenFileDialog(slFiles: TMyWStrings; sDir: WideString): Boolean;
begin
	Result := gfnbOpenFileDialog(slFiles, sDir, [ofPathMustExist, ofFileMustExist, ofHideReadOnly, ofEnableSizing, ofAllowMultiselect]);
end;

function gfnbOpenFileDialog(slFiles: TMyWStrings): Boolean;
begin
	Result := gfnbOpenFileDialog(slFiles, '');
end;


//一つだけ選択版
function gfnbOpenFileDialog(var sFile: WideString; sDir: WideString; Opt: TOpenOptions): Boolean; overload;
{2007-08-27,09-11,11-19:
Unicode対応のファイル選択ダイアログのひとつだけ版
2007-09-11:hHandleをApplication.Handleにしていたのをやめ引数として指定するように変更
2007-11-19:オプションを呼び出し側で指定できるように変更。
}
var
	lsl_Files: TMyWStrings;
begin
	lsl_Files := TMyWStrings.Create;
	try
		//複数選択のオプションがあれば取り除く
		if (ofAllowMultiselect in Opt) then Opt := Opt - [ofAllowMultiselect];
		//sWFileをセットすることで初期ディレクトリを指定している
		lsl_Files.Add(sFile);
		Result := gfnbOpenFileDialog(lsl_Files, sDir, Opt);
		if (Result) and (lsl_Files.Count > 0) then begin
			sFile := lsl_Files[0];
		end else begin
			sFile := '';
		end;
	finally
		lsl_Files.Free;
	end;
end;

function gfnbOpenFileDialog(var sFile: WideString; sDir: WideString): Boolean;
begin
	Result := gfnbOpenFileDialog(sFile, sDir, [ofPathMustExist, ofFileMustExist, ofHideReadOnly, ofEnableSizing]);
end;

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


//------------------------------------------------------------------------------
{TMySaveFileDialog}
function TMySaveFileDialog.DoExecute: Boolean;
{
2008-12-28:lpstrFileまわりを簡素化。
2008-11-15:ファイル名の後ろに余計なゴミがついてしまっていた不具合を修正。
2008-11-08:ファイル名にセットした文字列が表示されない不具合を修正。
}
var
	l_Info: TOpenFilenameW;
begin
	FillChar(l_Info, SizeOf(l_Info), 0);	//0で初期化

	l_Info.lStructSize := SizeOf(l_Info);
	if (F_Owner = nil)
	then begin
		l_Info.hwndOwner := Application.Handle;
	end
	else
	begin
		l_Info.hwndOwner := F_Owner.Handle;
	end;

	l_Info.hInstance  := SysInit.HInstance; //カスタムダイアログで必要。
	l_Info.lpstrTitle := PWideChar(F_sTitle);

	if (Filter <> '')
	then begin
		l_Info.lpstrFilter := PWideChar(WideString(StringReplace(Filter, '|', #0, [rfReplaceAll]) + #0#0));
	end;

	l_Info.nFilterIndex := FilterIndex;
	if (F_sDefaultExt <> '')
	then begin
		l_Info.lpstrDefExt	:= PWideChar(F_sDefaultExt);
	end
	else
	begin
		l_Info.lpstrDefExt := nil;
	end;

	if  (F_sInitialDir <> '')
	and (gfnbFolderExists(F_sInitialDir))
	then begin
		l_Info.lpstrInitialDir := PWideChar(F_sInitialDir);
	end
	else
	begin
		l_Info.lpstrInitialDir := nil;
	end;

	if (ofReadOnly            in Options) then l_Info.Flags := l_Info.Flags or OFN_READONLY;
	if (ofOverwritePrompt     in Options) then l_Info.Flags := l_Info.Flags or OFN_OVERWRITEPROMPT;
	if (ofHideReadOnly        in Options) then l_Info.Flags := l_Info.Flags or OFN_HIDEREADONLY;
	if (ofNoChangeDir         in Options) then l_Info.Flags := l_Info.Flags or OFN_NOCHANGEDIR;
	if (ofShowHelp            in Options) then l_Info.Flags := l_Info.Flags or OFN_SHOWHELP;
	if (ofNoValidate          in Options) then l_Info.Flags := l_Info.Flags or OFN_NOVALIDATE;
//複数選択は無効
//		if (ofAllowMultiSelect    in Options) then l_Info.Flags := l_Info.Flags or OFN_ALLOWMULTISELECT;
	if (ofExtensionDifferent  in Options) then l_Info.Flags := l_Info.Flags or OFN_EXTENSIONDIFFERENT;
	if (ofPathMustExist       in Options) then l_Info.Flags := l_Info.Flags or OFN_PATHMUSTEXIST;
	if (ofFileMustExist       in Options) then l_Info.Flags := l_Info.Flags or OFN_FILEMUSTEXIST;
	if (ofCreatePrompt        in Options) then l_Info.Flags := l_Info.Flags or OFN_CREATEPROMPT;
	if (ofShareAware          in Options) then l_Info.Flags := l_Info.Flags or OFN_SHAREAWARE;
	if (ofNoReadOnlyReturn    in Options) then l_Info.Flags := l_Info.Flags or OFN_NOREADONLYRETURN;
	if (ofNoTestFileCreate    in Options) then l_Info.Flags := l_Info.Flags or OFN_NOTESTFILECREATE;
//古いタイプは無効
//		if (ofNoNetworkButton     in Options) then l_Info.Flags := l_Info.Flags or OFN_NONETWORKBUTTON;
//		if (ofNoLongNames         in Options) then l_Info.Flags := l_Info.Flags or OFN_NOLONGNAMES;
//		if (ofOldStyleDialog      in Options) then l_Info.Flags := l_Info.Flags or OFN_EXPLORER;
	if (ofNoDereferenceLinks  in Options) then l_Info.Flags := l_Info.Flags or OFN_NODEREFERENCELINKS;
	if (ofEnableIncludeNotify in Options) then l_Info.Flags := l_Info.Flags or OFN_ENABLEINCLUDENOTIFY;
	if (ofEnableSizing        in Options) then l_Info.Flags := l_Info.Flags or OFN_ENABLESIZING;
	if (ofDontAddToRecent     in Options) then l_Info.Flags := l_Info.Flags or OFN_DONTADDTORECENT;
	if (ofForceShowHidden     in Options) then l_Info.Flags := l_Info.Flags or OFN_FORCESHOWHIDDEN;
	//エクスプローラ風は必須(古いタイプのとでは区切りが違うので)
	l_Info.Flags := l_Info.Flags or OFN_EXPLORER;

	//メッセージフックのため
	l_Info.Flags     := l_Info.Flags or OFN_ENABLEHOOK;
	l_Info.lpfnHook  := l_fniCallbackFileDialog;
	l_Info.lCustData := LPARAM(Self); //自身のアドレスを代入

	if (ofExNoPlacesBar in OptionsEx)
	then begin
		l_Info.FlagsEx := l_Info.FlagsEx or OFN_EX_NOPLACESBAR;
	end;

	//カスタムダイアログ。
	if  (F_sCustomTemplate <> '')
	and (F_CustomBasePanel <> nil)
	then begin
		l_Info.Flags := l_Info.Flags or OFN_ENABLETEMPLATE;
		l_Info.lpTemplateName := PWideChar(F_sCustomTemplate);
	end;

	l_Info.nMaxFile  := 1024;	//ファイルは一つだけ
	l_Info.lpstrFile := AllocMem((l_Info.nMaxFile +2) * SizeOf(WideChar));
	try
		//ファイル名を表示
		lstrcpyw(l_Info.lpstrFile, PWideChar(gfnsFileNameGet(F_sFileName)));

		Result := GetSaveFileNameW(l_Info);
		if (Result)
		then begin
			FilterIndex := l_Info.nFilterIndex;
			F_sFileName := WideString(l_Info.lpstrFile);
			if ((l_Info.Flags and OFN_EXTENSIONDIFFERENT) = OFN_EXTENSIONDIFFERENT)
			then begin
				Options := Options + [ofExtensionDifferent];
				if (DefaultExt <> '')
				then begin
					F_sFileName := gfnsStrEndFit(F_sFileName, gfnsStrHeadFit(DefaultExt, '.'));
				end;
			end;
			F_slFiles.Clear;
			F_slFiles.Add(F_sFileName);
		end;
	finally
		FreeMem(l_Info.lpstrFile);
	end;
end;

//関数版
function gfnbSaveFileDialog(var sFile: WideString; sDir: WideString; Opt: TOpenOptions): Boolean;
{2007-11-19,11-22,2008-07-13:
SaveDialogだけども実際はファイル名取得のためだけにも使えてしまう
2007-11-22:初期フォルダの指定をしようとあれこれやっていたら読み込み違反のエラーが頻繁に出るようになってしまったのをVCLのソースを元に修正。
2008-07-13:コンポーネント化によりラッパー関数化。
}
var
	l_SaveFileDialog: TMySaveFileDialog;
begin
	l_SaveFileDialog := TMySaveFileDialog.Create(nil);
	with l_SaveFileDialog do begin
		try
			//複数選択は不可
			if (ofAllowMultiSelect in Opt) then Exclude(Opt, ofAllowMultiSelect);
			FileName   := sFile;
			Options    := Opt;
			InitialDir := sDir;
			Result     := Execute;
			sFile      := FileName;
		finally
			Free;
		end;
	end;
end;

function gfnbSaveFileDialog(var sFile: WideString; sDir: WideString): Boolean;
begin
	Result := gfnbSaveFileDialog(sFile, sDir, [ofHideReadOnly, ofEnableSizing]);
end;

function gfnbSaveFileDialog(var sFile: WideString; Opt: TOpenOptions): Boolean;
begin
	Result := gfnbSaveFileDialog(sFile, '', Opt);
end;

function gfnbSaveFileDialog(var sFile: WideString): Boolean;
begin
	Result := gfnbSaveFileDialog(sFile, '', [ofHideReadOnly, ofEnableSizing]);
end;


//------------------------------------------------------------------------------
procedure gpcDialogFilterToStrings(sFilter : WideString; AList : TStrings);
{2011-07-19:
ダイアログのフィルター文字列を分割してリストに追加するルーチン。
AListは呼び出し側で作成、破棄、初期化すること。
}
//テキスト文書 (*.txt)|*.TXT|設定ファイル (*.ini)|*.INI|すべてのテキスト (*.txt;*.ini;*.log)|*.TXT;*.INI;*.LOG;|Delphi (*.pas;*.dpr;*.rc)|*.PAS;*.DPR;*.RC|VB (*.bas;*.frm)|*.BAS;*.FRM|C/C++ (*.h;*.c;*.cpp)|*.H;*.C;*.CPP|Perl (*.pl;*.cgi)|*.PL;*.CGI|HTML (*.htm;*.html;*.css)|*.HTM;*.HTML;*.CSS|すべて (*.*)|*.*
	procedure _AddItem(AList : TStrings; sStr : WideString; iStart, iEnd : Integer);
	var
		ls_Item : WideString;
	begin
		//iEndの位置の文字はコピーしないので+1とはしない
		ls_Item := Trim(Copy(sStr, iStart, iEnd - iStart));
		if (ls_Item <> '') then begin
			AList.Add(ls_Item);
		end;
	end;
const
	lcs_DIV = '|';
var
	i        : Integer;
	lb_Div   : Boolean;
	li_Start : Integer;
begin
	lb_Div   := False;
	li_Start := 1;
	for i := 1 to Length(sFilter) do begin
		if (sFilter[i] = lcs_DIV) then begin
			if (lb_Div) then begin
				//二つ目の'|'なのでフィルター分割
				_AddItem(AList, sFilter, li_Start, i);
				lb_Div   := False;
				li_Start := i +1;
			end else begin
				//一つ目の'|'
				lb_Div := True;
			end;
		end;
	end;
	_AddItem(AList, sFilter, li_Start, MAXINT);
end;
procedure gpcDialogFilterToStrings(sFilter: WideString; AList: TMyWStrings);
var
	l_List : TStrings;
begin
	l_List := TStringList.Create;
	try
		gpcDialogFilterToStrings(sFilter, l_List);
		AList.Text := gfnsAnsiToWideEx(l_List.Text);
	finally
		l_List.Free;
	end;
end;

procedure gpcDialogFilterKindToStrings(sFilter : WideString; AList : TStrings);
{2011-07-19:
ダイアログのフィルター文字列を分割してリストに追加するルーチン。
フィルター文字列の左側の「種類」をリストに格納する。
下の例でいうと「テキスト文書 (*.txt)」と「すべてのテキスト (*.txt;*.ini;*.log)」、「すべて (*.*)」
AListは呼び出し側で作成、破棄、初期化すること。
}
//テキスト文書 (*.txt)|*.TXT|設定ファイル (*.ini)|*.INI|すべてのテキスト (*.txt;*.ini;*.log)|*.TXT;*.INI;*.LOG;|Delphi (*.pas;*.dpr;*.rc)|*.PAS;*.DPR;*.RC|VB (*.bas;*.frm)|*.BAS;*.FRM|C/C++ (*.h;*.c;*.cpp)|*.H;*.C;*.CPP|Perl (*.pl;*.cgi)|*.PL;*.CGI|HTML (*.htm;*.html;*.css)|*.HTM;*.HTML;*.CSS|すべて (*.*)|*.*
	procedure _AddItem(AList : TStrings; sStr : WideString; iStart, iEnd : Integer);
	var
		ls_Item : WideString;
	begin
		//iEndの位置の文字はコピーしないので+1とはしない
		ls_Item := Trim(Copy(sStr, iStart, iEnd - iStart));
		if (ls_Item <> '') then begin
			AList.Add(ls_Item);
		end;
	end;
const
	lcs_DIV = '|';
var
	i        : Integer;
	lb_Div   : Boolean;
	li_Start : Integer;
	li_End   : Integer;
begin
	lb_Div   := False;
	li_Start := 1;
	li_End   := 0;
	for i := 1 to Length(sFilter) do begin
		if (sFilter[i] = lcs_DIV) then begin
			if (lb_Div) then begin
				//二つ目の'|'なのでフィルター分割
				_AddItem(AList, sFilter, li_Start, li_End);
				lb_Div   := False;
				li_Start := i +1;
			end else begin
				//一つ目の'|'
				lb_Div := True;
				li_End := i;
			end;
		end;
	end;
	_AddItem(AList, sFilter, li_Start, li_End);
end;
procedure gpcDialogFilterKindToStrings(sFilter: WideString; AList: TMyWStrings);
var
	l_List : TStrings;
begin
	l_List := TStringList.Create;
	try
		gpcDialogFilterKindToStrings(sFilter, l_List);
		AList.Text := gfnsAnsiToWideEx(l_List.Text);
	finally
		l_List.Free;
	end;
end;

procedure gpcDialogFilterExtToStrings(sFilter : WideString; AList : TStrings);
{2011-07-19,2011-10-09:
ダイアログの個々のフィルター文字列の拡張子を分割してリストに追加するルーチン。
AListは呼び出し側で作成、破棄、初期化すること。
2011-10-09:個々のフィルター文字列ではなく一連のフィルター文字列が与えられた場合に
　次のフィルター文字列の頭がくっついてしまう不具合を修正。
}
//すべてのテキスト (*.txt;*.ini;*.log)|*.TXT;*.INI;*.LOG;
	procedure _AddItem(AList : TStrings; sStr : WideString; iStart, iEnd : Integer);
	var
		ls_Item : WideString;
	begin
		//iEndの位置の文字はコピーしないので+1とはしない
		ls_Item := Trim(Copy(sStr, iStart, iEnd - iStart));
		if (ls_Item <> '') then begin
			AList.Add(ls_Item);
		end;
	end;
const
	lcs_DIV = '|';
	lcs_SEP = ';';
var
	i : Integer;
	k : Integer;
	li_Pos    : Integer;
	li_Start  : Integer;
	l_List    : TStrings;
	ls_Filter : String;
begin
	l_List := TStringList.Create;
	try
		gpcDialogFilterToStrings(sFilter, l_List);
		for k := 0 to l_List.Count -1 do
		begin
			ls_Filter := l_List[k];
			li_Pos := Pos(lcs_DIV, ls_Filter);
			if (li_Pos <= 0) then
			begin
Exit;
			end;

			ls_Filter := Copy(ls_Filter, li_Pos +1, MAXINT);
			li_Start  := 1;
			for i := 1 to Length(ls_Filter) do
			begin
				if (ls_Filter[i] = lcs_SEP) then
				begin
					_AddItem(AList, ls_Filter, li_Start, i);
					li_Start := i +1;
				end;
			end;
			_AddItem(AList, ls_Filter, li_Start, MAXINT);
		end;
	finally
		l_List.Free;
	end;
end;
procedure gpcDialogFilterExtToStrings(sFilter: WideString; AList: TMyWStrings);
var
	l_List : TStrings;
begin
	l_List := TStringList.Create;
	try
		gpcDialogFilterExtToStrings(sFilter, l_List);
		AList.Text := gfnsAnsiToWideEx(l_List.Text);
	finally
		l_List.Free;
	end;
end;

function gfnsDialogFileterExtAddAllKind(sFilter: WideString; sKind : WideString): WideString;
//フィルターの種類をまとめて「すべての〜」と「すべて」を付け足すルーチン。
var
	i : Integer;
	l_List  : TStringList;
	ls_Kind : WideString;
	ls_Ext  : WideString;
begin
	l_List := TStringList.Create;
	try
		gpcDialogFilterExtToStrings(sFilter, l_List);
		ls_Kind := WideFormat('|%s (', [sKind]);
		ls_Ext  := '|';
		for i := 0 to l_List.Count -1 do
		begin
			if (i = 0) then
			begin
				ls_Kind := ls_Kind + l_List[i];
				ls_Ext  := ls_Ext  + l_List[i];
			end else
			begin
				ls_Kind := ls_Kind + ';' + l_List[i];
				ls_Ext  := ls_Ext  + ';' + l_List[i];
			end;
		end;
		Result := sFilter + ls_Kind + ')' + ls_Ext + '|すべて(*.*)|*.*';
	finally
		l_List.Free;
	end;
end;

function gfnsDialogFilterStringsGet(sTitle: WideString; AExtList: TMyWStrings): WideString;
{2011-12-06:
ファイルの種類の文字列を返す関数。
左の文字列(sTitle)に拡張子のリストAExtList中の項目を小括弧に入れて表現。
sKind := gfnsDialogFilterStringsGet('すべてのテキスト' ['txt','ini', 'log']);
sKind は 'すべてのテキスト (*.txt;*.ini;*.log)|*.txt;*.ini;*.log'
}
var
	ls_Ext    : WideString;
	ls_Titles : WideString;
	ls_Kinds  : WideString;
	i : Integer;
begin
	Result := '';

	if  (sTitle <> '')
	and (AExtList <> nil)
	and (AExtList.Count > 0)
	then
	begin
		ls_Titles := '';
		ls_Kinds  := '';
		for i := 0 to AExtList.Count -1 do
		begin
			ls_Ext := AExtList[i];
			if (ls_Ext = '') then
			begin
		Continue;
			end;
			if (ls_Ext[1] = '.') then
			begin
				ls_Ext := '*' + ls_Ext;
			end else
			begin
				ls_Ext := gfnsStrHeadFit(ls_Ext, '*.')
			end;

			if (ls_Titles = '') then
			begin
				ls_Titles := ls_Ext;
			end else
			begin
				ls_Titles := WideFormat('%s;%s', [ls_Titles, ls_Ext]);
			end;

			if (ls_Kinds = '') then
			begin
				ls_Kinds := ls_Ext;
			end else
			begin
				ls_Kinds := WideFormat('%s;%s', [ls_Kinds, ls_Ext]);
			end;
		end;

		if  (ls_Titles <> '')
		and (ls_Kinds  <> '')
		then
		begin
			Result := WideFormat('%s (%s)|%s', [Trim(sTitle), ls_Titles, ls_Kinds]);
		end;
	end;
end;

function gfnsDialogStringsToFilter(AList: TMyWStrings): WideString;
var
	i : Integer;
begin
	if (AList = nil)
	or (AList.Count <= 0)
	then
	begin
		Result := '';
Exit;
	end;

	for i := 0 to AList.Count -1 do
	begin
		if (i = 0) then
		begin
			Result := AList[i];
		end else
		begin
			Result := WideFormat('%s|%s', [Result, AList[i]]);
		end;
	end;
end;


function gfniFilterIndexGet(sFilter, sExt: WideString): Integer;
	function lfnb_ExtExist(sExtList, sExt: WideString): Boolean;
	var
		i, li_Start: Integer;
	begin
		Result   := False;
		sExtList := gfnsStrEndFit(sExtList, ';'); //末尾に区切りの';'を足して分割しやすくする
		li_Start := 1;
		for i := 1 to Length(sExtList) do begin
			if (i > Length(sExtList)) or (sExtList[i] = ';') then begin
				if (WideCompareText(sExt, gfnsFileExtGet(Copy(sExtList, li_Start, i - li_Start))) = 0) then begin
					Result := True;
	Exit;
				end;
				li_Start := i +1;
			end;
		end;
	end;
var
	i, li_Index, li_Count, li_Start: Integer;
	ls_ExtList: WideString;
	lb_Sep: Boolean;
begin
	li_Index := 0;
	li_Count := 0;
	li_Start := 1;
	lb_Sep   := False;
	sFilter  := gfnsStrEndFit(Trim(sFilter), '|');
	for i := 1 to Length(sFilter) do begin
		if (sFilter[i] = '|') then begin
			if (lb_Sep) then begin
				//分割、拡張子取り出し
				lb_Sep     := False;
				ls_ExtList := Copy(sFilter, li_Start, i - li_Start);
				if (lfnb_ExtExist(ls_ExtList, sExt)) then begin
					Result := li_Index;
Exit;
				end else begin
					Inc(li_Count);
				end;
			end else begin
				//次に|が現れたら分割
				Inc(li_Index);
				lb_Sep   := True;
				li_Start := i +1;
			end;
		end;
	end;
	Result := li_Count;
end;


function gfnsFilterExtGet(sFilter : WideString; iIndex : Integer) : WideString;
{2011-05-24:
フィルター文字列sFilter中のiIndex番目のフィルタの拡張子を返す。
拡張子が複数ある場合は最初の拡張子を返す。
}
const
	lcs_SEPKIND = '|'; //フィルタの区切り
	lcs_SEPEXT  = ';'; //拡張子の区切り
var
	i          : Integer;
	li_Pos     : Integer;
	li_Index   : Integer;
	li_Start   : Integer;
	ls_ExtList : WideString;
	lb_Sep     : Boolean;
begin
	Result   := '';
	li_Index := -1;
	li_Start := 1;
	lb_Sep   := False;
	sFilter  := gfnsStrEndFit(Trim(sFilter), lcs_SEPKIND);
	for i := 1 to Length(sFilter) do begin
		if (sFilter[i] = lcs_SEPKIND) then begin
			if (lb_Sep) then begin
				//分割、拡張子取り出し
				lb_Sep := False;
				if (li_Index = iIndex) then begin
					ls_ExtList := Copy(sFilter, li_Start, i - li_Start);
					li_Pos     := Pos(lcs_SEPEXT, ls_ExtList);
					if (li_Pos > 0) then begin
						//拡張子リストに複数の拡張子あり('*.jpeg;*.jpg'など)
						Result := Copy(ls_ExtList, 1, li_Pos -1);
					end else begin
						//拡張子リストは単一の拡張子
						Result := ls_ExtList;
					end;
Exit;
				end;
			end else begin
				//次に|が現れたら分割
				Inc(li_Index);
				lb_Sep   := True;
				li_Start := i +1;
			end;
		end;
	end;
end;


//------------------------------------------------------------------------------
procedure Register;
begin
	RegisterComponents('Samples', [TMyOpenFileDialog, TMySaveFileDialog]);
end;


end.