Alvin Seville
334 / 266 / 132
Регистрация: 25.07.2014
Сообщений: 4,537
Записей в блоге: 9
1

Почему не заливает нужную область?

17.07.2017, 10:58. Показов 942. Ответов 6
Метки нет (Все метки)

Почему не заливает нужную область?
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
uses crt, GraphABC;
const
  C = clRed;
 
var
  x, y: integer;
  xset, yset: set of integer;
 
procedure Fill(x, y: integer);
begin
  if (GetPixel(x - 1, y) <> clBlack) and not (x - 1 in xset) then begin PutPixel(x - 1, y, C);Include(xset, x - 1);Fill(x - 1, y); end;
  if (GetPixel(x + 1, y) <> clBlack) and not (x + 1 in xset) then begin PutPixel(x + 1, y, C);Include(xset, x + 1);Fill(x + 1, y); end;
  if (GetPixel(x, y - 1) <> clBlack) and not (y - 1 in yset) then begin PutPixel(x, y - 1, C);Include(yset, y - 1);Fill(x, y - 1); end;
  if (GetPixel(x, y + 1) <> clBlack) and not (y + 1 in yset) then begin PutPixel(x, y + 1, C);Include(yset, y + 1);Fill(x, y + 1); end;
end;
 
begin
  DrawRectangle(100, 100, 300, 300);
  x := 150;y := 150;
  SetSmoothingOff;
  Fill(x, y);
end.
Добавлено через 4 минуты
Pascal
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
uses crt, GraphABC;
const
  C = clRed;
  BC = clBlack;
 
var
  x, y: integer;
  xset, yset: set of integer;
 
procedure Fill(x, y: integer);
begin
  var xM := x - 1;
  var xP := x + 1;
  var yM := y - 1;
  var yP := y + 1;
  if (GetPixel(xM, y) <> BC) and not (xM in xset) then begin PutPixel(xM, y, C);Include(xset, xM);Fill(xM, y); end;
  if (GetPixel(xP, y) <> BC) and not (xP in xset) then begin PutPixel(xP, y, C);Include(xset, xP);Fill(xP, y); end;
  if (GetPixel(x, yM) <> BC) and not (yM in yset) then begin PutPixel(x, yM, C);Include(yset, yM);Fill(x, yM); end;
  if (GetPixel(x, yP) <> BC) and not (yP in yset) then begin PutPixel(x, yP, C);Include(yset, yP);Fill(x, yP); end;
end;
 
begin
  DrawRectangle(100, 100, 300, 300);
  x := 150;y := 150;
  SetSmoothingOff;
  Fill(x, y);
end.
0
Лучшие ответы (1)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
17.07.2017, 10:58
Ответы с готовыми решениями:

