この発言は
#00853　牧原　博司　　　さんのOpenDialogを使ったディレクトリ選択Dlg
に対するコメントです



  こんにちは、牧原　博司 さん。

  #00853  OpenDialogを使ったディレクトリ選択Dlg を元にしたコンポです。
不具合等ありましたら、修正してください。



---------------------------------------------------------------------
unit DirDialog;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  FileCtrl;

type
  TDirDialog = class(TOpenDialog)
  private
    FIsJustExecute: boolean; // Execute したところか？
    function GetDirectory: string;
  protected
    procedure DoShow; override;
    procedure DoFolderChange; override;
  public
    constructor Create(AOwner: TComponent); override;
    function Execute: Boolean; override;
  published
    property FileName;
    property Directory: string read GetDirectory;
  end;

procedure Register;

implementation

var
  // 各ハンドル
  EditHandle, ComboHandle, LabelFNameHandle, LabelFilterHandle,
  LabelDirHandle, ButtonOpenHandle: Longint;


// ******** ここから、EnumChildProc, EnumChildWindows の為の処理 ***********
**

function EnumChildProc(const HWND, lParam: Longint): Boolean; stdcall;
var
  cName,
  cText: array[0..256]of Char;
begin
  Result := True;
  if (lParam = 1) and (GetClassName(HWND, cName, 255) > 0) then
  begin
    // Edit
    if StrComp('Edit', cName) = 0 then
      EditHandle := HWND
    // ComboBox
    else if (StrComp('ComboBox', cName) = 0) then
      ComboHandle := HWND

    // LabelFName
    else if (StrComp('Static', cName) = 0)        and
            (GetWindowText(HWND, cText, 255) > 0) and
            (StrComp('ファイル名(&N):', cText)    = 0)       then
      LabelFNameHandle := HWND

    // LabelFilter
    else if (StrComp('Static', cName) = 0)        and
            (GetWindowText(HWND, cText, 255) > 0) and
            (StrComp('ファイルの種類(&T):', cText)    = 0)       then
      LabelFilterHandle := HWND

    // LabelDir
    else if (StrComp('Static', cName) = 0)        and
            (GetWindowText(HWND, cText, 255) > 0) and
            (StrComp('ファイルの場所(&I):', cText)    = 0)       then
      LabelDirHandle := HWND


    // ButtonOpen
    else if (StrComp('Button', cName) = 0)        and
            (GetWindowText(HWND, cText, 255) > 0) and
            (StrComp('開く(&O)', cText)    = 0)       then
      ButtonOpenHandle := HWND

  end;
end;

function FindEditCombo(const FormHandle: Longint): Boolean;
begin
  // 初期化
  Result := False;
  if IsWindow(FormHandle) then
  begin
    EnumChildWindows(FormHandle, @EnumChildProc, 1);

    if IsWindow(EditHandle)       and
       IsWindow(ComboHandle)      and
       IsWindow(LabelFNameHandle) and
       IsWindow(LabelFilterHandle) and
       IsWindow(LabelDirHandle) and
       IsWindow(ButtonOpenHandle)  then Result := True;
  end;
end;

constructor TDirDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIsJustExecute := False;
  FileName := 'Dummy.dat';
  Filter := '*.*|*.*';
  EditHandle := 0;
  ComboHandle := 0;
  LabelFNameHandle := 0;
  LabelFilterHandle := 0;
  LabelDirHandle := 0;
  ButtonOpenHandle := 0;
end;

procedure TDirDialog.DoShow;
var
  pc: PChar;
  SelfHandle: integer;
begin
  inherited DoShow;
  pc := PChar(Self.Title);
  // ダイアログのハンドルの取得
  SelfHandle := FindWindow('#32770', pc);
  FindEditCombo(SelfHandle);

  //  なぜかこれだとうまくいかない
  //  FindEditCombo(Self.Handle);
end;

procedure TDirDialog.DoFolderChange;
begin
  inherited DoFolderChange;

  if FIsJustExecute and
     IsWindow(EditHandle)  and
     IsWindow(ComboHandle) and
     IsWindow(LabelFNameHandle) and
     IsWindow(LabelFilterHandle) and
     IsWindow(LabelDirHandle) and
     IsWindow(ButtonOpenHandle) then
  begin
    FIsJustExecute := False;
    ShowWindow(EditHandle,SW_HIDE);
    ShowWindow(ComboHandle,SW_HIDE);
    ShowWindow(LabelFNameHandle,SW_HIDE);
    ShowWindow(LabelFilterHandle,SW_HIDE);

    SetWindowText(LabelFNameHandle,PChar(''));  // '***(&T)' '***(&T)'
    SetWindowText(LabelFilterHandle,PChar('')); // を無視するように空文字に
しておく
    SetWindowText(LabelDirHandle,PChar('フォルダの場所(&I)'));
    SetWindowText(ButtonOpenHandle,PChar('OK'));
  end;
end;

function TDirDialog.Execute: Boolean;
begin
  FIsJustExecute := True;
  if Title='' then Title := 'フォルダの選択';
  Result := inherited Execute;
end;

function TDirDialog.GetDirectory: string;
begin
  if FileName<>'' then
    Result := ExtractFileDir(FileName)
  else
    Result := ExtractFileDir(Application.ExeName);
  if not DirectoryExists(Result) then
    Result := ExtractFileDir(Application.ExeName);
end;

procedure Register;
begin
  RegisterComponents('Samples', [TDirDialog]);
end;

end.

---------------------------------------------------------------------

// 使い方

procedure TForm1.Button1Click(Sender: TObject);
begin
  if DirDialog1.Execute then
    Label1.Caption := DirDialog1.Directory;
end;

     牧原博司  hiroshi.makihara@nifty.ne.jp  - 99/09/20 (Mon) 23:27 -


Original document by 牧原　博司　　　氏 ID:(QZS03450)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。