На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! ПРАВИЛА РАЗДЕЛА · FAQ раздела Delphi · Книги по Delphi
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.
Следующие вопросы задаются очень часто, подробно разобраны в FAQ и, поэтому, будут безжалостно удаляться:
1. Преобразовать переменную типа String в тип PChar (PAnsiChar)
2. Как "свернуть" программу в трей.
3. Как "скрыться" от Ctrl + Alt + Del (заблокировать их и т.п.)
4. Как прочитать список файлов, поддиректорий в директории?
5. Как запустить программу/файл?
... (продолжение следует) ...

Вопросы, подробно описанные во встроенной справочной системе Delphi, не несут полезной тематической нагрузки, поэтому будут удаляться.
Запрещается создавать темы с просьбой выполнить какую-то работу за автора темы. Форум является средством общения и общего поиска решения. Вашу работу за Вас никто выполнять не будет.


Внимание
Попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки бан.
Мат в разделе - бан на три месяца...
Модераторы: jack128, D[u]fa, Shaggy, Rouse_
  
> Простой (но функциональный) модуль для замера скорости
    Накидал модуль для замера скорости процедур и отдельных участков кода.
    Модуль простой (без заморочек вроде повторных запусков), но вместе с тем довольно функциональный.
    Пользуйтесь, кому нужно ;)

    Интерфейсная часть (весь код и DCU-шки в прикреплённом архиве):
    ExpandedWrap disabled
      unit Measure7x;  { v1.10 (c) 2018 by Jin X (jin.x@sources.ru), http://xk7.ru/p/d/u }
      // Модуль для измерения скорости процедур/методов и отдельных участков кода
      // Для замера скорости используются высокоточные функции WinAPI QueryPerformanceCounter и QueryPerformanceFrequency, если они
      // поддерживаются системой (в Windows XP и более старших версиях поддерживаются всегда), либо GetTickCount в противном случае
       
      {$IF CompilerVersion >= 17} // Delphi 2005+
        {$DEFINE INLINE}
        {$DEFINE STATIC}
      {$IFEND}
       
      {$IF CompilerVersion >= 20} // Delphi 2009+
        {$DEFINE ANONYMMETHODS}
      {$IFEND}
       
      interface
       
      {$IF CompilerVersion >= 23} // Delphi XE2+
      uses System.Types, Winapi.Windows;
      {$ELSE}
      uses Types, Windows;
      {$IFEND}
       
      const
        // Версия модуля
        Measure7xVersion = 1.10;
       
      type
        // Процедура без параметров
        TProcedure = procedure;
        // Процедура с 1-м параметром типа Integer
        TProcedureInt = procedure(N: Integer);
       
        // Объектный метода без параметров
        TObjectProc = procedure of object;
        // Объектный метода с 1-м параметром типа Integer
        TObjectProcInt = procedure(N: Integer) of object;
       
      {$IFDEF ANONYMMETHODS}
        // Анонимный метод без параметров
        TReferenceProc = reference to procedure;
        // Анонимный метод с 1-м параметром типа Integer
        TReferenceProcInt = reference to procedure(N: Integer);
      {$ENDIF} // {$IFDEF ANONYMMETHODS}
       
        // Класс замера скорости (с одним счётчиком)
        TMeasure = class
          protected
            FCounter: Int64;
          public
            // Начать отсчёт времени
            procedure Start; {$IFDEF INLINE}inline;{$ENDIF}
            // Остановить отсчёт времени (начатый/продолженный методом Start/Continue) и вернуть разницу между текущим и начальным значениями счётчика времени
            function Stop: Int64;
            // Продолжить прерванный методом Stop отсчёт времени и вернуть текущее значение счётчика времени
            function Continue: Int64;
       
            // Получить скорость работы процедуры или метода
            function Proc(Proc: TProcedure): Int64;
            function ObjProc(Proc: TObjectProc): Int64;
      {$IFDEF ANONYMMETHODS}
            function RefProc(Proc: TReferenceProc): Int64;
      {$ENDIF}
            // Получить скорость работы процедуры или метода с параметром N
            function ProcInt(Proc: TProcedureInt; N: Integer): Int64;
            function ObjProcInt(Proc: TObjectProcInt; N: Integer): Int64;
      {$IFDEF ANONYMMETHODS}
            function RefProcInt(Proc: TReferenceProcInt; N: Integer): Int64;
      {$ENDIF}
       
            // Получить значение счётчика (последний замер)
            // Если счётчик не был запущен, будет возвращено нулевое значение, если не было остановлен, будет возвращено значение времени старта
            property Last: Int64 read FCounter;
            // Получить значение счётчика времени (последний замер) в секундах, миллисекундах или микросекундах
            function Sec: Double; {$IFDEF INLINE}inline;{$ENDIF}
            function Millisec: Int64; {$IFDEF INLINE}inline;{$ENDIF}
            function Microsec: Int64; {$IFDEF INLINE}inline;{$ENDIF}
            // Перевести значение счётчика времени в секунды, миллисекунды или микросекунды
            class function ToSec(Counter: Int64): Double; {$IFDEF STATIC}static; inline;{$ENDIF}
            class function ToMillisec(Counter: Int64): Int64; {$IFDEF STATIC}static; inline;{$ENDIF}
            class function ToMicrosec(Counter: Int64): Int64; {$IFDEF STATIC}static; inline;{$ENDIF}
            // Получить текущее значение системного счётчика
            class function Counter: Int64; {$IFDEF STATIC}static; inline;{$ENDIF}
            // Получить частоту счётчика (кол-во отсчётов в секунду)
            class function Frequency: Int64; {$IFDEF STATIC}static; inline;{$ENDIF}
        end;
       
      ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
       
      // Начать отсчёт времени, используя счётчик номер Idx или пользовательский счётчик Counter
      // Если отсчёт уже начат, он будет перезапущен заново
      // Если Idx < 0, процедура завершится без запуска отсчёта времени
      procedure StartMeasure(Idx: Integer = 0);
      procedure StartMeasureX(var Counter: Int64); {$IFDEF INLINE}inline;{$ENDIF}
       
      // Остановить отсчёт времени (начатый/продолженный функцией StartMeasure[X]/ContinueMeasure[X]), используя счётчик номер Idx или пользовательский счётчик Counter
      // Возвращает разницу между текущим и начальным значениями счётчика времени
      // Если счётчика не существует (либо Idx < 0), будет возвращено значение -1
      function StopMeasure(Idx: Integer = 0): Int64;
      function StopMeasureX(var Counter: Int64): Int64;
       
      // Продолжить прерванный функцией StopMeasure[X] отсчёт времени, используя счётчик номер Idx или пользовательский счётчик Counter
      // Возвращает текущее значение счётчика времени
      // Если счётчика не существует (либо Idx < 0), будет возвращено значение -1
      function ContinueMeasure(Idx: Integer = 0): Int64;
      function ContinueMeasureX(var Counter: Int64): Int64;
       
      // Получить значение счётчика времени номер Idx (последний замер)
      // Если счётчик не был остановлен, будет возвращено значение времени старта
      // Если счётчика не существует (либо Idx < 0), будет возвращено значение -1
      function LastMeasure(Idx: Integer = 0): Int64;
       
      // Получить значение счётчика времени номер Idx (последний замер) в секундах, миллисекундах или микросекундах
      function LastMeasureSec(Idx: Integer = 0): Double; {$IFDEF INLINE}inline;{$ENDIF}
      function LastMeasureMillisec(Idx: Integer = 0): Int64; {$IFDEF INLINE}inline;{$ENDIF}
      function LastMeasureMicrosec(Idx: Integer = 0): Int64; {$IFDEF INLINE}inline;{$ENDIF}
       
      // Получить скорость работы процедуры или метода, используя счётчик номер Idx или пользовательский счётчик Counter
      // Если Idx < 0, будет возвращено значение -1, но процедура/метода Proc всё равно будет выполнен(а)
      function MeasureProc(Proc: TProcedure; Idx: Integer = 0): Int64;
      function MeasureProcX(Proc: TProcedure; var Counter: Int64): Int64;
      function MeasureObjProc(Proc: TObjectProc; Idx: Integer = 0): Int64;
      function MeasureObjProcX(Proc: TObjectProc; var Counter: Int64): Int64;
      {$IFDEF ANONYMMETHODS}
      function MeasureRefProc(Proc: TReferenceProc; Idx: Integer = 0): Int64;
      function MeasureRefProcX(Proc: TReferenceProc; var Counter: Int64): Int64;
      {$ENDIF}
       
      // Получить скорость работы процедуры или метода с параметром N, используя счётчик номер Idx (по умолчанию 0, а не N !!!) или пользовательский счётчик Counter
      // Если Idx < 0, будет возвращено значение -1, но процедура/метод Proc всё равно будет выполнен(а)
      function MeasureProcInt(Proc: TProcedureInt; N: Integer; Idx: Integer = 0): Int64;
      function MeasureProcIntX(Proc: TProcedureInt; N: Integer; var Counter: Int64): Int64;
      function MeasureObjProcInt(Proc: TObjectProcInt; N: Integer; Idx: Integer = 0): Int64;
      function MeasureObjProcIntX(Proc: TObjectProcInt; N: Integer; var Counter: Int64): Int64;
      {$IFDEF ANONYMMETHODS}
      function MeasureRefProcInt(Proc: TReferenceProcInt; N: Integer; Idx: Integer = 0): Int64;
      function MeasureRefProcIntX(Proc: TReferenceProcInt; N: Integer; var Counter: Int64): Int64;
      {$ENDIF}
       
      // Замерить скорость работы нескольких процедур или методов
      // Значения счётчиков времени можно получить с помощью функции LastMeasure, указав в качестве параметра номер процедуры/метода
      procedure MeasureProcs(const ProcList: array of TProcedure);
      procedure MeasureObjProcs(const ProcList: array of TObjectProc);
      {$IFDEF ANONYMMETHODS}
      procedure MeasureRefProcs(const ProcList: array of TReferenceProc);
      {$ENDIF}
       
      // Замерить скорость работы процедуры или метода со значениями параметра от 0 до Count-1
      // Значения счётчиков времени можно получить с помощью функции LastMeasure, указав в качестве параметра значение от 0 до Count-1
      procedure MeasureProcCalls(Proc: TProcedureInt; Count: Integer);
      procedure MeasureObjProcCalls(Proc: TObjectProcInt; Count: Integer);
      {$IFDEF ANONYMMETHODS}
      procedure MeasureRefProcCalls(Proc: TReferenceProcInt; Count: Integer);
      {$ENDIF}
       
      // Сравнить скорость работы нескольких процедур или методов и вернуть номер (индекс массива) самой быстрой из них
      // Если массив пуст, результатом будет значение -1
      // Значения счётчиков времени можно получить с помощью функции LastMeasure, указав в качестве параметра номер процедуры/метода
      function MeasureFastestProc(const ProcList: array of TProcedure): Integer;
      function MeasureFastestObjProc(const ProcList: array of TObjectProc): Integer;
      {$IFDEF ANONYMMETHODS}
      function MeasureFastestRefProc(const ProcList: array of TReferenceProc): Integer;
      {$ENDIF}
       
      // Сравнить скорость работы процедуры или метода со значениями параметра от 0 до Count-1 и вернуть номер самого быстрого вызова (начиная с 0)
      // Если Count <= 0, будет возвращено значение -1
      // Значения счётчиков времени можно получить с помощью функции LastMeasure, указав в качестве параметра значение от 0 до Count-1
      function MeasureFastestProcCalls(Proc: TProcedureInt; Count: Integer): Integer;
      function MeasureFastestObjProcCalls(Proc: TObjectProcInt; Count: Integer): Integer;
      {$IFDEF ANONYMMETHODS}
      function MeasureFastestRefProcCalls(Proc: TReferenceProcInt; Count: Integer): Integer;
      {$ENDIF}
       
      // Сравнить скорость работы нескольких процедур или методов и вернуть номер (индекс массива) самой медленной из них
      // Если массив пуст, результатом будет значение -1
      // Значения счётчиков времени можно получить с помощью функции LastMeasure, указав в качестве параметра номер процедуры/метода
      function MeasureSlowestProc(const ProcList: array of TProcedure): Integer;
      function MeasureSlowestObjProc(const ProcList: array of TObjectProc): Integer;
      {$IFDEF ANONYMMETHODS}
      function MeasureSlowestRefProc(const ProcList: array of TReferenceProc): Integer;
      {$ENDIF}
       
      // Сравнить скорость работы процедуры или метода со значениями параметра от 0 до Count-1 и вернуть номер самого медленного вызова (начиная с 0)
      // Если Count <= 0, будет возвращено значение -1
      // Значения счётчиков времени можно получить с помощью функции LastMeasure, указав в качестве параметра значение от 0 до Count-1
      function MeasureSlowestProcCalls(Proc: TProcedureInt; Count: Integer): Integer;
      function MeasureSlowestObjProcCalls(Proc: TObjectProcInt; Count: Integer): Integer;
      {$IFDEF ANONYMMETHODS}
      function MeasureSlowestRefProcCalls(Proc: TReferenceProcInt; Count: Integer): Integer;
      {$ENDIF}
       
      // Сравнить скорость работы двух процедур или методов с учётом погрешности и вернуть результат сравнения (см. описание функции CompareMeasures)
      // Значения счётчиков времени можно получить с помощью функции LastMeasure, указав в качестве параметра номер процедуры/метода (0 или 1)
      function MeasureAndCompareProcs(Proc1, Proc2: TProcedure; RelError: Double = 0.01): TValueRelationship;
      function MeasureAndCompareObjProcs(Proc1, Proc2: TObjectProc; RelError: Double = 0.01): TValueRelationship;
      {$IFDEF ANONYMMETHODS}
      function MeasureAndCompareRefProcs(Proc1, Proc2: TReferenceProc; RelError: Double = 0.01): TValueRelationship;
      {$ENDIF} // {$IFDEF ANONYMMETHODS}
       
      // Вернуть номер счётчика с минимальным значением среди первых Count счётчиков (с номерами от 0 до Count-1)
      // Если существующих счётчиков меньше, чем Count, будет возвращён результат сравнения существующих счётчиков
      // Если Count <= 0 либо не существует ни одного счётчика, будет возвращено значение -1
      // !!! Помните, что все счётчики объединены в обычный массив, поэтому, например, при создании счётчиков №0 и №2 будет создан и счётчик №1, но с нулевым
      // значением, поэтому при сравнении 3-х счётчиков функция вернёт в качестве результата 1, т.к. этот счётчик имеет минимальное (нулевое) значение
      // (разумеется, если только счётчик №0 не имеет тоже нулевое значение) !!!
      function FastestMeasure(Count: Integer): Integer;
      // Вернуть номер счётчика с максимальным значением среди первых Count счётчиков (с номерами от 0 до Count-1)
      // Если существующих счётчиков меньше, чем Count, будет возвращён результат сравнения существующих счётчиков
      // Если Count <= 0 либо не существует ни одного счётчика, будет возвращено значение -1
      function SlowestMeasure(Count: Integer): Integer;
       
      // Сравнить два значения времени с учётом погрешности и вернуть результат сравнения:
      // -1, если A < B (A быстрее); 0, если A примерно равно B; 1, A > B (B быстрее)
      // RelError указывает долю допустимой разницы (от среднего значения A и B) до которой измерения считаются одинаковыми (0.01 = 1%)
      function CompareMeasures(A, B: Int64; RelError: Double = 0.01): TValueRelationship;
       
      // Перевести значение счётчика времени в секунды, миллисекунды или микросекунды
      function MeasureToSec(Counter: Int64): Double;
      function MeasureToMillisec(Counter: Int64): Int64;
      function MeasureToMicrosec(Counter: Int64): Int64;
       
      // Сбросить (удалить) все счётчики
      // Эту процедуру можно использовать после завершения всех измерений для экономии памяти, выделенного под массив счётчиков
      // Тем не менее, сброс ни коим образом не ограничивает повторное выполнение измерений
      procedure ResetMeasures;
       
      // Получить текущее значение системного счётчика
      function MeasureCounter: Int64;
       
      // Получить частоту счётчика (кол-во отсчётов в секунду)
      // Если высокоточные функции WinAPI QueryPerformanceCounter и QueryPerformanceFrequency не поддерживаются системой, будет возвращено значение 1000
      function MeasureFrequency: Int64;

    delphi7x
    Прикреплённый файлПрикреплённый файлMeasure7x_1.10.zip (608,8 Кбайт, скачиваний: 104)

    Старые версии:
    Прикреплённый файлПрикреплённый файлMeasure7x.zip (36,88 Кбайт, скачиваний: 100) (версия 1.00)
      Модуль существенно переработан!
      Многое добавлено, многое удалено...
      Появилась демо-программа :)

      История изменений:
      ExpandedWrap disabled
        Measure7x: модуль для измерения скорости процедур/методов и отдельных участков кода.
        (c) 2018 by Jin X (jin.x@sources.ru), http://xk7.ru/p/d/u
         
        v1.10 (22.06.2018):
        [!] Модуль полностью переработан! Теперь он будет функционировать, даже если функции WinAPI QueryPerformanceCounter
            и QueryPerformanceFrequency не поддерживаются системой (это возможно в Windows 2000, ME и более ранних версиях).
            Модуль не содержит перегруженных функций и методов, т.к. это порождает неоднозначные вызовы некоторых из них в
            ранних версиях Delphi. Каждая функция и метод теперь имеет отдельное имя с соответствующими суффиксами.
        [+] Добавлены методы и функции для работы с объектными методами (procedure of object: TObjectProc, TObjectProcInt)
            и анонимными методами (reference to procedure: TReferenceProc, TReferenceProcInt). Их имена оканчиваются на
            ObjProc, ObjProcInt и RefProc, RefProcInt (Int - для вызова процедуры с параметром типа Integer).
        [*] Имена методов MeasureProc и MeasureCall заменены на более короткие Proc и ProcInt соответственно, а также
            добавлены методы ObjProc, ObjProcInt RefProc, RefProcInt.
        [*] Функции MeasureFastestCall и MeasureSlowestCall переименованы в MeasureFastestProcCalls и MeasureSlowestProcCalls
            соответственно (а также добавлены функции с окончаниями ...ObjProcCalls и ...RefProcCalls). Я не использовал
            имена вроде MeasureFastestProcInt, т.к. у таких окончаний другой смысл: разовый вызов с указанным параметром,
            а не множественный (с перебором значений параметра), как у описанных выше функций.
        [+] Добавлены процедуры MeasureProcs (MeasureObjProcs, MeasureRefProcs) и MeasureProcCalls (MeasureObjProcCalls,
            MeasureRefProcCalls), позволяющие измерять скорость без сравнения (в отличие от MeasureFastestProc[Calls],
            MeasureSlowestProc[Calls] и их производных). Не путайте MeasureProcs и MeasureProc !!!
        [*] Функции, принимающие в качестве параметра переменную-счётчик (var Counter: Int64), переименованы с добавлением
            суффикса X, что означает eXternal counter, т.е. внешний счётчик (например, StartMeasureX, StopMeasureX).
        [+] Добавлены метод TMeasure.Continue и функции ContinueMeasure/ContinueMeasureX, позволяющие продолжить отсчёт
            времени, прерванный методом TMeasure.Stop или функциями StopMeasure/StopMeasureX.
        [-] Удалён тип TProcedureArray, функции MeasureFastestProc и MeasureSlowestProc с 2, 3, 4 и 5-ю параметрами типа
            TProcedure, вместо них теперь можно использовать функции с теми же именами, но с открытыми массивами процедур
            и методов (array of TProcedure, array of TObjectProc, array of TReferenceProc) в качестве параметра. Например,
            так: MeasureFastestProc([A, B, C]).
        [+] Добавлены функции MeasureAndCompareProc (...ObjProc, ...RefProc), позволяющие сравнить скорость работы двух
            процедур или методов с учётом погрешности. Также добавлена функция CompareMeasures.
        [*] Свойство TMeasure.Counter переименовано в Last.
        [+] Добавлена функция MeasureCounter и статический метод класса TMeasure.Counter, позволяющие получить текущее
            значение системного счётчика.
        [+] Добавлены статические методы класса TMeasure: ToSec, ToMillisec, ToMicrosec, позволяющие переводить результаты
            измерений в секунды, миллисекунды и микросекунды (аналогично использованию MeasureToSec, MeasureToMillisec,
            MeasureToMicrosec).
        [+] Добавлена процедура ResetMeasures, удаляющая массив счётчиков (освобождающая память).
        [+] Добавлены функции FastestMeasure, SlowestMeasure для определения самого быстрого и медленного измерения.
        [*] Вызов QueryPerformanceFrequency удалён из секции инициализации и выполняется только при первом обращении к
            функциям MeasureFrequency и ...Sec, ...Millisec, ...Microsec и аналогичным методам класса TMeasure. Так что,
            теперь, если модуль подключен, но не используется, ваша программа не будет содержать никакого лишнего кода :)
        [+] Добавлена константа Measure7xVersion = 1.10, которую можно использовать в директивах компиляции {$IFDEF} и {$IF}.
        [+] Сделана демонстрационная программа.
        [*] Небольшие внутренние доработки.
         
        v1.00 (21.06.2018):
        [!] Первая версия.

      Архив прикреплён к первому сообщению ;)
      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
      0 пользователей:


      Рейтинг@Mail.ru
      [ Script execution time: 0,0339 ]   [ 18 queries used ]   [ Generated: 28.03.24, 16:42 GMT ]