Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

просьба помочь с вызовом функции в основной программе.

53K
29 октября 2009 года
Виталий_Сигов
1 / / 29.10.2009
Существует функция сравнения дат:
Код:
function compare(d_1, d_2: string): integer;

  function strtoint(s: string): integer;
  var res, code: integer;
  begin
    val(s, res, code);
    strtoint := res;
  end;
  function day(s: string): integer;
  begin
    day := strtoint(copy(s, 1, 2));
  end;
  function month(s: string): integer;
  begin
    month := strtoint(copy(s, 4, 2));
  end;
  function year(s: string): integer;
  begin
    year := strtoint(copy(s, 7, 2));
  end;

var
  yr1, yr2,
  mt1, mt2,
  dy1, dy2: integer;

begin
  yr1 := year(d_1); yr2 := year(d_2);
  if yr1 <> yr2 then compare := (yr1 - yr2) div abs(yr1 - yr2)
  else begin
    mt1 := month(d_1); mt2 := month(d_2);
    if mt1 <> mt2 then compare := (mt1 - mt2) div abs(mt1 - mt2)
    else begin
      dy1 := day(d_1); dy2 := day(d_2);
      if dy1 <> dy2 then compare := (dy1 - dy2) div abs(dy1 - dy2)
      else compare := 0;
    end
  end
end;


и основная программа:
Код:
program k_2_2;
uses crt;
label 1,4,5,6,8,9,10,12,20,30,40,18,19;
type
tovar=record
naimenovanie:string[30];
strana_exporter:string[30];
data_postavki:string[10];
kolichestvo_tovara:byte;
end;
var
tov:array[1..100] of tovar;
f:file of tovar;
date,str:string;
k,l,n:integer;
i,j:byte;
ch:char;
quit:boolean;
simb:set of char;
smb:set of char;
begin
10:clrscr;
textcolor(white);
writeln('   МЕНЮ   ');
writeln(' 1:  Создание файла ');
writeln(' 2:   Чтение файла  ');
writeln(' 3:  Добавление записи в файл  ');
writeln(' 4:  Выборка записей из файла  ');
writeln(' 5:      Выход      ');
{readln(k);}
repeat
ch:=readkey;
until ch in ['1'..'5'];
k:=ord(ch)-ord('0');
{readln(k);}
case k of
1:goto 6;
2:goto 20;
3:goto 30;
4:goto 40;
5:goto 12;
end;


