#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.
Если при это все равно очень нужен таймер, то нужно делать его на потоке и при этом
не забывать, что гуй залочен.
