Поменять столбики местами

@Rolion · Регистрация: 04.01.2011

Студворк — интернет-сервис помощи студентам

Всем привет! Написал процедуру, но она не работает (хотя вроде все выполняется). Конкретнее. Два столбца с номерами c1 и c2 должны сначала окрашиваться в зелёный цвет, а потом поменяться местами. Но ничего не происходит, хотя все функции выполняются. В массиве А хранятся высоты столбов. Они плотно идут от точки (x, y) и каждый имеет ширину w. Собственно процедура:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
procedure TForm1.Chandge(c1,c2:integer);
begin
  with Form1.Image1.Canvas do
    begin
      Brush.Color:=RGB(0,255,0);
      Pen.Color:=RGB(0,0,0);
      sleep(100);
      Rectangle(x+(c1-1)*w,y-A[c1],x+c1*w,y);
      Rectangle(x+(c2-1)*w,y-A[c2],x+c2*w,y);
      Brush.Color:=RGB(255,255,255);
      sleep(100);
      FillRect(Bounds(x+(c1-1)*w,y-320,x+c1*w,y));
      FillRect(Bounds(x+(c2-1)*w,y-320,x+c2*w,y));
      Brush.Color:=RGB(255,0,0);
      Rectangle(x+(c1-1)*w,y-A[c2],x+c1*w,y);
      Rectangle(x+(c2-1)*w,y-A[c1],x+c2*w,y);
    end;
end;

Заранее спасибо.

@FIL · 20.11.2012, 20:35

Проверил со значениями "от балды", что-то рисует:

Delphi
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
31
procedure TForm1.Chandge(c1,c2:integer);
var
  A : array[0..20] of integer;
  x,y,w: integer;
begin
  x := 50;
  y := 50;
  w := 5;
  A[c1] := 10;
  A[c2] := 50;
  with Form1.Image1.Canvas do
    begin
      Brush.Color:=RGB(0,255,0);
      Pen.Color:=RGB(0,0,0);
      sleep(100);
      Rectangle(x+(c1-1)*w,y-A[c1],x+c1*w,y);
      Rectangle(x+(c2-1)*w,y-A[c2],x+c2*w,y);
      Brush.Color:=RGB(255,255,255);
      sleep(100);
      FillRect(Bounds(x+(c1-1)*w,y-320,x+c1*w,y));
      FillRect(Bounds(x+(c2-1)*w,y-320,x+c2*w,y));
      Brush.Color:=RGB(255,0,0);
      Rectangle(x+(c1-1)*w,y-A[c2],x+c1*w,y);
      Rectangle(x+(c2-1)*w,y-A[c1],x+c2*w,y);
    end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Chandge(10,20);
end;

Но стоит, например, w задать больше 5 и изображения исчезают.
Скорее всего проблема в том, что рисунки вылетают за границы поля Image1.

@Rolion · 20.11.2012, 20:46 **[ТС]**

Э, не, тут все сложнее. Это лишь часть целого, которое выглядит примерно так:

