ホーム >プログラム >Delphiソースコード一覧 >lib >myFileDialog.pas
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.