SpeedButton. Как заблокировать отжатие кнопки?

@Mahhono · Регистрация: 11.05.2021

Студворк — интернет-сервис помощи студентам

Всех приветствую.
Пробую сделать панель окон. В принципе, все получилось - при открытии форм на панельке появляются кнопки, нажатие по которым дает фокус формам, при выборе мышкой формы кнопки соответственно отжимаются, нажимаются и т.д.
Но есть один затык, с которым никак не получается справиться - если к-либо форма активна, соответствующая ей кнопка SpeedButton находится в нажатом положении. И если тыкнуть в нее мышкой, она отжимается, а это не надо, т.к. отжатие происходит программно при уходе фокуса на другое окно.
Никакого обработчика отжатия у нее не нашел. Процедура OnClick - если тыкать в отжатую, работает исправно, а вот если тыкнуть в нажатую, то вываливается ошибка(((.

Вот код нажатия кнопки MfinMenu, при котором открывается нужная форма и создается на панельке кнопка для этой формы:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
procedure TfrmMain.miBtnSprBooksClick(Sender: TObject);
var
  C: TComponent;
  cToolButtonBooks: TToolButton;
  sbtnSprBooks: TSpeedButton;
  countBtns: integer;
begin
  //if not Assigned(frmSprGoods) then
    Application.CreateForm(TfrmSprGoods, frmSprGoods);
  frmSprGoods.Show;
 
  C := Panel1.FindComponent(frmSprGoods.Name);
  if C = nil then
    begin
      countBtns := CountBtnsForms(Panel1);
      sbtnSprBooks            := TSpeedButton.Create(Panel1);
      sbtnSprBooks.Parent     := Panel1;
      sbtnSprBooks.Name       := frmSprGoods.Name;
      sbtnSprBooks.Caption    := frmSprGoods.Caption;
      sbtnSprBooks.AllowAllUp := true;
      sbtnSprBooks.GroupIndex := 1;
      sbtnSprBooks.Margin     := 0;
      sbtnSprBooks.Top        := 2;
      sbtnSprBooks.Width      := 200;
      sbtnSprBooks.Height     := 21;
      sbtnSprBooks.Left       := 2+countBtns*202;
      sbtnSprBooks.Down       := true;
      sbtnSprBooks.OnClick    := onPanel1btnFormClick;
    end
  else
    TSpeedButton(C).Down := true;
 
end; //miBtnSprBooksClick

Вот код обработки нажатия этой кнопки:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure TfrmMain.onPanel1btnFormClick(Sender: TObject);
var
  sbtnSprClients: TSpeedButton;
  Form: TForm;
begin                                      
  if sbtnSprClients.Down = true then
    begin    ShowMessage('sbtnSprClients.Down := true');
      Form := Application.FindComponent(sbtnSprClients.Name) as TForm;
      if Assigned(Form) then
        Form.SetFocus;
    end
  else
    ShowMessage('sbtnSprClients.Down := false');
 end; //onPanel1btnFormClick

Повторюсь - как не дать нажатой кнопке отжаться?

Добавлено через 11 минут
На всякий случай - код закрытия формы и удаления соответствующей кнопки

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
procedure TfrmSprGoods.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i, numDelBtn: integer;
begin
  extSaveInit(Self);
 
  with frmMain.Panel1 do
  for i:=0 to ControlCount-1 do
    begin
      if Controls[i] is TSpeedButton then
        if Controls[i].Name = Self.Name then
          begin
            numDelBtn := i;
            Controls[i].Destroy;
            break;
          end;
    end;
  with frmMain.Panel1 do
  for i:=0 to ControlCount-1 do
    Controls[i].Left := 2+i*202;
 
  //FreeAndNil(Self);
  //frmSprGoods.Destroy;
  Action := CaFree;
  Self   := nil;
end; // FormClose

@Mahhono · 14.12.2021, 23:28 **[ТС]**

Arcor, по Sender -

Delphi
1
if Sender is TSpeedButton then

показывает и при нажатии и при отжатии, что Sender - TSpeedButton. Вчера под утро возился с этой панелькой, действительно, не совсем то наваял.
По хорошему я должен теперь проверять Down у Sender, но

Delphi
1
if Sender.Down = true then

ругается, что Down не задекларирован. По ходу надо где-то время выделить, почитать с самого начала.
Но по этому вопросу - чтобы уж с затыком спать не ложиться, как с Sender-ом дальше работать?

@Arcor · 14.12.2021, 23:30

Сообщение от Mahhono

Но по этому вопросу - чтобы уж с затыком спать не ложиться, как с Sender-ом дальше работать?

ну прочитай сообщения которые я написал(на предыдущей странице последнее), может там есть что полезного? )))

