Отправляет email-рассылки с помощью сервиса Sendsay

Все, что вы не знали, но хотели бы узнать о Delphi

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Сетевой адаптер: осваиваем Интернет" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Май 2006   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Автор
Petrify

Статистика

872 подписчиков
-1 за неделю
←   Все выпуски   →

Все, что вы не знали, но хотели бы узнать о Delphi


Выпуск №7

Раздел: Язык Программирования Delphi

Подраздел: Работа с датой и временем +

работа с числами

 

Уважаемый подписчик,

О чем будет следующий раздел - решать вам.

Варианты:

VCL

Системные функции и Winapi

Базы данных

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

Репортинг, работа с принтером

Работа с сетью, Интернетом, протоколами

Работа с графикой, мультимедиа

 

Ваши предложения высылайте на

formyreferal@rambler.ru

В этом выпуске:

Как узнать номер недели данного дня в году?

Скорость работы процессора, точный таймер

Как реализовать сверхточный таймер?

Конвертируем TDateTime to Unix Timestamp

Как узнать об изменении системного времени

Как засечь время

Как получить дату по Юлианскому календарю?

Как проверить, существует ли дата?

Как подсчитать возраст по дню рождения?

Работа со временем или как реализовать 1.20+1.50=3.10 ?

 Как отчитывать промежутки времени с точностью, большей чем 60 мсек?

Функции преобразования чисел с плавающей точкой

Как округлять до сотых в большую сторону?

Проблемы с дробными числами

Hex ---> Integer

Dec ---> Hex

Как узнать номер недели данного дня в году?  

function WeekOfYear(ADate : TDateTime) : word;
var
  day : word;
  month : word;
  year : word;
  FirstOfYear : TDateTime;
begin
  DecodeDate(ADate, year, month, day);
  FirstOfYear := EncodeDate(year, 1, 1);
  Result := Trunc(ADate - FirstOfYear) div 7 + 1;
end;
 
Скорость работы процессора, точный таймер  

