Последние записи
- Рандомное слайдшоу
- Событие для произвольной области внутри TImage
- Удаление папки с файлами
- Распечатка файла
- Преобразовать массив байт в вещественное число (single)
- TChromium (CEF3), сохранение изображений
- Как в Delphi XE обнулить таймер?
- Изменить цвет шрифта TextBox на форме
- Ресайз PNG без потери прозрачности
- Вывод на печать графического файла
Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk
Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw
9th
Апр
Пример работы с таймером в delphi
Posted by Chas under Delphi, Исходники
ак сделать, так чтобы при установке ограничения времени,к примеру на 30 сек,через 30 сек вышло Showmessage ВРЕМЯ ВЫШЛО! потом и так далее для 1 мин,2 мин,5 мин для кнопки GO
Serge_Bliznykov
чуть-чуть усложнил вашу задачу.
Если что — выкиньте лишнее
Project1source.rar
Project1_EXE.rar
если кратко, то вот PAS код модуля:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls;
type
TForm1 = class(TForm)
trckbr1: TTrackBar;
btCloseAll: TButton;
Label1: TLabel;
Label2: TLabel;
tmr1: TTimer;
btGO: TButton;
btStop: TButton;
Memo1: TMemo;
lbRemainTime: TLabel;
procedure FormCreate(Sender: TObject);
procedure trckbr1Change(Sender: TObject);
procedure btGOClick(Sender: TObject);
procedure StopTimerAndPrepareToNext;
procedure tmr1Timer(Sender: TObject);
procedure btCloseAllClick(Sender: TObject);
procedure btStopClick(Sender: TObject);
private
TimerSeconds : integer;
StartTime : TDateTime;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses DateUtils;
{$R *.dfm}
const
buf : array[0..4] of String = ('нет', '30 сек', '1 мин', '2 мин' , '5 мин');
bufInterval : array[0..4] of Integer = (0, 30, 60, 2*60, 5*60);
procedure TForm1.FormCreate(Sender: TObject);
begin
StopTimerAndPrepareToNext;
lbRemainTime.Caption := '';
TimerSeconds := 0;
StartTime := Now;
end;
procedure TForm1.StopTimerAndPrepareToNext;
begin
tmr1.Enabled := false; // сразу выключили таймер
Memo1.Enabled := false; // запретили ввод в мемо
trckbr1.Enabled := true; // включили трекбар
btStop.Enabled := false; // выключили кнопку СТОП
end;
procedure TForm1.trckbr1Change(Sender: TObject);
begin
Label2.Caption := buf[trckbr1.Position];
end;
procedure TForm1.btGOClick(Sender: TObject);
begin
trckbr1.Enabled := false; // выключили трекбар
if trckbr1.Position>0 then begin {задали время выключения}
TimerSeconds := bufInterval[trckbr1.Position];
StartTime := Now;
tmr1.Interval := 1000; // каждую секунду таймер будет срабатывать
// и делать нужные обработки
tmr1.Enabled := true; // запустили таймер
end;
btStop.Enabled := true; // включили кнопку остановки таймера
Memo1.Enabled := true; // открыли контрол, где можно что-то вводить
end;
procedure TForm1.btStopClick(Sender: TObject);
begin
StopTimerAndPrepareToNext;
lbRemainTime.Caption := '';
end;
procedure TForm1.tmr1Timer(Sender: TObject);
var Secs : integer;
begin
Secs := SecondsBetween(Now, StartTime);
if Secs>=TimerSeconds then begin
// баста!! Время вышло!
StopTimerAndPrepareToNext;
lbRemainTime.Caption := 'время вышло';
ShowMessage('Ваше время истекло!!');
TimerSeconds := 0;
end
else
lbRemainTime.Caption := 'Осталось '+IntToStr(TimerSeconds - Secs)+' сек.';
end;
procedure TForm1.btCloseAllClick(Sender: TObject);
begin
Close;
end;
end.
Похожие статьи
Купить рекламу на сайте за 1000 руб
пишите сюда - alarforum@yandex.ru
Да и по любым другим вопросам пишите на почту
пеллетные котлы
Пеллетный котел Emtas
Наши форумы по программированию:
- Форум Web программирование (веб)
- Delphi форумы
- Форумы C (Си)
- Форум .NET Frameworks (точка нет фреймворки)
- Форум Java (джава)
- Форум низкоуровневое программирование
- Форум VBA (вба)
- Форум OpenGL
- Форум DirectX
- Форум CAD проектирование
- Форум по операционным системам
- Форум Software (Софт)
- Форум Hardware (Компьютерное железо)