Как сделать счетчик в delphi

Обновлено: 06.07.2024

Точное время измерения выполнения операции в Delphi может пригодится во многих случаях, начиная от самого простого - показать пользователю время, затраченное на выполнение длительной операции (здесь, кстати, высокая точность нужна редко) и, заканчивая, ситуациями, когда в целях оптимизации программы нам необходимо выявить в программе наиболее "узкие" места в которых программа "застревает" на длительный промежуток времени. В основном, последняя ситуация характерна при разработке программ, использующих и обрабатывающих большие массивы данных, когда скорость выполнения операций выходит, если не на первое, то на одно из первых мест в требованиях к приложению.
Есть несколько способов узнать время выполнения операций в Delphi и все эти способы, в принципе, рассмотрены как в Сети, так и моем блоге. Поэтому представленная ниже статья - это лишь объединение всех возможных способов измерения времени в Delphi и опытный Delphi-программист здесь врядли встретит что-то новое для себя.

Способ №1 - самый простой. Используем функцию Now()

Самый простейший и наименее точный способ измерить время, затраченное на выполнение какой-либо операции в Delphi - воспользоваться функцией Now() из модуля System.SysUtils .

Исходный код может выглядеть, например, так:

uses System.DateUtils; . var Start, Stop: TDateTime; Elapsed: int64; begin Start:=Now; //засекли начало выполнения операции DoSomething;//выполняем что-либо Stop:=Now; //засекли окончание выполнения операции Elapsed:=SecondsBetween(Start, Stop);//время в секундах end;

Вполне вероятно, что у вас может возникнуть резонный вопрос: почему я использовал в примере SecondsBetween() , а не, например, MilliSecondsBetween() для большей точности? Сделал я это, опираясь исключительно, на описание функции Now() в официальной справке по Delphi, которая гласит следующее: " Несмотря на то, что в TDateTime могут передаваться миллисекунды, Now() имеет точность до ближайшей секунды ". То есть, если использовать Now() , то определять интервал времени с точностью до миллисекунд - не имеет смысла.

Способ №2 - используем Windows API. Функция GetTickCount().

Функция GetTickCount() не имеет параметров и возвращает количество миллисекунд, прошедших с момента запуска системы. Судя по официальной справке Microsoft, разрешение функции GetTickCount() ограничено разрешением системного таймера, которое обычно находится в диапазоне от 10 до 16 миллисекунд. При этом, счётчик миллисекунд будет обнулен, если система запущена более 49,7 дней.
В принципе, пример использования этой функции похож на предыдущий:

var Start, Stop: cardinal; Elapsed: cardinal; begin Start:=GetTickCount; //засекли начало выполнения операции DoSomething;//выполняем что-либо Stop:=GetTickCount; //засекли окончание выполнения операции Elapsed:=Stop-Start;//время в миллисекундах end;

Так, используя функцию GetTickCount() мы можем засечь время выполнения операции в Delphi с точностью до миллисекунды. Если и такая точность Вам не подходит и необходимо измерить интервал времени ещё точнее, то следующий способ - для вас.

Способ №3 - продолжаем использовать Windows API. Функции QueryPerformanceCounter и QueryPerformanceFrequency