6:clrscr;
writeln('Введите полный адрес и имя типизированного файла');readln(str);
{$I-}
assign(f,str);
rewrite(f);
{$I+}
if IoResult<>0 then begin
writeln('Повтори ввод полного пути и имени типизированного файла');
writeln('');
delay(500);
goto 6;
end
else
{$I-}
8:writeln('Введите количество записей');readln(n);
{$I+}
if (IoResult<>0) or (n<=0) then begin
writeln('Повтори ввод количества записей !!!');
delay(500);
goto 8;
end
else
writeln('Введите наименование товара, страну - экспортер, срок поставки и количество товара');
for i:=1 to n do begin
writeln('Введите данные ',i,' - й записи');
with tov do begin
simb:=['А'..'Я','а'..'я',' ',#8];
write('Введите наименование товара : ');
naimenovanie:='';
repeat
if keypressed then begin
ch:=readkey;
if ch in simb then begin
write(ch);
naimenovanie:=naimenovanie+ch;
end;
end;
until ch=#13;
ch:=#0;
writeln;
write('Введите страну - экспортер  : ');
strana_exporter:='';
repeat
if keypressed then begin
ch:=readkey;
if ch in simb then begin
write(ch);
strana_exporter:=strana_exporter+ch;
end;
end;
until ch=#13;
ch:=#0;
writeln;
smb:=['1'..'9','0','.',#8];
write('Введите дату поставки       : ');
data_postavki:='';
repeat
if keypressed then begin
ch:=readkey;
if ch in smb then begin
write(ch);
data_postavki:=data_postavki+ch;
end;
end;
until ch=#13;
ch:=#0;
writeln;
{$I-}
9:write('Введите количество товара   : '); readln(kolichestvo_tovara);
{$i+}
if (IoResult<>0) or (kolichestvo_tovara<=0) or(kolichestvo_tovara>1000) then begin
writeln('Повтори ввод количества товара !!!');
delay(500);
goto 9;
end
else
writeln;
writeln('Нажмите Enter');readln;
end;
write(f,tov);
end;
close(f);
str:='';
goto 10;

20:clrscr;
writeln('Введите полный адрес и имя типизированного файла');readln(str);
{$I-}
assign(f,str);
reset(f);
{$I+}
if IoResult<>0 then begin
writeln('Повтори ввод полного пути и имени типизированного файла');
writeln('');
delay(5000);
goto 20;
end
else
i:=0;
while not eof(f) do begin
i:=i+1;
read(f,tov);
writeln(tov.naimenovanie);
writeln(tov.strana_exporter);
writeln(tov.data_postavki);
writeln(tov.kolichestvo_tovara);

end;
close(f);
writeln;
writeln('Для выхода в меню нажмите клавишу Enter...');
readln;
goto 10;

30:clrscr;
writeln('Введите полный адрес и имя типизированного файла');readln(str);
{$I-}
assign(f,str);
reset(f);
{$I+}
if IoResult<>0 then begin
writeln('Повтори ввод полного пути и имени типизированного файла');
writeln('');
delay(5000);
goto 30;
end
else
n:=filesize(f);
seek(f,n);
n:=n+1;
18:writeln('Введите количество записей');readln(n);
{$I+}
if (IoResult<>0) or (n<=0) then begin
writeln('Повтори ввод количества записей !!!');
delay(500);
goto 18;
end
else
writeln('Введите наименование товара, страну - экспортер, срок поставки и количество товара');
for i:=1 to n do begin
writeln('Введите данные ',i,' - й записи');
with tov do begin
write('Введите наименование товара : '); readln(naimenovanie);
write('Введите страну - экспортер  : '); readln(strana_exporter);
write('Введите дату поставки       : '); readln(data_postavki);
{$I-}
19:write('Введите количество товара   : '); readln(kolichestvo_tovara);
{$i+}
if (IoResult<>0) or (kolichestvo_tovara<=0) or(kolichestvo_tovara>1000) then begin
writeln('Повтори ввод количества товара !!!');
delay(500);
goto 19;
end
else
writeln;
writeln('Нажмите Enter');readln;
end;
write(f,tov);
end;
close(f);
goto 10;

40:clrscr;
writeln('Введите полный адрес и имя типизированного файла');readln(str);
{$I-}
assign(f,str);
reset(f);
{$I+}
if IoResult<>0 then begin
writeln('Повтори ввод полного пути и имени типизированного файла');
writeln('');
delay(5000);
goto 40;
end
else
writeln('Введите дату'); readln(date);
i:=0;
j:=0;
while not eof(f) do begin
i:=i+1;
read(f,tov);
if tov.data_postavki<date then
begin
j:=1;
writeln(tov.naimenovanie);
writeln(tov.strana_exporter);
writeln(tov.data_postavki);
writeln(tov.kolichestvo_tovara);
end;
end;
if j=0 then writeln('Ни одна запись не удовлетворяет введенному условию');
close(f);
writeln;
writeln('Для выхода в меню нажмите клавишу Enter...');
readln;
goto 10;


12:clrscr;
writeln('Завершить работу программы ? ');
writeln('    "д" -да  "н"-нет   ');
repeat
if keypressed then
ch:=readkey;
case readkey of
'д':quit:=true;
'н':goto 10;
end;
until quit;
end.


Просьба помочь вызвать функцию в основной программе.
Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог