16.08.2018, 08:11 [+3 UTC]
в нашей команде: 2 913 чел. | участники онлайн: 1 (рекорд: 21)

:: РЕГИСТРАЦИЯ

:: задать вопрос

:: все разделы

:: правила

:: новости

:: участники

:: доска почёта

:: форум

:: блоги

:: поиск

:: статистика

:: наш журнал

:: наши встречи

:: наша галерея

:: отзывы о нас

:: поддержка

:: руководство

Версия системы:
7.47 (16.04.2018)

Общие новости:
13.04.2018, 10:33

Форум:
15.08.2018, 01:47

Последний вопрос:
13.08.2018, 01:44

Последний ответ:
12.08.2018, 20:20

Последняя рассылка:
15.08.2018, 21:45

Писем в очереди:
0

Мы в соцсетях:

Наша кнопка:

RFpro.ru - здесь вам помогут!

Отзывы о нас:
16.09.2009, 22:22 »
Sergey66
...Спасибо за оперативность! [вопрос № 172211, ответ № 254230]
13.11.2010, 19:35 »
Посетитель - 342817
Берусь за настройки. Благодарю за ответ. [вопрос № 180719, ответ № 264003]

РАЗДЕЛ • Pascal / Delphi / Lazarus

Создание программ на языках Pascal, Delphi и Lazarus.

[администратор рассылки: Зенченко Константин Николаевич (Модератор)]

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

Зенченко Константин Николаевич
Статус: Модератор
Рейтинг: 312
mklokov
Статус: 6-й класс
Рейтинг: 24
Асмик Гаряка
Статус: Советник
Рейтинг: 0

Перейти к консультации №:
 

Консультация онлайн # 191963
Раздел: • Pascal / Delphi / Lazarus
Автор вопроса: pNod (1-й класс)
Отправлена: 02.12.2017, 18:44
Поступило ответов: 1

Уважаемые эксперты! Пожалуйста, ответьте на вопрос:
у меня задача отсортировать массив алгоритмом простого выбора и отразить каждое перемещение элементов графически с помощью graphABC. Массив должен быть изображен в виде диаграммы, элемент - это столбик с высотой пропорциональной значению.
Сортировку сделала по возрастанию, возможности графического модуля изучила, но не могу понять - как собрать эти знания в кучу для выполнения данной задачи. Прошу помощи! smile
Изучаю Паскаль в ABC.net, работаю под Windows 7...

Состояние: Консультация закрыта

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

У Вас есть два варианта:
1)чистить экран;
2)чистить столбец цветом фона.
Оба они есть в коде:

Код (Pascal) :: выделить код
uses GRAPHABC;
const 
  N=5;
type 
  array1 = array[1..N] of integer; 
var 
  arr: array1; 
procedure gist(var arr: array1;arr_max,arr_min:integer);  
var w,h: integer;
   begin 
   //ClearWindow;// 
   w:=windowwidth div 2;
   h:=windowheight div 2;
    for i:integer:=1 to n do 
      begin 
        write(arr[i],' '); 
        Pen.Width := 15;// 
        Pen.Color := clWhite;// 
        line(w+i*20-2,h,w+i*20-2,0);// 
        Pen.Width := 10;
        Pen.Color := clRandom; 
        line(w+i*20,h,w+i*20,h-round((h div 2)*arr[i]/(arr_max-arr_min)));
      end;
      writeln;
    end;   
   
procedure sortirovka(var arr: array1); 
var 
  index_max, max,imax,imin: integer; 
begin 
  imax:=arr[1];
  imin:=arr[1];
  for var i:=1 to n do 
    if imax<arr[i] then imax:=arr[i] 
      else if imin>arr[i]then imin:=arr[i];
  for i:integer:=n downto 1 do 
    begin 
      index_max:=i; 
      max:=arr[i]; 
      for j:integer:=1 to i-1 do  
        if arr[j] > max then 
          begin 
            index_max:=j; 
            max:=arr[index_max]; 
          end;
        if index_max <> i then 
          begin 
            arr[index_max]:=arr[i]; 
            arr[i]:=max; 
       end;
       gist(arr,imax,imin);
       sleep(2000);
    end;