QueryPerformanceCounter - извлекает текущее значение счетчика производительности, которое представляет собой метку времени с высоким разрешением ( QueryPerformanceFrequency - извлекает частоту счетчика производительности. Частота счетчика производительности фиксируется при загрузке системы и согласована во всех процессорах,поэтому значение нужно запрашивать только при инициализации приложения, а результат может быть кэширован.

Для того, чтобы воспользоваться этими функциями для отсчёта интервала времени, затраченного на выполнение какой-либо операции в Delphi нам необходимо оформить исходный код, например, таким образом:

var iCounterPerSec: TLargeInteger; T1, T2: TLargeInteger; //значение счётчика ДО и ПОСЛЕ операции begin QueryPerformanceFrequency(iCounterPerSec);//определили частоту счётчика QueryPerformanceCounter(T1); //засекли время начала операции DoSomething; //выполнили что-то QueryPerformanceCounter(T2);//засекли время окончания ShowMessage(FormatFloat('0.0000', (T2 - T1)/iCounterPerSec) + ' сек.');//вывели количество секунд на выполнение операции end;

С полученными значениями T1 и T2 можно "играться" как угодно, например, выводить отдельно минуты/секунды/миллисекунды и т.д. тут всё зависит от ваших потребностей и желаний, я же показал наиболее простой пример использования счётчика с высоким разрешением в Delphi.

Способ №4 - используем возможности Delphi. Модуль System.Diagnostics

Модуль этот появился в Delphi уже достаточно давно (могу ошибаться, но, по-моему с Delphi XE-XE2). В модуле представлена всего одна запись ( record ) - TStopwatch , которая является ни чем иным, как удобной "обёрткой" для использования таймеров высокого разрешения из примера выше. Судя по достаточно скромной справке, TStopwatch использует функциональные возможности, зависящие от операционной системы, для получения доступа к таймерам с высоким разрешением, если они доступны. Если таймеры с высоким разрешением в ОС недоступны, то используются обычные таймеры.

Несмотря на то, что TStopwatch - это запись, для корректного использования всё же необходимо вызывать метод Create или StartNew .

Описание TStopwatch следующее:

TStopwatch = record strict private class var FFrequency: Int64; class var FIsHighResolution: Boolean; class var TickFrequency: Double; strict private FElapsed: Int64; FRunning: Boolean; FStartTimeStamp: Int64; function GetElapsed: TTimeSpan; function GetElapsedDateTimeTicks: Int64; function GetElapsedMilliseconds: Int64; function GetElapsedTicks: Int64; class procedure InitStopwatchType; static; public class function Create: TStopwatch; static; class function GetTimeStamp: Int64; static; procedure Reset; procedure Start; class function StartNew: TStopwatch; static; procedure Stop; property Elapsed: TTimeSpan read GetElapsed; property ElapsedMilliseconds: Int64 read GetElapsedMilliseconds; property ElapsedTicks: Int64 read GetElapsedTicks; class property Frequency: Int64 read FFrequency; class property IsHighResolution: Boolean read FIsHighResolution; property IsRunning: Boolean read FRunning; end;

Свойство IsHighResolution указывает, основан ли таймер на счетчике производительности с высоким разрешением.
Метод Start() начинает измерять прошедшее время.
Метод Stop() останавливает измерение прошедшего времени.
Свойство ElapsedMilliseconds получает общее истекшее время в миллисекундах.
Свойство Elapsed получает истекшее время в виде TTimeSpan .

Воспользоваться возможностями TStopwatch также достаточно просто, например, так:

uses System.Diagnostics; . var SW: TStopwatch; begin SW:=TStopwatch.StartNew; SW.Start; DoSomething; SW.Stop; ShowMessage(SW.Elapsed.TotalMinutes.ToString); end;

В представленном выше примере мы воспользовались TStopwatch и вывели количество минут (с дробной частью), пошедших на выполнение какой-то операции. В целом же, используя возможность TStopwatch.Elapsed можно выводить любые значения, ограниченные лишь возможностями TTimeSpan (см. справку).

Подведем итог

Итак, чтобы измерить точное время выполнения операции в Delphi, необходимо, прежде всего определиться с тем какая точность Вас устроит? Если достаточно, чтобы интервал времени определялся с точностью до секунды, то достаточно воспользоваться обычной, давно известной функцией Now() . Да, точность самая низкая, но, зато - просто.

Если ваше требование к точности измерения времени ограничивается миллисекундой - используйте GetTickCount() : просто, достаточно надежно (только, если вы не планируете измерять интервал времени больше 49,7 дней).

Пытаюсь сделать счётчик операций в минуту, уже подустал, нашёл данный код на c++, как его можно перенести в delphi?

вот пример моего кода где считаю, но не хватает мозгов додумать, был вариант, но ругается на 0, хотя в другой среде всё работает, тут проблема с остатком, почему то при деление только 0 выдаёт, без сотых и т.д. и есть совсем не приятный момент, что тут показывает результат только спустя минуту

Простой 1 комментарий

Для начала было бы неплохо выяснить, что оператор div это "оператор целочисленного деления", т.е. без остатка. По этому "без сотых".

Это работает отлично, но всё равно, не тот результат.
Мне нужно чтобы он считал сколько раз он пройдёт поток в течении минуты.
Пример

Данная функция не работает должным образом и результат спустя минуту или же поток может вообще удалится

Yam0lod5y, я по вашему отрывку кода не могу понять что вы хотите сделать. Где и как это происходит. Что в какой момент замеряется.

Yam0lod5y, счетчик операций в минуту это, когда у вас есть:
1. Кол-во выполненных задач
2. И таймер, который будет забирать значение выше каждую секунду (или реже/чаще)

Обычно календарь юникса измеряется в секундах, и только в JS исключение с миллисекундами. Если там правда миллисекунды, может, тогда заменить целочисленное деление div на операцию с плавающей точкой /

Также хорошей практикой будет использовать по возможности не гражданский календарь, а монотонное время. В языке Ada это приложение к стандарту D.8 Monotonic Time, описывающее пакет Ada.Real_Time. В Delphi тот же функционал спрятан в модуль с не очевидным названием System.Diagnostics. Это если программа не перезапускается в течение всего интересующего интервала.

Ну и зачем вам юникстайм для этого?
Есть же функция ОС GetTickCount , а если работать с датами то в DateUtils есть MillisecondsBetween который вернет ровно тот же результат что и GetTickCount. Дальше хоть в секунды хоть в часы.

Создание CGI счётчика в Delphi 5

Если Вы программируете в Delphi и, хотели бы, чтобы Ваш любимый компилятор поучавствовал в создании Вашей веб-странички, то можно начать с маленькой, но довольно важной части веб-проекта - счётчика. Обычно, счётчик выглядит как кнопка на странице. В данном случае это JPEG картинка, генерируемая на лету.

Те, кто желает сразу приступить к компиляции, могут скачать исходник и, в случае возникновения каких либо вопросов, вернуться к данной статье.

Вызывается счётчик тэгом IMG примерно так:

CGI скрипт так же может получать определённый набор параметров:

Txt e.g. "You are visitor %d today, and %d ever."

FontName e.g. "Courier"

FontColor e.g. "clGreen" or "$404040"

BackgroundColor e.g. "clYellow" or "$808080"

А вот так выглядит вызов скрипта с несколькими параметрами:

Итак, давайте разбираться с кодом.

Начать создавать новое CGI приложение следует с выбора File | New | Web Server Application | CGI stand-alone executable. После этого Вы получите чистый Web модуль. Добавьте новый TWebActionItem в подсвеченном свойстве действий (Actions) в TWebModule, нажав на Add Item. Затем двойным щелчком на событие OnAction создайте обработчик действия.

Изображение JPEG, получается как снимок изображения с TPanel, с TMemo внитри него. Таким способом легче придать 3D вид счётчику. Для начала нам необходимо добавить следующую строку в раздел implementation:

ExtCtrls, StdCtrls, Controls, Forms, Graphics, JPEG;

Теперь, мы определим некоторые основные процедуры, которые будут использоваться в коде. GetPaths будет обеспечивать нас двумя жизненно важными путями. Первый путь будет указывать где хранится сам скрипт по отношению к корневой директории web сервера (т.е. относительный путь). Скорее всего это будет "scripts" или "cgi-bin" в зависимости от того, куда Вы его положите. Второй - это локальный путь в Windows. Он может выглядеть как "C:\InetPub". Для нас важны оба пути, чтобы обеспечить переносимость CGI скрипта из директории в директорию и с одного сервера на другой.

procedure GetPaths(Request: TWebRequest; var ScriptPath, LocalPath : String );

ScriptFileName := ExtractFileName(ParamStr( 0 ));

// Убираем EXE/DLL имя, чтобы получить путь

Delete(ScriptPath,Pos(ScriptFileName,ScriptPath)- 1 ,Length(ScriptFileName)+ 1 );

// Убираем главную косую

Delete(ScriptPath, 1 , 1 );

LocalPath := ExtractFilePath(ParamStr( 0 ));

// Удаление ScriptPath даёт нам корневой путь

Delete(LocalPath,Pos(ScriptPath,LocalPath)- 1 ,Length(ScriptPath)+ 1 );

Процедура SetVariable будет использоваться для инициализации нужных нам переменных.

procedure SetVariable( var S : String ; const Value, Default : String );

Вся суть CGI скрипта заключается в событие OnAction. Давайте рассмотрим его по шагам.

procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;

Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);

