喫茶XRAY [Mr.XRAY掲示板]

> 添付のプログラム修正しました．

プログラムのソースコードです．
開発環境は Windows 7 U64(SP1) + Delphi XE(UP1) Pro です．

//=============================================================================
//  [ファイル名を指定して実行] ダイアログを表示するプログラム
//=============================================================================
unit plRunFileDlgUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ShellAPI, MultiMon;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    FMonitorInfoEx : TMonitorInfoEx;
    FDialogTitle   : PChar;
    procedure WMApp(var Message: TMessage); message WM_APP+98;
    function GetMonitorHDC(AMousePos: TPoint): HDC;
  public
    { Public 宣言 }
  end;

  //---------------------------------------------------------------------------
  //  Delphiが関数類のヘッダ宣言を提供していない場合は，この様に利用者が定義して
  //  使用する
  //  この関数は非公開API関数
  //
  //  Shell32.dllを使用するにはusesにShellAPIが必要．
  //---------------------------------------------------------------------------
  SH_RunFileDlg = procedure (Handle    : THandle;
                             hIcon     : HICON;
                             lpazPaht  : PChar;
                             lpszTitle : PChar;
                             lpszPromp : PChar;
                             uFlages   : Integer); stdcall;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const
  SHRD_DEFAULT      = $00; // 通常の画面
  SHRD_NOBROWSE     = $01; // 参照ボタンを非表示
  SHRD_NOMRU        = $02; // コンボボックスの履歴(MRU)を非表示
  SHRD_CALCDIRECTORY= $04; // [参照]で現在のフォルダの中身を表示
  SHRD_NOLABEL      = $08; // エディットボックスのラベルを非表示
  SHRD_OSEPARATEMEM = $20; // コンボボックスの横に表示されるラベル非表示

//=============================================================================
//  フォーム生成時の処理
//  実際にはフォームは表示しない
//  プロジェクトのソースコードに以下の変更をしている
//    Application.ShowMainForm := False;   デフォルトはTrue
//    Application.Run;                     実行しない(削除している)
//  プロジェクトのアイコンも変更している
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LPrompt      : PChar;
  LuFlages     : Integer;
  LSHRunDialog : SH_RunFileDlg;
  LShHandle    : THandle;
begin
  FDialogTitle := 'ファイル名を指定して実行 - EXE 版 [Mr.XRAY]';
  LPrompt   := nil;
  LuFlages  := SHRD_NOMRU;
  LShHandle := LoadLibrary('shell32.dll');
  try
    PostMessage(Handle, WM_APP+98, 0, 0);
    LSHRunDialog := GetProcAddress(LShHandle, PChar(61));
    LSHRunDialog(Handle, 0, nil, FDialogTitle, LPrompt, LuFlages);
  finally
    FreeLibrary(LShHandle);
  end;
end;

//-----------------------------------------------------------------------------
//  マウスカーソル位置のモニタのデバイスとコンテキストの値を取得
//  モニタのデバイスコンテキスは以下の方法で取得できる
//      CreateDC('DISPLAY', nil, nil, nil);
//      GetDC(0)
//      GetWindowDC(GetDeskTopWindow);
//  使用する関数によって解放に使用する関数が異なる
//  本プログラムではMonitor単位のデバイスコンテキストを取得するCreateDCを使用
//-----------------------------------------------------------------------------
function TForm1.GetMonitorHDC(AMousePos: TPoint): HDC;
var
  LHandleMonitor : HMONITOR;
begin
  LHandleMonitor := MonitorFromPoint(Point(AMousePos.X, AMousePos.Y),
                                     MONITOR_DEFAULTTONEAREST);
  FMonitorInfoEx.cbSize := SizeOf(FMonitorInfoEx);
  GetMonitorInfo(LHandleMonitor, @FMonitorInfoEx);
  Result := CreateDC('DISPLAY', FMonitorInfoEx.szDevice, nil, nil);
end;

//-----------------------------------------------------------------------------
//  ダイアログの表示位置の制御
//  オリジナルの[ファイル名を指定して実行]ダイアログと同じにする
//-----------------------------------------------------------------------------
procedure TForm1.WMApp(var Message: TMessage);
var
  LMousePos  : TPoint;
  LScreenDC  : HDC;
  LLeft      : Integer;
  LBottom    : Integer;
  LhWindow   : HWND;
  LDlgHeight : Integer;
  LDlgRect   : TRect;
  LDlgPosX   : Integer;
  LDlgPosY   : Integer;
begin
  inherited;

  GetCursorPos(LMousePos);
  LScreenDC := GetMonitorHDC(LMousePos);
  try
    LLeft   := FMonitorInfoEx.rcWork.Left;
    LBottom := FMonitorInfoEx.rcWork.Bottom;
  finally
    DeleteDC(LScreenDC);
  end;

  LhWindow := FindWindow(nil, FDialogTitle);

  if LhWindow > 0 then begin
    GetWindowRect(LhWindow, LDlgRect);
    LDlgHeight := LDlgRect.Bottom - LDlgRect.Top;

    LDlgPosX := LLeft + 7;
    LDlgPosY := LBottom - LDlgHeight - 7;
    SetWindowPos(LhWindow,
                 0,
                 LDlgPosX,
                 LDlgPosY,
                 0,
                 0,
                 SWP_NOSIZE or SWP_NOZORDER);
  end;
end;

end.