Formatdatetime delphi пример: Delphi. FormatDateTime(

Пример разработки пользовательской функции

Рассмотрим небольшой пример. Как упоминалось в уроке 11, стандартная функция UPPER правильно работает только с набором символов WIN 1251 и порядком сортировки PXW_CYRL. В описываемом примере создается и включается в базу данных функция Upper_Rus, которая гарантированно преобразует кириллицу для других наборов символов и порядков сортировки.

Поскольку вопросы создания DLL не являются темой этой книги, я сразу привожу полный текст библиотеки udf_dll:

library udf_dll; uses

SysUtils, Classes; {$R *.RES}

function Upper__Rus (InpString: PChar) : PChar; cdecl;

// Функция преобразует буквы входной строки в прописные

begin

Result := PChar(ANSIUpperCase(String(InpString)) ) end;

exports

Upper_Rus;

begin end.

Обратите внимание: экспортируемая функция для правильной работы с InterBase должна использовать соглашение cdecl о передаче входных параметров.

После компиляции библиотеки перенесите ее файл udf_dLL.

dLL в каталог ВШкаталога размещения InterBase (при стандартной установке — это c:\Program Files\Borland\ InterBase).

Затем с помощью SQL Explorer зарегистрируйте функцию на сервере:

DECLARE EXTERNAL FUNCTION UPPER_RUS CSTRING(256) RETURNS CSTRING(256) ENTRY_POINT «Upper_Rus» MODULE_NAME «UDF_DLL.DLL»

Рисунки 15.1 и 15.2 иллюстрируют разницу в работе стандартной и новой функций преобразования для набора символов WIN 1251 и порядком сортировки WIN1251.

При разработке функций следует помнить о том, что тип CSTRING InterBase соответствует типу PChar в Delphi, а тип DATE эквивалентен такой записи:

type TIBDateTime = record Days: Integer; MSec: Cardinal; end

1 Я пробовал устанавливать файл в другие каталоги и указывать путь к нему при регистрации функции на сервере, но у меня ничего не вышло — сервер игнорирует путь доступа и ищет библиотеку только в своем каталоге запуска.

Рис. 15.1. Результат преобразования кириллицы функцией UPPER

Рис. 15.2. Результат преобразования кириллицы функцией Ііррег.КиБ

При этом для преобразования из формата TIBDateTime в тип TDateTime Delphi необходимы следующие вычисления:

TDataTime = TIBDataTime.Days — 15018 +

TIBDateTime.MSec / (MSecsPerDay * 2)

Здесь константа MSecsPerDay, объявленная в модуле SysUtils, определяет количество миллисекунд в сутках.

Вот как выглядит функция, которая возвращает по передаваемой ей дате полное название месяца:

type

TIBDateTime = record

Days: Integer;

MSec: Cardinal; end;

function GetMonthName(var InpDate: TIBDateTime): PChar;

cdecl;

begin

Result := PChar(LongMonthNames[StrToInt(FormatDateTime(‘m’, InpDate.Days-15018+InpDate.MSec/ (MSecsPerDay*2)))]) end;

А вот как выглядит регистрация этой функции:

DECLARE EXTERNAL FUNCTION GetMonthName DATE

RETURNS CSTRING(20) ENTRY_POINT «GetMonthName» MODULE NAME «udf dll.dll»

⇐Реализация пользовательской функции || Оглавление || Технология InterBase Express⇒

Использование стандартных дженериков Delphi для работы с наборами данных

Начиная с версии 2009, в Delphi на уровне языка и компилятора появилась поддержка универсальных типов или дженериков (известных также как параметризованные типы), аналога шаблонов в C++. Вместе с этими изменениями появился юнит System.Generics.Collections, служащий для работы с массивами и группировки данных в словари, списки, стеки и очереди. Именно об этом юните и о работе с ним пойдёт здесь речь.

Статья рассчитана на читателей, имеющих представление о том, что такое универсальный тип или шаблон. Здесь я буду рассматривать только использование юнита

System.Generics.Collections. Будут рассмотрены основные классы, которые в нём реализованы, и даны примеры использования. Все приведённые примеры сделаны для Delphi XE7 и их работоспособность в других версиях Delphi не гарантируется.

TArray

Класс TArray юнита System.Generics.Collections содержит статические методы для поиска (BinarySearch) и сортировки массива (Sort). При поиске с помощью функции BinarySearch используется бинарный поиск с использованием

O(log n) алгоритма, где n — количество элементов массива. Давайте рассмотрим пример использования класса TArray.

Обратите внимание, что универсальный тип для массива (TArray<T>) определён в юните System, а в юните System.Generics.Collections определён лишь вспомогательный класс, который может только сортировать массив и искать в нём.

program Project1;
 
{$APPTYPE CONSOLE}
 
{$R *.res}
 
uses
   System.SysUtils, System.Generics.Defaults, System.Generics.Collections;
 
var
   strElem: string;
   intElem: integer;
   outFoundIndex: integer;
 
   //Массив строк.
   strArray: TArray<string> = ['Раз', 'Два', 'Три', 'Четыре', 'Пять'];
   //Массив чисел.
   intArray: TArray<integer> = [5, 4, 2, 1, 3];
 
begin
   try
      WriteLn('Массив строк до сортировки.');
      for strElem in strArray do Writeln(strElem);
      //Сортируем строки в массиве по алфавиту.
      TArray.Sort<string>(strArray); //Результат будет Два, Пять, Раз, Три, Четыре.
      WriteLn('Массив строк после сортировки.
  ');
      for strElem in strArray do Writeln(strElem);
 
      WriteLn('Массив чисел до сортировки.');
      for intElem in intArray do Writeln(intElem);
      //Сортируем строки в массиве по алфавиту.
      TArray.Sort<integer>(intArray); //Результат будет 1, 2, 3, 4, 5.
      WriteLn('Массив чисел после сортировки.');
      for intElem in intArray do Writeln(intElem);
 
      WriteLn('Ищем в массиве строк заданную строку.');
      //Ищем строку, начиная с начала.
      if TArray.BinarySearch<string>(strArray, 'Пять', outFoundIndex) then //Результат будет индекс 1.
         WriteLn('Элемент найден. Индекс найденного элемента: ' + IntToStr(outFoundIndex))
      else
         WriteLn('Элемент не найден.');
 
      WriteLn('Ищем в массиве строк заданную строку, начиная с элемента с индексом 2.');
      //Ищем строку, начиная со строки с индексом 2 и до конца,
      //для сравнения строк используем стандартный для строки компаратор.
      if TArray.BinarySearch<string>(strArray, 'Пять', outFoundIndex, TComparer<string>.   Default, 2, Length(strArray) - 2) then //Результат будет "Элемент не найден".
         WriteLn('Элемент найден. Индекс найденного элемента: ' + IntToStr(outFoundIndex))
      else
         WriteLn('Элемент не найден.');
 
      WriteLn('Ищем в массиве чисел заданное число.');
      //Ищем число, начиная с начала.
      if TArray.BinarySearch<integer>(intArray, 4, outFoundIndex) then //Результат будет индекс 3.
         WriteLn('Элемент найден. Индекс найденного элемента: ' + IntToStr(outFoundIndex))
      else
         WriteLn('Элемент не найден.');
 
      WriteLn('Ищем в массиве чисел заданное число, начиная с элемента с индексом 1 и проходим только 2 элемента.');
      //Ищем число, начиная с элемента с индексом 1, проходим только два элемента,
      //для сравнения чисел используем стандартный для числа компаратор.
      if TArray.BinarySearch<integer>(intArray, 4, outFoundIndex, TComparer<integer>.Default, 1, 2) then //Результат будет "Элемент не найден".
         WriteLn('Элемент найден.    Индекс найденного элемента: ' + IntToStr(outFoundIndex))
      else
         WriteLn('Элемент не найден.');
 
      ReadLn;
   except
      on E: Exception do
         Writeln(E.ClassName, ': ', E.Message);
   end;
end.

Теперь рассмотрим вариант сортировки с использованием своего компаратора (сравнивателя). Допустим, что в примере нам нужно сортировать строки не по алфавиту, а по своему собственному алгоритму.

program Project1;
 
{$APPTYPE CONSOLE}
 
{$R *.res}
 
uses
   System.SysUtils, System.Generics.Defaults, System.Generics.Collections;
 
var
   strElem: string;
   сomparer: IComparer<string>;
   strArray: TArray<string> = ['Два', 'Пять', 'Четыре', 'Раз', 'Три'];
 
begin
   try
      //Создаём свой компаратор для сравнения по своему алгоритму.
      сomparer := TDelegatedComparer<String>.Create
       (
         function(const Left, Right: String): Integer
            function NumberByName(const name: string): integer;
            begin
               if name = 'Раз' then
                  Result := 1
               else if name = 'Два' then
                  Result := 2
               else if name = 'Три' then
                  Result := 3
               else if name = 'Четыре' then
                  Result := 4
               else if name = 'Пять' then
                  Result := 5
               else
                  Result := 0;
            end;
         begin
            //Получаем числа по названиям и возвращаем разницу между ними.
   
            Result := NumberByName(Left) - NumberByName(Right);
         end
      );
 
      WriteLn('Массив строк до сортировки.');
      for strElem in strArray do Writeln(strElem);
      //Сортируем строки, используя свой компаратор.
      TArray.Sort<string>(strArray, сomparer); //Элементы будут отсортированы не по алфавиту, а по порядку.
      WriteLn('Массив строк после сортировки.');
      for strElem in strArray do Writeln(strElem);
 
      ReadLn;
   except
      on E: Exception do
         Writeln(E.ClassName, ': ', E.Message);
   end;
end.

TDictionary и TObjectDictionary

Словарь TDictionary или TObjectDictionary – это коллекция пар ключ-значение. Разница между этими двумя классами в том, что второй класс умеет автоматически удалять экземпляры ключей-объектов и/или значений-объектов, т.е. вы можете использовать в качестве ключей или значений экземпляры объектов.

Добавить ключ с соответствующим значением в словарь вы можете с помощью методов Add (вернёт ошибку, если попытаться добавить ключ повторно) или AddOrSetValue (заменит значение для ключа, если ключ уже есть в коллекции). Удалять элементы словаря можно с помощью Remove (удаление одного элемента) и Clear (полная очистка словаря). Полезными могут быть события OnKeyNotify и OnValueNotify, которые происходят при добавлении, изменении или удалении пары (следует учитывать, что для одной операции может произойти несколько событий).

Добавление или удаление пары ключ-значение, а также чтение значения по ключу являются эффективными, близкими к O (1), т.к. для хранения пар используется хэш-таблица. Ключи не могут быть nil, а значения – могут.

Узнать наличие в словаре ключа или значения можно с помощью методов TryGetValue (пытается считать значение по ключу), ContainsKey (проверяет наличие ключа) и ContainsValue (проверяет наличие значения). Прочитать значение по ключу можно с помощью свойства Items, узнать количество пар в словаре – с помощью свойства Count. Получить список всех ключей можно из свойства Keys, а значений – из свойства Values.

Рассмотрим несколько вариантов использования словарей.

program Project1;
 
{$APPTYPE CONSOLE}
 
{$R *.res}
 
uses
   System.SysUtils, Windows, System.Generics.Collections;
 
type
   //Класс для хранения характеристик столицы.
   TCapital = class
      //Название.
      name: string;
      //Широта.
      latitude: double;
      //Долгота.
      longitude: double;
      //Деструктор класса.
      destructor Destroy; override;
      //Конструктор класса.
      constructor Create(name: string; latitude, longitude: double);
   end;
 
   destructor TCapital.Destroy;
   begin
      //При удалении выводим на консоль информацию об удаляемом классе.
      Writeln('Удаляется объект TСapital: ' + name);
      inherited Destroy;
   end;
 
   constructor TCapital.Create(name: string; latitude, longitude: double);
   begin
      inherited Create;
      //Инициализируем переменные. 
      self.name := name;
      self.latitude := latitude;
      self.longitude := longitude;
   end;
 
var
   s: string;
   key: string;
   value: string;
   capital: TCapital;
   pair1: TPair<string, string>;
   pair3: TPair<string, TCapital>;
 
   //Словарь для хранения пары string-string.
   dictionary1: TDictionary<string, string>;
   //Словарь для хранения пары string-TCapital.
   //TCapital класс и хранящиеся в словаре экземпляры этого класса нужно удалять,
   //поэтому используем TObjectDictionary, чтобы удаление происходило автоматически.
   dictionary3: TObjectDictionary<string, TCapital>;
begin
   try
 
      //Создаём словарь для хранения пары string-string.
      dictionary1 := TDictionary<string, string>.Create;
      try
         //Добавление пары.
         dictionary1.Add('Россия', 'Москва');
         //Попытка добавить пару с помощью метода Add с уже имеющимся в словаре ключом
         //вызовет ошибку EListError с сообщением 'Duplicates not allowed'. 
         try
            dictionary1.Add('Россия', 'Москва1');
         except
            on e: EListError do
               Writeln(e.ClassName, ': ', e.Message);
         end;
         //Метод AddOrSetValue заменит для ключа 'Россия' значение 'Москва' на 'Москва2'.
         dictionary1.AddOrSetValue('Россия', 'Москва2');
         //А здесь метод AddOrSetValue добавит пару 'Великобритания'-'Лондон'.
         dictionary1.AddOrSetValue('Великобритания', 'Лондон');
         //Узнаем есть ли ключ в словаре с помощью метода ContainsKey и добавим значение если нет.
         if not dictionary1.ContainsKey('США') then
            dictionary1.Add('США', 'Вашингтон');
         //Узнаем количество пар в словаре.
         Writeln('Количество пар в словаре dictionary1: ', dictionary1.Count);
         //Прочитаем все ключи и выведем для них значения.
         Writeln('--Ключи и значения');
         for key in dictionary1.Keys do
            Writeln(key, ': ', dictionary1[key]);
         //Прочитаем все значения. 
         Writeln('--Значения');
         for value in dictionary1.Values do
            Writeln(value);
         //Прочитаем все пары ключ-значения.
         Writeln('--Пары');
         for pair1 in dictionary1 do
            Writeln(pair1.Key, ': ', pair1.Value);
         //Очистим словарь.
         dictionary1.Clear;
      finally
         dictionary1.Free;
      end;
 
      //Cоздаём словарь для хранения пары string-TCapital.
      //При создании сообщаем словарю (флаг doOwnsValues),
      //чтобы словарь автоматически отслеживал, когда нужно удалять
      //экземпляры класса TCapital (будет вызываться функция Free).
      dictionary3 := TObjectDictionary<string, TCapital>.Create([doOwnsValues]);
      try
         //Добавление пары с помощью метода Add.
         dictionary3.Add('Россия', TCapital.Create('Москва', 55.75, 37.62));
         //Добавление с помощью метода AddOrSetValue.
         dictionary3.AddOrSetValue('Великобритания', TCapital.Create('Лондон', 51.51, -0.13));
         //Проверка есть ли ключ в словаре, и если нет, то добавляем. 
         if not dictionary3.ContainsKey('США') then
            dictionary3.Add('США', TCapital.Create('Вашингтон', 38.9, -77.04));
         //Прочитаем все ключи и выведем по ним информацию.
         Writeln('--Ключи и значения');
         for key in dictionary3.Keys do
            Writeln(key, ': ', dictionary3[key].name,
               ': ', FloatToStr(dictionary3[key].latitude),
               'x', FloatToStr(dictionary3[key].longitude));
         //Прочитаем все значения.
         Writeln('--Значения');
         for capital in dictionary3.Values do
            Writeln(capital.name,
               ': ', FloatToStr(capital.latitude),
               'x', FloatToStr(capital.longitude));
         //Прочитаем все пары ключ-значения.
         Writeln('--Пары');
         for pair3 in dictionary3 do
            Writeln(pair3.Key, ': ', pair3.Value.name,
               ': ', FloatToStr(pair3.Value.latitude),
               'x', FloatToStr(pair3.Value.longitude));
         //Спросим у пользователя, для какой страны он хочет узнать столицу. 
         Writeln('--Поиск страны в словаре');
         Writeln('Введите название страны: ');
         Readln(s);
         //Конвертируем полученную строку из кодировки CP1251 в кодировку консоли (в моём случае CP866).
         with TEncoding.GetEncoding(GetConsoleCP) do
         begin
            s := GetString(TEncoding.ANSI.GetBytes(s));
            Free;
         end;
         //Ищем столицу введённой страны в словаре.
         if dictionary3.ContainsKey(s) then
            Writeln('Столица введённой страны: ', dictionary3[s].name)
         else
            Writeln('Ошибка! Введённая страна не найдена в словаре!');
      finally
         //При удалении (dictionary3.Free) или очистке (dictionary3.Clear) этого словаря
         //будут удалены все хранящиеся в нём экземпляры класса TCapital.
         dictionary3.Free;
      end;
 
      ReadLn;
   except
      on e: Exception do
         Writeln(e.ClassName, ': ', e.Message);
   end;
end.

Теперь рассмотрим более сложный вариант, когда в качестве ключа используется экземпляр класса. Также определим для ключа свой компаратор (сравниватель).

program Project1;
 
{$APPTYPE CONSOLE}
 
{$R *.res}
 
uses
   System.SysUtils, System.Generics.Defaults, System.Generics.Collections;
 
type
   TPosition = class
      X: integer;
      Y: integer;
   end;
 
var
   position: TPosition;
   x, y: integer;
 
   //Словарь для хранения пары TPosition-string.
   //TPosition класс и хранящиеся в словаре экземпляры этого класса нужно удалять,
   //поэтому используем TObjectDictionary, чтобы удаление происходило автоматически.
   dictionary: TObjectDictionary<TPosition, string>;
   //Компаратор для сравнения двух объектов TPosition по своему алгоритму
   //и вычисления хэш-кода для объекта TPosition тоже по своему алгоритму.
   comparer: IEqualityComparer<TPosition>;
begin
   try
      //Создаём свой компаратор, используя класс TDelegatedEqualityComparer.
      comparer := TDelegatedEqualityComparer<TPosition>.Create
      (
         //Функция сравнения TEqualityComparison<TPosition>. 
         function(const Left, Right: TPosition): Boolean
         begin
            //Сравниваем координаты двух объектов TPosition.
            Result := (Left.X = Right.X) and (Left.Y = Right.Y);
         end,
         //Функция вычисления хэш-кода THasher<TPosition>.
         function(const Value: TPosition): Integer
         begin
            //Генерируем хэш-код, просто используя исключающее ИЛИ (XOR).
            Result := Value.X xor Value.Y;
         end
      );
 
      //Cоздаём словарь для хранения пары TPosition-string.
      //При создании сообщаем словарю (флаг doOwnsKeys),
      //чтобы словарь автоматически отслеживал, когда нужно удалять
      //экземпляры класса TPosition (будет вызываться функция Free).
      //Для сравнения ключей и вычисления хэш-кода используем свой компаратор.
      dictionary := TObjectDictionary<TPosition, string>.Create([doOwnsKeys], comparer);
      try
         //Заполняем словарь.
         position := TPosition.Create;
         position. X := 10;
         position.Y := 10;
         dictionary.Add(position, 'Треугольник');
         position := TPosition.Create;
         position.X := 11;
         position.Y := 12;
         dictionary.Add(position, 'Квадрат');
         position := TPosition.Create;
         position.X := 20;
         position.Y := 20;
         dictionary.Add(position, 'Ромб');
         try
            position := TPosition.Create;
            position.X := 11;
            position.Y := 12;
            //Попытка добавить пару с помощью метода Add с уже имеющимся в словаре ключом
            //вызовет ошибку EListError с сообщением 'Duplicates not allowed'.
            dictionary.Add(position, 'Многогранник');
         except
            on e: EListError do
               Writeln(e.ClassName, ': ', e.Message);
         end;
         //Выводим все ключи словаря и значения для них.
         for position in dictionary.Keys do
            WriteLn('Координата: ', position.X, 'x', position.Y, ', Фигура: ', dictionary[position]);
         //Запросим у пользователя координаты и выведем фигуру для этих координат. 
         WriteLn('Введите координаты: ');
         ReadLn(x, y);
         position := TPosition.Create;
         try
            position.X := x;
            position.Y := y;
            if dictionary.ContainsKey(position) then
               WriteLn('По введённой координате ', x, 'x', y, ' расположена фигура: ', dictionary[position])
            else
               WriteLn('Ошибка! Для координаты ', x, 'x', y, ' фигура не найдена!');
         finally
            position.Free;
         end;
      finally
         //При удалении (dictionary.Free) или очистке (dictionary.Clear) этого словаря
         //будут удалены все хранящиеся в нём экземпляры класса TPosition.
         dictionary.Free;
      end;
 
      ReadLn;
   except
      on e: Exception do
         Writeln(e.ClassName, ': ', e.Message);
   end;
end.

TList и TObjectList

Список TList или TObjectList – это упорядоченный список, доступ к элементам которого происходит по индексу. Разница между этими классами в том, что второй класс умеет автоматически удалять экземпляры элементов при их удалении из списка.

В список можно добавлять или вставлять элементы, менять и удалять их. Можно добавлять nil. При изменении списка срабатывает событие OnNotify.

Список можно сортировать, используя стандартные или свои компараторы. Можно искать в нём и делать реверсию.

Свойство Count показывает количество элементов в списке, а Capacity – количество зарезервированных мест. Прочитать элемент по индексу можно с помощью свойства Items.

Вот пример использования объекта TList.

program Project1;
 
{$APPTYPE CONSOLE}
 
{$R *.res}
 
uses
   System.SysUtils, System.Generics.Defaults,
   System.Generics.Collections, System.Types;
 
var
   index: integer;
   item1: integer;
   i: integer;
   contains: boolean;
   //Список целых чисел.
   list1: TList<integer>;
 
begin
   try
      //Создаём список. 
      list1 := TList<integer>.Create;
      try
         //Добавление одного элемента в список.
         //В результате в списке будет только число 5.
         list1.Add(5);
         //Добавляем сразу несколько элементов.
         //Элементы добавятся в конец в том же порядке.
         //В результате в списке будет 5, 2, 6, 8, 1, 9, 0.
         list1.AddRange([2, 6, 8, 1, 9, 0]);
         //Вставка в список вместо элемента с индексом 2.
         //Результат будет 5, 2, 4, 6, 8, 1, 9, 0.
         list1.Insert(2, 4);
         //Вставка нескольких элементов с индекса 1.
         //Результат будет 5, 7, 3, 4, 2, 4, 6, 8, 1, 9, 0.
         list1.InsertRange(1, [7, 3, 4]);
         //Передвигаем элемент с индексом 7 в конец списка.
         //Результат будет 5, 7, 3, 4, 2, 4, 6, 1, 9, 0, 8.
         list1.Move(7, list1.Count - 1);
         //Читаем все элементы из списка.
         for item1 in list1 do
            WriteLn(item1);
         //Линейный поиск в списке, начиная с начала.
         //Результат поиска будет 3. 
         index := list1.IndexOf(4);
         //Линейный поиск в списке, начиная с конца.
         //Результат поиска будет 5.
         index := list1.LastIndexOf(4);
         //Этот метод может искать как с начала, так и с конца.
         //Направление задаётся вторым параметром.
         //Результат поиска будет 5.
         index := list1.IndexOfItem(4, TDirection.FromEnd);
         //Проверка, есть ли элемент в списке. Для проверки используется IndexOf.
         //Результат проверки будет True.
         contains := list1.Contains(4);
         //Сортировка. Результат будет 0, 1, 2, 3, 4, 4, 5, 6, 7, 8, 9.
         list1.Sort;
         //Читаем элементы из списка.
         for i := 0 to list1.Count - 1 do
            WriteLn(list1[i]);
         //Поиск в отсортированном списке.
         //BinarySearch работает намного быстрее IndexOf, но только с отсортированным списком.
         //Результат поиска будет 4.
         list1.BinarySearch(4, index);
         //Изменение направления списка.  Все элементы будут установлены в обратном порядке.
         //Результат будет 9, 8, 7, 6, 5, 4, 4, 3, 2, 1, 0.
         list1.Reverse;
         //Удаляем число 4 из списка.
         //В результате будет удалён только первый найденный элемент.
         //В примере функция найдёт элемент с индексом 5 и удалит его.
         //В функции используется линейный поиск с начала списка.
         //Результат будет 9, 8, 7, 6, 5, 4, 3, 2, 1, 0.
         //В переменной index будет 5, т.е. индекс удалённого элемента до его удаления.
         index := list1.Remove(4);
         //Здесь метод Remove не найдёт число 11 в списке и вернёт индекс -1.
         index := list1.Remove(11);
         //Удаляем число 4 из списка, при этом ищем с конца.
         //Результат будет 9, 8, 7, 6, 5, 3, 2, 1, 0.
         //В переменной index будет 5.
         index := list1.RemoveItem(4, TDirection.FromEnd);
         //Удаляем элемент по индексу.
         //Результат будет 9, 8, 6, 5, 3, 2, 1, 0.
         list1.Delete(2);
         //Удаляем два элемента, начиная с индекса 3. 
         //Результат будет 9, 8, 6, 2, 1, 0.
         list1.DeleteRange(3, 2);
         //Удаляем из списка все элементы, значения которых являются значениями по умолчанию.
         //Для типа Integer - это 0. Следовательно, все нули будут удалены.
         //Результат будет 9, 8, 6, 2, 1.
         list1.Pack;
         //А теперь будем определять, нужно ли удалять элемент с помощью своей функции.
         //Параметр функции L - это значение элемента списка, а R - это значение по умолчанию (в нашем случае 0).
         //Удалим все элементы, значения которых больше 7.
         //Результат будет 6, 2, 1.
         list1.Pack(function(const L, R: integer): boolean
            begin
               Result := L > 7;
            end
         );
         //Меняем местами два элемента списка.
         //Результат будет 1, 2, 6.
         list1.Exchange(0, 2);
         //Полная очистка списка.
         list1.Clear;
      finally
         list1.Free;
      end;
      ReadLn;
   except
      on e: Exception do
         Writeln(e. ClassName, ': ', e.Message);
   end;
end.

Использование объекта TObjectList очень похоже, поэтому я лишь покажу пример, который покажет дополнительные тонкие моменты.

program Project1;
 
{$APPTYPE CONSOLE}
 
{$R *.res}
 
uses
   System.SysUtils, System.Generics.Defaults,
   System.Generics.Collections, System.Types;
 
type
   TMyObject = class
   private
      FName: string;
   public
      constructor Create(const AName: String);
      destructor Destroy(); override;
   end;
 
var
   myObject: TMyObject;
   //Список объектов TStrings.
   list2: TObjectList<TMyObject>;
 
   constructor TMyObject.Create(const AName: String);
   begin
      FName := AName;
   end;
 
   destructor TMyObject.Destroy;
   begin
      //Показываем, когда объект удаляется.
      WriteLn('Объект "', FName, '" удалён!');
      inherited;
   end;
 
begin
   try
      //Создаём список. По умолчанию свойство OwnsObjects выставляется в True.
      //Это значит, что список сам удаляет объекты. 
      list2 := TObjectList<TMyObject>.Create;
      try
         //Добавление объекта в список.
         list2.Add(TMyObject.Create('Один'));
         //Добавление нескольких объектов сразу.
         list2.AddRange([TMyObject.Create('Два'), TMyObject.Create('Три')]);
         //Удаление объекта из списка влечёт удаление объекта 'Один'.
         list2.Delete(0);
         //Изымаем объект из списка без удаления.
         //Т.к. мы извлекли объект 'Два' из списка, он не будет автоматически удалён
         //и его нужно удалять самостоятельно, но в примере мы умышленно этого не будем делать.
         myObject := list2.Extract(list2[0]);
         WriteLn('Объект "', myObject.FName, '" изъят из списка!');
         //При попытке извлечь из списка объект, которого в списке нет,
         //метод Extract вернёт значение по умолчанию. Для класса TMyClass - это nil.
         myObject := list2.Extract(myObject);
      finally
         //При удалении списка оставшиеся в нём объекты будут удалены. 
         //В примере объект 'Три' будет автоматически удалён.
         list2.Free;
      end;
      ReadLn;
   except
      on e: Exception do
         Writeln(e.ClassName, ': ', e.Message);
   end;
end.

TThreadList

TThreadList – это тоже список, но потокобезопасный, т.е. с ним можно смело работать сразу из нескольких потоков. На самом деле – это обёртка над классом TList. Набор методов для работы с элементами здесь очень скромный: Add (добавление элемента), Clear (очистка списка), Remove (удаление элемента) и RemoveItem (удаление элемента с указанием направления поиска). А чтобы работать со списком в полную силу (чтение всех элементов, поиск, сортировка), нужно получить доступ к списку TList, который хранится внутри TThreadList. Сделать это можно с помощью функции блокировки LockList, которая заблокирует список и вернёт указатель на список TList. После работы со списком TList, список нужно разблокировать с помощью метода UnlockList. Также здесь есть очень полезное свойство Duplicates (дубликаты), которое задаёт поведение списка при добавлении дубликатов: разрешать добавление дубликатов (dupAccept), игнорировать дубликаты, не добавляя их, (dupIgnore) или генерировать ошибку при добавлении дубликата (dupError). По умолчанию свойство Duplicates имеет значение dupIgnore.

Вот пример работы со списком TThreadList (для создания потоков я использую класс TTask, о котором я уже рассказывал в статье «Параллельное программирование в Delphi XE7»).

program Project1;
 
{$APPTYPE CONSOLE}
 
{$R *.res}
 
uses
   System.SysUtils, System.Generics.Collections, System.Threading;
var
   list: TThreadList<integer>;
   writer, reader: ITask;
begin
   try
      list := TThreadList<integer>. Create;
      try
         //Создаём задачу, которая будет добавлять элементы в список.
         writer := TTask.Create(procedure()
            var
               i: integer;
            begin
               //Добавляем в список 9 элементов раз в 2 секунды.
               for i := 1 to 9 do
               begin
                  //Добавляем в список один элемент.
                  list.Add(Random(100));
                  //Ждём 2 секунды.
                  Sleep(2000);
               end;
            end
         );
         //Создаём задачу, которая будет читать элементы из списка.
         reader := TTask.Create(procedure()
            var
               listCount: integer;
               item: integer;
               internalList: TList<integer>;
            begin
               //Читаем список раз в секунду, пока количество элементов не будет равно 9.
               repeat
                  //Ждём секунду.
                  Sleep(1000);
                  //Блокируем список и одновременно получаем указатель на внутренний список, который хранит элементы. 
                  internalList := list.LockList;
                  try
                     //Узнаём количество элементов в списке.
                     listCount := internalList.Count;
                     WriteLn('Количество элементов в списке: ', listCount);
                     //Читаем все элементы списка.
                     Write('Элементы списка: ');
                     for item in internalList do
                        Write(item, '; ');
                     WriteLn;
                  finally
                     //Разблокируем список.
                     list.UnlockList;
                  end;
               until listCount = 9;
            end
         );
         //Запускаем задачи.
         writer.Start;
         reader.Start;
         //Ждём пока задачи выполнятся.
         TTask.WaitForAll([writer, reader]);
      finally
         list.Free;
      end;
      ReadLn;
   except
      on E: Exception do
         Writeln(E.ClassName, ': ', E.Message);
   end;
end.

TStack и TObjectStack

Стек TStack или TObjectStack – это стек элементов, работающий по принципу «последним пришёл — первым вышел» (last in — first out). Т.е. добавленные в стек элементы, вытаскиваются из него в обратном порядке. Стеки TStack и TObjectStack отличаются друг от друга тем, что второй стек предоставляет механизм автоматического удаления объектов удаляемых из стека.

Стек может быть произвольного размера. В стек можно добавлять nil. При изменении стека срабатывает событие OnNotify. Свойство Count показывает общее количество элементов в стеке.

Пример использования стека TStack.

program Project1;
 
{$APPTYPE CONSOLE}
 
{$R *.res}
 
uses
   System.SysUtils, System.Generics.Defaults,
   System.Generics.Collections, System.Types;
 
var
   item: string;
   //Стек строк.
   stack: TStack<string>;
 
begin
   try
      //Создаём стек.
      stack := TStack<string>.Create;
      try
         //Добавляем 5 элементов.
         stack.Push('Алексей');
         stack.Push('Людмила');
         stack.Push('Сергей');
         stack. Push('Наталья');
         stack.Push('Александр');
         //узнаём количество элементов в стеке.
         //Результат будет - 5 элементов.
         WriteLn('Стек содержит ' + IntToStr(stack.Count) + ' элементов.');
         //Читаем все элементы в стеке по порядку, т.е. от 'Алексей' до 'Александр'.
         //Стек при этом не меняется.
         for item in stack do
            WriteLn(item);
         //Смотрим последний добавленный элемент без изменения стека.
         //Если стек пуст, то метод Peek сгенерирует ошибку.
         //Результат будет 'Александр'.
         WriteLn(stack.Peek);
         //Извлекаем последний добавленный элемент из стека.
         //Если стек пуст, то метод Pop сгенерирует ошибку.
         //Результат будет 'Александр', при этом элемент 'Александр' будет удалён из стека.
         WriteLn(stack.Pop);
         //Извлекаем последний добавленный элемент из стека.
         //Теперь результат будет 'Наталья', при этом элемент 'Наталья' будет удалён из стека.
         WriteLn(stack. Pop);
         //Очистка стека, т.е. удаление всех элементов.
         stack.Clear;
      finally
         stack.Free;
      end;
      ReadLn;
   except
      on e: Exception do
         Writeln(e.ClassName, ': ', e.Message);
   end;
end.

Использование стека TObjectStack аналогичное и рассматривать его я здесь не буду. Упомяну лишь, что здесь можно использовать метод Extract, вместо Pop, если не требуется автоматическое удаление извлекаемого элемента.

TQueue и TObjectQueue

Очередь TQueue или TObjectQueue позволяет вам добавлять элементы в конец, а вытаскивать их из начала. Т.е. из очереди элементы будут считываться в том же порядке, в котором они были туда добавлены. Разница между очередями TQueue или TObjectQueue состоит в том, что очередь TObjectQueue умеет автоматически удалять объекты при удалении элементов из очереди.

Свойство Count показывает количество элементов в очереди. При добавлении или удалении элемента вызывается событие OnNotify. В очередь можно добавлять nil.

Вот пример использования очереди TQueue.

program Project1;
 
{$APPTYPE CONSOLE}
 
{$R *.res}
 
uses
   System.SysUtils, System.Generics.Defaults,
   System.Generics.Collections, System.Types;
 
var
   item: string;
   //Очередь строк.
   queue: TQueue<string>;
 
begin
   try
      //Создаём очередь.
      queue := TQueue<string>.Create;
      try
         //Добавляем 5 элементов.
         queue.Enqueue('Алексей');
         queue.Enqueue('Людмила');
         queue.Enqueue('Сергей');
         queue.Enqueue('Наталья');
         queue.Enqueue('Александр');
         //Узнаём количество элементов в очереди.
         //Результат будет - 5 элементов.
         WriteLn('Очередь содержит ' + IntToStr(queue.Count) + ' элементов.');
         //Читаем все элементы в очереди по порядку, т.е. от 'Алексей' до 'Александр'.
         //Очередь при этом не меняется. 
         for item in queue do
            WriteLn(item);
         //Смотрим первый добавленный элемент без изменения очереди.
         //Если очередь пуста, то метод Peek сгенерирует ошибку.
         //Результат будет 'Алексей'.
         WriteLn(queue.Peek);
         //Извлекаем первый добавленный элемент из очереди.
         //Если очередь пуста, то метод Dequeue сгенерирует ошибку.
         //Результат будет 'Алексей', при этом элемент 'Алексей' будет удалён из очереди.
         WriteLn(queue.Dequeue);
         //Извлекаем первый добавленный элемент из очереди.
         //Теперь результат будет 'Людмила', при этом элемент 'Людмила' будет удалён из очереди.
         WriteLn(queue.Dequeue);
         //Очистка очереди, т.е. удаление всех элементов.
         queue.Clear;
      finally
         queue.Free;
      end;
      ReadLn;
   except
      on e: Exception do
         Writeln(e.ClassName, ': ', e.Message);
   end;
end.

Использование стека TObjectQueue аналогичное и рассматривать его я здесь не буду. Здесь, так же как и в классах TObjectList и TObjectStack, можно использовать метод Extract вместо метода Dequeue, если не требуется автоматическое удаление извлекаемого элемента.

TThreadedQueue

TThreadedQueue — это ещё одна реализация очереди, но в отличие от TQueue или TObjectQueue, эта очередь предназначена для вставки и изъятия элементов из разных потоков. Для этой очереди задаётся ограничение на максимальное количество находящихся в ней элементов, и, если очередь максимально заполнена и какой либо поток пытается добавить ещё один элемент, то этот поток ожидает, пока в очереди появится свободное место или пока не истечёт время ожидания.

Очередь TThreadedQueue подходит, например, для реализации какого либо сервера, который принимает сообщения от клиентов в одном потоке (или нескольких потоках) и складывает их в очередь, а затем берёт эти сообщения из очереди и обрабатывает их в другом потоке (или нескольких потоках).

Вот пример использования очереди TThreadedQueue (для создания потоков я использую класс TTask, о котором я уже рассказывал в статье «Параллельное программирование в Delphi XE7»):

program Project1;
 
{$APPTYPE CONSOLE}
 
{$R *.res}
 
uses
   System.SysUtils, System.Generics.Defaults,
   System.Generics.Collections, System.Types, System.Threading;
 
var
   //Очередь для хранения строк.
   queue: TThreadedQueue<string>;
   //Потоки для записи в очередь и чтения из неё.
   writer, reader: ITask;
 
begin
   try
      //Создаём очередь. Здесь специально делаем размер очереди (всего 5 элементов)
      //и время ожидания на постановку в очередь (всего 1 сек.) очень маленькими.
      queue := TThreadedQueue<string>.Create(5, 1000);
      try
         //Создаём задачу, которая будет писать сообщения в поток.
         writer := TTask.Create(procedure()
            var
               i: integer;
               message: string;
               waitResult: TWaitResult;
            begin
               for i := 1 to 9 do
               begin
                  //Формируем сообщение. 
                  message := Format('Сообщение %d. Создано в %s.',
                     [i, FormatDateTime('hh:nn:ss.zzz', Time)]);
                  //Пишем сообщение в очередь.
                  waitResult := queue.PushItem(message);
                  //Если превышено разрешённое время ожидания, то выдаём сообщение об этом.
                  if waitResult = wrTimeout then
                     WriteLn(Format('ОШИБКА! Не удалось отправить сообщение %d. Истекло время ожидания.', [i]));
               end;
            end
         );
         //Создаём задачу, которая будет читать сообщения из потока.
         reader := TTask.Create(procedure()
            var
               message: string;
            begin
               //Читаем сообщения из очереди, пока они там есть.
               repeat
                  //Читаем первое сообщение в очереди и одновременно вынимаем его оттуда.
                  message := queue.PopItem;
                  //Выдаём сообщение на консоль, заодно отображаем время его получения. 
                  WriteLn(message, ' Получено в ' + FormatDateTime('hh:nn:ss.zzz', Time) + '.');
                  //Ждём 2 секунды (как будто сообщение очень долго обрабатывается).
                  Sleep(2000);
               until queue.QueueSize = 0;
            end
         );
         //Запускаем писателя.
         writer.Start;
         //Ждём секунду.
         Sleep(1000);
         //Запускаем читателя.
         reader.Start;
         //Ждём пока обе задачи отработают.
         TTask.WaitForAll([writer, reader]);
         //Выдаём статистические данные:)
         WriteLn('Всего сообщений отправлено: ', queue.TotalItemsPushed);
         WriteLn('Всего сообщений получено: ', queue.TotalItemsPopped);
      finally
         queue.Free;
      end;
      ReadLn;
   except
      on e: Exception do
         Writeln(e.ClassName, ': ', e.Message);
   end;
end.

А вот результат, который будет выведен на консоль:

ОШИБКА! Не удалось отправить сообщение 6. Истекло время ожидания. 
ОШИБКА! Не удалось отправить сообщение 7. Истекло время ожидания.
Сообщение 1. Создано в 19:40:57.624. Получено в 19:40:59.649.
ОШИБКА! Не удалось отправить сообщение 9. Истекло время ожидания.
Сообщение 2. Создано в 19:40:57.624. Получено в 19:41:01.651.
Сообщение 3. Создано в 19:40:57.624. Получено в 19:41:03.651.
Сообщение 4. Создано в 19:40:57.624. Получено в 19:41:05.652.
Сообщение 5. Создано в 19:40:57.624. Получено в 19:41:07.652.
Сообщение 8. Создано в 19:40:59.642. Получено в 19:41:09.652.
Всего сообщений отправлено: 6
Всего сообщений получено: 6

Теперь давайте разберёмся, как работает этот пример. Здесь чтение из очереди умышленно делается очень медленно, раз в 2 секунды. А записывающий поток пытается записать всё сразу. У него бы и получилось записать сразу все 9 сообщений, но у нас установлено ограничение на максимальный размер очереди – всего 5 элементов. Поэтому он записывает первые пять сообщений сразу, а при попытке записать шестое сообщение зависает в ожидании, пока в очереди не освободится место. Но мы опять же специально ограничили время ожидания всего одной секундой, поэтому через секунду он перестаёт ждать и выдаёт ошибку. То же самое происходит и со следующим седьмым сообщением. А вот к моменту отправки восьмого сообщения в очереди появляется свободное место и сообщение успешно записывается. С девятым опять случается неудача, потому, что только что на свободное место было записано сообщение 8 и очередь опять заполнена, а чтение происходит ну оооочень медленно…

Если будете плотно использовать этот класс, то вам может пригодиться ещё функция DoShutDown, которая объявляет, что очередь остановлена (после вызова этой функции новые элементы в очередь не добавляются, т.е. при вызове метода PushItem ничего не происходит), и свойство ShutDown, с помощью которого вы можете проверить, остановлена очередь или нет. Здесь нужно заметить, что после остановки очереди вы всё равно сможете считать попавшие туда элементы.

И в заключении об использовании стандартных дженериков Delphi.

..

…можно сказать следующее. Рассмотренные в статье дженерики или универсальные типы очень сильно облегчают программирование. Ведь массивы, списки и словари используются в программировании постоянно. А при использовании дженериков вы облегчаете читабельность кода. Кроме того ошибки несоответствия добавляемых типов в такие словари или списки отлавливаются ещё на этапе компиляции. Кроме того каждый из рассмотренных классов специально оптимизирован для выполнения возложенной на него задачи. Так, что если вы ещё не используете дженерики, настала пора это сделать.

Функции даты-времени в VBA. Работа с датой и временем

Функции даты и времени VBScript помогают разработчикам преобразовывать дату и время из одного формата в другой или выражать дату или время в формате, соответствующем определенному условию.

Date

Функция возвращает текущую системную дату.

Синтаксис

date()

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   Dim a as Variant
   a = date()
   msgbox "The Value of a : " & a
End Sub

Когда вы выполняете функцию, она производит следующий вывод.

The Value of a : 19/07/2014

Функция, которая возвращает текущую системную дату.

CDate

Функция преобразует действительное выражение даты и времени для ввода даты.

Синтаксис

cdate(date)

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   Dim a As Variant
   Dim b As Variant
   
   a = CDate("Янв 01 2020")
   MsgBox ("The Value of a : " & a)
   
   b = CDate("31 Дек 2050")
   MsgBox ("The Value of b : " & b)
End Sub

Когда вы выполняете функцию, она производит следующий вывод.

The Value of a : 1/01/2020
The Value of b : 31/12/2050

Функция, которая преобразует данный вход в дату.

DateAdd

Функция, которая возвращает дату, к которой был добавлен указанный временной интервал.

Синтаксис

DateAdd(interval,number,date)

Параметр/Описание

• Интервал — требуемый параметр. Он может принимать следующие значения.
• d — день года
• м — месяц года
• y — год года
• yyyy — year
• w — день недели
• ww — неделя
• q — квартал
• час — час
• м — минута
• s — секунда
• Номер — требуемый параметр. Он может принимать как положительные, так и отрицательные параметры.
• Дата — требуемый параметр. Вариант или литерал, представляющий дату добавления интервала.

пример

Sub Constant_demo_Click()
   ' Positive Interal
   date1 = 1 - Jan - 2013
   MsgBox ("Line 1 : " & DateAdd("yyyy", 1, date1))
   MsgBox ("Line 2 : " & DateAdd("q", 1, date1))
   MsgBox ("Line 3 : " & DateAdd("m", 1, date1))
   MsgBox ("Line 4 : " & DateAdd("y", 1, date1))
   MsgBox ("Line 5 : " & DateAdd("d", 1, date1))
   MsgBox ("Line 6 : " & DateAdd("w", 1, date1))
   MsgBox ("Line 7 : " & DateAdd("ww", 1, date1))
   MsgBox ("Line 8 : " & DateAdd("h", 1, "01-Янв-2013 12:00:00"))
   MsgBox ("Line 9 : " & DateAdd("n", 1, "01-Янв-2013 12:00:00"))
   MsgBox ("Line 10 : " & DateAdd("s", 1, "01-Янв-2013 12:00:00"))
  
   ' Negative Interval
   MsgBox ("Line 11 : " & DateAdd("yyyy", -1, date1))
   MsgBox ("Line 12 : " & DateAdd("q", -1, date1))
   MsgBox ("Line 13 : " & DateAdd("m", -1, date1))
   MsgBox ("Line 14 : " & DateAdd("y", -1, date1))
   MsgBox ("Line 15 : " & DateAdd("d", -1, date1))
   MsgBox ("Line 16 : " & DateAdd("w", -1, date1))
   MsgBox ("Line 17 : " & DateAdd("ww", -1, date1))
   MsgBox ("Line 18 : " & DateAdd("h", -1, "01-Янв-2013 12:00:00"))
   MsgBox ("Line 19 : " & DateAdd("n", -1, "01-Янв-2013 12:00:00"))
   MsgBox ("Line 20 : " & DateAdd("s", -1, "01-Янв-2013 12:00:00"))
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод.

Line 1 : 27/06/1895
Line 2 : 27/09/1894
Line 3 : 27/07/1894
Line 4 : 28/06/1894
Line 5 : 28/06/1894
Line 6 : 28/06/1894
Line 7 : 4/07/1894
Line 8 : 1/01/2013 1:00:00 PM
Line 9 : 1/01/2013 12:01:00 PM
Line 10 : 1/01/2013 12:00:01 PM
Line 11 : 27/06/1893
Line 12 : 27/03/1894
Line 13 : 27/05/1894
Line 14 : 26/06/1894
Line 15 : 26/06/1894
Line 16 : 26/06/1894
Line 17 : 20/06/1894
Line 18 : 1/01/2013 11:00:00 AM
Line 19 : 1/01/2013 11:59:00 AM
Line 20 : 1/01/2013 11:59:59 AM

Функция, которая возвращает дату, к которой был добавлен указанный временной интервал.

DateDiff

Функция, которая возвращает разницу между двумя заданными временными интервалами.

Синтаксис

DateDiff(interval, date1, date2 [,firstdayofweek[, firstweekofyear]])

Параметр/Описание

• Интервал — требуемый параметр. Он может принимать следующие значения.
• d — день года
• м — месяц года
• y — год года
• yyyy — year
• w — день недели
• ww — неделя
• q — квартал
• час — час
• м — минута
• s — секунда
• Date1 и Date2 — Необходимые параметры.
• Firstdayofweek — необязательный параметр. Задает первый день недели. Он может принимать следующие значения.
• 0 = vbUseSystemDayOfWeek — настройка API поддержки национальных языков (NLS)
• 1 = vbSunday — воскресенье
• 2 = vbMonday — понедельник
• 3 = vbTuesday — вторник
• 4 = vbWednesday — среда
• 5 = vbThursday — четверг
• 6 = vbFriday — пятница
• 7 = vbSaturday — суббота
• Firstdayofyear — необязательный параметр. Указывает на первый день года. Он может принимать следующие значения.
• 0 = vbUseSystem — настройка API поддержки национальных языков (NLS)
• 1 = vbFirstJan1 — начать с недели, в которой происходит 1 января (по умолчанию)
• 2 = vbFirstFourDays — Начните с недели, которая имеет не менее четырех дней в новом году
• 3 = vbFirstFullWeek — начните с первой полной недели нового года

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   Dim fromDate As Variant
   fromDate = "01-Янв-09 00:00:00"
   
   Dim toDate As Variant
   toDate = "01-Янв-10 23:59:00"
   
   MsgBox ("Line 1 : " & DateDiff("yyyy", fromDate, toDate))
   MsgBox ("Line 2 : " & DateDiff("q", fromDate, toDate))
   MsgBox ("Line 3 : " & DateDiff("m", fromDate, toDate))
   MsgBox ("Line 4 : " & DateDiff("y", fromDate, toDate))
   MsgBox ("Line 5 : " & DateDiff("d", fromDate, toDate))
   MsgBox ("Line 6 : " & DateDiff("w", fromDate, toDate))
   MsgBox ("Line 7 : " & DateDiff("ww", fromDate, toDate))
   MsgBox ("Line 8 : " & DateDiff("h", fromDate, toDate))
   MsgBox ("Line 9 : " & DateDiff("n", fromDate, toDate))
   MsgBox ("Line 10 : " & DateDiff("s", fromDate, toDate))
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод.

Line 1 : 1
Line 2 : 4
Line 3 : 12
Line 4 : 365
Line 5 : 365
Line 6 : 52
Line 7 : 52
Line 8 : 8783
Line 9 : 527039
Line 10 : 31622340

Функция, которая возвращает разницу между двумя периодами времени.

DatePart

Функция, возвращающая определенную часть данной даты.

Синтаксис

DatePart(interval,date[,firstdayofweek[,firstweekofyear]])

Параметр/Описание

• Интервал — требуемый параметр. Он может принимать следующие значения.
• d — день года
• м — месяц года
• y — год года
• yyyy — year
• w — день недели
• ww — неделя
• q — квартал
• час — час
• м — минута
• s — секунда
• Date1 — обязательный параметр.
• Firstdayofweek — необязательный параметр. Задает первый день недели. Он может принимать следующие значения.
• 0 = vbUseSystemDayOfWeek — настройка API поддержки национальных языков (NLS)
• 1 = vbSunday — воскресенье
• 2 = vbMonday — понедельник
• 3 = vbTuesday — вторник
• 4 = vbWednesday — среда
• 5 = vbThursday — четверг
• 6 = vbFriday — пятница
• 7 = vbSaturday — суббота
• Firstdayofyear — необязательный параметр. Указывает на первый день года. Он может принимать следующие значения.
• 0 = vbUseSystem — настройка API поддержки национальных языков (NLS)
• 1 = vbFirstJan1 — начать с недели, в которой происходит 1 января (по умолчанию)
• 2 = vbFirstFourDays — Начните с недели, которая имеет не менее четырех дней в новом году
• 3 = vbFirstFullWeek — начните с первой полной недели нового года

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   Dim Quarter As Variant
   Dim DayOfYear As Variant
   Dim WeekOfYear As Variant
  
   Date1 = "2013-01-15"
   Quarter = DatePart("q", Date1)
   
   MsgBox ("Line 1 : " & Quarter)
   DayOfYear = DatePart("y", Date1)
   
   MsgBox ("Line 2 : " & DayOfYear)
   WeekOfYear = DatePart("ww", Date1)
   
   MsgBox ("Line 3 : " & WeekOfYear)
   MsgBox ("Line 4 : " & DatePart("m", Date1))
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод.

Line 1 : 1
Line 2 : 15
Line 3 : 3
Line 4 : 1

Функция, возвращающая указанную часть заданного значения даты ввода.

DateSerial

Функция, которая возвращает дату для заданных параметров дня, месяца и года.

Синтаксис

DateSerial(year,month,day)

Параметр/Описание

• Год — требуемый параметр. Число от 100 до 9999 или числовое выражение. Значения от 0 до 99 интерпретируются как годы с 1900 по 1999 год. Для всех аргументов за другой год используйте полный четырехзначный год.
• Месяц — требуемый параметр. Он также может быть в форме выражения, которое должно варьироваться от 1 до 12.
• День — требуемый параметр. Он также может быть в форме выражения, которое должно варьироваться от 1 до 31.

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   msgbox(DateSerial(2013,5,10))
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод.

10/05/2013

Функция, которая возвращает действительную дату для данного года, месяца и даты.

FormatDateTime

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

Синтаксис

FormatDateTime(date,format)

Параметр/Описание

• Дата — требуемый параметр.
• Формат — необязательный параметр. Значение, определяющее формат даты или времени, который будет использоваться. Он может принимать следующие значения.
• 0 = vbGeneralDate — Default
• 1 = vbLongDate — дата возврата
• 2 = vbShortDate — Дата возврата
• 3 = vbLongTime — возвращает время
• 4 = vbShortTime — возвращает время

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   d = ("2013-08-15 20:25")
   msgbox("Line 1 : " & FormatDateTime(d))
   msgbox("Line 2 : " & FormatDateTime(d,1))
   msgbox("Line 3 : " & FormatDateTime(d,2))
   msgbox("Line 4 : " & FormatDateTime(d,3))
   msgbox("Line 5 : " & FormatDateTime(d,4))
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод.

Line 1 : 15/08/2013 8:25:00 PM
Line 2 : Thursday, 15 August 2013
Line 3 : 15/08/2013
Line 4 : 8:25:00 PM
Line 5 : 20:25

Функция, которая форматирует дату на основе поставляемых параметров.

IsDate

Функция, возвращающая логическое значение, независимо от того, является ли данный ввод датой.

Синтаксис

IsDate(expression)

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   msgbox("Line 1 : " & IsDate("Nov 03, 1950"))
   msgbox("Line 2 : " & IsDate(#01/31/20#))
   msgbox("Line 3 : " & IsDate(#05/31/20 10:30 PM#))
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод.

Line 1 : True
Line 2 : True
Line 3 : True

Функция, возвращающая логическое значение, независимо от того, является ли поставленный параметр датой.

Day

Функция «День» возвращает число от 1 до 31, которое представляет день указанной даты.

Синтаксис

Day(date)

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   msgbox(Day("2013-06-30"))
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод.

30

Функция, которая возвращает целое число от 1 до 31, которое представляет день указанной даты.

Month

Функция Month возвращает число от 1 до 12, которое представляет месяц указанной даты.

Синтаксис

Month(date)

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   msgbox(Month("2013-06-30"))
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод.

6

Функция, которая возвращает целое число от 1 до 12, которое представляет месяц указанной даты.

Year

Функция Год возвращает целое число, которое представляет год указанной даты.

Синтаксис

Year(date)

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   msgbox(Year("2013-06-30"))
End sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод.

2013

Функция, которая возвращает целое число, которое представляет год указанной даты.

MonthName

Функция MonthName возвращает имя месяца для указанной даты.

Синтаксис

MonthName(month[,toabbreviate])

Параметр Описание

• Месяц — требуемый параметр. Он определяет номер месяца.
• Toabbreviate — необязательный параметр. Булевское значение, указывающее, следует ли сокращать имя месяца. Если оставить пустым, значение по умолчанию будет считаться False.

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   msgbox("Line 1 : " & MonthName(01,True))
   msgbox("Line 2 : " & MonthName(01,false))
   msgbox("Line 3 : " & MonthName(07,True))
   msgbox("Line 4 : " & MonthName(07,false))
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод.

Line 1 : Jan
Line 2 : January
Line 3 : Jul
Line 4 : July

Функция, которая возвращает имя определенного месяца за указанную дату.

WeekDay

Функция WeekDay возвращает целое число от 1 до 7, которое представляет день недели для указанной даты.

Синтаксис

Weekday(date[,firstdayofweek])

Параметр/Описание

Дата — требуемый параметр. День недели вернет указанную дату. Firstdayofweek — необязательный параметр. Задает первый день недели. Он может принимать следующие значения. 0 = vbUseSystemDayOfWeek — настройка API поддержки национальных языков (NLS) 1 = vbSunday — воскресенье 2 = vbMonday — понедельник 3 = vbВперед — вторник 4 = vbWednesday — среда 5 = vbThursday — четверг 6 = vbFriday — пятница 7 = vbSaturday — суббота

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   msgbox("Line 1: " & Weekday("2013-05-16",1))
   msgbox("Line 2: " & Weekday("2013-05-16",2))
   msgbox("Line 3: " & Weekday("2013-05-16",2))
   msgbox("Line 4: " & Weekday("2010-02-16"))
   msgbox("Line 5: " & Weekday("2010-02-17"))
   msgbox("Line 6: " & Weekday("2010-02-18"))
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод.

Line 1: 5 Line 2: 4 Line 3: 4 Line 4: 3 Line 5: 4 Line 6: 5

Функция, которая возвращает целое число (от 1 до 7), которое представляет день недели в течение указанного дня.

WeekDayName

Функция WeekDayName возвращает имя дня недели за указанный день.

Синтаксис WeekdayName(weekday[,abbreviate[,firstdayofweek]])

Параметр — Описание

• Weekday — требуемый параметр. Номер дня недели.
• Toabbreviate — необязательный параметр. Булевское значение, указывающее, следует ли сокращать имя месяца. Если оставить пустым, значение по умолчанию будет считаться False.
• Firstdayofweek — необязательный параметр. Задает первый день недели.
• 0 = vbUseSystemDayOfWeek — настройка API поддержки национальных языков (NLS)
• 1 = vbSunday — воскресенье
• 2 = vbMonday — понедельник
• 3 = vbTuesday — вторник
• 4 = vbWednesday — среда
• 5 = vbThursday — четверг
• 6 = vbFriday — пятница
• 7 = vbSaturday — суббота

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   msgbox("Line 1 : " & WeekdayName(3))
   msgbox("Line 2 : " & WeekdayName(2,True))
   msgbox("Line 3 : " & WeekdayName(1,False))
   msgbox("Line 4 : " & WeekdayName(2,True,0))
   msgbox("Line 5 : " & WeekdayName(1,False,1))
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод.

Line 1 : Tuesday
Line 2 : Mon
Line 3 : Sunday
Line 4 : Tue
Line 5 : Sunday

Функция, которая возвращает имя дня недели для указанного дня.

Now

Функция Now возвращает текущую системную дату и время.

Синтаксис

Now()

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   Dim a as Variant
   a = Now()
   msgbox("The Value of a : " & a)
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод. The Value of a : 19/07/2013 3:04:09 PM

Функция, которая возвращает текущую системную дату и время.

Hour

Функция Hour возвращает число от 0 до 23, которое представляет час дня для указанной отметки времени.

Синтаксис

Hour(time)

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   msgbox("Line 1: " & Hour("3:13:45 PM"))
   msgbox("Line 2: " & Hour("23:13:45"))
   msgbox("Line 3: " & Hour("2:20 PM"))
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод.

Line 1: 15
Line 2: 23
Line 3: 14

Функция, которая возвращает целое число от 0 до 23, которое представляет часовую часть заданного времени.

Minute

Функция Minute возвращает число от 0 до 59, которое представляет минуту часа для указанной отметки времени.

Синтаксис

Minute(time)

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   msgbox("Line 1: " & Minute("3:13:45 PM"))
   msgbox("Line 2: " & Minute("23:43:45"))
   msgbox("Line 3: " & Minute("2:20 PM"))
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод.

Line 1: 13
Line 2: 43
Line 3: 20

Функция, возвращающая целое число от 0 до 59, которое представляет минутную часть данного времени.

Second

Функция возвращает число от 0 до 59, которое представляет вторую часть часа для указанной отметки времени.

Синтаксис

Second(time)

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   msgbox("Line 1: " & Second("3:13:25 PM"))
   msgbox("Line 2: " & Second("23:13:45"))
   msgbox("Line 3: " & Second("2:20 PM"))
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод. Line 1: 25
Line 2: 45
Line 3: 0

Функция, возвращающая целое число от 0 до 59, которое представляет собой секундную часть данного времени.

Time

Функция времени возвращает текущее системное время.

Синтаксис

Time()

пример

Sub Constant_demo_Click()
   msgbox("Line 1: " & Time())
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод.

Line 1: 3:29:15 PM

Функция, которая возвращает текущее системное время.

Timer

Функция таймера возвращает число секунд и миллисекунд с 12:00.

Синтаксис

Timer()

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   msgbox("Time is : " & Now())
   msgbox("Timer is: " & Timer())
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод.

Time is : 19/07/2013 3:45:53 PM
Timer is: 56753.4

Функция, которая возвращает число секунд и миллисекунд с 12:00.

TimeSerial

Функция TimeSerial возвращает время для указанных часов, минут и вторых значений.

Синтаксис

TimeSerial(hour,minute,second)

Параметр/Описание

• Hour — обязательный параметр, который представляет собой целое число от 0 до 23 или любое числовое выражение.
• Minute — обязательный параметр, который представляет собой целое число от 0 до 59 или любое числовое выражение.
• Second — обязательный параметр, который представляет собой целое число от 0 до 59 или любое числовое выражение.

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click()
   msgbox(TimeSerial(20,1,2))
   msgbox(TimeSerial(0,59,59))
   msgbox(TimeSerial(7*2,60/3,15+3))
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод.

8:01:02 PM
12:59:59 AM
2:20:18 PM

Функция, которая возвращает время для конкретного ввода часа, минуты и секунды.

TimeValue

Функция TimeValue преобразует заданную входную строку в допустимое время.

Синтаксис

TimeValue(StringTime)

пример

Добавьте кнопку и добавьте следующую функцию.

Sub Constant_demo_Click() 
   msgbox(TimeValue("20:30"))
   msgbox(TimeValue("5:15"))
   msgbox(TimeValue("2:30:58"))
End Sub

Когда вы выполняете вышеуказанную функцию, она производит следующий вывод.

8:30:00 PM
5:15:00 AM
2:30:58 AM

Функция, которая преобразует входную строку в формат времени.

 С уважением, авторы сайта Компьютерапия

Понравилась статья? Поделитесь ею с друзьями и напишите отзыв в комментариях!

Быстрая обработка данных Excel в Delphi.

Праздники ещё не закончились, работать лень, но надо как-то уже прекращать заниматься кишкоблудством и начинать работать в полную силу. Ну, а чтобы как-то себя расшевелить и начать уже работу в блоге, решил первый пост сделать простым – снова сказать несколько слов про Excel. Дело в том, что с момента выхода поста под названием “Работа с Excel в Delphi. Основы основ.” прошло практически полтора года и этот пост (почему-то вопреки всем ожиданиям) очень прочно закрепился в выдаче поисковиков. Это, конечно хорошо, но этот пост (читай название) дает лишь небольшое представление о том как работать с Excel в Delphi. Никто ведь не изучает сразу квантовую механику с первого класса? Сначала учимся основам вообще – математика, физика и т.д. Так я решил поступить в начале рассказа про Excel – сначала дать общее представление, а потом потихоньку раскрывать тему более подробно и детально. Но поисковики немного спутали карты, подняв пост выше других про Excel. Соответственно, те из посетителей, кто уже имеют представление о работе с Excel, видя представленные в статье примеры, возмущаются по поводу того, что чтение данных в этом случае будет происходить медленно. И я не спорю, да проход по каждой ячейке листа – это жуткие тормоза. А ускорить процесс чтения можно и необходимо. Поэтому можно считать, что эта статья – расширение к основам.

За полтора года мне предлагали кучу вариантов того как ускорить чтение данных с листа Excel – от использования MSXML и других готовых библиотек до самопальных процедур и функций. Что ж, любую задачу можно решить несколькими способами. Рассмотрим несколько вариантов и определимся какой из вариантов окажется наиболее быстрым. Ну, а какой вариант окажется более удобным – это уже каждый решит для себя сам.

Чтение данных из Excel

Вначале рассмотрим вариант чтения данных использованием которого грешат те, кто только начинает свое знакомство с Excel в Delphi – чтение данных из каждой ячейки по отдельности. Тестовая процедура с таким вариантом чтения может выглядеть следующим образом:

procedure TForm16.SlowVariant;
var Rows, Cols, i,j: integer;
    WorkSheet: OLEVariant;
    d: TDateTime;
begin
  //открываем книгу
  ExcelApp. Workbooks.Open(edFile.Text);
  //получаем активный лист
  WorkSheet:=ExcelApp.ActiveWorkbook.ActiveSheet;
  //определяем количество строк и столбцов таблицы
  Rows:=WorkSheet.UsedRange.Rows.Count;
  Cols:=WorkSheet.UsedRange.Columns.Count;
 
  StringGrid1.RowCount:=Rows;
  StringGrid1.ColCount:=Cols;
 
  //засекаем время начала чтения
  d:=Now;
 
  //выводим данные в таблицу
  for I := 0 to Rows-1 do
    for j := 0 to Cols-1 do
        StringGrid1.Cells[J,I]:=WorkSheet.UsedRange.Cells[I+1,J+1].Value;
 
 Label2.Caption:='Время чтения всего листа: '+FormatDateTime('hh:mm:ss:zzz',
    Now()-d);
end;

Счётчик будет в итоге содержать время чтения и вывода в StringGrid данных. Можно было бы сделать счётчик исключительно на чтение данных с листа, но я решил не перегружать исходник лишними переменными. Если будет желание – можете переписать чуть-чуть исходник и получить “чистое” время чтения.

Для теста этого варианта был создан лист Excel, содержащий 143 строки и 142 столбца с данными, т. е. 20306 ячеек с данными. На рисунке ниже представлено значение счётчика после чтения данных:

12 секунд на чтение…а если будет 1000 строк и 1000 столбцов? Так можно и не дождаться окончания операции.

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

На деле реализация этого варианты работы окажется даже проще, чем представленного выше. Смотрите сами. Вот вариант чтения данных целым диапазоном:

procedure TForm16.RangeRead;
var Rows, Cols, i,j: integer;
    WorkSheet: OLEVariant;
    FData: OLEVariant;
    d: TDateTime;
begin
  //открываем книгу
  ExcelApp. Workbooks.Open(edFile.Text);
  //получаем активный лист
  WorkSheet:=ExcelApp.ActiveWorkbook.ActiveSheet;
  //определяем количество строк и столбцов таблицы
  Rows:=WorkSheet.UsedRange.Rows.Count;
  Cols:=WorkSheet.UsedRange.Columns.Count;
 
  //считываем данные всего диапазона
  FData:=WorkSheet.UsedRange.Value;
 
  StringGrid1.RowCount:=Rows;
  StringGrid1.ColCount:=Cols;
 
//засекаем время начала чтения
  d:=Now;
 
//выводим данные в таблицу
  for I := 0 to Rows-1 do
    for j := 0 to Cols-1 do
        StringGrid1.Cells[J,I]:=FData[I+1,J+1];
 
    Label2.Caption:='Время чтения всего листа: '+FormatDateTime('hh:mm:ss:zzz',
    Now()-d);
end;

Здесь мы ввели всего одну переменную FData типа Variant. В эту переменную мы прочитали за 1 операцию весь диапазон, занятый данными. После того как диапазон прочитан FData будет содержать матрицу, каждый элемент которой будет типом данных, определенным в Excel.

Смотрим на время выполнения операции:

Как видите, прирост скорости оказался колоссальным, учитывая даже то, что в счётчик попало время обновления StringGrid’а.

Здесь было бы уместно показать и обратный метод работы с Excel, т.е. запись данных на лист Excel с использованием вариантного массива.

Запись данных в Excel

В случае, если нам необходимо записать большой объем данных на лист Excel нам необходимо провести обратную операцию, т.е. вначале создать вариантный массив, затем записать в этот массив данные после чего записать весь массив одной операцией в Excel. Для примера я написал процедуру, которая считывает большой объем данных из StringGrid и записывает эти данные на второй лист открытой книги Excel:

procedure TForm16.WriteData;
var i,j: integer;
    FData: Variant;
    Sheet,Range: Variant;
begin
//создаем вариантный массив
  FData:=VarArrayCreate([1,StringGrid1.RowCount,1,StringGrid1.ColCount],varVariant);
//заполняем массив данными из StringGrid
  for i:=1 to VarArrayHighBound(FData,1) do
    for j:=1 to VarArrayHighBound(FData,2) do
      FData[i,j]:=StringGrid1.Cells[J-1,I-1];
{активируем второй лист книги}
//открываем книгу
ExcelApp. Workbooks.Open(edFile.Text);
//активируем
Sheet:=ExcelApp.ActiveWorkBook.Sheets[2];
Sheet.Activate;
//выделяем диапазон для вставки данных
Range:=Sheet.Range[Sheet.Cells[1,1],Sheet.Cells[VarArrayHighBound(FData,1),VarArrayHighBound(FData,2)]];
//вставляем данные
Range.Value:=FData;
//показываем окно Excel
ExcelApp.Visible:=True;
end;

Здесь мы вначале создаем двумерный вариантный массив, используя метод VarArrayCreate, после чего заполняем массив данным и передаем этот массив в Excel. Обратите внимание, что при записи в Excel не используются никакие циклы – запись происходит в 2 простых действия:

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

Для полноты картины ниже на рисунке представлено значение счётчика, который отсчитал время от момента создания массива до активации приложения Excel включительно:

Естественно, что с ростом объема данных будет расти и время выполнения операции. Так, например, лист, содержащий 1000 строк и 256 столбцов с данными заполнялся около 7 секунд. Если для Вас такое время неприемлемо, то представленная выше процедура может быть немного ускорена использованием пары методов VarArrayLock() и VarArrayUnLock(), но при этом следует учитывать, что матрица FData будет транспонирована.

Что ещё стоит сказать по поводу чтения/записи данных в Excel? Наверное то, что предложенные выше методы работы в обязательном порядке требуют наличия установленного Excel на том компьютере где запускается Ваша программа. В связи с этим обстоятельством может потребоваться более универсальный способ работы с Excel. Здесь, опять же, может быть несколько вариантов работы, но я покажу, а точнее укажу только на один из них – с использованием библиотека XLSReadWrite.

Про эту библиотеку мне поведал один из читателей блога в комментарии как раз-таки к посту “”Работа с Excel в Delphi. Основы основ“. Чтобы лишний раз Вас не переправлять на комментарий с примером использования этой библиотеки, я с разрешения GS (ник автора кода) просто опубликую здесь уже готовые примеры использования библиотеки XLSReadWrite:

Упрощенный пример для Delphi 7

var
  IntlXls: TXLSReadWriteII2;
  I, J: Integer;
 
begin
  // создаем объект
  IntlXls := TXLSReadWriteII2. Create(nil);
 
  // название книги
  IntlXls.Sheets[0].Name := ‘ Название моего отчета ’;
  // добавляем необходимое количество строк и колонок
  IntlXls.Sheets[0].Rows.AddIfNone(0, 10000);
  IntlXls.Sheets[0].Columns.AddIfNone(0, 100);
 
  // добавляем и заносим ширины ячеек (значение в пикселях)
  for I := 0 to 99 do
    IntlXls.Sheets[0].Columns[I].PixelWidth := 150;
  // заносим высоты строк (значение здесь не в пикселях, поэтому нужно корректировать)
  for I := 0 to 9999 do
    IntlXls.Sheets[0].Rows[I].Height := 20 * 14;
 
  // настраиваем
  for J := 0 to 9999 do
    for I := 0 to 99 do
    begin
      // заносим числовое значение
      // если нужно например занести строку, то использовать AsString
      IntlXls.Sheets[0].AsFloat[I, J] := J + I / 100;
 
      // выравнивание по горизонтали (доступно chaLeft, chaCenter, chaRight)
      IntlXls.Sheets[0].Cell[I, J].HorizAlignment := chaLeft;
 
      // выравнивание по вертикали (доступно cvaTop, cvaCenter, cvaBottom)
      IntlXls. Sheets[0].Cell[I, J].VertAlignment := cvaTop;
 
      // шрифт
      IntlXls.Sheets[0].Cell[I, J].FontName := ‘ Arial ’;
      IntlXls.Sheets[0].Cell[I, J].FontSize := 12;
      IntlXls.Sheets[0].Cell[I, J].FontStyle := [];
      IntlXls.Sheets[0].Cell[I, J].FontColor := TColorToClosestXColor(clBlue);
      IntlXls.Sheets[0].Cell[I, J].Rotation := 0;
      // жирное начертание
      with IntlXls.Sheets[0].Cell[I, J] do
        FontStyle := FontStyle + [xfsBold];
      // наклонное начертание
      with IntlXls.Sheets[0].Cell[I, J] do
        FontStyle := FontStyle + [xfsItalic];
      // цвет фона
      IntlXls.Sheets[0].Cell[I, J].FillPatternForeColor :=
        TColorToClosestXColor(clYellow);
 
      // бордюр слева (аналогично и остальные бордюры)
      IntlXls.Sheets[0].Cell[I, J].BorderLeftColor :=
        TColorToClosestXColor(clBlack);
      IntlXls.Sheets[0].Cell[I, J].BorderLeftStyle := cbsThin;
 
      // объединение ячеек (здесь объединяются две ячейки по горизонтали)
      if I = 49 then
        IntlXls. Sheets[0].MergedCells.Add(I, J, I + 1, J);
    end;
 
  IntlXls.SaveToFile(‘ c: \ demo.xls ’);
  IntlXls.Free;
end;

Полный пример работы с библиотекой:

function ExportToExcelXls(var AFileName: string): Integer;
var
  IntlXls: TXLSReadWriteII2;
  IntlCol: Integer;
  IntlRow: Integer;
  IntlMainCol: Integer;
  IntlMainRow: Integer;
begin
  // инициализируем статус
  prgrbrStatus.Max := FLinkReport.RowCount;
  prgrbrStatus.Position := 0;
  pnlStatus.Visible := TRUE;
  pnlStatus.Refresh;
  // добавлено в конце имени файла расширение ‘.XLS’?
  if Length(AFileName) < 5 then
    // добавляем
    AFileName := AFileName + ‘.xls ’
  else if AnsiCompareText(Copy(AFileName, Length(AFileName)— 3, 4), ‘.xls ’) <> 0
  then
    // добавляем
    AFileName := AFileName + ‘.xls ’;
  // файл уже существует?
  if FileExists(AFileName) then
    // спросим
    if Application.MessageBox
      (PChar(‘ Файл « ‘ + AFileName + ‘ » уже существует.Перезаписать ? ’),
      ‘ Внимание ’, MB_TASKMODAL + MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON2)
      <> IDYES then
    // выходим
    begin
      // код ошибки
      Result := UNIRPT_GENERATE_ABORT;
 
      // выходим
      Exit;
    end; // if
  // создаем объект
  IntlXls := TXLSReadWriteII2. Create(nil);
  // все делаем защищаясь
  try
    // название книги
    IntlXls.Sheets[0].Name := FLinkReport.Caption;
    // добавляем необходимое количество строк и колонок
    IntlXls.Sheets[0].Rows.AddIfNone(0, FLinkReport.Cells.RowCount + 1);
    IntlXls.Sheets[0].Columns.AddIfNone(0, FLinkReport.Cells.ColCount + 1);
    // добавляем и заносим ширины ячеек
    for IntlCol := 0 to FLinkReport.Cells.ColCount — 1 do
      IntlXls.Sheets[0].Columns[IntlCol].PixelWidth :=
        FLinkReport.ColWidths[IntlCol];
    // заносим высоты строк
    for IntlRow := 0 to FLinkReport.Cells.RowCount — 1 do
      IntlXls.Sheets[0].Rows[IntlRow].Height := FLinkReport.RowHeights
        [IntlRow] * 14;
    // проходим по всем строкам
    for IntlRow := 0 to FLinkReport.Cells.RowCount — 1 do
    begin
      // проходим по всем колонкам
      for IntlCol := 0 to FLinkReport.Cells.ColCount — 1 do
      begin
        // определяем главную ячейку
        IntlMainCol := IntlCol + FLinkReport.Cells[IntlCol, IntlRow]. Range.Left;
        IntlMainRow := IntlRow + FLinkReport.Cells[IntlCol, IntlRow].Range.Top;
        // заносим оформление
        with FLinkReport.Cells[IntlMainCol, IntlMainRow] do
        begin
          // главная ячейка?
          if (IntlMainCol = IntlCol) and (IntlMainRow = IntlRow) then
          // да, заносим текст и его оформление
          begin
            // значение
            try
              // если значение — число то заносим его как число
              IntlXls.Sheets[0].AsFloat[IntlCol, IntlRow] := StrToFloat(Value);
            except
              // иначе заносим его как строку
              IntlXls.Sheets[0].AsString[IntlCol, IntlRow] := Value;
            end;
 
            // выравнивание по горизонтали
            case HorizAlign of
              haLeft:
                // выравнивание слева
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].HorizAlignment
                  := chaLeft;
              haCenter:
                // выравнивание по центру
                IntlXls. Sheets[0].Cell[IntlCol, IntlRow].HorizAlignment :=
                  chaCenter;
              haRight:
                // выравнивание справа
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].HorizAlignment
                  := chaRight;
            end; // case
            // выравнивание по вертикали
            case VertAlign of
              vaTop:
                // выравнивание сверху
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].VertAlignment
                  := cvaTop;
              vaCenter:
                // выравнивание в центре
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].VertAlignment :=
                  cvaCenter;
              vaBottom:
                // выравнивание снизу
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].VertAlignment :=
                  cvaBottom;
            end; // case
            // шрифт
            IntlXls.Sheets[0].Cell[IntlCol, IntlRow].FontName := Font.Name;
            IntlXls.Sheets[0].Cell[IntlCol, IntlRow]. FontSize := Font.Size;
            IntlXls.Sheets[0].Cell[IntlCol, IntlRow].FontCharset :=
              Font.Charset;
            IntlXls.Sheets[0].Cell[IntlCol, IntlRow].FontStyle := [];
            IntlXls.Sheets[0].Cell[IntlCol, IntlRow].FontColor :=
              TColorToClosestXColor(Font.Color);
            IntlXls.Sheets[0].Cell[IntlCol, IntlRow].Rotation := Font.Angle;
            // есть жирное начертание?
            if Font.IsBold then
              // есть
              with IntlXls.Sheets[0].Cell[IntlCol, IntlRow] do
                FontStyle := FontStyle + [xfsBold];
            // есть наклонное начертание?
            if Font.IsItalic then
              // есть
              with IntlXls.Sheets[0].Cell[IntlCol, IntlRow] do
                FontStyle := FontStyle + [xfsItalic];
            // цвет фона
            if Color <> clWindow then
              // цвет задан
              IntlXls.Sheets[0].Cell[IntlCol, IntlRow].FillPatternForeColor :=
                TColorToClosestXColor(Color);
          end // if
          else
            // просто активизируем ячейку (иначе ниже невозможно добавить бордюры)
            IntlXls. Sheets[0].AsString[IntlCol, IntlRow] := »;
 
          // бордюр слева есть?
          with Borders.Left do
            if LineHeight > 0 then
            // настраиваем
            begin
              // цвет
              IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderLeftColor :=
                TColorToClosestXColor(Color);
              // толщина
              if LineHeight = 1 then
                // тонка
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderLeftStyle
                  := cbsThin
              else if LineHeight in [1, 2] then
                // средняя толщина
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderLeftStyle :=
                  cbsMedium
              else
                // толстая
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderLeftStyle
                  := cbsHair;
            end; // if, with
          // бордюр сверху есть?
          with Borders.Top do
            if LineHeight > 0 then
            // настраиваем
            begin
              // цвет
              IntlXls. Sheets[0].Cell[IntlCol, IntlRow].BorderTopColor :=
                TColorToClosestXColor(Color);
              // толщина
              if LineHeight = 1 then
                // тонка
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderTopStyle
                  := cbsThin
              else if LineHeight in [1, 2] then
                // средняя толщина
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderTopStyle :=
                  cbsMedium
              else
                // толстая
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderTopStyle
                  := cbsHair;
            end; // if, with
          // бордюр справа есть?
          with Borders.Right do
            if LineHeight > 0 then
            // настраиваем
            begin
              // цвет
              IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderRightColor :=
                TColorToClosestXColor(Color);
              // толщина
              if LineHeight = 1 then
                // тонка
                IntlXls. Sheets[0].Cell[IntlCol, IntlRow].BorderRightStyle
                  := cbsThin
              else if LineHeight in [1, 2] then
                // средняя толщина
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderRightStyle :=
                  cbsMedium
              else
                // толстая
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderRightStyle
                  := cbsHair;
            end; // if, with
          // бордюр снизу есть?
          with Borders.Bottom do
            if LineHeight > 0 then
            // настраиваем
            begin
              // цвет
              IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderBottomColor :=
                TColorToClosestXColor(Color);
              // толщина
              if LineHeight = 1 then
                // тонка
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderBottomStyle
                  := cbsThin
              else if LineHeight in [1, 2] then
                // средняя толщина
                IntlXls. Sheets[0].Cell[IntlCol, IntlRow].BorderBottomStyle :=
                  cbsMedium
              else
                // толстая
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderBottomStyle
                  := cbsHair;
            end; // if, with
          // объединение нужно?
          if ((Range.Width > 1) or (Range.Height > 1)) and
            ((IntlMainCol = IntlCol) and (IntlMainRow = IntlRow)) then
            // объединяем
            IntlXls.Sheets[0].MergedCells.Add(IntlCol, IntlRow,
              IntlCol + Range.Width — 1, IntlRow + Range.Height — 1);
          // пользователь нажал кнопку прерывания экспорта?
          if btnCancel.Tag = 2 then
            // да, выходим
            Break;
        end; // with
      end; // for
      // обновляем статус
      prgrbrStatus.Position := prgrbrStatus.Position + 1;
      Application.ProcessMessages;
      // пользователь нажал кнопку прерывания экспорта?
      if btnCancel.Tag = 2 then
        // да, выходим
        Break;
    end; // for
    // пользователь нажал кнопку прерывания экспорта?
    if btnCancel. Tag <> 2 then
    // нет
    begin
      // на левый верхний угол
      IntlXls.Sheet[0].TopRow := 0;
      IntlXls.Sheet[0].LeftCol := 0;
      IntlXls.Sheet[0].Selection.ActiveRow := 0;
      IntlXls.Sheet[0].Selection.ActiveCol := 0;
 
      // статус
      prgrbrStatus.Position := prgrbrStatus.Max;
      Application.ProcessMessages;
      // записываем в файл
      IntlXls.FileName := AFileName;
      IntlXls.Write;
      // все успешно
      Result := UNIRPT_OK;
 
    end // if
    else
      // да
      Result := UNIRPT_GENERATE_ABORT;
 
  finally
    // освобождаем память
    IntlXls.Free;
  end; // try..finally
end; // function ExportToExcelXls

Вот такой подробный пример предоставил нам GS в своем комментарии. Спасибо ему за это. Мне же в заключении остается только добавить и подчеркнуть, что самые правильные ответы и примеры к вопросам, касающимся работы с Excel содержаться в Справке для разработчиков в самом Excel и надо только воспользоваться поиском. Например, если вам довольно часто приходится перетаскивать данные из базы данных в Excel и в работе используется ADO, то специально для таких случаев в справке рассказывается про интересный метод объекта Range под названием CopyFromRecordset, а если вам надо разукрасить свою таблицу Excel в разные цвета и установить разные виды границ ячеек, то специально для таких случаев в справке приводится подробные перечень всех перечислителей Excel’я.  В общем много чего есть – надо только этим воспользоваться и все получится. Ну, а если не получится, то милости прошу – задавайте вопросы здесь или на нашем форуме.

Книжная полка

Автор: Юрий Магда Название:Разработка приложений Microsoft Office 2007 в Delphi Описание Описаны общие подходы к программированию приложений MS Office. Даны программные методы реализации функций MS Excel, MS Word, MS Access и MS Outlook в среде Delphi.

 

3 1 голос

Рейтинг статьи

Набор компонентов для Delphi

Инструкция по установке компонентов на Delphi Набор компонентов на GitHub

Общие компоненты

• KRBLEdit – поле ввода с прикрепленной меткой
• KRBluetooth.pas – работа с блютуз устройством
• KRBoundLabel.pas – метка, которую можно прикрепить к любому визуальному компоненту
• KRCheckBox.pas – модифицированный TCheckBox
• KRCheckGroupBox – модифицированный TCheckGroupBox
• KRComboBox – модифицированный TComboBox
• KRComponentCollection – коллекция из TComponent
• KRImageList – модифицированный TImageList
• KRIniConfig – набор компонентов для работы с ini-файлом
• KRListView – модифицированный TListView
• KRNormalArray – компоненты для потокового расчета среднеарифметического значения
• KRProgressBar – модифицированный TProgressBar
• KRRadioButton – модифицированный TRadioButton
• KRThreadQueue – синхронизированная очередь
• KRThread – модифицированный TThread
• KRTimer – таймер
• KRValueEdit – поле для ввода числового значения
• KRVersionInfo – получение информации о приложении

Работа с файловой системой

• KRDriveComboBox – выпадающий список дисковых накопителей
• KRFileList – список файлов
• KROpenFolderDlg – диалоговое окно выбора папки

Сеть

• KRBTSocketClient – сокет клиент для передачи данных по bluetooth
• KRBTSocketServer – сокет сервер для передачи данных по bluetooth
• KRParser – класс для создания потоковых парсеров
• KRParserCfg – конфигурационные данные для KRParser
• KRSockets – набор компонентов для работы с сокетами
• KRTCPSocketClient – сокет клиент для передачи данных по протоколу TCP/IP
• KRTCPSocketServer – сокет сервер для передачи данных по протоколу TCP/IP
• KRUDPSocketServer – сокет сервер для передачи данных по протоколу UDP

Автоматизация

• KRBTConnector – клиент для передачи данных по bluetooth в потоке
• KRBtnVarUpdate – кнопка обновления переменной TKRVariable
• KRBTServer – сервер для передачи данных по bluetooth в потоке
• KRCOMPort – класс для работы с COM-портом
• KRCOMPortSets – форма настройки COM-порта
• KRCOMPortConnector – клиент для передачи данных через COM-порт в потоке
• KRConnector – набор классов для потоковых клиентов
• KRConnectorQueueBar – компонент на основе TKRProgressBar, отображающий уровень заполнения очереди коннектора
• KRField – поле для мониторинга и установки значения переменной TKRVariable
• KRIndicator – индикатор
• KRMBMon – мониторинг пакетов протокола Modbus
• KRMBRegIndex – компонент настройки Modbus регистра, устанавливает индекс
• KRMBRegInterval – компонент настройки Modbus регистра, устанавливает интервал обновления
• KRMBRegReadFunc – компонент настройки Modbus регистра, устанавливает функцию чтения
• KRMBRegs – компонент для отладки Modbus регистров
• KRMBRegWriteFunc – компонент настройки Modbus регистра, устанавливает функцию записи
• KRModbus – компонент для работы по протоколу Modbus
• KRModbusMaster – набор стандартных функций Modbus и инструментов для построения и обработки результата
• KRModbusClient – набор инструментов для управления удаленными переменными, связь с которыми осуществляется по средствам протокола Modbus
• KRNMEA0183 – компонент для работы по протоколу NMEA0183
• KRPlcIO – компонент для работы с файлами контроллеров ОВЕН
• KRServer – сервер для передачи данных в потоке
• KRSpeedInfo – компонент для отображения скорости
• KRTCPConnector – клиент для передачи данных по протоколу TCP/IP в потоке
• KRTCPServer – сервер для передачи данных по протоколу TCP/IP в потоке
• KRVariables – переменные, используются при сетевой передачи данных
• KRVarLabel – компонент для мониторинга значения переменной TKRVariable
• KRVButton – кнопка для установки значения переменной TKRVariable
• KRVCheckBox – checkbox для включения/выключения бита в переменной TKRVariable
• KRVCheckGroupBox – GroupBox с прикрепленным компонентом KRVCheckBox
• KRVComboBox – выпадающий список для установки значения переменной TKRVariable по индексу выбранного элемента

Web

• KRGoogleAuth – авторизация в Google, посредством протокола OAuth 2. 0
• KRGoogleContacts – работа с контактами через Google Contacts API
• KRGoogleSheets – работа с таблицами через Google Sheets API

Утилиты

• funcs – набор функция
• KRCRC – функции расчета crc-суммы
• KRHTMLParseUtils – набор функция для поиска в HTML коде
• KRStreamCoder – кодировка потока относительно кодового слова
• KRStrUtils – набор функций для работы со строками
• lgop – логические операции

Версия Delphi должна быть не ниже XE.

Скачать:

Набор компонентов для Delphi от 21.01.2021 г.

Старые версии

 

Аналог функции FormatDateTime на TSQL

CREATE FUNCTION dbo.FormatDateTime(@Format varchar(1000), @Time datetime)
RETURNS varchar(1000) AS
/*©Drkb v.3(2007): «http://www.drkb.ru» title=»www.drkb.ru»>www. drkb.ru,
 ®Vit (Vitaly Nevzorov) — [email protected]*/

BEGIN
 Declare @temp varchar(20)
/*Special substitutions to avoid formating prepared strings*/
 Declare @dddd varchar(35) Set @dddd=’QQQQQQQQQQQQQQQQQQQQQQQQQQQQQQQ’
 Declare @ddd varchar(35) Set @ddd= ‘WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW’
 Declare @mmmm varchar(35) Set @mmmm=’EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE’
 Declare @mmm varchar(35) Set @mmm= ‘RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR’
 Declare @am varchar(35) Set @am= ‘AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA’
 Declare @pm varchar(35) Set @pm= ‘PPPPPPPPPPPPPPPPPPPPPPPPPPPPPPP’

 if PATINDEX(‘%dddd%’ , @Format)>0 Set @Format=Replace(@Format,’dddd’, @dddd)
 if PATINDEX(‘%ddd%’ , @Format)>0 Set @Format= Replace(@Format,’ddd’, @ddd)
 if PATINDEX(‘%mmmm%’ , @Format)>0 Set @Format=Replace(@Format,’mmmm’,@mmmm)
 if PATINDEX(‘%mmm%’ , @Format)>0 Set @Format=Replace(@Format,’mmm’, @mmm)
 if PATINDEX(‘%doy%’ , @Format)>0
 begin
  Declare @Doy int
  Set @Doy=Case Month(@Time)
  When 1 Then 0
  When 2 Then 31 — Jan
  Else
  Case
  When Year(@Time)%4=0 and Year(@Time)%400<>0 Then 31+29
  Else 31+28
  End — Feb
  End
  Set @Doy=Case Month(@Time)
  When 4 Then @Doy+31 — Mar
  When 5 Then @Doy+31+30 — Apr
  When 6 Then @Doy+31+30+31— May
  When 7 Then @Doy+31+30+31+30— Jun
  When 8 Then @Doy+31+30+31+30+31— Jul
  When 9 Then @Doy+31+30+31+30+31+31— Aug
  When 10 Then @Doy+31+30+31+30+31+31+30— Sep
  When 11 Then @Doy+31+30+31+30+31+31+30+31— Oct
  When 12 Then @Doy+31+30+31+30+31+31+30+31+30— Nov
  Else @Doy
  End
  Set @Doy=@Doy+Day(@Time)
  Set @Format= Case
  When @Doy<10 Then Replace(@Format,’doy’, ’00’+cast(@Doy as varchar(1)))
  When @Doy>=100 Then Replace(@Format,’doy’, cast(@Doy as varchar(3)))
  Else Replace(@Format,’doy’, ‘0’+cast(@Doy as varchar(2)))
  End
 end

 if PATINDEX(‘%dd%’ , @Format)>0
 begin
  if DATENAME(d, @time)<10
  Set @Format= Replace(@Format,’dd’, ‘0’+DATENAME(d, @time))
  else
  Set @Format= Replace(@Format,’dd’, DATENAME(d, @time))
 end
 if PATINDEX(‘%d%’ , @Format)>0 Set @Format= Replace(@Format,’d’, DATENAME(d, @time))
 if PATINDEX(‘%yyyy%’ , @Format)>0 Set @Format= Replace(@Format,’yyyy’, Year(@Time))
 if PATINDEX(‘%yy%’ , @Format)>0 Set @Format= Replace(@Format,’yy’, Right(Cast(Year(@Time) as varchar(4)),2))
 if PATINDEX(‘%hh%’ , @Format)>0
 begin
  if PATINDEX(‘%am/pm%’ , @Format)>0
  begin
  Set @Format=
  Case DATENAME(hh, @time)
  When 0 Then Replace(@Format,’hh’, ’12’)
  When 1 Then Replace(@Format,’hh’, ’01’)
  When 2 Then Replace(@Format,’hh’, ’02’)
  When 3 Then Replace(@Format,’hh’, ’03’)
  When 4 Then Replace(@Format,’hh’, ’04’)
  When 5 Then Replace(@Format,’hh’, ’05’)
  When 6 Then Replace(@Format,’hh’, ’06’)
  When 7 Then Replace(@Format,’hh’, ’07’)
  When 8 Then Replace(@Format,’hh’, ’08’)
  When 9 Then Replace(@Format,’hh’, ’09’)
  When 10 Then Replace(@Format,’hh’, ’10’)
  When 11 Then Replace(@Format,’hh’, ’11’)
  When 12 Then Replace(@Format,’hh’, ’12’)
  When 13 Then Replace(@Format,’hh’, ’01’)
  When 14 Then Replace(@Format,’hh’, ’02’)
  When 15 Then Replace(@Format,’hh’, ’03’)
  When 16 Then Replace(@Format,’hh’, ’04’)
  When 17 Then Replace(@Format,’hh’, ’05’)
  When 18 Then Replace(@Format,’hh’, ’06’)
  When 19 Then Replace(@Format,’hh’, ’07’)
  When 20 Then Replace(@Format,’hh’, ’08’)
  When 21 Then Replace(@Format,’hh’, ’09’)
  When 22 Then Replace(@Format,’hh’, ’10’)
  When 23 Then Replace(@Format,’hh’, ’11’)
  When 24 Then Replace(@Format,’hh’, ’12’)
  End
  Set @Format=
  Case
  When DATENAME(hh, @time)<12 Then Replace(@Format,’am/pm’, @am)
  Else Replace(@Format,’am/pm’, @pm)
  End
  end
  else
  begin
  if DATENAME(hh, @time)<10
  Set @Format= Replace(@Format,’hh’, ‘0’+cast(DATENAME(hh, @time) as varchar(2)))
  else
  Set @Format= Replace(@Format,’hh’, DATENAME(hh, @time))
  end
 end
 if PATINDEX(‘%h%’ , @Format)>0
 begin
  if PATINDEX(‘%am/pm%’ , @Format)>0
  begin
  Set @Format=
  Case DATENAME(hh, @time)
  When 0 Then Replace(@Format,’hh’, ’12’)
  When 1 Then Replace(@Format,’hh’, ‘1’)
  When 2 Then Replace(@Format,’hh’, ‘2’)
  When 3 Then Replace(@Format,’hh’, ‘3’)
  When 4 Then Replace(@Format,’hh’, ‘4’)
  When 5 Then Replace(@Format,’hh’, ‘5’)
  When 6 Then Replace(@Format,’hh’, ‘6’)
  When 7 Then Replace(@Format,’hh’, ‘7’)
  When 8 Then Replace(@Format,’hh’, ‘8’)
  When 9 Then Replace(@Format,’hh’, ‘9’)
  When 10 Then Replace(@Format,’hh’, ’10’)
  When 11 Then Replace(@Format,’hh’, ’11’)
  When 12 Then Replace(@Format,’hh’, ’12’)
  When 13 Then Replace(@Format,’hh’, ‘1’)
  When 14 Then Replace(@Format,’hh’, ‘2’)
  When 15 Then Replace(@Format,’hh’, ‘3’)
  When 16 Then Replace(@Format,’hh’, ‘4’)
  When 17 Then Replace(@Format,’hh’, ‘5’)
  When 18 Then Replace(@Format,’hh’, ‘6’)
  When 19 Then Replace(@Format,’hh’, ‘7’)
  When 20 Then Replace(@Format,’hh’, ‘8’)
  When 21 Then Replace(@Format,’hh’, ‘9’)
  When 22 Then Replace(@Format,’hh’, ’10’)
  When 23 Then Replace(@Format,’hh’, ’11’)
  When 24 Then Replace(@Format,’hh’, ’12’)
  End
  Set @Format=
  Case
  When DATENAME(hh, @time)<12 Then Replace(@Format,’am/pm’, @am)
  Else Replace(@Format,’am/pm’, @pm)
  End
  end
  else
  begin
  Set @Format= Replace(@Format,’h’, DATENAME(hh, @time))
  end
 end
 if PATINDEX(‘%mm%’ , @Format)>0
 begin
  if Month(@Time)<10
  Set @Format= Replace(@Format,’mm’, ‘0’+cast(Month(@Time) as varchar(2)))
  else
  Set @Format= Replace(@Format,’mm’, Month(@Time))
 end
 if PATINDEX(‘%m%’ , @Format)>0 Set @Format= Replace(@Format,’m’, Month(@Time))
 if PATINDEX(‘%nn%’ , @Format)>0
 begin
  if DATENAME(mi, @time)<10
  Set @Format= Replace(@Format,’nn’, ‘0’+cast(DATENAME(mi, @time) as varchar(2)))
  else
  Set @Format= Replace(@Format,’nn’, DATENAME(mi, @time))
 end
 if PATINDEX(‘%n%’ , @Format)>0 Set @Format= Replace(@Format,’n’, DATENAME(mi, @time))
 if PATINDEX(‘%ss%’ , @Format)>0
 begin
  if DATENAME(ss, @time)<10
  Set @Format= Replace(@Format,’ss’, ‘0’+cast(DATENAME(ss, @time) as varchar(2)))
  else
  Set @Format= Replace(@Format,’ss’, DATENAME(ss, @time))
 end
 if PATINDEX(‘%s%’ , @Format)>0 Set @Format= Replace(@Format,’s’, DATENAME(ss, @time))
 if PATINDEX(‘%’+@dddd+’%’ , @Format)>0
 begin
  Set @Format=
  Case DAtepart(weekday, @time)
  When 1 Then Replace(@Format,@dddd, ‘Sunday’)
  When 2 Then Replace(@Format,@dddd, ‘Monday’)
  When 3 Then Replace(@Format,@dddd, ‘Tuesday’)
  When 4 Then Replace(@Format,@dddd, ‘Wednesday’)
  When 5 Then Replace(@Format,@dddd, ‘Thursday’)
  When 6 Then Replace(@Format,@dddd, ‘Friday’)
  When 7 Then Replace(@Format,@dddd, ‘Saturday’)
  End
 end
 if PATINDEX(‘%’+@ddd+’%’ , @Format)>0
 begin
  Set @Format=
  Case DAtepart(weekday, @time)
  When 1 Then Replace(@Format,@ddd, ‘Sun’)
  When 2 Then Replace(@Format,@ddd, ‘Mon’)
  When 3 Then Replace(@Format,@ddd, ‘Tue’)
  When 4 Then Replace(@Format,@ddd, ‘Wed’)
  When 5 Then Replace(@Format,@ddd, ‘Thu’)
  When 6 Then Replace(@Format,@ddd, ‘Fri’)
  When 7 Then Replace(@Format,@ddd, ‘Sat’)
  End
 end
 if PATINDEX(‘%’+@mmmm+’%’ , @Format)>0
 begin
  Set @Format=
  Case DAtepart(month, @time)
  When 1 Then Replace(@Format,@mmmm, ‘January’)
  When 2 Then Replace(@Format,@mmmm, ‘February’)
  When 3 Then Replace(@Format,@mmmm, ‘March’)
  When 4 Then Replace(@Format,@mmmm, ‘April’)
  When 5 Then Replace(@Format,@mmmm, ‘May’)
  When 6 Then Replace(@Format,@mmmm, ‘June’)
  When 7 Then Replace(@Format,@mmmm, ‘July’)
  When 8 Then Replace(@Format,@mmmm, ‘August’)
  When 9 Then Replace(@Format,@mmmm, ‘September’)
  When 10 Then Replace(@Format,@mmmm, ‘October’)
  When 11 Then Replace(@Format,@mmmm, ‘November’)
  When 12 Then Replace(@Format,@mmmm, ‘December’)
  End
 end
 if PATINDEX(‘%’+@mmm+’%’ , @Format)>0
 begin
  Set @Format=
  Case DAtepart(month, @time)
  When 1 Then Replace(@Format,@mmm, ‘Jan’)
  When 2 Then Replace(@Format,@mmm, ‘Feb’)
  When 3 Then Replace(@Format,@mmm, ‘Mar’)
  When 4 Then Replace(@Format,@mmm, ‘Apr’)
  When 5 Then Replace(@Format,@mmm, ‘May’)
  When 6 Then Replace(@Format,@mmm, ‘Jun’)
  When 7 Then Replace(@Format,@mmm, ‘Jul’)
  When 8 Then Replace(@Format,@mmm, ‘Aug’)
  When 9 Then Replace(@Format,@mmm, ‘Sep’)
  When 10 Then Replace(@Format,@mmm, ‘Oct’)
  When 11 Then Replace(@Format,@mmm, ‘Nov’)
  When 12 Then Replace(@Format,@mmm, ‘Dec’)
  End
 end
 if PATINDEX(‘%’+@am+’%’ , @Format)>0 Set @Format=Replace(@Format, @am,’AM’)
 if PATINDEX(‘%’+@pm+’%’ , @Format)>0 Set @Format=Replace(@Format, @pm,’PM’)
 Return @Format

Поддерживает любые маски стандартных форматов, писал по спецификации:

Цитата
d Displays the day as a number without a leading zero (1-31).
dd Displays the day as a number with a leading zero (01-31).
ddd Displays the day as an abbreviation (Sun-Sat)
dddd Displays the day as a full name (Sunday-Saturday)
m Displays the month as a number without a leading zero (1-12). If the m specifier immediately follows an h or hh specifier, the minute rather than the month is displayed.
mm Displays the month as a number with a leading zero (01-12). If the mm specifier immediately follows an h or hh specifier, the minute rather than the month is displayed.
mmm Displays the month as an abbreviation (Jan-Dec)
mmmm Displays the month as a full name (January-December)
yy Displays the year as a two-digit number (00-99).
yyyy Displays the year as a four-digit number (0000-9999).
h Displays the hour without a leading zero (0-23).
hh Displays the hour with a leading zero (00-23).
n Displays the minute without a leading zero (0-59).
nn Displays the minute with a leading zero (00-59).
s Displays the second without a leading zero (0-59).
ss Displays the second with a leading zero (00-59).
am/pm Uses the 12-hour clock for the preceding h or hh specifier, and displays ‘am’ for any hour before noon, and ‘pm’ for any hour after noon. The am/pm specifier can use lower, upper, or mixed case, and the result is displayed accordingly.

Любой неописанный мусор в маске останется где он был, функция никаких ошибок не генерит, интерпретируются только описанные форматы:

Сегодня у нас 2006-07-27 (Thursday), чёрт бы его побрал!

PHP: DateTime::format — Manual

День	—	—
d	День месяца, 2 цифры с ведущим нулём	от 01 до 31
D	Текстовое представление дня недели, 3 символа	от Mon до Sun
j	День месяца без ведущего нуля	от 1 до 31
l (строчная ‘L’)	Полное наименование дня недели	от Sunday до Saturday
N	Порядковый номер дня недели в соответствии со стандартом ISO-8601	от 1 (понедельник) до 7 (воскресенье)
S	Английский суффикс порядкового числительного дня месяца, 2 символа	st, nd, rd или th. Применяется совместно с j
w	Порядковый номер дня недели	от 0 (воскресенье) до 6 (суббота)
z	Порядковый номер дня в году (начиная с 0)	От 0 до 365
Неделя	—	—
W	Порядковый номер недели года в соответствии со стандартом ISO-8601; недели начинаются с понедельника	Например: 42 (42-я неделя года)
Месяц	—	—
F	Полное наименование месяца, например, January или March	от January до December
m	Порядковый номер месяца с ведущим нулём	от 01 до 12
M	Сокращённое наименование месяца, 3 символа	от Jan до Dec
n	Порядковый номер месяца без ведущего нуля	от 1 до 12
t	Количество дней в указанном месяце	от 28 до 31
Год	—	—
L	Признак високосного года	1, если год високосный, иначе 0.
o	Номер года в соответствии со стандартом ISO-8601. Имеет то же значение, что и Y, кроме случая, когда номер недели ISO (W) принадлежит предыдущему или следующему году; тогда будет использован год этой недели.	Примеры: 1999 или 2003
Y	Порядковый номер года, 4 цифры	Примеры: 1999, 2003
y	Номер года, 2 цифры	Примеры: 99, 03
Время	—	—
a	Ante meridiem (лат. «до полудня») или Post meridiem (лат. «после полудня») в нижнем регистре	am или pm
A	Ante meridiem или Post meridiem в верхнем регистре	AM или PM
B	Время в формате Интернет-времени (альтернативной системы отсчёта времени суток)	от 000 до 999
g	Часы в 12-часовом формате без ведущего нуля	от 1 до 12
G	Часы в 24-часовом формате без ведущего нуля	от 0 до 23
h	Часы в 12-часовом формате с ведущим нулём	от 01 до 12
H	Часы в 24-часовом формате с ведущим нулём	от 00 до 23
i	Минуты с ведущим нулём	от 00 до 59
s	Секунды с ведущим нулём	от 00 до 59
u	Микросекунды. Учтите, что date() всегда будет возвращать 000000, т.к. она принимает целочисленный (int) параметр, тогда как DateTime::format() поддерживает микросекунды, если DateTime создан с ними.	Например: 654321
v	Миллисекунды (добавлено в PHP 7.0.0). Замечание такое же как и для u.	Пример: 654
Временная зона	—	—
e	Идентификатор временной зоны	Примеры: UTC, GMT, Atlantic/Azores
I (заглавная i)	Признак летнего времени	1, если дата соответствует летнему времени, 0 в противном случае.
O	Разница с временем по Гринвичу без двоеточия между часами и минутами	Например: +0200
P	Разница с временем по Гринвичу с двоеточием между часами и минутами	Например: +02:00
p	То же, что и P, но возвращает Z вместо +00:00	Например: +02:00
T	Аббревиатура временной зоны	Примеры: EST, MDT …
Z	Смещение временной зоны в секундах. Для временных зон, расположенных западнее UTC возвращаются отрицательные числа, а расположенных восточнее UTC — положительные.	от -43200 до 50400
Полная дата/время	—	—
c	Дата в формате стандарта ISO 8601	2004-02-12T15:19:21+00:00
r	Дата в формате » RFC 2822	Например: Thu, 21 Dec 2000 16:01:07 +0200
U	Количество секунд, прошедших с начала Эпохи Unix (1 января 1970 00:00:00 GMT)	Смотрите также time()

Ссылка

: logging_variables [mAirList Wiki]

Общие переменные

ГГ

% Y	Текущий год как YYYY
% г	Текущий год как
% M	Текущий месяц в MM
% D	Текущий день как DD
% h	Текущий час как HH
% m	Текущая минута как MM
% s	Текущая секунда как SS
% w	ISO 8601 неделя года
% T {Format}	Текущая дата / время с использованием форматирования FormatDateTime (см. Ниже)
% S {Format}	Время начала в формате FormatDateTime (используется для остановки регистрации)
% t	Символ табуляции ( ASCII 9)
% r	Символ CR ( ASCII 13)
% n	Символ новой строки ( ASCII 10)
% g	Уникальный идентификатор связанной операции воспроизведения
% R {Key}	Данные времени выполнения
% #	Общее количество текущих слушателей на всех соединениях кодировщика
% $ {Digits}	Индекс файла (используется для экспорта файла с произвольным шаблоном имени файла)
% x	Имя компьютера
% X	Имя экземпляра

Информация о проигрываемом предмете

% a	Художник
% b	Право собственности
% l	Общая продолжительность в секундах с долями
% l {Format}	Общая продолжительность в формате FormatDateTime
% L	Общая продолжительность, как ЧЧ: ММ: СС
% d	Фактическая продолжительность воспроизведения в единицах DirectSound в секундах (для остановки записи)
% e	Фактическая продолжительность воспроизведения в секундах с долями (для остановки записи)
% e {Format}	Фактическая продолжительность воспроизведения в формате FormatDateTime (для остановки записи)
% p	Эффективная длительность воспроизведения в секундах с дробями
% p {Format}	Эффективная продолжительность воспроизведения в формате FormatDateTime (начиная с v6. 3 на)
% P	Эффективная продолжительность воспроизведения в формате ЧЧ: ММ: СС
% F	Прогнозируемое время окончания (время начала + продолжительность) в формате FormatDateTime
% c {Type}	Кий-маркер, в сечениях с дробями
% E	Тип конца
% I	Тип позиции (внутренний идентификатор)
% J	Тип элемента (читаемый человеком)
% u {Key}	Значение атрибута
% C	Комментарий
% U	Внутренний идентификатор базы данных
% В	Внешний идентификатор
% k	Имя файла значка
% K	Данные значка в виде строки BASE64
% 1	Имя файла с путем
% 2	Имя файла без пути
% 3	Имя файла без пути и расширения
% 4	Имя файла без пути, только первый символ
% i {Key}	Необработанные данные тегов файла

Дополнительные переменные для протокола HTTP POST multipart / form-data

Следующие переменные поддерживаются только в журнале HTTP POST multipart / form-data.

Они должны быть введены в поле «значение» как есть, без каких-либо других строк / переменных вокруг них.

% ALBUMART

Обложка альбома (при наличии) в виде данных в двоичной форме (начиная с версии 6.3.3)

Дополнительные переменные для импорта списка воспроизведения / рекламы (шаблон имени файла)

% B	Номер блока
% 2B	Номер блока, две цифры, ведущие 0
% 3B	Номер блока, трехзначный, ведущий 0
% N	Номер региона
% 2N	Номер региона, две цифры, ведущие 0
% 3N	Номер региона, трехзначный, ведущий 0

FormatDateTime

Последующие статьи

Используя знаки + в переменных, вы можете получить доступ к данным последующих (следующих) элементов в списке воспроизведения.

Например, % + a извлекает исполнителя следующего элемента, а не текущего, % ++ a — исполнителя элемента после следующего элемента и т. Д.

По соображениям производительности количество рассматриваемых / доступных элементов по умолчанию ограничено 3. Вы можете настроить это значение вручную в mAirList.ini:

 [Параметры]
NextLoggingLimit = 10 

Обратите внимание, что это ограничение применяется к общему количеству последующих элементов, доступных для ведения журнала, до любой возможной фильтрации типа элемента.Итак, если вы хотите войти, например, следующие 3 элемента «Музыка», но бывают случаи, когда между ними есть 4 элемента, не относящиеся к музыке (джинглы, новости, реклама и т. д.), вы должны установить предел 7 или выше.

TCriticalSection Threrad Пример Delphi — Synaptica srl ​​

TThreadedMsgEvent = class (TThread)

private

FLock: TCriticalSection;

FStr: TQueue ;

FMemo: TMemo;

function GetEvent: String;

защищенный

процедура Execute; переопределить;

общедоступный

процедура AddEvent (aMsg: String);

конструктор Create (AMemo: TMemo);

деструктор Уничтожить; переопределить;

конец;

реализация

{TThreadedMsgEvent}

процедура TThreadedMsgEvent. AddEvent (aMsg: String);

начало

FLock.Acquire;

FStr.Enqueue (FormatDateTime (‘ДД / ММ / ГГ ЧЧ: NN: SS.ZZZ’, Сейчас) + ‘:’ + aMsg);

FLock.Релиз;

конец;

конструктор TThreadedMsgEvent.Create (aMemo: TMemo);

начало

унаследовано Create (True);

FreeOnTerminate: = False;

FOnMessage: = ACallBack;

FStr: = TQueue .Create ();

FLock: = TCriticalSection.Создавать;

FMemo: = aMemo;

Резюме;

конец;

деструктор TThreadedMsgEvent.Destroy; переопределить;

начало

FreeAndNil (FStr);

FreeAndNil (FLock);

конец;

procedure TThreadedMsgEvent.Execute;

начало

пока не завершено do

начало

попробуйте

if (FStr.Count> 0) then

begin

if Assigned (aMemo) then

begin

TThread.синхронизировать (процедура

начало

FMemo. Lines.Add (GetEvent);

конец;);

конец;

конец;

кроме

конец;

TThread.Sleep (1);

конец;

конец;

функция TThreadedMsgEvent.GetEvent: String;

начало

FLock.Acquire;

результат: = FStr.Dequeue;

FLock.Релиз;

конец;

時刻 ・ 日 付 型 (TDateTime 型) を 形式 を 指定 し 文字 列 に 変 換 す る — Delphi プ ロ グ ラ ミ ン グ

9000 6 9000 9000 6 zzzz 9000 000 ～ 999）。 000 000 7000 000 7000 000 7000 000 7000 000 9000 000 9000 000 900 06 ampm

指定000 子
指定000 子000
指定000 子000	905を 使 っ て 日 付 を 表示 し 次 LongTimeFormat グ ロ ー バ 指定 さ れ た 形式 を 使 を 表示 す る。 値 000 9 000 9 9 000 9 9 000 9 9 000日 付 を 先頭 の ゼ ロ な し で 表示 す る (1 か ら 31 ま で).
дд	日 付 を 先頭 の ゼ ロ も 含 め て 表示 す る (01 か ら 31 ま で).
ддд	ShortDayNames グ ロ ー バ ル 変 数で 与 え ら れ た 文字 列 を 使用 し て ， 曜 日 を 省略 形 （вс-сб） で 表示 す る。
dddd	LongDayNames グ ロ ー(воскресенье-суббота) で 表示 す る.
DDDDD	ShortDateFormat グ ロ ー バ ル 変 数 で 与 え ら れ た 形式 で 日 付 を 表示 す る.
DDDDDD	LongDateFormat グ ロ ー バ ル 変 数 で 与 え ら れ た 形式 で 日 付 を 表示 す る。
e	（Windows の み） 年 を 現在 の 年号 に ゼ ロ の つ て な い 数字 で 表示 す （（日本語 ， （日本語 ，
ee	（Windows の み） 年 を 現在 の 年号 を使 っ て 先頭 に ゼ ロ つ い た 表示 す る （日本語 ， 韓国 よ 体字 中国 語 の 場合 み）。
g	と 繁体字 中国 語 の 場合 の み））
gg	（Windows の み） 年号 を 完全 形 で す る。 （日本語 と 繁 9 9 9000	先頭 に ゼ ロ の な い 数字 （1-12） と し て 月 を 表示 す h ま た は hh 指定 子 の 直 後 m 子 を 指定 す る 月 で000 は000 9 000 は000 9 5 000 000 10 10 5 9 000 000 10 9 5000 000 9 5 000に ゼ ロ の あ る 数字 （01–12） と し て 月 を 表示 す る h ま た hh 指定 子 の 直 後 に мм 指定 子 を 指定 す る と 000 9000 000 9000 9000 000 9000 9000 000 9000 9000 000 9000 10 000 9000 000 000 9000で 与 え ら れ た 文字 列 を 使用 て ， 月 を 省略 形 （январь-декабрь） で 表示 す る。
мммм	LongMonthNames グ ー バ バ（Январь-декабрь） で 表示 す る。
г. г	年 を 2 桁 の 数字 （00-99） で 表示 す る。
гггг	年 を 4） 0000-99表示 す る。
ч	先頭 に ゼ ロ の な い （0-23） と し て 時 を 表示 す る。
hh	先頭。
n	先頭 に ゼ ロ の な い 数字 （0-59） と し て 分 を表示 す る。
nn	先頭 に ゼ ロ の あ る （00-59） と し て 分 を す る。
s	ShortDateFormat次 に LongTimeFormat グ ロ ー バ ル 変 指定 さ れ た 形式 を 使 を。 日 付 時刻 0 時 ち ょ う ど す す 9 000 9000 9 000 9000 9 000 9000 9 000 000 9 9 0 9000 9 7000 -59） と し て 秒 を 表示 す る。
z	ミ リ 秒 を 先頭 の ゼ ロ な し る （0 ～ 999）。
t	ShortTimeFormat グ ロ ー バ 与 え ら れ た 形式 を 表示 す る。
tt
tt
tt
утра / вечера	す る h 子 ま た は hh 指定 子 に 12 時間 形式 の 時刻 値 を し ， 正午 時間 に は 「am」 を 以降 の 時間 に pm すAm / pm 指定 子 は ， 小 文字 だ け 大 文字 だ け ， た 小 文字 と 大 文字 の 混成 を こ と が で に ， に た000 9 9000 9000 9000 9000 hh 指定 子 に 12 時間 形式 の 時刻 値 を ， 正午 以前 の 時間 に は a を ， 正午 以降 の 時間 に は p 」を 表示 す る a / p 子 は 小 文字 小 文字， 小 文字 と 大 文字 の 混成 を 使用 す る こ と が で き ， そ に し た が っ て 結果 が 表示。
先行 す る h 指定 子 ま た は hh 指定 子 に 12 時間 形式 の し ， 以前 の 時間 TimeAMString グ ロ ー を ，す る
/	DateSeparator グ ロ ー バ ル 変 数 で 与 え ら れ た 日 付 区 切 り 文字 を 表示 す る
:. ..	TimeSeparator グ ロ ー バ ル 変 数 で 与 え ら れ た 時刻 区 切 り 文字 を 表示 す る
«хх ‘/ «xx»	単 引用 符 ま た は 重 引用 符 で 囲 ま れ 文字 は そ の ま ま 表示 さ れ ， 設定 に は 影響 し な。

— Planeta Delphi | Строка состояния (аджуда, диа, хора)…

StatusBar (Help, Data, Hora)

ADICIONANDO STATUSBAR E OS PANELS:

Primeiramente va paleta Win32, escolha or componete StatusBar e coloque no Formulrio.D um duplo clique no StatusBar, vai abrir uma janela amarela Добавить новые для дополнительных панелей, кроме случая 3, для справки, вывода для данных и вывода для Hora.

ADICIONANDO DATA E HORA NOS PANELS DO STATUSBAR:

— В системе Paleta и Escolha Timer e adicione ao Formulrio;
— Нажмите кнопку без значка для таймера и события и дважды нажмите кнопку OnTimer, например:

Begin
Statusbar1.Panels [1] .Text: = » + formatdatetime (‘dddd «,» dd «de» mmmm «de» yyyy’, now); // для данных
statusbar1.Panels [2] .Text: = » + formatdatetime (‘чч: мм: сс’, сейчас); // пункт
End;
Конец.

Ou

Begin
Statusbar1.Panels [1] .Text: = » + datetostr (date); // пара данных
statusbar1.Panels [2] .Text: = » + timetostr (now); // para hora
end;
Конец.

ADICIONANDO HELP AOS CAMPOS:

— Clique no Campo que voice quer que aparea a frase de ajuda, aquela que aperece quando o mouse fica em cima de um campo por algum tempo, em PropriedadesHint, vc escrecer aquilo que apare mouse passar por cima do campo, depois v em ShowHint e coloque True, para exibir a frase do do Hint, Se No Colocar ShowHint em True и фраза с vai aparecer no StatusBar, mas para que aparea no StatusBar tem que se fazer o seguinte:

— На блоке не сформировано, частное и частное объявление {Частные объявления} содержит указание на процедуру (отправитель: TObject), указание:

частное
{частные объявления}
ShowHint процедуры (отправитель: TObject);

— Депозит при внедрении и отказе от {$ R *.dfm} faa или seguinte:

Реализация
{$ R * .