Delphi Tips　
-----------------------------

キーワード：Dialogs

>> Index

● 06/25 フォルダもファイルも選べるダイアログ
● 09/24 TOpenDialogで、Executeメソッド実行時に表示位置を変えたい。
● 09/13 TFontDialog で標準以外のサイズを選択肢に表示したい

最終更新： 7820 日前

0339  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成： 2003/06/25 osamu rev 1.1
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新： 2003/06/25 osamu 編集
フォルダもファイルも選べるダイアログ

Ｑ．デスクトップ 〜 右クリック 〜 新規作成 〜 ショートカットの時に「参照」ボタンを押しますと、Caption は「フォルダの参照」とかになっていながらフォルダもファイルも選べるダイアログが出てきます。こいつを使用したいのです。

Ａ．ShBrowseForFolder で BIF_BROWSEINCLUDEFILES を指定すると良いようです。

  with BrowseInfo do begin
    hwndOwner := FhParent;
    pidlRoot := nil;
    pszDisplayName := BDisplayName;
    lpszTitle := 'フォルダを選択してください';
    ulFlags := BIF_STATUSTEXT or BIF_RETURNONLYFSDIRS or
                           BIF_BROWSEINCLUDEFILES; // ここを追加
    lpfn := @BrowseFolderProc;
    lParam := integer(@BFFR);
  end;
参照： [Delphi-ML:76043] <コンポーネント >

0141  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成： 1999/02/11 osamu rev 1.3
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新： 1999/09/24 西坂良幸 編集
TOpenDialogで、Executeメソッド実行時に表示位置を変えたい。

TOpenDialogは、OnShowイベントの段階では、位置がすでに決まっているようです。調べてみると、何回かWM_NOTIFYが送られますが、NMHDR構造体のCodeメンバーがCDN_INITDONEになるダイアログの初期化時を捕まえるとうまくいくようです。（ただし、これでも最初のExecute時しか効果ありません。Ｄ４のみ？）
以下のような拡張ダイアログコンポが紹介されています。

// 定義部
type
  TQueryDlgPosEvent = procedure(Sender: TObject; var pt: TPoint) of object;
  ThtOpenDialogEx = class(TOpenDialog)
  private
    FQueryDlgPos: TQueryDlgPosEvent;
  protected
    procedure DefaultHandler(var Message); override;
    procedure DoQueryDlgPos; virtual;
  published
    property OnQueryDlgPos: TQueryDlgPosEvent read FQueryDlgPos write FQueryDlgPos;
  end;

// 実装部n

procedure ThtOpenDialogEx.DefaultHandler(var Message);
begin
  inherited;
  with TWMNotify(Message) do
    if (Msg = WM_NOTIFY) then
      if (NMHdr^.Code = CDN_INITDONE) then
        DoQueryDlgPos;
end;

procedure ThtOpenDialogEx.DoQueryDlgPos;
var
  DlgHandle: THandle;
  Rect: TRect;
  pt: TPoint;
begin
  if Assigned(FQueryDlgPos) then
  begin
    DlgHandle := GetParent(Handle);
    GetWindowRect(DlgHandle, Rect);
    pt.x := (GetSystemMetrics(SM_CXSCREEN) - Rect.Right + Rect.Left) div 2;
    pt.y := (GetSystemMetrics(SM_CYSCREEN) - Rect.Bottom + Rect.Top) div 3;
    FQueryDlgPos(Self, pt);
    SetWindowPos(DlgHandle, HWND_TOP, pt.X, pt.Y, 0, 0,
        SWP_NOSIZE or SWP_NOZORDER);
  end;
end;

// テスト
procedure TForm1.Button1Click(Sender: TObject);
var
  OpenDialogEx:ThtOpenDialogEx;
begin
  OpenDialogEx:=ThtOpenDialogEx.Create(self);
  try
    with OpenDialogEx do
    begin
      OnQueryDlgPos := QueryDlgPos;
      Execute;
    end;
  finally
    OpenDialogEx.Free;
  end;
end;

procedure TForm1.QueryDlgPos(Sender: TObject; var pt: TPoint);
begin
  Pt.x := 800;
  pt.y := 600;
