Зависают таймеры при удержании кнопок свернуть, развернуть, закрыть

#delphi #timer

Зависают таймеры при удержании кнопок свернуть, развернуть, закрыть.
Т.е. можно остановить таймер, нажав и удерживая кнопку.  

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   n := n +1;
   Caption := IntToStr(n);
end;


Как с этим можно бороться?
    

Ответы

Ответ 1

Ну, как вариант: сделать свой таймер через отдельный поток, тогда сообщения WM_TIMER
будут накапливаться и при отпускании кнопки всё накопленное вывалится разом. Вообще
такие таймеры я когда-то даже видел готовые в виде компонент, но простейший пример
будет выглядеть так:

unit tmMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    StopTimer: PBoolean;
    procedure WMTimerProc(var Message: TWMTimer); message WM_TIMER;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  PTimerData = ^TTimerData;
  TTimerData = record
    Owner: THandle;
    Interval: Cardinal;
    Terminated: Boolean;
  end;

function TimerProc(Param: PTimerData): DWORD; stdcall;
begin
  while not Param.Terminated do begin
    Sleep(Param.Interval);
    PostMessage(Param.Owner, WM_TIMER, 0, 0);
  end;
  Dispose(Param);
end;

function StartTimer(Interval: Cardinal; Wnd: THandle): PBoolean;
var
  TimerData: PTimerData;
  ThreadID: Cardinal;
begin
  if Interval < 10 then
    raise Exception.Create('Timer interval is too small');
  New(TimerData);
  TimerData.Owner := Wnd;
  TimerData.Interval := Interval;
  TimerData.Terminated := False;
  Result := @TimerData^.Terminated;
  if CreateThread(nil, 0, @TimerProc, TimerData, 0, ThreadID) = 0 then
    RaiseLastOSError;
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  StopTimer := StartTimer(500, Handle);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  StopTimer^ := True;
end;

procedure TForm1.WMTimerProc(var Message: TWMTimer);
begin
  Caption := IntToStr(GetTickCount);
end;

end.


P.S: if Interval < 10 then из-за того что разрешающая способность Sleep() где-то 8-15 мс.


Ответ 2

Delphi у меня под рукой нет, поэтому опишу на примере платформы .NET.

Любопытно. Попробовал в C# WinForms с применением System.Windows.Forms.Timer - аналогичное
поведение.

Дело тут вот в чём: событие тика таймера происходит в гуевом потоке. Событие нажатия
на эти кнопки - тоже в потоке GUI. Кнопку нажали - произошёл вход в обработчик события
- происходит ожидание отжатия - всё встало.

Взял взамен System.Threading.Timer. Событие тика этого типа таймера происходит не
в том потоке, в котором работает форма, а в отдельном потоке, взятом из пула. Однако,
к компонентам формы можно обращаться только из того потока, в котором они созданы.
Поэтому для обновления, в частности, заголовка формы нужно использовать Control.Invoke.
При этом происходит передача управления в поток GUI - снова всё зависает.

В C# удалось побороть это используя System.Threading.Timer и Control.BeginInvoke.
Этот метод вызывается асинхронно и хотя прорисовка формы при зажатии кнопки по-прежнему
не происходит, но инкремент переменной n продолжается. И когда кнопку отпускаем, выводится
увеличенное значение.


Ответ 3

Добавить в описании класса формы:

procedure WmNcLButtonDown(var Msg:TMessage); message WM_NCLBUTTONDOWN;
procedure WmNcRButtonDown(var Msg:TMessage); message WM_NCRBUTTONDOWN;


с такой реализацией:

procedure TForm1.WmNcLButtonDown(var Msg: TMessage);
begin
 Msg.Result := 0;
 case Msg.WParam of
  HTCLOSE:     PostMessage(Handle, WM_SYSCOMMAND, SC_CLOSE, 0);
  HTMINBUTTON: PostMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
  HTMAXBUTTON: if ( WindowState = wsMaximized )
                then PostMessage(Handle, WM_SYSCOMMAND, SC_RESTORE,  0)
                else PostMessage(Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 0);
  else Msg.Result := DefWindowProc(Handle, Msg.Msg, Msg.WParam, Msg.LParam);
 end;
end;

procedure TForm1.WmNcRButtonDown(var Msg: TMessage);
begin
 Msg.Result := 0;
 case Msg.WParam of
  HTMINBUTTON, HTCAPTION, HTSYSMENU:
   PostMessage(Handle, WM_CONTEXTMENU, Msg.WParam, Msg.LParam);
  else Msg.Result := DefWindowProc(Handle, Msg.Msg, Msg.WParam, Msg.LParam);
 end;
end;


Теперь удерживать кнопку не получится - действие будет сразу по нажатию.


Ответ 4

На английском для шарпа(но по сути для всего) ответ тут

По русский
Происходит это потому что пока нажата хотя бы одна из этих кнопок главный поток блокируется.
Соответственно сообщения таймера не придет. Проверяется очень легко через переопределение
WndProc с OutoutDebugString.

Если при это все равно очень нужен таймер, то нужно делать его на потоке и при этом
не забывать, что гуй залочен.