Сперва объявим некоторые локальные переменные.

Ever, LastToday : Integer;

Теперь вызовем GetPaths, чтобы выяснить путь к скрипту, а так же локальный путь. В данном примере мы будем помещать наши счётчики в директорию "counters". Физический путь будет выглядеть примерно так "C:\InetPub\counters".

LocalPath := LocalPath+ 'counters\' ;

Затем, мы получаем все параметры, переданные вместе с вызовом скрипта. Параметры поступают к нам через свойство Request.QueryFields. Обратите внимание, что если какой-то параметр не был передан, то SetVariable устанавливает его по умолчанию.

with Request.QueryFields do begin

FileName := LocalPath+Values[ 'FileName' ]+ '.txt' ;

SetVariable(Txt,Values[ 'Txt' ], 'You are visitor %d today, and %d ever.' );

SetVariable(FontName,Values[ 'FontName' ], 'Arial' );

SetVariable(FontSize,Values[ 'FontSize' ], '10' );

SetVariable(FontColor,Values[ 'FontColor' ], 'clWhite' );

SetVariable(BackgroundColor,Values[ 'BackgroundColor' ], 'clBlack' );

Теперь мы должны быть уверены, что присутствует файл для данного счётчика. Если его нет, то просто создаём его.

// Write a new empty counter file if it doesn't exist

