Создание таймера Borland Delphi

[Stilet]

было бы неплохо навести вне зависимости от бзика

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

[vitalina21]

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Menus;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    Button8: TButton;
    Button9: TButton;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    Label3: TLabel;
    Memo1: TMemo;
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
var
setup:string;
flag:integer;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if flag = 1 then begin winexec(PChar(setup),1);flag:=2; end;
if flag = 0 then begin Memo1.Text:=setup;flag:=10; end;
timer1.Enabled:=false;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
timer1.Enabled:=false;
timer1.Interval:=StrToInt(Edit1.Text)*1000;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
flag:=1;
setup:='cmd.exe';
timer1.Enabled:=true;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
flag:=1;
setup:='notepad.exe';
timer1.Enabled:=true;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
flag:=1;
setup:='mmc.exe';
timer1.Enabled:=true;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
flag:=1;
setup:='calc.exe';
timer1.Enabled:=true;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
flag:=1;
setup:='dxdiag.exe';
timer1.Enabled:=true;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
flag:=1;
setup:='regedit.exe';
timer1.Enabled:=true;
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
Form1.Close;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
ShowMessage('Разработала'+ #13 + 'Виталия');
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
flag:=0;
setup:=Edit2.Text;
timer1.Enabled:=true;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
Form1.Close;
end;

end.

Вот такой код у меня - а куда прицепить данные функции?

Сообщение от Сергeй

Это прихоть препода в учебной задаче ?
Или есть какое-то иное разумное объяснение требованию по обеспечению такой вот "точности" ?

В оригинале Звучит следующим Образом...
"Используя сервис Win32 API (функция QueryPerformanceFrequency, QueryPerformanceCounter и gettickcount) разработать таймер в виде визуального компонента для среды Delphi. работа таймера должна заключаться в стабильном отсчете заданных временных параметров, по истечению которых должно происходить выполнение назначенного пользовательского события. по окончанию работы должно срабатывать событие завершения работы. Работа таймера не должна зависеть от производственного процесса"

[Stilet]

vitalina21

Хо! Так тебе не просто таймер симитировать, тебе компонент нужно написать... И я так понимаю что он должен создавать отдельный поток, в котором будет отсчет времени, а по завершению потока вызывать некое событие...

[Сергeй]

> Работа таймера не должна зависеть от производственного процесса

Я плакалЪ...

Какого такого, спрашивается, "производственного процесса" ?)

Это же надо такую чушь пороть в задании)

[vitalina21]

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

А про процесс - это наверняка подразумевается то, что таймер не должен мешать процессу работы самого пользователя...Думаю что так...

[Stilet]

то тогда я буду очень рада

Радуйся. Воть вспомнил молодость:

unit Tmr;

interface

uses
  SysUtils, Classes,windows;

type
    TTmrThr = class(TThread)
  private
   ii:integer;
    { Private declarations }
  protected
    procedure Execute; override;
  end;


  TTmr = class(TComponent)
  private
    FInterval: integer;
    FOnTime: TNotifyEvent;
    Fthr:TTmrThr;
    procedure SetInterval(const Value: integer);
    procedure SetOnTime(const Value: TNotifyEvent);
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
    procedure Start;
  published
   Property Interval:integer read FInterval write SetInterval;
   Property OnTime:TNotifyEvent read FOnTime write SetOnTime;
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TTmr]);
end;

{ TTmr }

procedure TTmr.SetInterval(const Value: integer);
begin
  FInterval := Value;
end;

procedure TTmr.SetOnTime(const Value: TNotifyEvent);
begin
  FOnTime := Value;
end;

procedure TTmr.Start;
begin
  Fthr:=TTmrThr.Create(true);
  fthr.ii:=FInterval;
  Fthr.OnTerminate:=FOnTime;
  Fthr.FreeOnTerminate:=true;
  Fthr.Resume;
end;

{ TTmrThr }

procedure TTmrThr.Execute;
var tk:Integer;
begin
  inherited;
 tk:=GetTickCount;
 while abs(tk-GetTickCount)<ii do sleep(10);

end;

end.

Так может выглядеть модуль компонента. Проинсталируй его кинь на форму и пропиши

procedure TForm1.Button1Click(Sender: TObject);
begin
 Tmr1.Interval:=1000;
 Tmr1.Start;
end;

Типа запускаем
и его событие

procedure TForm1.Tmr1Time(Sender: TObject);
begin
 ShowMessage('dsadsad');
end;

Типа по срабатыванию таймера.

что таймер не должен мешать процессу работы самого пользователя

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

[Сергeй]

> если прокатит то что есть, то тогда я буду очень рада

Не прокатит, ни по одному из пунктов.
Даже не надейся)

> таймер в виде визуального компонента

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

> while .. do sleep(10);

Хреновый таймер получился, "нестабильный")

Препод возьмет да установит сдуру интервал в 1 мс .. или заведомо некратный 10-ти ..

Да в общем какой бы ни установил - один шиш таймер не даст ожидаемого от него преподом разрешения)

Ну и к тому же никакой "визуальностью" в классе TTmr даже не пахнет, а по заданию именно он должен картину маслом расписать)

[Stilet]

Хреновый таймер получился, "нестабильный")

Это же пример. Проблема разве убрать этот Sleep?

Ну и к тому же никакой "визуальностью" в классе TTmr даже не пахнет

А вот это уже автору предстоит дописать, тем паче что неизвесно в ТЗ какого рода визуализация нужна. Я не зря написал "может выглядеть модуль компонента"

[Сергeй]

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

Проблема разве убрать этот Sleep?

Не проблема. Но тогда пострадает "производственный процесс". И ощутимо)

[vitalina21]

procedure TTmrThr.Execute;
var tk:Integer;
begin
  inherited;
 tk:=GetTickCount;
 while abs(tk-GetTickCount)<ii do sleep(10);

end;

Ошибка о несоответствии знаковых и незнаковых типов...