end;   
begin 
  Window.Title := 'Сортировка массива';
  setwindowsize(600,300);
  writeln('Элементы массива: ');
    for i:integer:=1 to n do 
      read(arr[i]); 
  sortirovka(arr);
  writeln;  
end.

Удачи!


Консультировал: Зенченко Константин Николаевич (Модератор)
Дата отправки: 05.12.2017, 10:23

5
нет комментария
-----
Дата оценки: 05.12.2017, 10:26

Рейтинг ответа:

0

[подробно]

Сообщение
модераторам

Отправлять сообщения
модераторам могут
только участники портала.
ВОЙТИ НА ПОРТАЛ »
регистрация »

Мини-форум консультации № 191963

Зенченко Константин Николаевич
Модератор

ID: 31795

# 1

= общий = | 02.12.2017, 19:56 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер
pNod:

Покажите, что у Вас есть, будем допиливать.

=====
Мне безразлично, что Вы думаете о обо мне, но я рад за Вас - Вы начали думать.
smile

pNod
1-й класс

ID: 401172

# 2

= общий = | 02.12.2017, 21:45 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер

© Цитата: Зенченко Константин Николаевич
Покажите, что у Вас есть, будем допиливать.

Вот до чего додумалась:
uses GRAPHABC;
const
  N=5;
type 
  array1 = array[1..N] of integer; 
var
  arr: array1; 

procedure gist(var arr: array1);  
var w: integer;
   begin
   setwindowsize(600,300);
        
    for i:integer:=1 to n do
      begin
        write(arr[i]:4); 
        w:=(windowwidth-20)div n;
        Pen.Width := 10;
        Pen.Color := clRandom; 
        line(i*20,100,i*20,100-arr[i]);
      end;
      write('   ');
    end;   
   
procedure sortirovka(var arr: array1); 
var 
  index_max, max: integer; 
begin
  for i:integer:=n downto 1 do 
    begin
      index_max:=i; 
      max:=arr[i]; 
      for j:integer:=1 to i-1 do  
        if arr[j] > max then 
          begin
            index_max:=j; 
            max:=arr[index_max]; 
          end;
        if index_max <> i then 
          begin
            arr[index_max]:=arr[i]; 
            arr[i]:=max; 
       end;
       gist(arr);
    end;
end;   

begin
  Window.Title := 'Сортировка массива';
  writeln('Элементы массива: ');
    for i:integer:=1 to n do
      read(arr[i]); 
  
  sortirovka(arr);
  writeln;  
  
end.

pNod
1-й класс

ID: 401172

# 3

= общий = | 02.12.2017, 21:49 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер

Если выводить программу на выполнение, видно, что картинка печатается на одном и том же месте... по крайней мере, появляются составные разноцветные столбики вместо однотонных.
Как сдвинуть не знаю. Думала привязку к системе координат делать, рассчитала ширину сдвига (w), куда ее прибавлять не понятно.

Зенченко Константин Николаевич
Модератор

ID: 31795

# 4

= общий = | 04.12.2017, 13:07 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер
pNod:

Простите долго не отвечал.
Все очень даже хорошо у Вас всё написано, мои маленькие изменения увидите.
smile

У Вас есть два варианта решения:
1)чистить окно- недостаток пропадает выводимые данные этапов сортировки(есть в коде //ClearWindow;//);
2)чистить выводимый столбец цветом фона, т.е. белым - предупреждение, если ширина кисти совпадает с шириной выводимого столбика, может появляться ореол, поэтому нужно будет менять ширину кисти на больший;
Добавлена ещё функция задержки, чтобы можно было любоваться работой программы и калибровка выводимых данных-если разница большая, то может быть построен неравномерный график.


Код (Pascal) :: выделить код
uses GRAPHABC;
const
  N=5;