Данная тема уже обсуждалась, но у меня есть своя реализация сабжа. Начиная с Pentium MMX, Intel ввели в процессор счетчик тактов на 64 бита (Присутствует точно и в К6). Для того чтобы посмотреть на его содержание, была введена команда "rdtsc" (подробное описание в интеловской мануале). Эту возможность можно использовать для реализации сабжа.
Поскольку Дельфи не в курсе насчет rdtsc, то пришлось юзать опкод (0F31).
Привожу простенький примерчик юзания, Вы уж извините - немножко кривоват получился, да и ошибка компилятора какая-то вылезла :( (V4 Bld5.104 Upd 2). Кому интересно, поделитесь своими соображениями по этому поводу. Особенно интересует работа в режиме когда меняется частота процессора (Duty Cycle, Standby).


// (C) 1999 ISV
unit Unit1;interfaceuses  Windows, Messages, SysUtils, Classes, Graphics,
 Controls, Forms,Dialogs,  StdCtrls, Buttons, ExtCtrls;
type  TForm1 = class(TForm)
    Label1: TLabel;
    Timer1: TTimer;
    Label2: TLabel;
    Label3: TLabel;
    Button1: TButton;
    Button2: TButton;
    Label4: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private    
{ Private declarations }
  public    
{ Public declarations }
    Counter:integer;
      //Счетчик срабатывания таймера    
Start:int64;              
//Начало роботы    
Previous:int64;        
//Предыдущее значение    
PStart,PStop:int64;
 //Для примера выч. времени   
 CurRate:integer;
     //Текущая частота проца    
function GetCPUClick:int64;    
function GetTime(Start,Stop:int64):double;
 end;
var  Form1: TForm1;implementation{$R *.DFM}
// Функция работает на пнях ММХ или выше а
// также проверялась на К6
function TForm1.GetCPUClick:int64;
begin
  asm    db  0fh,31h   
// Опкод для команды rdtsc    mov dword ptr result,eax    mov dword ptr result[4],edx  
end;
// Не смешно :(. Без ?той штуки
// Компайлер выдает Internal error C1079  
Result:=Result;
end;
// Время в секундах между старт и стоп
function TForm1.GetTime(Start,Stop:int64):double;
begin
  try    result:=(Stop-Start)/CurRate  except    result:=0;
 end;
end;
// Обработчик таймера считает текущую частоту, выводит ее, а также
// усредненную частоту, текущий такт с момента старта процессора.
// При постоянной частоте процессора желательно интервал братьпобольше
// 1-5с для точного прощета частоты процессора.
procedure TForm1.Timer1Timer(Sender: TObject);
  var    i:int64;
begin
  i:=GetCPUClick;
  if Counter=0    then Start:=i    else 
begin
      Label2.Caption:=Format('Частота общая:%2f',[(i-Start)/(Counter*Timer1.Interval*1000)]);
      Label3.Caption:=Format('Частота текущая:%2f',[(i-Previous)/(Timer1.Interval*1000)]);
      CurRate:=Round(((i-Previous)*1000)/(Timer1.Interval));
    end;
  Label1.Cap примера
procedure TForm1.Button1Click(Sender: TObject);
begin
  PStart:=GetCPUClick;
end;
// Останавливаем отсчет времени и показуем соко
// прошло секунд
procedure TForm1.Button2Click(Sender: TObject);
begin
  PStop:=GetCPUClick;
  Label4.Caption:=Format!
('Время между нажатиями:%gсек',[GetTime(PStart,PStop)])
end;
end.
 
Как реализовать сверхточный таймер?  

Windows is not a real time operating system so it is not really able to reliably achieve high accuracy timing without using a device driver. The best I have been able to get is a few nanoseconds using QueryPerformanceCounter. This is the procedure I use:

var
  WaitCal: Int64;

procedure Wait(ns: Integer);
var
  Counter, Freq, WaitUntil: Int64;
begin
  if QueryPerformanceCounter(Counter) then
  begin
    QueryPerformanceFrequency(Freq);
    WaitUntil := Counter + WaitCal + (ns * (Freq div 1000000));
    while Counter < WaitUntil do
      QueryPerformanceCounter(Counter);
  end
  else
    Sleep(ns div 1000);
end;


To get improved accuracy do this a little while before using Wait()


var
  Start, Finish: Int64;

Application.ProcessMessages;
Sleep(10);
QueryPerformanceCounter(Start);
Wait(0);
QueryPerformanceCounter(Finish);
WaitCal := Start - Finish;


A trick I have found to increase the reliability of this on my computer is to call Wait like this:

Application.ProcessMessages;
Sleep(0);
DoSomething;
Wait(10);
DoSomethingElse;
 

Как отчитывать промежутки времени с точностью, большей чем 60 мсек?  

Для начала описываешь процедуру, которая будет вызываться по сообщению от таймера :
procedure FNTimeCallBack(uTimerID, uMessage: UINT;dwUser, dw1, dw2: DWORD)
stdcall;
begin
//
//  Тело процедуры.
end; 

а дальше в программе (например по нажатию кнопки) создаешь Таймер и вешаешь на него созданную процедуру
uTimerID:=timeSetEvent(10,500,@FNTimeCallBack,100,TIME_PERIODIC); 

Подробности смотри в Help.
Hу и в конце убиваешь таймер
timeKillEvent(uTimerID); 
И все. Точность этого способа до 1 мсек. минимальный интервал времени можно задавать 1 мсек.

Работа со временем или как реализовать 1.20+1.50=3.10 ?  

Если Вы создаёте приложение, в котором пользователь вводит значения времени, то стандартные вычисления не подойдут. Проблема в том, что нужно сделать так, чтобы выражение 1.20 + 1.70 было равно НЕ 2.90 а 3.10.
Здесь представлены три функции, которые решают эту проблему. Они работают только с часами и минутами, потому что пользователь очень редко используют секунды, но если Вам потребуются секунды, то Вы без труда сможете доработать эти функции по своему желанию. Вторая и третья функции позволяют преобразовать реальное значение времени в десятичный эквивалент и обратно. Все поля на форме будут в формате hh.mm.

function sumhhmm(a, b: double): double;
var
  h1: double;
begin
  h1 := (INT(A) + INT(B)) * 60 + (frac(a) + frac(b)) * 100;
  result := int(h1 / 60) + (h1 - int(h1 / 60) * 60) / 100;
end;

function hhmm2hhdd(const hhmm: double): double;
begin
  result := int(hhmm) + (frac(hhmm) / 0.6);
end;

function hhdd2hhmm(const hhdd: double): double;
begin
  result := int(hhdd) + (frac(hhdd) * 0.6);
end;

Использование: 
// sumtime(1.20,1.50) => 3.10 
// sumtime(1.20,- 0.50) => 0.30 
// hhmm2hhdd(1.30) => 1.5 (1h.30m = 1.5h) 
// hhdd2hhmm(1.50) => 1.30 (1.5h = 1h30m) 
 

Как подсчитать возраст по дню рождения?  




{ BrthDate:  Date of birth }

function TFFuncs.CalcAge(brthdate: TDateTime): Integer;
var
  month, day, year, bmonth, bday, byear: word;
begin
  DecodeDate(BrthDate, byear, bmonth, bday);
  if bmonth = 0 then
    result := 0
  else
  begin
    DecodeDate(Date, year, month, day);
    result := year - byear;
    if (100 * month + day) < (100 * bmonth + bday) then
      result := result - 1;
  end;
end;



 



procedure TForm1.Button1Click(Sender: TObject);
var
  Month, Day, Year, CurrentMonth, CurrentDay, CurrentYear: word;
  Age: integer;
begin
  DecodeDate(DateTimePicker1.Date, Year, Month, Day);
  DecodeDate(Date, CurrentYear, CurrentMonth, CurrentDay);
  if (Year = CurrentYear) and (Month = CurrentMonth) and (Day = CurrentDay) then
    Age := 0
  else
  begin
    Age := CurrentYear - Year;
    if (Month > CurrentMonth) then
      dec(Age)
    else if Month = CurrentMonth then
      if (Day > CurrentDay) then
        dec(Age);
  end;
  Label1.Caption := IntToStr(Age);
end;
 
Как проверить, существует ли дата?  

function DateExists(Date: string; Separator: char): Boolean;
var
  OldDateSeparator: Char;
begin
  Result := True;
  OldDateSeparator := DateSeparator;
  DateSeparator := Separator;
  try
    try
      StrToDate(Date);
    except
      Result := False;
    end;
  finally
    DateSeparator := OldDateSeparator;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  if DateExists('35.3.2001', '.') then
  begin
    {your code}
  end;
end;
 

Как получить дату по Юлианскому календарю?  
 

function julian(year, month, day: Integer): real;
var
  yr, mth: Integer;
  noleap, leap, days, yrs: Real;
begin
  if year < 0 then
    yr := year + 1
  else
    yr := year;
  mth := month;
  if (month < 3) then
  begin
    mth := mth + 12;
    yr := yr - 1;
  end;
  yrs := 365.25 * yr;
  if ((yrs < 0) and (frac(yrs) <> 0)) then
    yrs := int(yrs) - 1
  else
    yrs := int(yrs);
  days := int(yrs) + int(30.6001 * (mth + 1)) + day - 723244.0;
  if days < -145068.0 then
    julian := days
  else
  begin
    yrs := yr / 100.0;
    if ((yrs < 0) and (frac(yrs) <> 0)) then
      yrs := int(yrs) - 1;
    noleap := int(yrs);
    yrs := noleap / 4.0;
    if ((yrs < 0) and (frac(yrs) <> 0)) then
      yrs := int(yrs) - 1;
    leap := 2 - noleap + int(yrs);
    julian := days + leap;
  end;
end;
 

Как засечь время  

Засекание обычно нужно в двух случаях: самому программисту – узнать, как программа работает быстрее, или для информирования пользователя, сколько программа уже трудится.

Для засекания времени удобнее всего использовать функцию GetTickCount, но нельзя забывать о ее погрешности при измерении очень коротких промежутков времени, и о том, что программы в Windows работают с непостоянной скоростью. Поэтому не стоит засекать быстрые процессы, и не стоит делать выводы о каком-то алгоритме после одного тестирования. И еще. Если вы тестируете алгоритм, то поставьте его в цикл, выполнив его, например, тысячу раз, а потом получившееся время делите на тысячу. Так точнее. Эта программа засекает, сколько времени меняется цвет точек окна в этой программе.

procedure TForm1.Button1Click(Sender: TObject);
var
  i, t: integer;
begin
  t := GetTickCount;
  randomize;
  for i := 0 to 100000 do
    Form1.Canvas.Pixels[i mod Form1.ClientWidth, i div Form1.ClientWidth] := RGB(random(255), random(255), random(255));
  Form1.Caption := IntToStr(GetTickCount - t);
end;
Как узнать об изменении системного времени  

Эта программа пикает, когда кто-нибудь меняет системное время.

...
private
  procedure WMTIMECHANGE(var Message: TWMTIMECHANGE); message WM_TIMECHANGE;
...
procedure TForm1.WMTIMECHANGE(var Message: TWMTIMECHANGE);
begin
  MessgeBeep(0);
end;

Конвертируем TDateTime to Unix Timestamp t

{
  Sometimes you want to communicate with mySQL or other databases using
  the unix timestamp. To solve this difference you may want to convert your
  TDateTime to the unix timestamp format and vice versa.

}

unit unix_utils;

interface

implementation

const
  // Sets UnixStartDate to TDateTime of 01/01/1970
  UnixStartDate: TDateTime = 25569.0;

function DateTimeToUnix(ConvDate: TDateTime): Longint;
begin
  //example: DateTimeToUnix(now);
  Result := Round((ConvDate - UnixStartDate) * 86400);
end;

function UnixToDateTime(USec: Longint): TDateTime;
begin
  //Example: UnixToDateTime(1003187418);
  Result := (Usec / 86400) + UnixStartDate;
end;

end.
 
Функции преобразования чисел с плавающей точкой  

Преобразование числа с плавающей точкой (далее в этом разделе просто числа) в текстовую строку и обратно всегда было достаточно сложной задачей. Для ее решения в Delphi есть функции сразу трех уровней сложности.
Первый — самый простой — представлен функцией FloatToStr:

function FloatToStr( Value : Extended): string;
Число, заданное параметром Value, преобразуется в возвращаемую функцией строку. Формат преобразования соответствует типу преобразования g функции Format, причем длина выходной строки принимается равной 15 символам.
Больше возможностей для управления форматом вывода дает функция:

function PloatToStrF(Value: Extended; Format: TFloatFormat; Precision, Digits: Integer): string;
Здесь Value — преобразуемое значение, Format — один из предопределенных форматов. Хотя этот параметр имеет тип TFloatFormat, он имеет очень много общего с типами преобразований в функции Format (ссылки на них есть в предлагаемой таблице). Параметр Precision задает общее число символов в выходной строке и не должен превышать 7 для фактического параметра типа Single, 15 — для Double и 18 — для Extended. Digits — это параметр, интерпретируемый в зависимости от значения параметра Format:
ffExponent   Научный формат, соответствует типу е. Precision задает общее число символов, Digits — число знаков в показателе экспоненты {0-4).   
ffFixed   Формат с фиксированной точкой; соответствует типу f. Precision задает общее число символов, Digits — число знаков после запятой (0-18). Если значение Precision мало для представления числа, используется научный формат.   
ffGeneral   Обобщенный формат, соответствует типу д (см. описание функции Format).   
ffNumber   Отличается от fTFixed наличием символов-разделителей тысяч (см. тип преобразования п).   
ffCurrency   Соответствует типу преобразования т. Параметр Digits задает число символов после десятичной точки в выходной строке (0-18).   

В случае, когда в функцию переданы значения Value, соответствующие особым случаям сопроцессора ("не-число", плюс и минус бесконечность), она возвращает соответственно строки 'NAN', 'INF' и '-INF'.
Наконец, возможность полного управления форматом предоставляет функция FormatFloat:
function FormatFloat(const Format: string; Value: Extended): string;
Она преобразует число в строку в соответствии со спецификатором формата, содержащимся в параметре Format. Правила его задания следующие:
0   Поле для цифры. Если форматируемая величина имеет в этой позиции цифру, то вставляется она, в противном случае вставляется 0.   
#   Поле для цифры. Если форматируемая величина имеет в этой позиции цифру, то вставляется она, в противном случае ничего не вставляется.   

   Поле для десятичной точки. Сюда вставляется символ, определенный константой DecimalSeparator.   
;   Поле для разделителя тысяч. Оно означает, что группы по три цифры, считая влево от десятичной точки, будут разделяться специальным символом (он задан константой ThousandSeparator). Местоположение поля может быть произвольным.   
Е+, Е-, е+, е-   Признаки представления числа в научном формате. Появление любого из этих аргументов означает, что число будет преобразовано с характеристикой и мантиссой. Вставка нулей после такого аргумента позволяет определить ширину мантиссы. Разница между Е+, е+ и Е-, е-в том, что в первых двух случаях ставится "+" при выводе положительных чисел.   
'хх' "хх"   Символы, заключенные в обычные или двойные кавычки, напрямую включаются в выходную строку.   
;   Разделяет спецификаторы формата для положительных, отрицательных и нулевых чисел.   


Примечания:
1. Число всегда округляется до той точности, которую позволяет заданное программистом количество полей для размещения цифр ('0' и '#').
2. Если у преобразуемого числа слева от десятичной точки получается больше значащих цифр, чем задано полей для их размещения, то цифры все равно добавляются в строку. Если полей недостаточно справа от точки, происходит округление.
3. Символ ';' позволяет задать три разных формата вывода для чисел с разным знаком. При различном количестве форматов они применяются следующим образом:
один: применяется для всех чисел;
два: первый применяется для чисел, больших или равных нулю, второй — для отрицательных;
три: первьш применяется для положительных, второй — для отрицательных чисел, третий — для нуля.
Если форматы для отрицательных чисел или нуля пусты, применяется формат для положительных чисел.
Если пуст формат для положительных чисел или спецификатор формата вообще не задан (пустая строка), то числа форматируются согласно обобщенному формату (как в функции FloatToStr). Такое форматирование применяется также в случае, если число значащих цифр слева от десятичной точки превысило 18 и не задан научный формат.
Применение спецификатора иллюстрируется в таблице на примере преобразования четырех чисел:
Спецификатор   1234   -1234   0.5   0   
0   1234   -1234   1   0   
0.00   1234.00   -1234.00   0.50   0.00   
#.##   1234   -1234   .5       
#.##0.00   1,234.00   -1,234.00   0.50   0.00   
#,##0.00;(#,##0.00)   1,234.00   (1,234.00)   0.50   0.00   
#,##0.00;;Zero   1,234.00   -1,234.00   0.50   Zero   
О.ОООЕ+00   1.234Е+03   -1.234Е+03   5.000Е-01   О.ОООЕ+00   
#.###Е-0   1.234ЕЗ   -1.234ЕЗ   5Е-1   ОЕО   

Две следующие функции применяют те же правила, что и рассмотренные выше функции, но отличаются параметрами:

function FloatToText(Buffer: PChar; Value: Extended; Format: TFloatFormat; Precision, Digits: Integer) : Integer;   Соответствует FloatToStrF, но выходная строка помещается в буфер Buffer (без начальной длины!), а число символов в ней возвращается самой функцией.   

function FloatToTextFmt(Buffer: PChar; Value: Extended; Format: PChar): Integer;   Соответствует FormatFloat, но выходная строка помещается в буфер Buffer (без начальной длины!), а число символов в ней возвращается самой функцией.   

Наконец, процедура:
procedure FloatToDecimal(var Result: TFloatRec; Value: Extended; Precision, Decimals: Integer);   Производит подготовительный анализ преобразуемого числа, занося в поля записи Result различные его характеристики.   


Перейдем к рассмотрению функций преобразования текстовой строки в число. Их две — соответственно для строк типа string и PChar:

function StrToPloat(const S: string): Extended;

function TextToFloat(Buffer: PChar; var Value: Extended): Boolean;

Общие правила для передаваемой в функцию строки таковы:
допускаются как научный, так и фиксированный форматы;
в качестве десятичной точки должен выступать символ, который содержится в DecimalSeparator;
не допускаются символы-разделители тысяч (ThousandSeparator), а также символы обозначения денежньк единиц.
В случае ошибки преобразования функция StrToFloat генерирует исключительную ситуацию EConvertError, a TextToFloat — возвращает значение False.
 
Как округлять до сотых в большую сторону?  

 
   
 

Прибавляешь 0.5 затем отбрасываешь дробную часть:

Uses Math;  

Function RoundMax(Num:real; prec:integer):real; 
begin 
  result:=roundto(num+Power(10, prec-1)*5, prec); 
end;    


До сотых соответственно будет:

Function RoundMax100(Num:real):real; 
begin 
  result:=round(num*100+0.5)/100; 
end;    
 
Проблемы с дробными числами  

Иногда возникают трудности интерпретации дробных чисел - что есть разделитель точка или запятая?

В Дельфи есть системные переменные:
DECIMALSEPARATOR - десятичный разделитель который принят в системе
THOUSANDSEPARATOR - разделитель тысяч, который принят в системе

Для USA регионального стандарта
DECIMALSEPARATOR будет "."
THOUSANDSEPARATOR будет ","

Для России
DECIMALSEPARATOR будет ","
THOUSANDSEPARATOR будет "." или " " (не помню уже)
Hex ---> Integer  

var
  i: integer
  s: string;
begin
  s := '$' + ThatHexString;
  i := StrToInt(a);
end;

 


const HEX: array['A'..'F'] of INTEGER = (10, 11, 12, 13, 14, 15);
var str: string;
    Int, i: integer;
begin
  READLN(str);
  Int := 0;
  for i := 1 to Length(str) do
    if str[i] < 'A' then
      Int := Int * 16 + ORD(str[i]) - 48
    else
      Int := Int * 16 + HEX[str[i]];
  WRITELN(Int);
  READLN;
end.
Dec ---> Hex  

function dec2hex(value: dword): string[8];
const
  hexdigit = '0123456789ABCDEF';
begin
  while value <> 0 do
  begin
    dec2hex := hexdigit[succ(value and $F)];
    value := value shr 4;
  end;
  if dec2hex = '' then dec2hex := '0';
end;
 

 

 

Сайт рассылки Здесь

Так же можете посетить несколько сайтов для заработка в Интернете:

Hit&Host

 

Raskrutim.ru

 

WmSearch

 
В избранное