@Mahhono · 14.12.2021, 23:31 **[ТС]**

опоздал немного, вот он, пазл - SB := Sender as TSpeedButton;, спасибо

Добавлено через 1 минуту
просто в свое время на 1С семерке баловался, говорили на Делфи похоже, ага...))

@AzAtom · 14.12.2021, 23:34

Mahhono, объявлена переменная типа TSpeedButton и сразу обращение к ней. Странно, что оно вообще срабатывает без падения.

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure TfrmMain.onPanel1btnFormClick(Sender: TObject);
var
  sbtnSprClients: TSpeedButton;
  Form: TForm;
begin                                      
  if sbtnSprClients.Down = true then
    begin    ShowMessage('sbtnSprClients.Down := true');
      Form := Application.FindComponent(sbtnSprClients.Name) as TForm;
      if Assigned(Form) then
        Form.SetFocus;
    end
  else
    ShowMessage('sbtnSprClients.Down := false');
 end; //onPanel1btnFormClick

@Mahhono · 14.12.2021, 23:34 **[ТС]**

куда-то вся переписка делась...

@AzAtom · 14.12.2021, 23:36

А, уже Arcor подсказал про это.

Добавлено через 1 минуту

Сообщение от Mahhono

куда-то вся переписка делась...

Вторая страница началась.

@Arcor · 14.12.2021, 23:37

Сообщение от Mahhono

куда-то вся переписка делась...

мы на второй странице уже кашу варим), так и третья скоро откроется

Добавлено через 59 секунд

Сообщение от AzAtom

Вторая страница началась.

с модераторством вас, товарисчь

@AzAtom · 14.12.2021, 23:52

Arcor, спасибо.

@Mahhono · 15.12.2021, 00:13 **[ТС]**

Всё, допинали! Всем поклон, для отмены возврата кнопки понадобилось две мышиные процедуры:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
procedure TfrmMain.onPanel1btnFormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  SB: TSpeedButton;
  Form: TForm;
begin
    if Sender is TSpeedButton then
    SB := Sender as TSpeedButton;
      begin
        if SB.Down = true then
          begin
            SB.Down := false;
            Exit;
          end
      end;
end;
 
//******************************************************************************
 
procedure TfrmMain.onPanel1btnFormClick(Sender: TObject);
var
  SB: TSpeedButton;
  Form: TForm;
begin
    if Sender is TSpeedButton then
      begin
      SB := Sender as TSpeedButton;
      if SB.Down = true then
        begin
          Form := Application.FindComponent(SB.Name) as TForm;
          if Assigned(Form) then
            Form.SetFocus;
        end
    end;
 end; //onPanel1btnFormClick

Вот теперь в самое утро оно и сон придёт приятный, еще раз всем спасибо, особенно Arcor, как и думал, одна строка всё решила)).

@Arcor · 15.12.2021, 00:15

Сообщение от Mahhono

Form := Application.FindComponent(SB.Name) as TForm;

ну и снова же в ту же лужу.. а если там не форма найдется? а зачем мы ищем форму? что мы ее так не знаем заранее? ее указатель там где создавали тоже не имеем?

@Mahhono · 15.12.2021, 00:41 **[ТС]**

ну и там же, в главной, код открытия одной из форм с созданием горячо полюбившейся кнопки:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
procedure TfrmMain.miBtnSprBooksClick(Sender: TObject);
var
  C: TComponent;
  cToolButtonBooks: TToolButton;
  sbtnSprBooks: TSpeedButton;
  countBtns: integer;
begin
  //if not Assigned(frmSprGoods) then
    Application.CreateForm(TfrmSprGoods, frmSprGoods);
  frmSprGoods.Show;
 
  C := Panel1.FindComponent(frmSprGoods.Name);
  if C = nil then
    begin
      countBtns := CountBtnsForms(Panel1);
      sbtnSprBooks            := TSpeedButton.Create(Panel1);
      sbtnSprBooks.Parent     := Panel1;
      sbtnSprBooks.Name       := frmSprGoods.Name;
      sbtnSprBooks.Caption    := frmSprGoods.Caption;
      sbtnSprBooks.AllowAllUp := true;
      sbtnSprBooks.GroupIndex := 1;
      sbtnSprBooks.Margin     := 0;
      sbtnSprBooks.Top        := 2;
      sbtnSprBooks.Width      := 200;
      sbtnSprBooks.Height     := 21;
      sbtnSprBooks.Left       := 2+countBtns*202;
      sbtnSprBooks.Down       := true;
      sbtnSprBooks.OnClick    := onPanel1btnFormClick;
      sbtnSprBooks.OnMouseDown:= onPanel1btnFormMouseDown;
    end
  else
    TSpeedButton(C).Down := true;
 
