Технический форум

Технический форум (http://www.tehnari.ru/)
-   Delphi, Kylix and Pascal (http://www.tehnari.ru/f43/)
-   -   Составьте программу (http://www.tehnari.ru/f43/t249829/)

Rus555 04.11.2016 17:08

Составьте программу
 
1) составьте программу которая создает файл компонент которого имеют следующую структуру
Табельный номер
ФИО
оклад
введите в файл о пяти работниках выведите в другой файл данные о работнике имеющем максимальный оклад.

2) составьте программу которая по названию числа <1000 написанному на русском языке формирует его цифровую запись

Vladimir_S 04.11.2016 21:33

Цитата:

Сообщение от Rus555 (Сообщение 2430650)
1) составьте программу которая создает файл компонент которого имеют следующую структуру Табельный номер ФИО оклад введите в файл о пяти работниках выведите в другой файл данные о работнике имеющем максимальный оклад.

На подобные запросы всегда даю стандартный ответ: http://www.tehnari.ru/f41/t81350/#post827208
Цитата:

Сообщение от Rus555 (Сообщение 2430650)
2) составьте программу которая по названию числа <1000 написанному на русском языке формирует его цифровую запись

А вот это - пожалуйста:
Код:

Var
 N:Word;
 b1,b10,b100,bf:boolean;
 S:String;
 Nw,i,H,T,U,F:byte;
 W:Array[1..3] of String;

Procedure Hundr(R:String; var NH:byte; var b:boolean);
begin
 b:=false;
 if R='сто'      then begin NH:=1; b:=true; end else
 if R='двести'    then begin NH:=2; b:=true; end else
 if R='триста'    then begin NH:=3; b:=true; end else
 if R='четыреста' then begin NH:=4; b:=true; end else
 if R='пятьсот'  then begin NH:=5; b:=true; end else
 if R='шестьсот'  then begin NH:=6; b:=true; end else
 if R='семьсот'  then begin NH:=7; b:=true; end else
 if R='восемьсот' then begin NH:=8; b:=true; end else
 if R='девятьсот' then begin NH:=9; b:=true; end;
end;

Procedure Tens(R:String; var NT:byte; var b:boolean);
begin
 b:=false;
 if R='двадцать'    then begin NT:=2; b:=true; end else
 if R='тридцать'    then begin NT:=3; b:=true; end else
 if R='сорок'      then begin NT:=4; b:=true; end else
 if R='пятьдесят'  then begin NT:=5; b:=true; end else
 if R='шестьлесят'  then begin NT:=6; b:=true; end else
 if R='семьдесят'  then begin NT:=7; b:=true; end else
 if R='восемьдесят' then begin NT:=8; b:=true; end else
 if R='девяносто'  then begin NT:=9; b:=true; end;
end;

Procedure Units(R:String; var NU:byte; var b:boolean);
begin
 b:=false;
 if R='один'  then begin NU:=1; b:=true; end else
 if R='два'    then begin NU:=2; b:=true; end else
 if R='три'    then begin NU:=3; b:=true; end else
 if R='четыре' then begin NU:=4; b:=true; end else
 if R='пять'  then begin NU:=5; b:=true; end else
 if R='шесть'  then begin NU:=6; b:=true; end else
 if R='семь'  then begin NU:=7; b:=true; end else
 if R='восемь' then begin NU:=8; b:=true; end else
 if R='девять' then begin NU:=9; b:=true; end;
end;

Procedure Teens(R:String; var NF:byte; var b:boolean);
begin
 b:=false;
 if R='десять'      then begin NF:=10; b:=true; end else
 if R='одиннадцать'  then begin NF:=11; b:=true; end else
 if R='двенадцать'  then begin NF:=12; b:=true; end else
 if R='тринадцать'  then begin NF:=13; b:=true; end else
 if R='четырнадцать' then begin NF:=14; b:=true; end else
 if R='пятнадцать'  then begin NF:=15; b:=true; end else
 if R='шестнадцать'  then begin NF:=16; b:=true; end else
 if R='семнадцать'  then begin NF:=17; b:=true; end else
 if R='восемнадцать' then begin NF:=18; b:=true; end else
 if R='девятнадцать' then begin NF:=19; b:=true; end;
end;

Begin
 Repeat
  Writeln('Введите название числа, меньшего 1000 без отступа в начале,');
  Writeln('с однократными пробелами и без точки в конце.');
  Writeln('Для выхода из программы введите "ноль" (без кавычек).');
  Readln(S);
  if S<>'ноль' then
  begin
    NW:=0;
    for i:=1 to 3 do W[i]:='';
    i:=0;
    Repeat
    Inc(NW);
    repeat
      Inc(i);
      if S[i]<>' ' then W[NW]:=W[NW]+S[i];
    until (S[i]=' ') or (i=Length(S));
    Until i=Length(S);

    if NW=1 then
    begin
      Units(W[1],U,b1);
      Tens(W[1],T,b10);
      Hundr(W[1],H,b100);
      Teens(W[1],F,bf);
      if b1 then N:=U else
      if b10 then N:=10*T else
      if b100 then N:=100*H else N:=F;
    end else
    if NW=2 then
    begin
      Units(W[2],U,b1);
      Teens(W[2],F,bf);
      Tens(W[2],T,b10);
      if b1 then N:=U else
      if bf then N:=F else N:=T*10;
      if b1 then
      begin
        Tens(W[1],T,b10);
        if b10 then N:=N+10*T else
        begin
          Hundr(W[1],H,b100);
          N:=N+100*H;
        end;
      end else
      if bf then
      begin
        Hundr(W[1],H,b100);
        N:=N+100*H;
      end;
    end else
    begin
      Units(W[3],U,b1);
      Tens(W[2],T,b10);
      Hundr(W[1],H,b100);
      N:=100*H+10*T+U;
    end;
    Writeln(N);
  end;
 Until S='ноль';
End.


Rus555 05.11.2016 15:04

Подскажите пожалуйста что нужно вводить на саму форму TEdit,TLabel, Button?

Vladimir_S 05.11.2016 15:20

Цитата:

Сообщение от Rus555 (Сообщение 2431004)
Подскажите пожалуйста что нужно вводить на саму форму TEdit,TLabel, Button?

Нужно было с самого начала оговорить, что требуется программа на Delphi, а не на Pascal. Извините, Delphi знаю плохо.

Rus555 05.11.2016 18:40

То есть в лазарусе этот код не будет работать?

Vladimir_S 05.11.2016 19:44

Цитата:

Сообщение от Rus555 (Сообщение 2431092)
То есть в лазарусе этот код не будет работать?

Ах еще и Лазарус? Нет, напрямую не будет, нужно организовать ввод/вывод через формы. Всё остальное - годится.

Rus555 05.11.2016 19:47

большое спасибо вам


Часовой пояс GMT +4, время: 06:26.

Powered by vBulletin® Version 4.5.3
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.