Отправляет email-рассылки с помощью сервиса Sendsay

RFpro.ru: Программирование на Delphi и Lazarus

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 3.307 RSS
←   Июнь 2016   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30


За последние 60 дней ни разу не выходила


Сайт рассылки: http://rusfaq.ru/
Открыта: 14-03-2002

Автор
Калашников О.А.

Статистика

3.307 подписчиков
0 за неделю
←   Все выпуски   →

RFpro.ru: Программирование на Delphi и Lazarus


РАССЫЛКИ ПОРТАЛА RFPRO.RU

Лучшие эксперты в разделе

Евгений/Genia007/
Статус: Профессионал
Рейтинг: 277
∙ повысить рейтинг » 		Асмик Гаряка
Статус: Советник
Рейтинг: 2
∙ повысить рейтинг » 		Максим
Статус: 1-й класс
Рейтинг: 0
∙ повысить рейтинг »

∙ Pascal / Delphi / Lazarus

Номер выпуска:1693
Дата выхода:20.06.2016, 16:21
Администратор рассылки:Зенченко Константин Николаевич (Модератор)
Подписчиков / экспертов:21 / 17
Вопросов / ответов:1 / 1

Консультация # 189568: Уважаемые эксперты! Пожалуйста, ответьте на вопрос: Имеется задача для Delphi: Заполните список игрушек, некоторые из которых имеются в N детских садах. Определить игрушки из списка: которых нет ни в одном из детсадов; которые есть в каждом из детсадов. У меня так получилось:

Консультация # 189568:

Уважаемые эксперты! Пожалуйста, ответьте на вопрос:

Имеется задача для Delphi:
Заполните список игрушек, некоторые из которых имеются в N детских садах.
Определить игрушки из списка:
которых нет ни в одном из детсадов;
которые есть в каждом из детсадов.

У меня так получилось:

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, jpeg, ExtCtrls;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
 
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}


procedure TForm2.Button1Click(Sender: TObject);

type igr=(kb,kn,kk,ms,lg,pr,vl); //перечислимый тип
     mnz=set of igr;//тип множества
const k=7;//список игрушек
      sp:array[0..k-1] of string=('кубики','конструктор','кукла','машинка',
                                  'лего','пирамидка','велосипед');
var m:array[1..20] of mnz; //массив множеств
    m1:mnz;
    i:igr;
    n,j,v:integer;
begin
repeat
memo1.Lines[0]:='Количество детсадов до 20 n=';
n:=StrToInt(Edit1.Text);
until n in [1..20];
memo1.Lines[0]:='Перечислите в каком из '+IntToStr(n)+' детсадов какие игрушки';
for j:=1 to n do
 begin
memo1.Lines[1]:='Детсад '+IntToStr(j);
  m[j]:=[];
memo1.Lines[2]:='Выберите игрушки';
memo1.Lines[3]:='0-кубики 1-конструктор 2-кукла 3-машинка 4-лего 5-пирамидка 6-велосипед 7-выход';
  repeat
  v:=StrToInt(Edit2.Text);
   if v in [0..k-1] then m[j]:=m[j]+[igr(v)];//заполняем множества
  until v=7;

 end;
memo1.Lines[4]:='Полный список игрушек:';
for i:=kb to vl do
memo1.Lines[5]:=sp[ord(i)]+' ';
memo1.Lines[6]:='Список игрушек в детсадах:';
for j:=1 to n do
 begin
  memo1.Lines[j+6]:=IntToStr(j)+' - ';
  for i:=kb to vl do
  if i in m[j] then memo1.Lines[j+6]:=memo1.Lines[j+6]+sp[ord(i)]+' ';
 end;
memo1.Lines[n+7]:='Игрушки, которых нет ни в одном детсаду:';
m1:=[kb,kn,kk,ms,lg,pr,vl];//полное множество
for j:=1 to n do
m1:=m1-m[j];//вычитаем все по садам
if m1=[] then memo1.Lines[n+8]:='Таких игрушек нет'//если ничего не осталось
else
 for i:=kb to vl do //если осталось
 if i in m1 then memo1.Lines[n+8]:=sp[ord(i)];