type 
  array1 = array[1..N] of integer; 
var
  arr: array1; 
procedure gist(var arr: array1;arr_max,arr_min:integer);  
var w,h: integer;
   begin
   //ClearWindow;//
   w:=windowwidth div 2;
   h:=windowheight div 2;
    for i:integer:=1 to n do
      begin
        write(arr[i],' '); 
        Pen.Width := 15;//
        Pen.Color := clWhite;//
        line(w+i*20-2,h,w+i*20-2,0);//
        Pen.Width := 10;
        Pen.Color := clRandom; 
        line(w+i*20,h,w+i*20,h-round((h div 2)*arr[i]/(arr_max-arr_min)));
      end;
      writeln;
    end;   
   
procedure sortirovka(var arr: array1); 
var 
  index_max, max,imax,imin: integer; 
begin
  imax:=arr[1];
  imin:=arr[1];
  for var i:=1 to n do
    if imax<arr[i] then imax:=arr[i]
      else if imin>arr[i]then imin:=arr[i];
  for i:integer:=n downto 1 do 
    begin
      index_max:=i; 
      max:=arr[i]; 
      for j:integer:=1 to i-1 do  
        if arr[j] > max then 
          begin
            index_max:=j; 
            max:=arr[index_max]; 
          end;
        if index_max <> i then 
          begin
            arr[index_max]:=arr[i]; 
            arr[i]:=max; 
       end;
       gist(arr,imax,imin);
       sleep(2000);
    end;
end;   
begin
  Window.Title := 'Сортировка массива';
  setwindowsize(600,300);
  writeln('Элементы массива: ');
    for i:integer:=1 to n do
      read(arr[i]); 
  sortirovka(arr);
  writeln;  
end.

smile
Удачи!

=====
Мне безразлично, что Вы думаете о обо мне, но я рад за Вас - Вы начали думать.
smile

pNod
1-й класс

ID: 401172

# 5

= общий = | 04.12.2017, 14:03 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер

Спасибо за ответ!
Результат работы эффектный smile , я не подумала, что графику можно не тиражировать в одном окне)))
Я глянула код по быстрому, вроде понятно, но прошу Вас не закрывать пока консультацию, я вечером подробней посмотрю, вдруг вопросы интересные возникнут, а завтра отпишусь в любом случае, возникнут вопросы или нет smile , можно так?

Зенченко Константин Николаевич
Модератор

ID: 31795

# 6

= общий = | 04.12.2017, 14:08 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер
pNod:

© Цитата:
Состояние: Консультация активна (до закрытия: 3 сут. 04 час. 38 мин.)

Консультация автоматически закроется см. выше, мини-форум, остается активным в любом случае.
smile

=====
Мне безразлично, что Вы думаете о обо мне, но я рад за Вас - Вы начали думать.
smile

pNod
1-й класс

ID: 401172

# 7

= общий = | 05.12.2017, 10:18 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер

Вопросов не возникло smile !

• Отредактировал: pNod (1-й класс)
• Дата редактирования: 05.12.2017, 10:27

Зенченко Константин Николаевич
Модератор

ID: 31795

# 8

= общий = | 05.12.2017, 10:31 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер
pNod:

Удачи в программировании! smile

=====
Мне безразлично, что Вы думаете о обо мне, но я рад за Вас - Вы начали думать.
smile

pNod
1-й класс

ID: 401172

# 9

= общий = | 05.12.2017, 10:33 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер

smile спасибо!

 

Возможность оставлять сообщения в мини-форумах консультаций доступна только после входа в систему.
Воспользуйтесь кнопкой входа вверху страницы, если Вы зарегистрированы или пройдите простую процедуру регистрации на Портале.

Яндекс Rambler's Top100

главная страница | поддержка | задать вопрос

Время генерирования страницы: 0.14632 сек.

© 2001-2018, Портал RFPRO.RU, Россия
Калашников О.А.  |  Гладенюк А.Г.
Версия системы: 7.47 от 16.04.2018