end;

追記：
DefaultHandlerメソッドのかわりに、WndProcメソッドをオーバーライドしてもほぼ同じ結果が得られます。
以下は、イベントの代わりに、InitialLeft, InitialTop、というプロパティを設定しています。
procedure ThtOpenDialogEx.WndProc(var Message: TMessage);
var
  DlgHandle: THandle;
begin
  inherited WndProc(Message);
  if (Message.Msg = WM_NOTIFY) then
    if (TWMNOTIFY(Message).NMHdr^.Code = CDN_INITDONE)
      and not ((FInitialLeft < 0) or (FInitialTop < 0)) then
    begin    // 負数のときは処理しない
      DlgHandle := GetParent(Handle);
      SetWindowPos(DlgHandle, 0, FInitialLeft, FInitialTop, 0, 0, SWP_NOSIZE or SWP_NOZORDER);
    end;
end;
参照： [Delphi-ML:12600] [Delphi-ML:24640] <ダイアログ> <コンポーネント >

0253  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成： 1999/09/13 osamu rev 1.1
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新： 1999/09/13 osamu 編集
TFontDialog で標準以外のサイズを選択肢に表示したい

> ルビをうつフォントを指定しようと思い、TFontDialogで
> 片付けようと思いましたが、TFontDialogで、MSゴシック
> など8Pt以下のポイントが出てきません。指定できるように
> する方法をどなたかご存知でしょうか。

思いっきり強引ですけど

unit FontDialogEx;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs;
type
  TFontDialogEx = class(TFontDialog)
  protected
    function TaskModalDialog(DialogFunc: Pointer;
                             var DialogData): Bool; override;
  end;

procedure Register;

implementation

uses Dlgs, CommDlg;

const
  WM_FONTDIALOGEX = WM_USER + 256;
  str1: string = '4';
  str2: string = '5';
  str3: string = '6';
  str4: string = '7';

var
  OldHook: function(Wnd: HWnd; Msg: UINT; WParam: WPARAM;
                    LParam: LPARAM): UINT; stdcall;

function FontDialogHookEx(Wnd: HWnd; Msg: UINT; WParam: WPARAM;
                          LParam: LPARAM): UINT; stdcall;
begin
  if (Msg = WM_COMMAND) and (LOWORD(WParam) = cmb1) then begin
    PostMessage(Wnd, WM_FONTDIALOGEX, 0, 0);
  end;

  if Msg = WM_FONTDIALOGEX then begin
    SendDlgItemMessage(Wnd, cmb3, CB_RESETCONTENT, 0, 0);
    SendDlgItemMessage(Wnd, cmb3, CB_ADDSTRING, 0, LongInt(PCHAR(str1)));
    SendDlgItemMessage(Wnd, cmb3, CB_ADDSTRING, 0, LongInt(PCHAR(str2)));
    SendDlgItemMessage(Wnd, cmb3, CB_ADDSTRING, 0, LongInt(PCHAR(str3)));
    SendDlgItemMessage(Wnd, cmb3, CB_ADDSTRING, 0, LongInt(PCHAR(str4)));
    Result := 1;
    exit;
  end;
  Result := OldHook(Wnd, Msg, WParam, LParam);
end;

function TFOntDialogEx.TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool;
begin
  OldHook := TChooseFont(DialogData).lpfnHook;
  TChooseFont(DialogData).lpfnHook := FontDialogHookEx;
  inherited TaskModalDialog(DialogFunc, DialogData);
end;

procedure Register;
begin
  RegisterComponents('NkCtrls', [TFontDialogEx]);
end;

end.

一応動いてます(^^ フォント名毎に表示するサイズリストを変えたい場合は、cmb1 に選択されているフォント名を確認するコードが必要になるでしょう。

一瞬元のポイントサイズがコンボボックスに表示されてしまいますが今のところ他に良い手を思いつきません(^^;
参照： [Delphi-ML:42562] <ダイアログ> <描画> <コンポーネント >

[新規作成] [最新の情報に更新]

How To
Lounge
KeyWords
Tips
Delphi
Home
Osamu Takeuchi osamu@big.or.jp