end; //miBtnSprBooksClick

Добавлено через 7 минут
Arcor, я динамически присваиваю создаваемым кнопкам название открываемых форм, таким образом я решил вопрос удаления этих кнопок из панельки при закрытии самих форм и управление фокусами этих форм при нажатии на эти кнопки. Не сомневаюсь, что ваше решение более изящно, дорасту, тоже научусь, пока так получилось, но работает.
Что по поиску по наименованию..., конечно вероятность, она такая, но здесь используются не штатные названия и вряд ли у кого еще фантазия повернет так назвать.
Может как-то тэги можно использовать, не знаю, до них еще не добрался. Сегодня немного фрэймов коснулся, тоже прикольные штуки, чую, за ними большие возможности управления изменениями из одного места, как мне нравится).

Добавлено через 2 минуты
кстати, про указатели завтра почитаю, спасибо за намек.

Добавлено через 15 минут
Arcor, еще пару слов, почему названии формы присваиваю названию кнопки - при открытии формы из меню создается форма и кнопка, как настроить между ними другую связь я не смог придумать. Ведь потом, например, идет тык мышкой по кнопке, и откуда эта кнопка поймёт, что надо такой-то форме дать фокус? В неё же не запихнешь ничего от этой формы, а так - однофамильцы, почти братья, тыкнул в одного, сразу второй отозвался.
Если предложите более изящную схему, будет здорово.

@Arcor · 15.12.2021, 00:58

Сообщение от Mahhono

Arcor, еще пару слов, почему названии формы присваиваю названию кнопки - при открытии формы из меню создается форма и кнопка, как настроить между ними другую связь я не смог придумать. Ведь потом, например, идет тык мышкой по кнопке, и откуда эта кнопка поймёт, что надо такой-то форме дать фокус? В неё же не запихнешь ничего от этой формы, а так - однофамильцы, почти братья, тыкнул в одного, сразу второй отозвался.
Если предложите более изящную схему, будет здорово.

ну если хочешь разобраться, то хоть можно сделать так, один из вариантов, но не один единственный, чтобы понимал

создаем новый класс на основе кнопки, туда добавляем например ссылку на форму

Delphi
1
2
3
4
5
6
  TButton = class(Vcl.StdCtrls.TButton)
    private
      FFormLink: TForm;
    public
      property FormLink: TForm read FFormLink write FFormLink;
  end;

важно, в данном случае, чтобы оно до использования кнопки было объявлено

далее бросаем на форму кнопку, создаем событие на тык кнопки и событие создания формы.. к примеру

Delphi
1
2
3
4
5
6
7
8
9
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    FForm: TForm;
  public
    { Public-Deklarationen }
  end;

далее создаем некую аля-форму и даем некой кнопке ссылку на форму

Delphi
1
2
3
4
5
6
procedure TForm1.FormCreate(Sender: TObject);
begin
  FForm := TForm.Create(Self);
 
  Button1.FormLink := FForm;
end;

ну а дальше по накатанной уже..
на клик по кнопке

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
procedure TForm1.Button1Click(Sender: TObject);
var B: TButton;
begin
  if not (Sender is TButton) then Exit;
 
  B := Sender as TButton;
 
  if B.FormLink <> nil then
    begin
      B.FormLink.Show;
    end;
end;

думаю объяснять не надо дальше ))))
вместо одинаковых имен, по сути ты просто добавляешь ссылку, и имеешь уже форму при тыке, без поиска

Терзай и все получится!!!
Я уверен, что разработаешь в конечном итоге некую инфраструктуру в приложении и сократишь много еще чего

@northener · 15.12.2021, 01:08

Сообщение от Arcor

я проверяю всегда сперва на тип, а потом с ним работаю

Delphi
1
2
if C is TSpeedButton then
(C as TSpeedButton).Down := true;

Позвольте Arcor ещё раз побрюзжать на тему "as после is". Ну нафига нужная двойная проверка типа класса?
Абсолютно естественный код в таком случае это:

Delphi
1
2
if C is TSpeedButton then
TSpeedButton(C).Down := true;

@Arcor · 15.12.2021, 01:12

Сообщение от northener

Ну нафига нужная двойная проверка типа класса?

а при чем двойная? as же не проверяет тип, он же приводит к типу

