Последние записи

made in programmersforum 1

Интенсив по 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.