procedure InitDataBase;
begin
LastDataBaseItem:= 0;
if FileExists(StandardDataBase) then begin
Assign(DataBaseFile,StandardDataBase);
Reset(DataBaseFile);
while not EOF(DataBaseFile) do begin
GetDataBaseItem(K0R, LastDataBaseItem);
ItemNameS[LastDataBaseItem]:= K0R.Name;
LastDataBaseItem:= LastDataBaseItem+1;
end;
if EOF(DataBaseFile) then if LastDataBaseItem>0 then LastDataBaseItem:= LastDataBaseItem-1;
end;
end; {InitDataBase}
function FindDataBaseName(Nstg: String): LongInt;
var ThisOne : LongInt;
begin
ThisOne:= 0;
FindDataBaseName:= –1;
while ThisOne<LastDataBaseItem do begin
if Nstg = ItemNameS[ThisOne] then begin
FindDataBaseName:= ThisOne;
Exit;
end;
ThisOne:= ThisOne+1;
end;
end; {FindDataBaseName}
{======================= Инициализация модуля ========================}
procedure InitLinearSystem;
begin
BaseFileName:= '\PROGRA~1\SIGNAL~1\';
StandardOutput:= BaseFileName + 'K0.wav';
StandardInput:= BaseFileName + 'K0.wav';
StandardDataBase:= BaseFileName + 'Radar.sdb';
InitAllSignals;
InitDataBase;
ReadWAVFile(K0R,K0B);
ScaleAllData;
end; {InitLinearSystem}
begin {инициализируемый модулем код}
InitLinearSystem;
end. {Unit LinearSystem}
Даты
Вычисление даты Пасхи
function TtheCalendar.CalcEaster:String;
var B,D,E,Q:Integer;
GF:String;
begin
B:= 225-11*(Year Mod 19);
D:= ((B-21)Mod 30)+21;
If d>48 then Dec(D);
E:= (Year+(Year Div 4)+d+1) Mod 7;
Q:= D+7-E;
If q<32 then begin
If ShortDateFormat[1]='d' then Result:= IntToStr(Q)+'/3/'+IntToStr(Year)
else Result:='4/'+IntToStr(Q-31)+'/'+IntToStr(Year);
end else begin
If ShortDateFormat[1]='d' then Result:= IntToStr(Q-31)+'/4/'+IntToStr(Year)
else Result:='4/'+IntToStr(Q-31)+'/'+IntToStr(Year);
end;
{вычисление страстной пятницы}
If Q<32 then begin
If ShortDateFormat[1]='d' then GF:= IntToStr(Q-2)+'/3/'+IntToStr(Year)
else GF:='3/'+IntToStr(Q-2)+'/'+IntToStr(Year);
end else begin
If ShortDateFormat[1]='d' then GF:= IntToStr(Q-31-2)+'/4/'+IntToStr(Year)
else GF:='4/'+IntToStr(Q-31-2)+'/'+IntToStr(Year);
end;
end;
Дни недели
Кто-нибудь пробовал написать функцию, возвращающую для определенной даты день недели?
Моя функция как раз этим и занимается.
unit datefunc;
interface
function checkdate(date : string): boolean;
function Date2julian(date : string): longint;
function Julian2date(julian : longint): string;
function DayOfTheWeek(date: string): string;
function idag: string;
implementation
uses sysutils;
function idag() : string;
{Получает текущую дату и возвращает ее в формате YYYYMMDD для использования
другими функциями данного модуля.}
var
Year, Month, Day: Word;
begin
DecodeDate(Now, Year, Month, Day);
result:= IntToStr(year)+ IntToStr(Month) +IntToStr(day);
end;
function Date2julian(date : string) : longint;
{Получает дату в формате YYYYMMDD.
Если у вас другой формат, в первую очередь преобразуйте его.}
var
month, day, year:integer;
ta, tb, tc : longint;
begin
month:= strtoint(copy(date,5,2));
day:= strtoint(copy(date,7,2));
year:= strtoint(copy(date,1,4));
if month > 2 then month:= month – 3
else begin
month:= month + 9;
year:= year – 1;
end;
ta:= 146097 * (year div 100) div 4;
tb:= 1461 * (year MOD 100) div 4;
tc:= (153 * month + 2) div 5 + day + 1721119;
result:= ta + tb + tc
end;
function mdy2date(month, day, year : integer): string;
var
y, m, d : string;
begin
y:= '000'+inttostr(year);
y:= copy(y,length(y)-3,4);
m:= '0'+inttostr(month);
m:= copy(m,length(m)-1,2);
d:= '0'+inttostr(day);
d:= copy(d,length(d)-1,2);
result:= y+m+d;
end;
function Julian2date(julian : longint): string;
{Получает значение и возвращает дату в формате YYYYMMDD}
var
x,y,d,m : longint;
month,day,year : integer;
begin
x:= 4 * julian – 6884477;
y:= (x div 146097) * 100;
d:= (x MOD 146097) div 4;
x:= 4 * d + 3;
y:= (x div 1461) + y;
d:= (x MOD 1461) div 4 + 1;
x:= 5 * d – 3;
m:= x div 153 + 1;
d:= (x MOD 153) div 5 + 1;
if m < 11 then month:= m + 2
else month:= m – 10;
day:= d;
year:= y + m div 11;
result:= mdy2date(month, day, year);
end;
function checkdate(date : string): boolean;
{Дата должна быть в формате YYYYMMDD.}
var
julian: longint;