Почему процедура заливает весь PictureBox а не только окружность
Здравствуйте. Подскажите почему так происходит (процедура заливает весь PictureBox а не только...

Вставка картинки с текстом в нужную область
Помогите пожалуйста. У меня есть файл main.php. Хочу чтобы ниже текста было следующее Вот мой...

Вставка картинки с текстом в нужную область
Помогите пожалуйста. У меня есть файл main.php. Хочу чтобы ниже текста было следующее Вот мой...

Объясните почему такая область определения
вот функция: z=arccos(x^2/y^2) область определения: y не равно 0 и x^2&lt;=y^2 Добавлено через...

6
Супер-модератор
Эксперт Pascal/DelphiАвтор FAQ
31835 / 20744 / 8057
Регистрация: 22.10.2011
Сообщений: 35,953
Записей в блоге: 7
17.07.2017, 11:01 2
Потому что
Program166.pas(16) : Ошибка времени выполнения: Parameter must be positive and < Width. Parameter name: x
1
Alvin Seville
334 / 266 / 132
Регистрация: 25.07.2014
Сообщений: 4,537
Записей в блоге: 9
17.07.2017, 11:03  [ТС] 3
Не, я уже видел это. Но что в алгоритме самом не так? Почему вместо заливки он мне рисует линию какую-то?
0
4847 / 2480 / 2279
Регистрация: 10.12.2014
Сообщений: 9,559
17.07.2017, 12:49 4
Лучший ответ Сообщение было отмечено Volobuev Ilya как решение

Решение

Pascal
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
uses GraphABC;
 
var
  x, y: integer;
 
procedure Fill(x, y: integer; clBorder, clFill : Color);
begin
  if (x < 1) or (x > window.Width-2) or (y < 0) or (y > window.Height-2) then Exit;
  var L := New List<point>;
  PutPixel(x, y, clFill); L.Add((x,y));
  repeat
    var r := New List<point>;
    var a := New List<point>;
    foreach var p in L do
      begin
        var f := 0;
        
        var c := GetPixel(p.X-1, p.Y);
        if (c.R = clBorder.R) and (c.G = clBorder.G) and (c.B = clBorder.B) or
           (c.R = clFill.R) and (c.G = clFill.G) and (c.B = clFill.B) then f += 1
        else begin PutPixel(p.X-1, p.Y, clFill); a.Add((p.X-1, p.Y)); end;
        
        c := GetPixel(p.X+1, p.Y);
        if (c.R = clBorder.R) and (c.G = clBorder.G) and (c.B = clBorder.B) or
           (c.R = clFill.R) and (c.G = clFill.G) and (c.B = clFill.B) then f += 1
        else begin PutPixel(p.X+1, p.Y, clFill); a.Add((p.X+1, p.Y)); end;
 
        c := GetPixel(p.X, p.Y-1);
        if (c.R = clBorder.R) and (c.G = clBorder.G) and (c.B = clBorder.B) or
           (c.R = clFill.R) and (c.G = clFill.G) and (c.B = clFill.B) then f += 1
        else begin PutPixel(p.X, p.Y-1, clFill); a.Add((p.X, p.Y-1)); end;
        
        c := GetPixel(p.X, p.Y+1);
        if (c.R = clBorder.R) and (c.G = clBorder.G) and (c.B = clBorder.B) or
           (c.R = clFill.R) and (c.G = clFill.G) and (c.B = clFill.B) then f += 1
        else begin PutPixel(p.X, p.Y+1, clFill); a.Add((p.X, p.Y+1)); end;
        
        if f = 4 then r.Add(p);
      end;
    foreach var p in r do L.Remove(p);
    foreach var p in a do L.Add(p);
    Redraw;
  until L.Count = 0;
  Window.Caption := 'End!';
end;
 
begin
  Window.Width := 800;
  Window.Height := 700;
  SetSmoothingOff;
  LockDrawing;
  
//  DrawRectangle(100, 100, 300, 300);
//  Redraw;
//  Fill(150, 150, clBlack, clRed);
  
  DrawPolygon((100,100),(200,100),(200,400),(300,400),(300,100),(700,100),(700,600),(600,600),(600,200),(400,200),(400,300),(500,300),(500,500),(100,500));
  Redraw;
  Fill(150, 150, clBlack, RGB(255,255,0));
end.
Почему-то GetPixel возвращает цвет, но он не равен константному…
А если его задавать с помощью функции RGB, то равенство однозначно ;–(
Pascal
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
uses GraphABC;
 
var
  x, y: integer;
 
procedure Fill(x, y: integer; clBorder, clFill : Color);
begin
  if (x < 1) or (x > window.Width-2) or (y < 0) or (y > window.Height-2) then Exit;
  var L := New List<point>;
  PutPixel(x, y, clFill); L.Add((x,y));
  repeat
    var r := New List<point>;
    var a := New List<point>;
    foreach var p in L do
      begin
        var f := 0;
        
        var c := GetPixel(p.X-1, p.Y);
        if (c.R = clBorder.R) and (c.G = clBorder.G) and (c.B = clBorder.B) or
           (c = clFill) then f += 1
        else begin PutPixel(p.X-1, p.Y, clFill); a.Add((p.X-1, p.Y)); end;
        
        c := GetPixel(p.X+1, p.Y);
        if (c.R = clBorder.R) and (c.G = clBorder.G) and (c.B = clBorder.B) or
           (c = clFill) then f += 1
        else begin PutPixel(p.X+1, p.Y, clFill); a.Add((p.X+1, p.Y)); end;
 
        c := GetPixel(p.X, p.Y-1);
        if (c.R = clBorder.R) and (c.G = clBorder.G) and (c.B = clBorder.B) or
           (c = clFill) then f += 1
        else begin PutPixel(p.X, p.Y-1, clFill); a.Add((p.X, p.Y-1)); end;
        
        c := GetPixel(p.X, p.Y+1);
        if (c.R = clBorder.R) and (c.G = clBorder.G) and (c.B = clBorder.B) or
           (c = clFill) then f += 1
        else begin PutPixel(p.X, p.Y+1, clFill); a.Add((p.X, p.Y+1)); end;
        
        if f = 4 then r.Add(p);
      end;
    foreach var p in r do L.Remove(p);
    foreach var p in a do L.Add(p);
    Redraw;
  until L.Count = 0;
  Window.Caption := 'End!';
end;
 
begin
  Window.Width := 800;
  Window.Height := 700;
  SetSmoothingOff;
  LockDrawing;
  
//  DrawRectangle(100, 100, 300, 300);
//  Redraw;
//  Fill(150, 150, clBlack, clRed);
  
  DrawPolygon((100,100),(200,100),(200,400),(300,400),(300,100),(700,100),(700,600),(600,600),(600,200),(400,200),(400,300),(500,300),(500,500),(100,500));
  Redraw;
  Fill(150, 150, clBlack, RGB(255,255,0));
end.
1
Alvin Seville
334 / 266 / 132
Регистрация: 25.07.2014
Сообщений: 4,537
Записей в блоге: 9
17.07.2017, 12:59  [ТС] 5
Можете пояснить как работает алгоритм?
0
4847 / 2480 / 2279
Регистрация: 10.12.2014
Сообщений: 9,559
17.07.2017, 13:03 6
Нет!
Отладчиком его! Отладчиком!!!

P.S. Работал бы и ваш, наверное, если бы в PABC.NET GetPixel был бы равен clRed или clBlack…
1
Alvin Seville
334 / 266 / 132
Регистрация: 25.07.2014
Сообщений: 4,537
Записей в блоге: 9
17.07.2017, 15:19  [ТС] 7
Даже хорошо, что сам все осознал и понял в вашем коде.

Добавлено через 1 час 31 минуту
Pascal
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
uses GraphABC;
const
  C = clRed;
  BC = clBlack;
 
var
  x, y: integer;
  xset, yset: set of integer;
 
function NotEqual(c1, c2: Color):= (c1.R <> c2.R) and (c1.G <> c2.G) and (c1.B <> c2.B);
 
procedure Fill(x, y: integer);
begin
  var xM := x - 1;
  var xP := x + 1;
  var yM := y - 1;
  var yP := y + 1;
  if NotEqual(GetPixel(xM, y), BC) and not (xM in xset) then begin PutPixel(xM, y, C);Include(xset, xM);Fill(xM, y); end;
  if NotEqual(GetPixel(xP, y), BC) and not (xP in xset) then begin PutPixel(xP, y, C);Include(xset, xP);Fill(xP, y); end;
  if NotEqual(GetPixel(x, yM), BC) and not (yM in yset) then begin PutPixel(x, yM, C);Include(yset, yM);Fill(x, yM); end;
  if NotEqual(GetPixel(x, yP), BC) and not (yP in yset) then begin PutPixel(x, yP, C);Include(yset, yP);Fill(x, yP); end;
end;
 
begin
  DrawRectangle(100, 100, 300, 300);
  x := 150;y := 150;
  SetSmoothingOff;
  Fill(x, y);
end.
Не работает.
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
17.07.2017, 15:19
Помогаю со студенческими работами здесь

Почему область активности ссылки такая высокая?
почему ссылка &quot;Зарегистрироваться&quot; активна так высоко? Прикрепил скрин выделенной страницы. Вот...

FloodFill - криво заливает
Всем привет. В общем, задача состоит в том, чтобы при нажатии на кнопку рисовались координатные...

Нагретый монитор заливает белым
Товарищи, help. Монитор NEC MultiSync LCD1760NX. После 2-3 часов работы монитор полностью заливает...

Vitek VT-1838 заливает пол
При использование пылесоса, вся грязная вода вытекает на ковер. Купили его совсем недавно. В чем...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
7
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2022, CyberForum.ru