Delphi
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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
unit Sort;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    Counter: TTrackBar;
    Label1: TLabel;
    MakeArray: TButton;
    Clear: TButton;
    Bubble: TButton;
    procedure CounterChange(Sender: TObject);
    procedure MakeArrayClick(Sender: TObject);
    procedure ClearClick(Sender: TObject);
    procedure BubbleClick(Sender: TObject);
    procedure Chandge(c1,c2:integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  x,y,w,c:integer;
  A:array [1..50] of integer;
 
 
implementation
 
{$R *.dfm}
 
procedure TForm1.CounterChange(Sender: TObject);
begin
  Label1.Caption:=IntToStr(Counter.Position);
end;
 
procedure TForm1.Chandge(c1,c2:integer);
begin
  with Form1.Image1.Canvas do
    begin
      Brush.Color:=RGB(0,255,0);
      Pen.Color:=RGB(0,0,0);
      sleep(100);
      Rectangle(x+(c1-1)*w,y-A[c1],x+c1*w,y);
      Rectangle(x+(c2-1)*w,y-A[c2],x+c2*w,y);
      Brush.Color:=RGB(255,255,255);
      sleep(100);
      FillRect(Bounds(x+(c1-1)*w,y-320,x+c1*w,y));
      FillRect(Bounds(x+(c2-1)*w,y-320,x+c2*w,y));
      Brush.Color:=RGB(255,0,0);
      Rectangle(x+(c1-1)*w,y-A[c2],x+c1*w,y);
      Rectangle(x+(c2-1)*w,y-A[c1],x+c2*w,y);
    end;
end;
 
procedure TForm1.MakeArrayClick(Sender: TObject);
var
  i,k:integer;
begin
  randomize;
  w:=10;
  c:=Counter.Position;
  Counter.Enabled:=False;
  MakeArray.Enabled:=False;
  Clear.Enabled:=True;
  Bubble.Enabled:=True;
  x:=25;
  y:=325;
  with Form1.Image1.Canvas do
    begin
      Brush.Color:=RGB(255,0,0);
      Pen.Color:=RGB(0,0,0);
      For i:=0 to c-1 do
        begin
          k:=Random(300)+10;
          A[i]:=k;
          Rectangle(x+i*w,y-k,x+(i+1)*w,y);
        end;
    end;
end;
 
procedure TForm1.ClearClick(Sender: TObject);
begin
  Counter.Enabled:=True;
  MakeArray.Enabled:=True;
  Clear.Enabled:=False;
  Bubble.Enabled:=False;
  Form1.Image1.Canvas.Brush.Color:=clWhite;
  Form1.Image1.Canvas.FillRect(Bounds(0,0,1000,1000));
  c:=0;
end;
 
procedure TForm1.BubbleClick(Sender: TObject);
var
  i,j,buf:integer;
begin
  For i:=1 to c do
    For j:=1 to c-1 do
      begin
        if A[j]>A[j+1] then
          begin
            Chandge(j,j+1);
            buf:=A[j];
            A[j]:=A[j+1];
            A[j+1]:=buf;
          end;
      end;
end;
 
end.

Программа должна показывать, как происходит тот или иной вид сортировки. Пока что реализован только пузырёк, но и для него ничего не работает. Начало сортировки -- кнопка Bubble. Создание массива и столбиков -- MakeArray. В процедуре TForm1.BubbleClick вызывается Chandge, выполняется, но на экране -- никаких изменений. В этом и заключается проблема. Если кому интересно -- исходники
Sort.rar

@FIL · 20.11.2012, 21:06

Я же говорил проблема в вылете за пределы Канваса.
А у тебя значения координат вообще в жесткий минус уходят (см. рис).
Добавь в процедуру:

Delphi
1
2
3
4
ShowMessage(IntToStr(x+(c1-1)*w) + #13#10 + 
            IntToStr(y-A[c1])    + #13#10 +
            IntToStr(x+c1*w)     + #13#10 + 
            IntToStr(y));

и сам посмотри.

@Rolion · 20.11.2012, 21:59 **[ТС]**

С этим вроде все в порядке. Такой ещё вопрос. У меня всё работает, но при этом не показывает промежуточный результат (т.е. сразу отсортированные столбики). Как это исправить?

@FIL · 20.11.2012, 22:13

Поподробней напиши, что должно быть и что не показывает.

@Rolion · 20.11.2012, 23:50 **[ТС]**

Должно быть что-то вроде длинной анимашки о том, как сортируется массив. Вместо этого он тупит минуту (из-за sleep-ов) и выдает конечный результат -- отсортированные столбики.

@FIL · 21.11.2012, 09:26

Если Chandge выполняется, но ничего не рисуется, то, видимо, проблема опять с расчетом координат.
Советую всетаки добавить в процедуру:

Delphi
1
2
3
4
ShowMessage(IntToStr(x+(c1-1)*w) + #13#10 + 
            IntToStr(y-A[c1])    + #13#10 +
            IntToStr(x+c1*w)     + #13#10 + 
            IntToStr(y));

и пошагово проверить все координаты.
Или выложи прогу с последними испрвлениями.

@Rolion · 21.11.2012, 20:17 **[ТС]**

Вот код, который я поменял

Delphi
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
31
procedure TForm1.Chandge();
begin
  with Form1.Image1.Canvas do
    begin
      Brush.Color:=RGB(0,255,0);
      sleep(100);
      Rectangle(x+(c1)*w,y-A[c1],x+(c1+1)*w,y);
      Rectangle(x+(c2)*w,y-A[c2],x+(c2+1)*w,y);
      Brush.Color:=RGB(255,255,255);
      sleep(100);
      Pen.Color:=RGB(255,255,255);
      Rectangle(x+(c1)*w,y-310,x+(c1+1)*w,y);
      Rectangle(x+(c2)*w,y-310,x+(c2+1)*w,y);
      Brush.Color:=RGB(255,0,0);
      Pen.Color:=RGB(0,0,0);
      Brush.Color:=RGB(0,255,0);
      sleep(100);
      Rectangle(x+(c1)*w,y-A[c1],x+(c1+1)*w,y);
      Rectangle(x+(c2)*w,y-A[c2],x+(c2+1)*w,y);
      Brush.Color:=RGB(255,0,0);
      sleep(100);
      Brush.Color:=RGB(255,255,255);
      Pen.Color:=RGB(255,255,255);
      Rectangle(x+(c1)*w,y-310,x+(c1+1)*w,y);
      Rectangle(x+(c2)*w,y-310,x+(c2+1)*w,y);
      Brush.Color:=RGB(255,0,0);
      Pen.Color:=RGB(0,0,0);
      Rectangle(x+(c1)*w,y-A[c2],x+(c1+1)*w,y);
      Rectangle(x+(c2)*w,y-A[c1],x+(c2+1)*w,y);
    end;
end;

и

Delphi
1
2
3
 Pen.Color:=RGB(0,0,0);
      For i:=1 to c do
        begin

Всё работает правильно, только промежуточные действия не отображаются

@FIL · 21.11.2012, 20:43

Чтобы видно было добавь после каждого sleep:

Delphi
1
2
  sleep(100);
  Application.ProcessMessages;

Но с расчетами прямоугольников, по-моему, что-то не то...

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .	Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»	SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .

@Rolion 14 / 14 / 8 Регистрация: 04.01.2011 Сообщений: 195
	20.11.2012, 21:59 [ТС]
	С этим вроде все в порядке. Такой ещё вопрос. У меня всё работает, но при этом не показывает промежуточный результат (т.е. сразу отсортированные столбики). Как это исправить? 0

@FIL Модератор 3492 / 2614 / 742 Регистрация: 19.09.2012 Сообщений: 7,977
	20.11.2012, 22:13
	Поподробней напиши, что должно быть и что не показывает. 0

@Rolion 14 / 14 / 8 Регистрация: 04.01.2011 Сообщений: 195
	20.11.2012, 23:50 [ТС]
	Должно быть что-то вроде длинной анимашки о том, как сортируется массив. Вместо этого он тупит минуту (из-за sleep-ов) и выдает конечный результат -- отсортированные столбики. 0