> 添付のプログラム修正しました．
プログラムのソースコードです．
開発環境は 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.
 |