Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2014.02.02;
Скачать: CL | DM;

Вниз

Остановить GetTickCount.   Найти похожие ветки 

 
Ъ   (2013-08-15 17:06) [0]

Функция GetTick() обёртка над GetTickCount.
С одной особенностью, её работу можно ставить на паузу.
Т.е. останавливать и запускать дальше.

В общем, код простой, но работает он не верно, не верно отображает тики, когда убираю с паузы.

Подскажите, где я ошибся в коде?


var
 IsPauseTick:   boolean = True; // Флаг паузы.
 StopTick:      LongWord;         // Метка, когда поставили на паузу.
 StartTicK:     LongWord;         // Метка, когда убрали с паузы.
 PauseInterval: LongWord;       // Суммарная длительность паузы.

function GetTick: LongWord;
begin
 If IsPauseTick then
 begin
   Result:= StopTick;

 end else
 begin
   Result:= (GetTickCount - PauseInterval);

 end;
end;

procedure SetPauseTick(Value: boolean);
begin
 If (Value <> IsPauseTick) then
 begin
   IsPauseTick:= Value;
   
   If IsPauseTick then
   begin
     StopTick:= GetTickCount;

   end else
   begin
     StartTick    := GetTickCount;
     PauseInterval:= PauseInterval + (StartTick - StopTick);
   end;
 end;

end;

procedure TForm1.Display;
begin
 Label1.Caption:= IntToStr(GetTick);
 Label2.Caption:= IntToStr(GetTickCount);
end;

procedure TForm1.CheckBox1Click;
begin
 SetPauseTick(CheckBox1.Enabled);
end;


 
RWolf ©   (2013-08-15 17:36) [1]

SetPauseTick(CheckBox1.Checked);


 
RWolf ©   (2013-08-15 17:38) [2]

ну, и, видимо:
 If IsPauseTick then
   Result := StopTick - PauseInterval;


 
Ъ   (2013-08-15 19:52) [3]


> RWolf ©   (15.08.13 17:38) [2]


Не подходит.


 
Sha ©   (2013-08-15 22:06) [4]

unit GameTimerForm;

interface

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

type
 TGameTimer= record
   LastTick: integer;
   LastPlayer: integer;
   Counters: array of integer;
   end;

type
 TForm1 = class(TForm)
   Memo1: TMemo;
   RadioGroup1: TRadioGroup;
   procedure FormCreate(Sender: TObject);
   procedure RadioGroup1Click(Sender: TObject);
 public
   gt: TGameTimer;
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure InitGameTimer(var gt: TGameTimer; PlayerCount: integer);
var
 i: integer;
begin;
 SetLength(gt.Counters, PlayerCount);
 for i:=0 to PlayerCount-1 do gt.Counters[0]:=0;
 gt.LastTick:=GetTickCount;
 gt.LastPlayer:=0;
 end;

procedure PlayerChanged(var gt: TGameTimer; PlayerNo: integer);
var
 t: integer;
begin;
 if gt.LastPlayer<>PlayerNo then begin;
   t:=GetTickCount;
   inc(gt.Counters[gt.LastPlayer],t-gt.LastTick);
   gt.LastTick:=t;
   gt.LastPlayer:=PlayerNo;
   end;
 end;

procedure TForm1.FormCreate(Sender: TObject);
begin;
 Memo1.Lines.Clear;
 RadioGroup1.ItemIndex:=0;
 InitGameTimer(gt,RadioGroup1.Items.Count);
 end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
var
 i: integer;
 s: string;
begin;
 PlayerChanged(gt, RadioGroup1.ItemIndex);
 s:="";          
 for i:=0 to Length(gt.Counters)-1 do s:=s+"   "+IntToStr(gt.Counters[i]);
 Memo1.Lines.Add(s);
 end;

end.


 
Ъ   (2013-08-16 09:08) [5]

> Sha ©   (15.08.13 22:06) [4]

Мне не помогло, это совсем другая задача.
Создавать свои таймеры я научился, а как останавливать тик - нет.


 
Sha ©   (2013-08-16 10:01) [6]

> Ъ   (16.08.13 09:08) [5]
> Мне не помогло, это совсем другая задача.

Это совсем та задача, причем более общая.
В ней ведется подсчет времени,
затраченного на обдумывание хода каждым из N игроков.

Твоя задача аналогична игре в шахматы:
в ней тебе надо использовать время, затраченное игроком-1,
а время игрока-0 - это время паузы


 
KilkennyCat ©   (2013-08-16 10:05) [7]


> как останавливать тик

неверная формулировка. отсюда и ошибки.
тики идут всегда.
судя по тз, надо запомнить 3 периода: 1 - от старта до паузы, 2 - от паузы до снова-старта, 3 - от снова-старта до стопа.
вот и все.
складывать их по вкусу.

при запуске таймера:

StartTicK := GetTickCount;

при постановке на паузу:

PausaTick := GetTickCount;

при снятии с паузы:
ResumeTicK := GetTickCount;

при остановке:
StopTicK := GetTickCount;

И тогда:
время от старта до паузы:= PausaTick - StartTicK;
длительность паузы:=ResumeTicK - PausaTick;
от возобновления до остановки:= StopTicK - ResumeTicK;
время общее:= StopTicK  - StartTicK;
время без паузы:= PausaTick - StartTicK + StopTicK - ResumeTicK;


 
Sha ©   (2013-08-16 10:32) [8]

> Ъ   (16.08.13 09:08) [5]

Возможно, тебе потребуется еще нечто вроде

function PlayerTime(var gt: TGameTimer; PlayerNo: integer): integer;
var
 t: integer;
begin;
 Result:=gt.Counters[PlayerNo];
 if gt.LastPlayer=PlayerNo then begin;
   t:=GetTickCount;
   inc(Result,t-gt.LastTick);
   end;
 end;



Страницы: 1 вся ветка

Текущий архив: 2014.02.02;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.006 c
2-1364475755
ttt
2013-03-28 17:02
2014.02.02
Интерфейсы


2-1363892736
Максим
2013-03-21 23:05
2014.02.02
Кнопка


15-1376656788
Иксик
2013-08-16 16:39
2014.02.02
Размер обычной советской шахматной доски


11-1249205334
DevilDevil
2009-08-02 13:28
2014.02.02
Иконка для ToolWindow


15-1376574390
картман
2013-08-15 17:46
2014.02.02
графики, диаграммы