Delphi/C++ Builder「既定のボタン」へマウスカーソル移動

Delphi/C++ Builder で、既定のボタンへマウスカーソル移動

コントロールパネルの情報「ポインタを自動的に既定のボタン上に移動する」がチェックされている場合、指定されたフォームから Default == True のボタンを探して、マウスカーソルを移動する関数↓

1. procedure MoveMouseCursorToDefaultButton(AForm: TForm);  
2.     var I: Integer;  
3.         MoveCursor: Integer; // Delphi XE2 アップデートにより、例外が発生するようになったため Boolean → Integer へ変更  
4. begin  
5.     if SystemParametersInfo(SPI_GETSNAPTODEFBUTTON, 0, @MoveCursor, 0) and (MoveCursor <> 0) and (AForm <> nil) then begin  
6.         for I := AForm.ComponentCount - 1 downto 0 do begin  
7.             if (AForm.Components[I] is TButton) and TButton(AForm.Components[I]).Default then begin  
8.                 with TButton(AForm.Components[I]) do begin  
9.                     SetCursorPos(ClientOrigin.X + (Width div 2), ClientOrigin.Y + (Height div 2));  
10.                 end;  
11.                 Exit;  
12.             end;  
13.         end;  
14.     end;  
15. end;  

procedure MoveMouseCursorToDefaultButton(AForm: TForm);
    var I: Integer;
        MoveCursor: Integer; // Delphi XE2 アップデートにより、例外が発生するようになったため Boolean → Integer へ変更
begin
    if SystemParametersInfo(SPI_GETSNAPTODEFBUTTON, 0, @MoveCursor, 0) and (MoveCursor <> 0) and (AForm <> nil) then begin
        for I := AForm.ComponentCount - 1 downto 0 do begin
            if (AForm.Components[I] is TButton) and TButton(AForm.Components[I]).Default then begin
                with TButton(AForm.Components[I]) do begin
                    SetCursorPos(ClientOrigin.X + (Width div 2), ClientOrigin.Y + (Height div 2));
                end;
                Exit;
            end;
        end;
    end;
end;

※横に長いのでコピペして見て下さい

この関数は、フォームの位置が決定していないと、ボタンの絶対位置を正しく取得できません
フォームの Position プロパティで、位置を決定している場合は、CM_SHOWINGCHANGED を利用して

1. private  
2.     procedure CMShowingChanged(var message: TMessage); message CM_SHOWINGCHANGED;  
3. //    :  
4. procedure TForm1.CMShowingChanged(var message: TMessage);  
5. begin  
6.     inherited;  
7.     if Visible then begin  
8.         Update;  
9.         MoveMouseCursorToDefaultButton(Self); //  
10.     end;  
11. end;  

private
    procedure CMShowingChanged(var message: TMessage); message CM_SHOWINGCHANGED;
//    :
procedure TForm1.CMShowingChanged(var message: TMessage);
begin
    inherited;
    if Visible then begin
        Update;
        MoveMouseCursorToDefaultButton(Self); //
    end;
end;

等とするとよいです

また、ダイアログの場合は FormActivate が一度しか呼ばれないため、そこへ記述すると簡単です

1. procedure TForm1.FormActivate(Sender: TObject);  
2. begin  
3.     MoveMouseCursorToDefaultButton(Self); //  
4. end;  

procedure TForm1.FormActivate(Sender: TObject);
begin
    MoveMouseCursorToDefaultButton(Self); //
end;