@krapotkin · 15.12.2021, 01:16

as тоже проверяет внутри

@northener · 15.12.2021, 01:17

Сообщение от Arcor

as же не проверяет тип

Таки проверяет! Это и в хелпе написано и во многих книжках. Да и по ассемблерному коду это видно. Собственно для оператор as и введен для того чтобы выполнить код если тип правильный или выдать исключение в противном случае.

@Arcor · 15.12.2021, 01:25

ну пусть првоеряет, нахрена я буду только генерировать исключение на ровном и в заведомо известном месте...?

ну и тогда в стандартную библиотеку от производителя загляните, и удивитесь, сколько там is и as в паре... ну да ладно, добрых снов господа

@northener · 15.12.2021, 01:40

Сообщение от Arcor

ну и тогда в стандартную библиотеку от производителя загляните, и удивитесь, сколько там is и as в паре...

Ты же и сам знаешь кто эти библиотеки пишет.

P.S.
Оператор as явно придумал какой-то троешник. Нифига не могу придумать где он может быть реально нужен!

Добавлено через 3 минуты

Сообщение от Arcor

с модераторством вас, товарисчь

AzAtom теперь от вас вдвое больше молока потребуют. Сочувствую.

@mr-Crocodile · 15.12.2021, 09:05

Не по теме:

AzAtom, поздравляю!

@AzAtom · 15.12.2021, 09:24

Не по теме:

mr-Crocodile, northener, спасибо. :)

Новые блоги и статьи Все статьи Все блоги /
GitHub Copilot в JetBrains: модель по умолчанию, Fix и контроль MCP and_y87 12.10.2026 10 октября 2026 года GitHub обновил Copilot для JetBrains: добавил настройки стартовой модели, исправления из диагностики и управление автозапуском MCP. Поддержка IDE 2025. 1 прекращена — требуется. . .	GitHub Copilot в JetBrains: модель по умолчанию, Fix и контроль MCP and_y87 12.10.2026 10 октября 2026 года GitHub обновил Copilot для JetBrains: добавил настройки стартовой модели, исправления из диагностики и управление автозапуском MCP. Поддержка IDE 2025. 1 прекращена — требуется. . .	День 5 из 28: Codex подсказывает следующий запрос and_y87 12.10.2026 9 октября 2026 года OpenAI запустила бету Composer predictions — подсказок следующего сообщения в текущем диалоге Codex. Это помощь с формулировкой запроса, а не автоматическое продолжение задачи. . . .	Запустил конкурс "тем и промптов для текстовых квестов созданных почти чисто ИИ" Adler 06.10.2026 Всем привет! За последние три-четыре дня я создал более 16 текстовых квестовых игр используя преимущественно по одному запросу к ИИ на игру. Мне так понравилось смотреть все ветки/ сцены во всех. . .
ИИ не может найти нужный язык в списке Supersumestria 05.10.2026 Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .	Новая последняя моя музыка в SUNO zorxor 05.10.2026 Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .	Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .	Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .

@Mahhono __________________ 4 / 4 / 1 Регистрация: 11.05.2021 Сообщений: 178
	14.12.2021, 23:31 [ТС]
	опоздал немного, вот он, пазл - SB := Sender as TSpeedButton;, спасибо Добавлено через 1 минуту просто в свое время на 1С семерке баловался, говорили на Делфи похоже, ага...)) 0

@Mahhono __________________ 4 / 4 / 1 Регистрация: 11.05.2021 Сообщений: 178
	14.12.2021, 23:34 [ТС]
	куда-то вся переписка делась... 0

@AzAtom Модератор 4153 / 2362 / 814 Регистрация: 15.11.2015 Сообщений: 9,498
	14.12.2021, 23:52
	Arcor, спасибо. 0

@krapotkin 6854 / 4680 / 1465 Регистрация: 14.04.2014 Сообщений: 20,686 Записей в блоге: 21
	15.12.2021, 01:16
	as тоже проверяет внутри 0

@Arcor 5709 / 2300 / 466 Регистрация: 20.11.2009 Сообщений: 7,721 Записей в блоге: 1
	15.12.2021, 01:25
	ну пусть првоеряет, нахрена я буду только генерировать исключение на ровном и в заведомо известном месте...? ну и тогда в стандартную библиотеку от производителя загляните, и удивитесь, сколько там is и as в паре... ну да ладно, добрых снов господа 0

@mr-Crocodile
	15.12.2021, 09:05
	Не по теме: AzAtom, поздравляю! 0

@AzAtom
	15.12.2021, 09:24
	Не по теме: mr-Crocodile, northener, спасибо. :) 0