memo1.Lines[n+9]:='Игрушки, которые есть в каждом детсаду:';
m1:=m[1]; //первый сад
for j:=1 to n do
m1:=m1*m[j];//пересекаем с остальными
if m1=[] then memo1.Lines[n+10]:='Таких игрушек нет'//если пересечение пустое
else
 for i:=kb to vl do //если нет
 if i in m1 then memo1.Lines[j+15]:=sp[ord(i)];
end;
end.


Только у меня не получилось реализовать заполнение множества в цикле

Пример рабочей программы в паскале:
type igr=(kb,kn,kk,ms,lg,pr,vl); //перечислимый тип
     mnz=set of igr;//тип множества
const k=7;//список игрушек
      sp:array[0..k-1] of string=('кубики','конструктор','кукла','машинка',
                                  'лего','пирамидка','велосипед');
var m:array[1..20] of mnz; //массив множеств
    m1:mnz;
    i:igr;
    n,j,v:byte;
begin
repeat
write('Количество детсадов до 20 n=');
readln(n);
until n in [1..20];
writeln('Перечислите в каком из ',n,' детсадов какие игрушки)');
for j:=1 to n do
 begin
  writeln('Детсад ',j);
  m[j]:=[];
  writeln('Выберите игрушки');
  writeln('0-кубики 1-конструктор 2-кукла 3-машинка 4-лего 5-пирамидка 6-велосипед 7-выход');
  repeat
   readln(v);
   if v in [0..k-1] then m[j]:=m[j]+[igr(v)];//заполняем множества
  until v=7;

 end;
writeln('Полный список игрушек:');
for i:=kb to vl do
write(sp[ord(i)],' ');
writeln;
writeln;
writeln('Список игрушек в детсадах:');
for j:=1 to n do
 begin
  write(j:2,' - ');
  for i:=kb to vl do
  if i in m[j] then write(sp[ord(i)],' ');
  writeln;
 end;
writeln('Игрушки, которых нет ни в одном детсаду:');
m1:=[kb,kn,kk,ms,lg,pr,vl];//полное множество
for j:=1 to n do
m1:=m1-m[j];//вычитаем все по садам
if m1=[] then writeln('Таких игрушек нет')//если ничего не осталось
else
 for i:=kb to vl do //если осталось
 if i in m1 then writeln(sp[ord(i)]);
writeln;
writeln('Игрушки, которые есть в каждом детсаду:');
m1:=m[1]; //первый сад
for j:=1 to n do
m1:=m1*m[j];//пересекаем с остальными
if m1=[] then writeln('Таких игрушек нет')//если пересечение пустое
else
 for i:=kb to vl do //если нет
 if i in m1 then writeln(sp[ord(i)]);
readln
end.


Ну и примерный результат:

Количество детсадов до 20 n=5

Перечислите в каком из 5 детсадов какие игрушки)

Детсад 1
Выберите игрушки
0-кубики 1-конструктор 2-кукла 3-машинка 4-лего 5-пирамидка 6-велосипед 7-выход
0
1
7

Детсад 2
Выберите игрушки
0-кубики 1-конструктор 2-кукла 3-машинка 4-лего 5-пирамидка 6-велосипед 7-выход
0
1
2
7

Детсад 3
Выберите игрушки
0-кубики 1-конструктор 2-кукла 3-машинка 4-лего 5-пирамидка 6-велосипед 7-выход
0
1
7

Детсад 4
Выберите игрушки
0-кубики 1-конструктор 2-кукла 3-машинка 4-лего 5-пирамидка 6-велосипед 7-выход
0
1
2
3
4
5
7

Детсад 5
Выберите игрушки
0-кубики 1-конструктор 2-кукла 3-машинка 4-лего 5-пирамидка 6-велосипед 7-выход
0
1
3
2
7