if not FileExists(FileName) then begin

Итак, файл существует. Естевственно, если мы создали его, что счётчик будет равен 0, иначе будем считывать старые значения, и зменять их, если необходимо. Обратите внимание , на то, как мы отслеживаем общее число посещение и посещений за день.

// Читаем старые значения счётчика

Ever := LastEver+ 1 ;

if Date = LastDate then

Today := LastToday+ 1

И в заключении, надо записать новые значения в файл, содержащий данные счётчика.

// Записываем новые значения счётчика

Теперь приступим к созднию того, что в конечном итоге будет называться JPEG. Для начала сделаем невидимым TForm которая содержит TPanel и TMemo. Так же устанавливаем FontName и FontSize.

Form := TForm.Create( nil );

with Form.Font do begin

Удостоверимся в том, что текст, который мы помещаем в memo контрол, содержит значения счётчика, считанные из файла.

Далее мы создаём панель. Ширина и высота будут определяться шириной текста, который мы помещаем в неё. Так же устанавливаем скашивание для 3D эффекта.

Panel := TPanel.Create( nil );

with Panel do begin

Width := Form.Canvas.TextWidth(Txt)+ 9 ;

Height := Form.Canvas.TextHeight(Txt)+ 9 ;

Помещаем memo в панель, и устанавливаем её ширину и высоту, а так же цвет, который указан в BackgroundColor.

Memo := TMemo.Create( nil );

with Memo do begin

Width := Panel.Width- 5 ;

Height := Panel.Height- 5 ;

Теперь необходимо сделать изображение эелемента управления, который мы создали. Для этого создаём TBitmap и закрашеваем его панелью. За одно рисуем текст на битмапе.

with Bitmap do begin

Width := Panel.Width- 1 ;

Height := Panel.Height- 1 ;

Panel.PaintTo(Canvas.Handle, 0 , 0 );

with Canvas.Font do begin

Canvas.TextOut( 4 , 3 ,Txt);

Затем преобразовываем bitmap в JPEG. JPEG будет записан в memory stream. Этот поток будет связан с браузером и передаваться посетителю странички в виде картинки.

var
AllTime,CurrentTime: TDateTime;
.
.
begin
CurrentTime:=0;
AllTime:=0;
Form1.Timer1.Enabled:=True;
.

procedure TForm1.Timer1Timer(Sender: TObject);
begin
IncSecond(CurrentTime);
Form1.Label8.Caption:=TimeToStr(CurrentTime);
Form1.Label8.Repaint;
Form1.Label10.Caption:=TimeToStr(AllTime);
Form1.Label10.Repaint;
end;

По прерыванию таймера раз в секунду хочу увеличить CurrentTime на одну секунду и вывести значение на экран, чтобы показать время работы программы. Но на экран выводиться всегда 0:00:00, те фйнкция IncSecond не работает или я что-то не правильно делаю. Подскажите кто знает.

Попробуй из CurrentTime выдернуть сек. и делать просто inc(x) потом обратно.
И еще, стесняюсь спросить зачем repaint у label?

procedure TForm1.Timer1Timer(Sender: TObject);
begin
CurrentTime:=IncSecond(CurrentTime);
Form1.Label8.Caption:=TimeToStr(CurrentTime);
Form1.Label8.Repaint;
Form1.Label10.Caption:=TimeToStr(AllTime);
Form1.Label10.Repaint;
end;

← →
zrv ( 2004-12-27 14:36 ) [3]

Иначе не успевает прорисовывать.

← →
zrv ( 2004-12-27 14:41 ) [4]

Спасибо.

Читайте также: