$(BDS)\source\db\ja             // Delphi XE
$(BDS)\source\data\vclctrls\ja  // Delphi XE5

procedure TForm1.TaskDialog1DialogCreated(Sender: TObject);
var
  LPosX : Integer;
  LPosY : Integer;
begin
  LPosX := 100;
  LPosY := 100;
  SetWindowPos(TTaskDialog(Sender).Handle,
               0,
               LPosX,
               LPosY,
               0,
               0,
               SWP_NOSIZE or SWP_NOZORDER);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  StrText : String;
begin
  Dialogs.UseLatestCommonDialogs := True;

  StrText := 'ダイアログ関係関数テスト';
  Dialogs.MessageDlg(StrText, mtInformation, [mbYes], 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  StrText : String;
begin
  Dialogs.UseLatestCommonDialogs := False;

  StrText := 'ダイアログ関係関数テスト';
  Dialogs.MessageDlg(StrText, mtInformation, [mbYes], 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  StrText : String;
begin
  StrText := 'ダイアログ関係関数テスト';
  Dialogs.ShowMessage(StrText);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  hWindow : HWND;
begin
  hWindow := Handle;
  Application.Title := 'ダイアログ関係関数テスト';
  Dialogs.ShowMessageFmt('%s $%.8x ( %.d )', ['16 進数表示', hWindow, hWindow]);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  StrText : String;
  hWindow : HWND;
begin
  StrText := 'ダイアログ関係関数テスト';
  Dialogs.ShowMessagePos(StrText, Self.Left + 20, Self.Top + 100);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  A : Integer;
  B : Integer;
begin
  A := 0;
  try
    B := 123 div A;
  except 
    on E: EZeroDivide do
      Application.ShowException(E);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  A : Integer;
  B : Integer;
  StrText : String;
begin
  A := 0;
  try
    B := 123 div A;
  except
    on E: Exception do begin
      StrText := E.ClassName + sLineBreak + E.Message;
      Application.MessageBox(PChar(StrText), '情報', MB_ICONINFORMATION);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  StrText : String;
begin
  StrText := 'ダイアログ関係関数テスト';
  Application.MessageBox(PChar(StrText), '情報', MB_ICONWARNING or MB_TOPMOST);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  StrText : String;
begin
  StrText := 'ダイアログ関係関数テスト';
  Application.MessageBox(PChar(StrText), '情報', MB_ICONINFORMATION);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  StrText : String;
begin
  StrText := 'ダイアログ関係関数テスト';
  Application.MessageBox(PChar(StrText), '情報', MB_ICONQUESTION);
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  StrText : String;
begin
  StrText := 'ダイアログ関係関数テスト';
  Application.MessageBox(PChar(StrText), '情報', MB_ICONSTOP,);
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  StrText : String;
  iRet    : Integer;
begin
  StrText := 'ダイアログ関係関数テスト';
  iRet :=  Application.MessageBox(PChar(StrText), '情報',
                                  MB_YESNOCANCEL or MB_ICONQUESTION,);
  if iRet = IDYES then begin
    //[はい]を選択した時の処理
  end else
  if iRet = IDNO then begin
    //[いいえ]を選択した時の処理
  end else
  if iRet = IDCANCEL then begin
    //[キャンセル]を選択した時の処理
  end;
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  StrText : String;
  iRet    : Integer;
begin
  StrText := 'ダイアログ関係関数テスト';
  iRet := Application.MessageBox(PChar(StrText), '情報',
                         MB_YESNOCANCEL or MB_DEFBUTTON2 or MB_ICONQUESTION);
  if iRet = IDYES then begin
    //[はい]を選択した時の処理
  end else
  if iRet = IDNO then begin
    //[いいえ]を選択した時の処理
  end else
  if iRet = IDCANCEL then begin
    //[キャンセル]を選択した時の処理
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  StrText : String;
begin
  StrText := 'ダイアログ関係関数テスト';
  Windows.MessageBox(Handle, PChar(StrText), '情報', MB_YESNO or MB_ICONASTERISK);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  StrText : String;
begin
  StrText := 'ダイアログ関係関数テスト';
  Dialogs.MessageDlg(StrText, mtWarning, [mbYes], 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  StrText : String;
begin
  StrText := 'ダイアログ関係関数テスト';
  Dialogs.MessageDlg(StrText, mtInformation, [mbYes], 0);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  StrText : String;
begin
  StrText := 'ダイアログ関係関数テスト';
  Dialogs.MessageDlg(StrText, mtConfirmation, [mbYes], 0);
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  StrText : String;
begin
  StrText := 'ダイアログ関係関数テスト';
  Dialogs.MessageDlg(StrText, mtError, [mbYes], 0);
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  StrText : String;
  iRet    : Integer;
begin
  StrText := 'ダイアログ関係関数テスト';
  iRet := MessageDlg(StrText, mtConfirmation, [mbYes, mbCancel], 0, mbCancel);
  if iRet = mrCancel then begin
    //キャンセルの時の処理
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  StrText  : String;
  iRet     : Integer;
begin
  StrText  := 'ダイアログ関係関数テスト';
  iRet := Dialogs.MessageDlgPos(StrText,
                                mtInformation,
                                [mbYes, mbAll, mbCancel],
                                0,
                                Self.Left + 20,
                                Self.Top + 100,
                                mbAll);
  if iRet = mrYes then begin
    //[はい]を選択した時の処理
  end else
  if iRet = mrAll then begin
    //[全て]を選択した時の処理
  end else
  if iRet = mrCancel then begin
    //[キャンセル]を選択した時の処理
  end;
end;

implementation

uses HTMLHelpViewer;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  StrText : String;
  HelpFile : String;
begin
  HelpFile := 'http://mrxray.on.coocan.jp/index.htm';

  StrText := '[F1] 押下で状況感知型ヘルプ表示';
  Dialogs.MessageDlgPosHelp(StrText,
                            mtInformation,
                            [mbYes],
                            1,
                            Self.Left + 20,
                            Self.Top + 100,
                            HelpFile);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  StrTitle : String;
  StrText  : String;
begin
  if not CheckWin32Version(6, 0) then exit;

  StrTitle := 'ダイアログのタイトル';
  StrText  := 'ダイアログ関係関数テスト';
  Dialogs.TaskMessageDlg(StrTitle, StrText, mtInformation, [mbYes, mball], 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  StrTitle : String;
  StrText  : String;
  iRet     : Integer;
begin
  if not CheckWin32Version(6, 0) then exit;

  StrTitle := 'ダイアログのタイトル';
  StrText  := 'ダイアログ関係関数テスト';
  iRet := Dialogs.TaskMessageDlgPos(StrTitle,
                                    StrText,
                                    mtInformation,
                                    [mbYes, mbAll, mbCancel],
                                    0,
                                    Self.Left + 20,
                                    Self.Top + 100,
                                    mbAll);
  if iRet = mrYes then begin
    //[はい]を選択した時の処理
  end else
  if iRet = mrAll then begin
    //[全て]を選択した時の処理
  end else
  if iRet = mrCancel then begin
    //[キャンセル]を選択した時の処理
  end;
end;

implementation

uses HTMLHelpViewer;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  StrTitle : String;
  StrText  : String;
  HelpFile : String;
begin
  if not CheckWin32Version(6, 0) then exit;

  StrTitle := 'ダイアログのタイトル';
  StrText  := 'ダイアログ関係関数テスト';
  HelpFile := 'http://mrxray.on.coocan.jp/index.htm';

  Dialogs.TaskMessageDlgPosHelp(StrTitle,
                                StrText,
                                mtInformation,
                                [mbYes],
                                1,
                                Self.Left + 20,
                                Self.Top + 100,
                                HelpFile);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  StrCaption : String;
  StrPrompt  : String;
  StrDefault : String;
  StrResult  : String;
begin
  StrCaption := '入力ダイアログ';
  StrPrompt  := '値の入力';
  StrDefault := '12345';

  StrResult := InputBox(StrCaption, StrPrompt, StrDefault);
  if StrResult = StrDefault then begin
    //[キャンセル]ボタンを選択した時，または入力値に変化がない場合
    //または[ESC]でダイアログを閉じた場合
  end else begin
    //[OK]ボタンを選択した時
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  StrCaption : String;
  StrPrompt  : String;
  StrValue     : String;
begin
  StrCaption := '入力ダイアログ';
  StrPrompt  := '値の入力';
  StrValue   := '12345';

  if InputQuery(StrCaption, StrPrompt, StrValue) then begin
    //[OK]ボタンを選択した時
  end else begin
    //[キャンセル]ボタンを選択した時，または[ESC]で閉じた場合
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  FrmDlg  : TForm;
  StrMsg  : String;
  iRet    : Integer;
begin
  StrMsg := 'ダイアログ関係関数テスト';
  FrmDlg := CreateMessageDialog(StrMsg,
                                mtInformation,
                                [mbYes, mbAll, mbCancel],
                                mbAll);
  try
    //オーナウィンドウの中央に表示(この場合はTForm1(Form1)
    FrmDlg.Position := poOwnerFormCenter;
    //[ヘルプ]ボタンを表示してみる
    FrmDlg.BorderIcons := FrmDlg.BorderIcons + [biHelp];

    iRet := FrmDlg.ShowModal;

    if iRet = mrYes then begin
      //[はい]でダイアログを閉じた場合
    end else
    if iRet = mrAll then begin
      //[すべて]でダイアログを閉じた場合
    end else
    if iRet = mrCancel then begin
      //[キャンセル]でダイアログを閉じた場合
    end;
  finally
    FrmDlg.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  FrmDlg : TForm;
  StrMsg : String;
  iRet   : Integer;
begin
  StrMsg := 'ダイアログ関数のテスト';
  FrmDlg := CreateMessageDialog(StrMsg,
                                mtConfirmation,
                                [mbYes, mbAll, mbCancel],
                                mbAll);
  try
    //表示前にダイアログ上のコンポーネント類のプロパティを変更
    TLabel(FrmDlg.Components[1]).Width      := FrmDlg.Width;
    TLabel(FrmDlg.Components[1]).Font.Size  := 15;
    TLabel(FrmDlg.Components[1]).Font.Color := clGreen;
    TLabel(FrmDlg.Components[1]).Font.Style := [fsBold];

    TButton(FrmDlg.Components[2]).Caption := 'YES';
    TButton(FrmDlg.Components[3]).Caption := 'CANCEL';
    TButton(FrmDlg.Components[4]).Caption := 'ALL';
    FrmDlg.Height := 200;
    FrmDlg.Left   := Self.Left + 33;
    FrmDlg.Top    := Self.Top + 50;

    iRet := FrmDlg.ShowModal;

    if iRet = mrYes then begin
      //[はい]でダイアログを閉じた場合
    end else
    if iRet = mrAll then begin
      //[すべて]でダイアログを閉じた場合
    end else
    if iRet = mrCancel then begin
      //[キャンセル]でダイアログを閉じた場合
    end;
  finally
    FrmDlg.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  FrmDlg : TForm;
  StrMsg : String;
begin
  StrMsg := 'ダイアログ関係関数テスト';
  FrmDlg := CreateMessageDialog(StrMsg,
                                mtInformation,
                                [mbYes, mbAll, mbCancel],
                                mbAll);
  try
    //イベントを定義してダイアログを表示
    FrmDlg.OnShow := OnFrmShow;
    FrmDlg.ShowModal;
  finally
    FrmDlg.Free;
  end;
end;

procedure TForm1.OnFrmShow(Sender: TObject);
var
  i      : Integer;
  aCompo : TComponent;
begin
  Memo1.Lines.Clear;
  for i := 0 to TForm(Sender).ComponentCount - 1 do begin
    aCompo := TForm(Sender).Components[i];
    Memo1.Lines.Add('Components[' + IntToStr(i) +'] : ' +  aCompo.ClassName);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  FrmDlg : TForm;
  StrMsg : String;
  ABtn   : TButton;

begin
  StrMsg := 'ダイアログ関係関数テスト';
  FrmDlg := CreateMessageDialog(StrMsg,
                                mtInformation,
                                [mbYes, mbAll, mbCancel],
                                mbAll);
  try
    //ダイアログにボタンを追加して表示位置を設定
    ABtn := TButton.Create(FrmDlg);
    ABtn.Parent := FrmDlg;
    ABtn.Left   := TButton(FrmDlg.Components[4]).Left;
    ABtn.Top    := TButton(FrmDlg.Components[4]).top - 30;

    FrmDlg.ShowModal;
  finally
    FrmDlg.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  AFileName   : String;
  AInitialDir : String;
begin
  AFileName   := '';
  AInitialDir := ExpandFileName('../');
  if PromptForFileName(AFileName,
                       'ユニットファイル (*.pas)|*.pas',
                       '',
                       '',
                       AInitialDir,
                       False)
  then begin
    //[開く]または[保存]でダイアログを閉じた場合
  end else begin
    //[キャンセル]でダイアログを閉じた場合
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not CheckWin32Version(6, 0) then exit;

  FileOpenDialog1.Options := [fdoPickFolders, fdoPathMustExist, fdoForceFileSystem];
  FileOpenDialog1.Execute;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  StrText : String;
begin
  StrText := 'ダイアログ関係関数テスト';
  Dialogs.MessageDlg(StrText, mtConfirmation, [mbYes], 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  StrText : String;
begin
  Dialogs.UseLatestCommonDialogs := False;

  StrText := 'ダイアログ関係関数テスト';
  Dialogs.MessageDlg(StrText, mtConfirmation, [mbYes], 0);

  Dialogs.UseLatestCommonDialogs := True;
end;

implementation

{$R *.dfm}

var
  MsgHook: HHOOK;

//-----------------------------------------------------------------------------
//  ウィンドウのクラス名を取得する関数
//-----------------------------------------------------------------------------
function GetWindowClassNameStr(hWindow: HWND): String;
var
  Buffer : array[0..MAX_PATH-1] of Char;
  Len    : Integer;
begin
  FillChar(Buffer, SizeOf(Buffer), #0);
  Len := GetClassName(hWindow, Buffer, Length(Buffer));
  if Len > 0 then Result := Buffer else Result := '';
end;

//-----------------------------------------------------------------------------
//  WH_CALLWNDPROCフックのコールバック関数
//  ダイアログのWM_SHOWWINDOWメッセージを処理
//
//  ここではMsg : PMsgではなくMsg: PCWPStructにして，wParamの値を受け取る
//  WM_SHOWWINDOWのwParamは1の時表示開始，閉じる時は0
//
//  Windowsのダイアログのクラス名は#32770
//-----------------------------------------------------------------------------
function GetMsgProc(Code: Integer; WPar: WPARAM; LPar: LPARAM): LRESULT; stdcall;
var
  pMsgStruct : PCWPStruct;
  ClassName  : String;
  hWindow    : HWND;
  DlgRect    : TRect;
  DlgWidth   : Integer;
  DlgHeight  : Integer;
  DlgPosX    : Integer;
  DlgPosY    : Integer;
begin
  if (code < 0) then begin
    Result := CallNextHookEx(MsgHook, Code, WPar, LPar);
    exit;
  end;

  if (code = HC_ACTION) then begin
    pMsgStruct := PCWPStruct(LPar);
    if pMsgStruct^.message = WM_SHOWWINDOW then begin
      if pMsgStruct^.wParam = 1 then begin
        ClassName := GetWindowClassNameStr(pMsgStruct.hwnd);
        if ClassName = '#32770' then begin

          //ダイアログのハンドルを取得してサイズを取得
          hWindow := pMsgStruct^.hwnd;
          GetWindowRect(hWindow, DlgRect);
          //ダイアログの幅と高さを取得
          DlgWidth  := DlgRect.Right  - DlgRect.Left;
          DlgHeight := DlgRect.Bottom - DlgRect.Top;

          //Form1の上下左右の中央に表示する
          DlgPosX := Form1.Left + (Form1.Width  - DlgWidth)  div 2;
          DlgPosY := Form1.Top  + (Form1.Height - DlgHeight) div 2;
          SetWindowPos(hWindow,
                       0,
                       DlgPosX,
                       DlgPosY,
                       0,
                       0,
                       SWP_NOSIZE or SWP_NOZORDER);
        end;
      end;
    end;
  end;

  Result := CallNextHookEx(MsgHook, Code, WPar, LPar);
end;

//=============================================================================
//  ローカルフック開始
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  MsgHook := SetWindowsHookEx(WH_CALLWNDPROC, GetMsgProc, 0, GetCurrentThreadID);
end;

//=============================================================================
//  フック解除
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnHookWindowsHookEx(MsgHook);
end;

//=============================================================================
//  ダイアログを表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  StrText : String;
begin
  StrText := 'ダイアログの表示位置の制御';
  Dialogs.MessageDlg(StrText, mtInformation, [mbYes], 0);
end;

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  protected
    procedure WMApp(var Message: TMessage); message WM_APP;
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  ダイアログを表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  PostMessage(Handle, WM_APP, 0, 0);
  MessageDlg('ダイアログ位置設定', mtInformation, [mbYes], 0);
end;

//=============================================================================
//  メッセージ処理
//  ダイアログ表示直前にPosMessageでメッセージキューに書き込んでおく
//=============================================================================
procedure TForm1.WMApp(var Message: TMessage);
var
  hWindow   : HWND;
  DlgRect   : TRect;
  DlgWidth  : Integer;
  DlgHeight : Integer;
  DlgPosX   : Integer;
  DlgPosY   : Integer;
begin
  inherited;

  hWindow := FindWindow('#32770', nil);
  //ウィンドウのタイトルが分かっているなら以下の方が確実
  hWindow := FindWindow(nil, '情報');

  if hWindow <> 0 then begin
    GetWindowRect(hWindow, DlgRect);
    //ダイアログの幅と高さを取得
    DlgWidth  := DlgRect.Right  - DlgRect.Left;
    DlgHeight := DlgRect.Bottom - DlgRect.Top;

    //Form1の上下左右の中央に表示する
    DlgPosX := Form1.Left + (Form1.Width  - DlgWidth)  div 2;
    DlgPosY := Form1.Top  + (Form1.Height - DlgHeight) div 2;
    SetWindowPos(hWindow,
                 0,
                 DlgPosX,
                 DlgPosY,
                 0,
                 0,
                 SWP_NOSIZE or SWP_NOZORDER);
  end;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    ReplaceDialog1: TReplaceDialog;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 宣言 }
    FDialogSetPos : Boolean;
    FDialogWindow : HWND;
    function DialogHook(var Message: TMessage): Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ShellAPI;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  Windowsシステムのダイアログのフックを開始する
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //ボタンクリックで表示するダイアログだけを操作対象とするためにTrueにしておく
  FDialogSetPos := True;
  //フック開始
  Application.HookMainWindow(DialogHook);
end;

//=============================================================================
//  フォームを閉じる時の処理
//  起動したダイアログを閉じる
//  Windowsシステムのダイアログのフックを解除する
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if FDialogWindow <> 0 then begin
    PostMessage(FDialogWindow, WM_CLOSE, 0, 0);
  end;
  Application.UnhookMainWindow(DialogHook);
end;

//=============================================================================
//  Windowsのシステム関係ダイアログを表示する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  StrText : String;
begin
  //表示のフラグをFalseにしておく
  FDialogSetPos := False;
  FDialogWindow := 0;

  //[日付と時刻]のダイアログを表示
  StrText := 'timedate.cpl';
  ShellExecute(Handle, 'open', 'control.exe', PChar(StrText), nil, SW_SHOW);
end;

//-----------------------------------------------------------------------------
//  TApplication.HookMainWindowの処理関数
//  システム関係のダイアログは非表示で複数起動している場合がある
//  最初に見つけたZオーダーがトップのダイアログを処理したらフラグをTrueにする
//-----------------------------------------------------------------------------
function TForm1.DialogHook(var Message: TMessage): Boolean;
var
  DlgRect : TRect;
  DlgPosX : Integer;
  DlgPosY : Integer;
begin
  Result := False;

  if FDialogSetPos = False then begin
    FDialogWindow := FindWindow('#32770', nil);
    //ダイアログのタイトルが分かっている場合は，以下の方が確実
    FDialogWindow := FindWindow(nil, '日付と時刻');

    if FDialogWindow <> 0 then begin
      if Message.Msg = WM_ACTIVATEAPP then begin

        FDialogSetPos := True;
        GetWindowRect(FDialogWindow, DlgRect);

        DlgPosX := Self.Left + 40;
        DlgPosY := Self.Top  + 80;

        SetWindowPos(FDialogWindow,
                     0,
                     DlgPosX,
                     DlgPosY,
                     0,
                     0,
                     SWP_NOSIZE or SWP_NOZORDER);
      end;
    end;
  end;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  protected
    procedure WMApp(var Message: TMessage); message WM_APP;
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  InputBoxダイアログを表示
//  メッセージ処理なし
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  InputBox('テスト','テストです','');
end;

//=============================================================================
//  InputBoxダイアログを表示
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  PostMessage(Handle, WM_APP, 0, 0);
  InputBox('テスト','テストです','');
end;

//=============================================================================
//  メッセージ処理
//  ダイアログ表示直前にPosMessageでメッセージキューに書き込んでおく
//=============================================================================
procedure TForm1.WMApp(var Message: TMessage);
var
  i      : Integer;
  FrmDlg : TForm;
  hOKBtn : HWND;
  OKBtn  : TWinControl;
begin
  FrmDlg := nil;
  //ダイアログのフォームを探す
  for i := 0 to Screen.FormCount-1 do begin
    if Screen.Forms[i].ClassName = 'TForm' then begin
      Frmdlg := Screen.Forms[i];
      break;
    end;
  end;
  if FrmDlg = nil then exit;

  //[OK]ボタンのハンドルを取得して，ハンドルからボタンオブジェクトを取得
  hOKBtn := FindWindowEx(FrmDlg.Handle, 0, 'TButton', 'OK');
  OKBtn  := FindControl(hOKBtn);
  //キャプションを変更する
  TButton(OKBtn).Caption := '決定';
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  protected
    procedure WMApp(var Message: TMessage); message WM_APP;
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  MessageDlgダイアログを表示
//  メッセージ処理なし
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  StrText : String;
begin
  StrText := 'ダイアログ関係関数テスト';

  MessageDlg(StrText, mtInformation, [mbYes, mbCancel, mbAll], 0);
end;

//=============================================================================
//  MessageDlgダイアログを表示
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  StrText : String;
begin
  StrText := 'ダイアログ関係関数テスト';

  PostMessage(Handle, WM_APP, 0, 0);
  MessageDlg(StrText, mtInformation, [mbYes, mbCancel, mbAll], 0);
end;

//-----------------------------------------------------------------------------
//  ウィンドウのクラス名を取得する関数
//-----------------------------------------------------------------------------
function GetWindowClassNameStr(hWindow: HWND): String;
var
  Buffer : array[0..MAX_PATH-1] of Char;
  Len    : Integer;
begin
  FillChar(Buffer, SizeOf(Buffer), #0);
  Len := GetClassName(hWindow, Buffer, Length(Buffer));
  if Len > 0 then Result := Buffer else Result := '';
end;

//-----------------------------------------------------------------------------
//  EnumChildWindowsのコールバック関数
//  ここでは，ダイアログの子ウィンドウを列挙
//  子ウインドウのクラス名がButtonだったらキャプションの文字列を変える
//-----------------------------------------------------------------------------
function EnumChildWndTestProc(hWindow: hWnd; lPar: PInteger):
  Boolean; Stdcall;
var
  ClassName : String;
  aCaption  : String;
begin
  Result := True;

  ClassName := GetWindowClassNameStr(hWindow);
  if ClassName = 'Button' then begin
    lPar^ := lPar^ + 1;
    if lPar^ = 1 then begin
      aCaption := 'YES (&Y)';
      SendMessage(hWindow, WM_SETTEXT, 0, LPARAM(PChar(aCaption)));
    end else
    if lPar^ = 2 then begin
      aCaption := 'NO';
      SendMessage(hWindow, WM_SETTEXT, 0, LPARAM(PChar(aCaption)));
    end else
    if lPar^ = 3 then begin
      aCaption := '全部 (&A)';
      SendMessage(hWindow, WM_SETTEXT, 0, LPARAM(PChar(aCaption)));
    end;
  end;
end;

//=============================================================================
//  メッセージ処理
//  ダイアログ表示直前にPosMessageでメッセージキューに書き込んでおく
//=============================================================================
procedure TForm1.WMApp(var Message: TMessage);
var
  hWindow   : HWND;
  BtnNumber : Integer;
  DlgRect   : TRect;
  DlgWidth  : Integer;
  DlgPosX   : Integer;
  DlgPosY   : Integer;
begin
  hWindow := FindWindow('#32770', nil);
  //ウィンドウのタイトルが分かっているなら以下の方が確実
  hWindow := FindWindow(nil, '情報');

  if hWindow <> 0 then begin
    BtnNumber := 0;
    //ダイアログの子ウィンドウを列挙
    EnumChildWindows(hWindow, @EnumChildWndTestProc, LPARAM(@BtnNumber));

    GetWindowRect(hWindow, DlgRect);
    //ダイアログの幅と高さを取得
    DlgWidth  := DlgRect.Right  - DlgRect.Left;

    //Form1の右の中央．Form1の上端から指定ピクセル下から表示
    DlgPosX := Form1.Left + (Form1.Width  - DlgWidth)  div 2;
    DlgPosY := Form1.Top  + 100;
    SetWindowPos(hWindow,
                 0,
                 DlgPosX,
                 DlgPosY,
                 0,
                 0,
                 SWP_NOSIZE or SWP_NOZORDER);
  end;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  MsgHook    : HHOOK;
  OldDlgProc : Pointer;

//-----------------------------------------------------------------------------
//  ウィンドウのクラス名を取得する関数
//-----------------------------------------------------------------------------
function GetWindowClassNameStr(hWindow: HWND): String;
var
  Buffer : array[0..MAX_PATH-1] of Char;
  Len    : Integer;
begin
  FillChar(Buffer, SizeOf(Buffer), #0);
  Len := GetClassName(hWindow, Buffer, Length(Buffer));
  if Len > 0 then Result := Buffer else Result := '';
end;

//-----------------------------------------------------------------------------
//  ダイアログのコールバック関数
//-----------------------------------------------------------------------------
function DialogProc(hdlg: HWND; uiMsg: UINT; wParam: 
  WPARAM; lParam:LPARAM): UINT; stdcall;
var
  LhdcStatic : HDC;
Begin
  if uiMsg = WM_CTLCOLORSTATIC then begin
    //クラス名がStaticのデバイスコンテキストを取得
    LhdcStatic := wParam;
    SetTextColor(LhdcStatic, clGreen);
    Result := GetStockObject(WHITE_BRUSH);
  end else
  if uiMsg = WM_CTLCOLORDLG then begin
    Result := GetStockObject(WHITE_BRUSH);
  end else begin
    Result := CallWindowProc(OldDlgProc, hdlg, uiMsg, wParam, lParam);
  end;
end;

//-----------------------------------------------------------------------------
//  WH_CALLWNDPROCフックのコールバック関数
//  ここではMsg : PMsgではなくMsg: PCWPStructにして，wParamの値を受け取る
//
//  Windowsのダイアログのクラス名は#32770
//-----------------------------------------------------------------------------
function GetMsgProc(Code: Integer; WPar: WPARAM; LPar: LPARAM): LRESULT; stdcall;
var
  LpMsgStruct : PCWPStruct;
  LhWindow    : HWND;
  LClassName  : String;
begin
  if (code < 0) then begin
    Result := CallNextHookEx(MsgHook, Code, WPar, LPar);
    exit;
  end;

  if (code = HC_ACTION) then begin
    //ウィンドウハンドルを取得
    LpMsgStruct := PCWPStruct(LPar);
    LhWindow := LpMsgStruct^.hwnd;

    LClassName := GetWindowClassNameStr(LhWindow);

    if LClassName = '#32770' then begin
      //ダイアログのハンドルを取得
      LhWindow := LpMsgStruct^.hwnd;

      if LpMsgStruct^.message = WM_INITDIALOG then begin
        //ダイアログボックスのプロシージャ(コールバック関数)を設定
        OldDlgProc := Pointer(GetWindowLong(LhWindow, DWL_DLGPROC));
        SetWindowLong(LhWindow, DWL_DLGPROC, Integer(@DialogProc));
      end;
    end;
  end;

  Result := CallNextHookEx(MsgHook, Code, WPar, LPar);
end;

//=============================================================================
//  ローカルフック開始
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  MsgHook := SetWindowsHookEx(WH_CALLWNDPROC, GetMsgProc, 0, GetCurrentThreadID);
end;

//=============================================================================
//  フック解除
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnHookWindowsHookEx(MsgHook);
end;

//=============================================================================
//  ダイアログを表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  StrText : String;
begin
  StrText := 'ダイアログのフォント色変更';
  MessageBox(Handle, PChar(StrText), '情報', MB_ICONINFORMATION);
end;

end.

//-----------------------------------------------------------------------------
//  WH_CALLWNDPROCフックのコールバック関数
//  ここではMsg : PMsgではなくMsg: PCWPStructにして，wParamの値を受け取る
//
//  Windowsのダイアログのクラス名は#32770
//-----------------------------------------------------------------------------
function GetMsgProc(Code: Integer; WPar: WPARAM; LPar: LPARAM): LRESULT; stdcall;
var
  LpMsgStruct : PCWPStruct;
  LhWindow    : HWND;
  LClassName  : String;
  LhDlgItem   : HWND;
  LLogFont    : TLogFont;
  LhFontOld   : HFONT;
begin
  if (code < 0) then begin
    Result := CallNextHookEx(MsgHook, Code, WPar, LPar);
    exit;
  end;

  if (code = HC_ACTION) then begin
    //ウィンドウハンドルを取得
    LpMsgStruct := PCWPStruct(LPar);
    LhWindow := LpMsgStruct^.hwnd;

    LClassName := GetWindowClassNameStr(LhWindow);

    if LClassName = '#32770' then begin
      //ダイアログのハンドルを取得
      LhWindow := LpMsgStruct^.hwnd;

      if LpMsgStruct^.message = WM_INITDIALOG then begin
        //ダイアログボックスのプロシージャ(コールバック関数)を設定
        OldDlgProc := Pointer(GetWindowLong(LhWindow, DWL_DLGPROC));
        SetWindowLong(LhWindow, DWL_DLGPROC, Integer(@DialogProc));


        LhDlgItem := GetDlgItem(LhWindow, $FFFF);
        //テキストのフォントハンドルを取得
        LhFontOld := SendMessage(LhDlgItem, WM_GETFONT, 0, 0);
        //そのテキストのTLogFontの値を取得
        GetObject(LhFontOld, SizeOf(TLogFont), @LLogFont);

        //論理フォント構造体の一部を変更
        LLogFont.lfHeight   := 25;
        LLogFont.lfFaceName := 'ＭＳ Ｐゴシック';
        //新しいフォントハンドルに設定したTLogFontを設定
        hFontNew := CreateFontIndirect(LLogFont);
        //フォントを設定
        SendMessage(LhDlgItem, WM_SETFONT, hFontNew, MakeLParam(1,0));
      end;
    end;
  end;

  Result := CallNextHookEx(MsgHook, Code, WPar, LPar);
end;

//=============================================================================
//  ローカルフック開始
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  MsgHook := SetWindowsHookEx(WH_CALLWNDPROC, GetMsgProc, 0, GetCurrentThreadID);
end;

//=============================================================================
//  フック解除
//  hFontNewはグローバル変数(HFONT)
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeleteObject(hFontNew);
  UnHookWindowsHookEx(MsgHook);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  StrText : String;
begin
  StrText := 'ダイアログ関係関数テスト' + sLineBreak + '2 行目のテキスト';
  Dialogs.ShowMessage(StrText);
end;

implementation

uses
  ShellAPI;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  LSourceDir : String;
  LDestDir   : String;
  LSHStruct  : TSHFileOpStruct;
begin
  LSourceDir := 'D:\000\100';
  LDestDir   := 'D:\000\200';

  //構造体の初期設定
  LSHStruct.wnd    := Handle;
  LSHStruct.wFunc  := FO_COPY;
  LSHStruct.pFrom  := PChar(LSourceDir);
  LSHStruct.pTo    := PChar(LDestDir);
  LSHStruct.fFlags := FOF_MULTIDESTFILES;

  //実行する
  SHFileOperation(LSHStruct);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Animate1.Active    := False;
  Animate1.AutoSize  := True;
  Animate1.CommonAVI := aviCopyFiles;

  Animate1.Active := True;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  LHeight : Integer;
  LWidth  : Integer;
begin
  Animate1.Active     := False;
  Animate1.CommonAVI  := aviEmptyRecycle;
  LHeight := Animate1.FrameHeight;
  LWidth  := Animate1.FrameWidth;

  Animate1.AutoSize := False;
  Animate1.Width    := LWidth;
  Animate1.Height   := LHeight;
  Animate1.Active   := True;
end;