Полный список игрушек:
кубики конструктор кукла машинка лего пирамидка велосипед


Список игрушек в детсадах:
1 - кубики конструктор
2 - кубики конструктор кукла
3 - кубики конструктор
4 - кубики конструктор кукла машинка лего пирамидка
5 - кубики конструктор кукла машинка
Игрушки, которых нет ни в одном детсаду:
велосипед

Игрушки, которые есть в каждом детсаду:
кубики
конструктор


Дата отправки: 10.06.2016, 16:07
Вопрос задал: almazmr (Посетитель)
Всего ответов: 1
Страница онлайн-консультации »

Консультирует Зенченко Константин Николаевич (Модератор):

Здравствуйте, almazmr!

Смотрте приложение.

Код (Pascal) :: выделить код
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
type
  TMode=(add,dat,shw);
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    ListBox1: TListBox;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Edit1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ListBox1Click(Sender: TObject);
  private{ Private declarations }
  public{ Public declarations }
  end;
const
  szAddList=7;
  szFileList=2;
  szShowList=3;
  AddList:array[0..szAddList]of string=('','kubiky','konstructor','kukly','mashinky','lego','piramidy','velosiped');
  FileList:array[0..szFileList]of string=('','save to file','load from file');
  ShowList:array[0..szShowList]of string=('','Full toys list in all preschool','Present in all preschool','No present in any preschool');
var
  Form1:TForm1;
  isMode:TMode;
  FileName:string;
