Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 16.02.2016, 05:53   #21
Filka
Форумчанин
 
Регистрация: 29.10.2015
Сообщений: 272
По умолчанию

Код:
unit SnapToDefaultButtonUnit;

interface

implementation

uses
  Windows, Messages, SysUtils, Classes;

var
  Hook: HHOOK = 0;
  WndHandle: HWND = 0;

const
  WM_SNAP = WM_USER + 1;

type
  TDummy = class
    class procedure WndProc(var Msg: TMessage);
  end;

function SnapToDefaultButton: Boolean;
var
  Snap: BOOL;
begin
  Snap := False;
  Result := SystemParametersInfo(SPI_GETSNAPTODEFBUTTON, 0, @Snap, 0) and Snap;
end;

procedure SnapTo(Wnd: HWND);
var
  R: TRect;
  X, Y: Integer;
begin
  if GetWindowRect(Wnd, R) then
  begin
    X := R.Left;
    Y := R.Top;
    Inc(X, (R.Right - R.Left) div 2);
    Inc(Y, (R.Bottom - R.Top) div 2);
    SetCursorPos(X, Y);
  end;
end;

function CheckFlag(const Flags, Flag: Integer): Boolean;
begin
  Result := (Flags and Flag) = Flag;
end;

function IsButton(Wnd: HWND): Boolean;
var
  Buf: array[Byte] of Char;
begin
  Result := (GetClassName(Wnd, Buf, Length(Buf)) <> 0) and (Buf = 'TButton');
end;

function IsDefButton(Wnd: HWND): Boolean;
begin
  Result := False;
  if IsButton(Wnd) then
    Result := CheckFlag(GetWindowLong(Wnd, GWL_STYLE), BS_DEFPUSHBUTTON);
end;

function FindDefButton(Wnd: HWND): HWND;

  procedure InternalFindDefButton(Wnd: HWND; out Result: HWND);
  var
    Child: HWND;
  begin
    Child := GetWindow(Wnd, GW_CHILD);
    while Child <> 0 do
    begin
      InternalFindDefButton(Child, Result);
      if IsDefButton(Child) then
      begin
        Result := Child;
        Exit;
      end;
      Child := GetWindow(Child, GW_HWNDNEXT);
    end;
  end;

begin
  Result := 0;
  InternalFindDefButton(Wnd, Result);
end;

function HookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  if nCode >= 0 then
  begin
    case nCode of
      HCBT_ACTIVATE:
        begin
          //if SnapToDefaultButton then
            PostMessage(WndHandle, WM_SNAP, wParam, 0);
        end;
    end;
  end;  
  Result := CallNextHookEx(Hook, nCode, wParam, lParam);
end;

{ TDummy }

class procedure TDummy.WndProc(var Msg: TMessage);
var
  DefButton: HWND;
begin
  with Msg do
    if Msg = WM_SNAP then
    begin
      Result := 0;
      DefButton := FindDefButton(WParam);
      if DefButton <> 0 then
        SnapTo(DefButton);
    end
    else
      Result := DefWindowProc(WndHandle, Msg, wParam, lParam);
end;

initialization
  WndHandle := AllocateHWnd(TDummy.WndProc);
  Hook := SetWindowsHookEx(WH_CBT, @HookProc, 0, GetCurrentThreadId);

finalization
  UnhookWindowsHookEx(Hook);
  DeallocateHWnd(WndHandle);

end.

Последний раз редактировалось Filka; 16.02.2016 в 08:59.
Filka вне форума Ответить с цитированием
Старый 16.02.2016, 12:10   #22
Sibedir
Тот ещё
Старожил
 
Аватар для Sibedir
 
Регистрация: 14.11.2007
Сообщений: 2,281
По умолчанию

Filka, а чё проверку на повторную активацию не делаешь? Зачем по второму разу позиционировать?
Вообще логично позиционировать только в модальном режиме.
Sibedir вне форума Ответить с цитированием
Старый 16.02.2016, 12:29   #23
Filka
Форумчанин
 
Регистрация: 29.10.2015
Сообщений: 272
По умолчанию

