12.12.2017, 18:53 [+3 UTC]
в нашей команде: 2 373 чел. | участники онлайн: 18 (рекорд: 21)

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

:: консультации

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

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

:: правила

:: новости

:: участники

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

:: форум

:: блоги

:: поиск

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

:: наш журнал

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

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

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

:: поддержка

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

Версия системы:
7.41 (25.02.2017)

Общие новости:
23.02.2017, 09:51

Форум:
12.12.2017, 02:52

Последний вопрос:
12.12.2017, 17:45

Последний ответ:
12.12.2017, 16:34

Последняя рассылка:
12.12.2017, 18:15

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

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

Наша кнопка:

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

Отзывы о нас:
18.11.2009, 07:42 »
Roma2010
Cпасибо за ценный совет! GRUB уже и установил! [вопрос № 174334, ответ № 256648]
31.10.2009, 23:54 »
Rasul
Спасибо за совет! Удалил 2 антивируса, оставил НОД32. [вопрос № 173865, ответ № 256059]
07.02.2016, 22:54 »
svrvsvrv
Большое спасибо за помощь. Установка получилась. [вопрос № 188776, ответ № 273351]

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

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

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

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

Зенченко Константин Николаевич
Статус: Модератор
Рейтинг: 432
Вадим Исаев ака sir Henry
Статус: Старший модератор
Рейтинг: 42
mklokov
Статус: 6-й класс
Рейтинг: 23

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

Консультация онлайн # 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:

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

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
Удачи!

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

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

pNod
1-й класс

ID: 401172

# 9

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

smile спасибо!

 

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

Яндекс Rambler's Top100

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

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

© 2001-2017, Портал RFPRO.RU, Россия
Авторское право: ООО "Мастер-Эксперт Про"
Калашников О.А.  |  Гладенюк А.Г.
Версия системы: 7.41 от 25.02.2017
Бесплатные консультации онлайн