Версия для печати темы

Автор: Виталий_Сигов 25.10.2009 23:25

Здравствуйте, уважаемые форумчане.
Решаю задачу с файлом записей:
Каждая запись содержит следующую информацию об экспортируемых товарах: наименование, страна-экспортер, срок поставки, количество товара. Вывести сведения обо всех странах, в которые должен быть поставлен товар до указанной даты.

Тип поля "Дата" у меня - строковый. Вводится дата в формате ДД.ММ.ГГГГ

Вопрос: Как преобразовать значения ДД ММ ГГГГ из тсрокового в числовой формат и при этом сохранив знак "." ?

Код своей программы привожу:

Автор: volvo 25.10.2009 23:44

Автор: Виталий_Сигов 26.10.2009 1:20

Большое спасибо за подсказку. Попробовал сделать по аналогии с приведенным по ссылке примером - не получилось.
Будьте добры, помогите, пожалуйста.

Автор: volvo 26.10.2009 2:40

Набирал прямо здесь:

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;

Автор: Гость 26.10.2009 14:04

Большое спасибо за помощь!

Автор: Виталий_Сигов 26.10.2009 14:06

Цитата(Гость @ 26.10.2009 10:04)

Автор: Гость 29.10.2009 18:45

Спасибо большое за функцию, но, подскажите, пожалуйста, как ее вызвать в основной программе ?
Извините, что программа написана с использованием меток-это главное условие задачи.

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[i] 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[i]);
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[i]);
writeln(tov[i].naimenovanie);
writeln(tov[i].strana_exporter);
writeln(tov[i].data_postavki);
writeln(tov[i].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[i] 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[i]);
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[i]);
if tov[i].data_postavki<date then
begin
j:=1;
writeln(tov[i].naimenovanie);
writeln(tov[i].strana_exporter);
writeln(tov[i].data_postavki);
writeln(tov[i].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.

Автор: Виталий_Сигов 29.10.2009 18:48

Прошу прощения, забыл войти под своим логином.

Автор: volvo 29.10.2009 19:02

{ if tov[i].data_postavki<date then } { <- Заменить на вызов функции: }
if compare(tov[i].data_postavki, date) < 0 then
begin
  j:=1;
  writeln(tov[i].naimenovanie);
  writeln(tov[i].strana_exporter);
  writeln(tov[i].data_postavki);
  writeln(tov[i].kolichestvo_tovara);
end;