Валентин Озеров - Советы по Delphi. Версия 1.0.6
- Название:Советы по Delphi. Версия 1.0.6
- Автор:
- Жанр:
- Издательство:неизвестно
- Год:неизвестен
- ISBN:нет данных
- Рейтинг:
- Избранное:Добавить в избранное
-
Отзывы:
-
Ваша оценка:
Валентин Озеров - Советы по Delphi. Версия 1.0.6 краткое содержание
Советы по Delphi. Версия 1.0.6 - читать онлайн бесплатно полную версию (весь текст целиком)
Интервал:
Закладка:
ChunkSize.x:=M1;
with Ki.WAV do case nChannels of
1:
if nBitsPerSample=16 then begin {1..2 Помещаем в буфер одноканальный 16-битный сэмпл}
Ki.yyy[N]:=1.0*ChunkSize.up;
if N
N:= N+2;
end else begin {1..4 Помещаем в буфер одноканальный 8-битный сэмпл}
for I:=0 to 3 do Ki.yyy[N+I]:=1.0*ChunkSize.chrs[I];
N := N+4;
end;
2:
if nBitsPerSample=16 then begin {2 Двухканальный 16-битный сэмпл}
Ki.yyy[N]:=1.0*ChunkSize.dn;
Kj.yyy[N]:=1.0*ChunkSize.up;
N:= N+1;
end else begin {4 Двухканальный 8-битный сэмпл}
Ki.yyy[N]:=1.0*ChunkSize.chrs[1];
Ki.yyy[N+1]:=1.0*ChunkSize.chrs[3];
Kj.yyy[N]:=1.0*ChunkSize.chrs[0];
Kj.yyy[N+1]:=1.0*ChunkSize.chrs[2];
N:= N+2;
end;
end;
if N<=MaxN then begin {LastN:= N;}
Ki.Last:= N;
if Ki.WAV.nChannels=2 then Kj.Last := N;
end else begin {lastn := maxn;}
Ki.Last:= MaxN;
if Ki.WAV.nChannels=2 then Kj.Last := MaxN;
end;
end;
end; {ReadOneDataBlock}
procedure ReadWAVFile(var Ki, K : Observation);
var MM: Byte;
I: Integer;
OK: Boolean;
NoDataYet: Boolean;
DataYet: Boolean;
nDataBytes: LongInt;
begin
if FileExists(StandardInput)then with Ki.WAV do begin { Вызов диалога открытия файла }
OK:= True; {если не изменится где-нибудь ниже}
{Приготовления для чтения файла данных}
AssignFile(InFile, StandardInput); { Файл, выбранный в диалоговом окне }
Reset(InFile);
{Считываем ChunkName "RIFF"}
ReadChunkName;
if ChunkName<>'RIFF' then OK:= False;
{Считываем ChunkSize}
ReadChunkSize;
RIFFSize:= ChunkSize.lint; {должно быть 18,678}
{Считываем ChunkName "WAVE"}
ReadChunkName;
if ChunkName<>'WAVE' then OK:= False;
{Считываем ChunkName "fmt_"}
ReadChunkName;
if ChunkName<>'fmt ' then OK:= False;
{Считываем ChunkSize}
ReadChunkSize;
fmtSize:= ChunkSize.lint; {должно быть 18}
{Считываем formatTag, nChannels}
ReadChunkSize;
ChunkSize.x:= M1;
formatTag:= ChunkSize.up;
nChannels:= ChunkSize.dn;
{Считываем nSamplesPerSec}
ReadChunkSize;
nSamplesPerSec := ChunkSize.lint;
{Считываем nAvgBytesPerSec}
ReadChunkSize;
nAvgBytesPerSec:= ChunkSize.lint;
{Считываем nBlockAlign}
ChunkSize.x:= F0;
ChunkSize.lint:= 0;
for i:= 0 to 3 do begin
Read(InFile, MM);
ChunkSize.chrs[I]:= MM;
end;
ChunkSize.x:= M1;
nBlockAlign:= ChunkSize.up;
{Считываем nBitsPerSample}
nBitsPerSample:= ChunkSize.dn;
for I:= 17 to fmtSize do Read(InFile,MM);
NoDataYet:= True;
while NoDataYet do begin
{Считываем метку блока данных "data"}
ReadChunkName;
{Считываем DataSize}
ReadChunkSize;
DataSize:= ChunkSize.lint;
if ChunkName <> 'data' then begin
for I:= 1 to DataSize do {пропуск данных, не относящихся к набору звуковых данных}
Read(InFile, MM);
end else NoDataYet:= False;
end;
nDataBytes:= DataSize;
{Наконец, начинаем считывать данные для байтов nDataBytes}
if nDataBytes>0 then DataYet:= True;
N:=0; {чтение с первой позиции}
while DataYet do begin
ReadOneDataBlock(Ki,Kj); {получаем 4 байта}
nDataBytes:= nDataBytes-4;
if nDataBytes<=4 then DataYet:= False;
end;
ScaleData(Ki);
if Ki.WAV.nChannels=2 then begin Kj.WAV:= Ki.WAV;
ScaleData(Kj);
end;
{Освобождаем буфер файла}
CloseFile(InFile);
end else begin
InitSpecs;{файл не существует}
InitSignals(Ki);{обнуляем массив "Ki"}
InitSignals(Kj);{обнуляем массив "Kj"}
end;
end; { ReadWAVFile}
{================= Операции с набором данных ====================}
const MaxNumberOfDataBaseItems = 360;
type SignalDirectoryIndex = 0..MaxNumberOfDataBaseItems;
VAR DataBaseFile: file of Observation;
LastDataBaseItem: LongInt; {Номер текущего элемента набора данных}
ItemNameS: array[SignalDirectoryIndex] of String[40];
procedure GetDatabaseItem(Kk : Observation; N : LongInt);
begin
if N
Seek(DataBaseFile, N);
Read(DataBaseFile, Kk);
end else InitSignals(Kk);
end; {GetDatabaseItem}
procedure PutDatabaseItem(Kk : Observation; N : LongInt);
begin
if N<=LastDataBaseItem then begin
Seek(DataBaseFile, N);
Write(DataBaseFile, Kk);
LastDataBaseItem:= LastDataBaseItem+1;
end else while lastdatabaseitem<=n do begin
Seek(DataBaseFile, LastDataBaseItem);
Write(DataBaseFile, Kk);
LastDataBaseItem:= LastDataBaseItem+1;
end else ReportError(1); {Попытка чтения MaxNumberOfDataBaseItems}
end; {PutDatabaseItem}
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
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);
Интервал:
Закладка:
