Список стран (Турбо паскаль), и экспорт данных. Опции

[South Fruit]

Отдельной темой сделал
Дан файл товар, который содержит сведения об экспортируемых товарах с указанным наименованием товара страна импорта товара и объемом постоянной партии. Составить список стран в которые экспортируются данные товары и указать общий объем его экспорта.
Вот такая задача, нужно до завтра человеку.

[Айра]

Если я правильно поняла задание, то вот:

uses wincrt;
type
  StStrana = string[30];
  StTovar = string[30];
  StObyom = real;
  zap = record
    Strana: StStrana;
    Tovar: StTovar;
    Obyom: StObyom;
  end;

var Tov: file of zap;
    work: zap;
    Name,st: string;
    mas: array[1..10] of string;
    End_Menu: boolean;
    vid: byte;

procedure Name_File;
begin 
  Name:='Tovar';
end;

procedure AddRec;
  begin
    Writeln ('Ввод записи № ',FilePos(Tov)+1);
    with work do
      begin
        Write('Введите название товара: ');
        readln (Tovar);
        Write('Введите страну экспортера: ');
        readln (Strana);
        Write('Введите объем поставок: ');
        readln (Obyom);
        Write(Tov,work);
      end;
  end;

procedure Creat_File;
  var
  i,kol: integer;
begin
	Name_File;
  Assign(Tov, name);
  Rewrite(Tov);
  Writeln ('Создание сведений о товаре');
  Write ('Введите количество записей не большее 10: ');
  Readln(kol);
  for i:=1 to kol do
    AddRec;
  Writeln ('Создания сведений о товаре завершено');
  Writeln ('Файл данных имеет ',FileSize(Tov),' записи');
  Close(Tov);
end;

procedure OutputRec;
  begin
    Read(Tov, work);
    with work do
      begin
        write('Запись № ',FilePos(Tov),' :');
        Writeln('Страна: ',Strana,'| товар: ',Tovar,'|  объем поставок: ',Obyom:6:4,'');
      end;
  end;

procedure OutputAllRec;
  begin
    Name_File;
    Assign(Tov, Name);
    {$I-}
    Reset(Tov);
    {$I+}
    if Ioresult = 0 then
      begin
        Seek(Tov, 0);
        writeln ('Вывод записей');
        while (not Eof(Tov)) do
          OutputRec;
      end
    else
      writeln('Файла с именем '+Name+' на диске нет');
  end;

procedure Poisk_Stran;
var mas: array[1..10] of string;
    Tov: file of zap;
    work: zap;
    maska: StTovar;
    Rez_Find: boolean;
    CountRec,nom: integer;
    sum: real;
begin
  sum:=0;
  nom:=1;
  Name_File;
  Assign(Tov, Name);
  {$I-}
  Reset(Tov);
  {$I+}
  if IOresult = 0 then
    begin
      Write('Введите интересующий товар: ');
      readln(maska);
      Rez_Find:=false;
      CountRec:=0;
      while (not Eof(Tov)) do
        begin
          read(Tov,work);
          with work do
          if (pos(maska, Tovar) <> 0) and (length(maska) = length(Tovar)) then
          	begin
              mas[nom]:=Strana;
              sum:=sum+obyom;
              writeln (mas[nom]);
              inc(nom);
            end;
        end;
      writeln ('Общий объем поставок: ',sum:6:4,'');
    Close(Tov);
  end
  else
    writeln ('Файла с именем '+Name+' на диске нет');
end;


begin
  ClrScr;
  End_Menu:=false;
  repeat
    writeln('*** Экспорт товаров ***');
    writeln('Выберите действие');
    writeln('1 - создание нового файла');
    writeln('2 - просмотр всех записей');
    writeln('3 - создание списка экспортеров');
    writeln('0 - завершение работы');
    write('Ваш выбор: ');
    readln(vid);
    case vid of
      1: Creat_File;
      2: OutputAllRec;
      3: Poisk_Stran;
      0: End_Menu:=true;
    end;
    writeln('Для продолжения нажмите Enter');
    readln;
    ClrScr;
  until End_Menu;
end.

Но

У нее есть знание и задача, но не совсем правильная и ей нужна помощь

пусть эта девушка в следующий раз сама создает темы, задает вопросы и пытается делать программы... А раз у нее есть знания, то она сама сможет разобраться в вышеизложенной проге...


p.p.s. в поиске экспортеров добавила проверку товара еще и по длинне троки:

if (pos(maska, Tovar) <> 0) and (length(maska) = length(Tovar)) then

Теперь вроде должен выводить точно)))


Сообщение отредактировано: Айра - 13.04.2007 21:12