Её (проверку) недолго прикрутить (но только не для динамически создаваемых окон), да и таким образом эмулируется поведение системы (Винда позиционирует всегда при установленной галочке "На кнопке, выбираемой по умолчанию").
Filka вне форума Ответить с цитированием
Старый 16.02.2016, 12:44   #24
Sibedir
Тот ещё
Старожил
 
Аватар для Sibedir
 
Регистрация: 14.11.2007
Сообщений: 2,281
По умолчанию

Цитата:
Сообщение от Filka Посмотреть сообщение
Винда позиционирует всегда при установленной галочке "На кнопке, выбираемой по умолчанию".
Не, я проверял. При сворачивании-активации (вторая активация) позиционировние не происходит.
Sibedir вне форума Ответить с цитированием
Старый 16.02.2016, 13:37   #25
Человек_Борща
Старожил
 
Аватар для Человек_Борща
 
Регистрация: 30.12.2009
Сообщений: 11,442
По умолчанию

Нужно для кнопок TButton, TBitBtn и прочих переопределить их конструкторы с CreateWindow и изменением стиля кнопки, с использованием этих стилей BS_DEFCOMMANDLINK, BS_DEFPUSHBUTTON, BS_DEFSPLITBUTTON. Тогда будет работать кнопка "по умолчанию".
Человек_Борща вне форума Ответить с цитированием
Старый 16.02.2016, 14:33   #26
Sibedir
Тот ещё
Старожил
 
Аватар для Sibedir
 
Регистрация: 14.11.2007
Сообщений: 2,281
По умолчанию

Цитата:
Сообщение от Человек_Борща Посмотреть сообщение
Нужно для кнопок TButton, TBitBtn и прочих переопределить их конструкторы с CreateWindow и изменением стиля кнопки, с использованием этих стилей BS_DEFCOMMANDLINK, BS_DEFPUSHBUTTON, BS_DEFSPLITBUTTON. Тогда будет работать кнопка "по умолчанию".
Есть такая трабла. Но если речь о собственном VCL-приложении, то можно и так (если я правильно понял Человека_Борща):
Код:
function IsDefButton(Wnd: HWND): Boolean;
var
  WC: TWinControl;
begin
  WC := FindControl(Wnd);
  Result := (WC <> nil) and (WC is TCustomButton) and TCustomButton(WC).Default;
end;
Добавлено --------------------------------------------------------------------------
Цитата:
Сообщение от Sibedir Посмотреть сообщение
... Зачем по второму разу позиционировать?...
Я б всё-таки проверил
Код:
var
  FBufList: TList;

function HookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  i: Integer;
begin
  if nCode >= 0 then
  begin
    case nCode of
      HCBT_DESTROYWND:
        begin
          i := FBufList.IndexOf(Pointer(wParam));
          if i > -1 then
            FBufList.Delete(i);
        end;
      HCBT_ACTIVATE:
        begin
          i := FBufList.IndexOf(Pointer(wParam));
          if i < 0 then begin
          //if SnapToDefaultButton then
            PostMessage(WndHandle, WM_SNAP, wParam, 0);
            FBufList.Add(Pointer(wParam));
          end;
        end;
    end;
  end;
  Result := CallNextHookEx(Hook, nCode, wParam, lParam);
end;

Последний раз редактировалось Sibedir; 16.02.2016 в 14:49.
Sibedir вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как заставить MS VS E "Петь" на Русском? Xe[N]o Visual C++ 9 27.11.2010 10:08
Продолжения темы про настройку апача для "локального" ииспользования vedro-compota PHP 23 24.07.2010 10:21
настроить при открытии Excel 2003 в окошке "Тип файлов" вывод пункта "Все файлы (*.*)" по умолчанию? Unior Microsoft Office Excel 2 01.03.2009 02:42
Как добавить "значение по умолчанию" в базе Access? bafy БД в Delphi 6 13.02.2009 12:29
Как прописать в ключ "(По умолчанию)" UnD)eaD)Snake Общие вопросы Delphi 4 16.08.2007 12:00