implementation
{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Visible:=false;
  ListBox1.Visible:=false;
  Memo1.Visible:=false;
  Memo2.Visible:=false;
  Label1.Caption:='Select mode';
  Button1.Caption:='Add';
  Button2.Caption:='File';
  Button3.Caption:='Show';
  Edit1.Clear;
  ListBox1.Clear;
  Memo1.Clear;
  memo2.Clear;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  i:integer;
begin
  isMode:=add;
  Label1.Caption:='Enter preschool numbers';
  Button1.Visible:=false;
  Button2.Visible:=false;
  Button3.Visible:=false;
  Edit1.Clear;
  Edit1.Visible:=true;
  Memo1.Lines.Add('');
  ListBox1.Items.Clear;
  for i:=0 to szAddList do
    ListBox1.Items.Add(AddList[i]);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
  i:integer;
begin
  isMode:=dat;
  Label1.Caption:='Enter file name';
  Button1.Visible:=false;
  Button2.Visible:=false;
  Button3.Visible:=false;
  Edit1.Clear;
  Edit1.Visible:=true;
  ListBox1.Items.Clear;
  for i:=0 to szFileList do
    ListBox1.Items.Add(FileList[i]);
  Memo1.Visible:=false;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
  i:integer;
begin
  isMode:=shw;
  Label1.Caption:='Select function';
  Button1.Visible:=false;
  Button2.Visible:=false;
  Button3.Visible:=false;
  ListBox1.Items.Clear;
  for i:=0 to szShowList do
    ListBox1.Items.Add(ShowList[i]);
  ListBox1.Visible:=true;
  Memo1.Visible:=false;
  Memo2.Visible:=true;
end;
procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  a:string;
  i:integer;
begin
  if Key=13 then
    case isMode of
      add:begin
            Label1.Caption:='Select toys';
            i:=Memo1.Lines.Count;
            a:=Edit1.Text;
            while(pos(a,Memo1.Lines[i])=0)and(0<=i)do dec(i);
            a:='Preschool-'+Edit1.Text+':';
            if 0<=i then
              begin
                a:=Memo1.Lines[i];
                Memo1.Lines.Delete(i);
              end;
            Memo1.Lines[Memo1.Lines.Count-1]:=a;{'Preschool-'+Edit1.Text+':';}
            Edit1.Visible:=false;
            ListBox1.Visible:=true;
            Memo1.Visible:=true;
          end;
      dat:begin
            FileName:=Edit1.Text;
            Label1.Caption:='Select operation';
            Edit1.Visible:=false;
            ListBox1.Visible:=true;
          end;
      shw:{only for syntax}
      end;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
var
  a:string;
  i,j:integer;
begin
  case isMode of
    add:begin
          if pos(ListBox1.Items[ListBox1.ItemIndex],Memo1.Lines[Memo1.Lines.Count-1])=0then
            Memo1.Lines[Memo1.Lines.Count-1]:= Memo1.Lines[Memo1.Lines.Count-1]+' '+ListBox1.Items[ListBox1.ItemIndex];
        end;
    dat:begin
          if ListBox1.ItemIndex=0
            then MessageBox(Self.Handle,pchar('Select any operation'),pchar('Preschool'),mb_ok)
            else
            begin
              case ListBox1.ItemIndex of
                1:Memo1.Lines.SaveToFile(FileName);
                2:Memo1.Lines.LoadFromFile(FileName);
                end;
            end;
        end;
    shw:begin
          if ListBox1.ItemIndex>0 then
            begin
              Memo2.Lines.Add(ListBox1.Items[ListBox1.ItemIndex]+' ');
              case ListBox1.ItemIndex of
                1:begin
                    a:='';
                    for i:=0 to Memo1.Lines.Count-1 do
                      for j:=1 to szAddList do
                        if(pos(AddList[j],a)=0)and(pos(AddList[j],Memo1.Lines[i])>0)then
                          a:=a+' '+AddList[j];
                  end;
                2:begin
                    a:='';
                    for i:=1 to szAddlist do a:=a+' '+AddList[i];
                    for i:=0 to Memo1.Lines.Count-1 do
                      for j:=1 to szAddList do
                        if(pos(AddList[j],a)>0)and(pos(AddList[j],Memo1.Lines[i])=0)then
                          delete(a,pos(AddList[j],a),length(AddList[j]));
                  end;
                3:begin
                    a:='';
                    for i:=1 to szAddlist do a:=a+' '+AddList[i];
                    for i:=0 to Memo1.Lines.Count-1 do
                      for j:=1 to szAddList do
                        if(pos(AddList[j],a)>0)and(pos(AddList[j],Memo1.Lines[i])>0)then
                          delete(a,pos(AddList[j],a),length(AddList[j]));
                  end;
                end;
              while pos('  ',a)>0 do delete(a,pos('  ',a),1);
              if length(a)<2 then a:='no any toys';
              Memo2.Lines.Add(a+' ');
            end;
        end;
    end;
  if(ListBox1.ItemIndex=0)xor(isMode=dat) then
    begin
      ListBox1.Visible:=false;
      Memo1.Visible:=false;
      Memo2.Visible:=false;
      Button1.Visible:=true;
      Button2.Visible:=true;
      Button3.Visible:=true;
    end;
end;
end.

дополнительно прикрепил сам проэкт.
Удачи!

Консультировал: Зенченко Константин Николаевич (Модератор)
Дата отправки: 16.06.2016, 14:44
Прикреплённый файл: посмотреть » [211.5 кб]
Рейтинг ответа:

НЕ одобряю 0 одобряю!

Оценить выпуск | Задать вопрос экспертам

главная страница  |  стать участником  |  получить консультацию
техническая поддержка

Дорогой читатель!
Команда портала RFPRO.RU благодарит Вас за то, что Вы пользуетесь нашими услугами. Вы только что прочли очередной выпуск рассылки. Мы старались. Пожалуйста, оцените его. Если совет помог Вам, если Вам понравился ответ, Вы можете поблагодарить автора - для этого в каждом ответе есть специальные ссылки. Вы можете оставить отзыв о работе портале. Нам очень важно знать Ваше мнение. Вы можете поближе познакомиться с жизнью портала, посетив наш форум, почитав журнал, который издают наши эксперты. Если у Вас есть желание помочь людям, поделиться своими знаниями, Вы можете зарегистрироваться экспертом. Заходите - у нас интересно!
МЫ РАБОТАЕМ ДЛЯ ВАС!
В избранное