Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[3.142.98.108] |
|
Сообщ.
#1
,
|
|
|
Доброе время суток.
Есть небольшая задачка. для простоты берем двумерный массив 3*3. var m:array[1..3,1..3] of byte; содержимое может быть таким 1) |444| |411| |414| 2) |444| |414| |441| 3) |444| |414| |414| Вопрос: как проще всего создать массив связанных ячеек? например для 1) должно быть № 1 2 3 4 5 i 1 1 1 2 3 j 1 2 3 1 1 Значение в 33 не подходит так как с ним связи нет |
Сообщ.
#2
,
|
|
|
Не очень понятно, что означает "проще"? Это же обычный FloodFill, реализаций коего - вагоны!
|
Сообщ.
#3
,
|
|
|
Всё. Понял.
|
Сообщ.
#4
,
|
|
|
Кстати, по поводу
Цитата Славян @ реализаций коего - вагоны! Вот такая вот ссылка wiki/Bitmap/Flood_fill , ничего странного не наблюдаете? Получается, да, но не точно. procedure FF(i,j:integer;oldColor:byte;newColor:byte); begin If ((i<0) Or (i>=14) Or (j<0) Or (j>=14)) Then Exit; if m[i,j] = oldColor then begin; if m[i,j]<> newColor then BeGin m[i,j]:=newColor; FF(i-1,j,oldColor,newColor); FF(i+1,j,oldColor,newColor); FF(i,j+1,oldColor,newColor); // FF(i,j-1,oldColor,newColor); //по идее должен быть, но тогда закрасит лишнее EnD end; end; так // FF(i,j-1,oldColor,newColor); добавляет лишние закрашенные ячейки по краю справа при значении 4 Прикреплённый файлSaved_String.txt (198 байт, скачиваний: 88) тестовый файл прикрепил или просто строкой. текст загружаемого файла: 4342513324566431151635354654111656112455233143436451666534611266355166223125245362621226126335522252514253454321623365244163266365663366411232453321644531112564556322334511435413516543534214161322 тестил на последовательности 3 1 4 2 3 6 должно получаться 3 9 12 19 26 35 выходит так 3 9 12 18 25 32 если раскомментить строку, то 3 9 14 21 29 40 посмотрел здесь geeksforgeeks Но что-то я упускаю из виду. Заранее спасибо. Здесь, то попробовал сделать в качестве теста. type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; Button2: TButton; Button3: TButton; Button4: TButton; Button5: TButton; Button6: TButton; Button7: TButton; Button8: TButton; Button10: TButton; Label1: TLabel; procedure Button10Click(Sender: TObject); procedure Button8Click(Sender: TObject); procedure Button7Click(Sender: TObject); procedure Button5Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button6Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Seven; function GetStringFromFile(s:string):string; procedure Showmas; procedure Loadmas; private { Private declarations } public { Public declarations } end; type my_array =record i,j:byte; end; var Form1: TForm1; m,before,after:array[1..14,1..14] of integer; place:array[1..196] of my_array; s:string; count:byte; implementation //uses kol; {$R *.dfm} procedure TForm1.Button2Click(Sender: TObject); var m2:array[1..3,1..3] of byte; //**********************************Метод обнуления масссива procedure Nullmassive; var i,j :byte; begin for i:= low(m2) to high(m2) do for j:= low(m2) to high(m2)do m2[j,i]:=0; end; //*********************************Метод вывода массива в текстовое поле procedure Showmassive; var i,j :byte; s:string; begin memo1.Lines.Add(''); for j:=low(m2) to high(m2) do begin for i:=low(m2) to high(m2) do s:= s+intTostr(m2[j,i]); memo1.Lines.Add(s); s:=''; end; end; procedure FloodFill(i,j:byte;oldColor:byte;newColor:byte); begin if m2[i,j] = oldColor then begin; m2[i,j]:=newColor; floodFill(i-1,j,4,5); floodFill(i+1,j,4,5); floodFill(i,j+1,4,5); //floodFill(i,j-1,4,5); //если оставить закрашивает лишнее end; end; //=============================== Основная работа Begin memo1.Clear; Nullmassive; m2[1,1]:=4; m2[1,2]:=1; m2[1,3]:=4; m2[2,1]:=4; m2[2,2]:=1; m2[2,3]:=4; m2[3,1]:=4; m2[3,2]:=4; m2[3,3]:=1; Showmassive; FloodFill(1,1,4,5); Showmassive; End; procedure FF(i,j:integer;oldColor:byte;newColor:byte); begin If ((i<0) Or (i>=14) Or (j<0) Or (j>=14)) Then Exit; if m[i,j] = oldColor then begin; if m[i,j]<> newColor then BeGin m[i,j]:=newColor; FF(i-1,j,oldColor,newColor); FF(i+1,j,oldColor,newColor); FF(i,j+1,oldColor,newColor); // FF(i,j-1,oldColor,newColor); //по идее должен быть, но тогда закрасит лишнее EnD end; end; procedure TForm1.Button3Click(Sender: TObject); var i,j:byte; s2:string; begin if m[1,1] <> 1 then Begin memo1.Clear; FF(1,1,m[1,1],1); memo1.Lines.Add(' '); s2:=''; for j:=1 to 14 do begin for i:=1 to 14 do begin s2:= s2+IntToStr(m[j,i]); end; memo1.Lines.Add(s2); s2:=''; end; form1.Caption:=form1.Caption+intTostr(1); End; end; procedure TForm1.Button4Click(Sender: TObject); var i,j:byte; s2:string; begin if m[1,1] <> 2 then Begin memo1.Clear; FF(1,1,m[1,1],2); memo1.Lines.Add(' '); s2:=''; for j:=1 to 14 do begin for i:=1 to 14 do begin s2:= s2+IntToStr(m[j,i]); end; memo1.Lines.Add(s2); s2:=''; end; form1.Caption:=form1.Caption+intTostr(2); End; end; procedure TForm1.Button5Click(Sender: TObject); var i,j:byte; s2:string; begin if m[1,1] <> 3 then Begin memo1.Clear; FF(1,1,m[1,1],3); memo1.Lines.Add(' '); s2:=''; for j:=1 to 14 do begin for i:=1 to 14 do begin s2:= s2+IntToStr(m[j,i]); end; memo1.Lines.Add(s2); s2:=''; end; form1.Caption:=form1.Caption+intTostr(3); End; end; procedure TForm1.Button6Click(Sender: TObject); var i,j:byte; s2:string; begin if m[1,1] <> 4 then Begin memo1.Clear; FF(1,1,m[1,1],4); memo1.Lines.Add(' '); s2:=''; for j:=1 to 14 do begin for i:=1 to 14 do begin s2:= s2+IntToStr(m[j,i]); end; memo1.Lines.Add(s2); s2:=''; end; form1.Caption:=form1.Caption+intTostr(4); End; end; procedure TForm1.Button7Click(Sender: TObject); var i,j:byte; s2:string; begin if m[1,1] <> 5 then Begin memo1.Clear; FF(1,1,m[1,1],5); memo1.Lines.Add(' '); s2:=''; for j:=1 to 14 do begin for i:=1 to 14 do begin s2:= s2+IntToStr(m[j,i]); end; memo1.Lines.Add(s2); s2:=''; end; form1.Caption:=form1.Caption+intTostr(5); End; end; procedure TForm1.Button8Click(Sender: TObject); var i,j:byte; s2:string; begin if m[1,1] <> 6 then Begin memo1.Clear; FF(1,1,m[1,1],6); memo1.Lines.Add(' '); s2:=''; for j:=1 to 14 do begin for i:=1 to 14 do begin s2:= s2+IntToStr(m[j,i]); end; memo1.Lines.Add(s2); s2:=''; end; form1.Caption:=form1.Caption+intTostr(6); End; end; procedure TForm1.Seven; var i,j:byte; s2:string; begin if m[1,1] <> 7 then Begin memo1.Clear; FF(1,1,m[1,1],7); memo1.Lines.Add(' '); s2:=''; for j:=1 to 14 do begin for i:=1 to 14 do begin s2:= s2+IntToStr(m[j,i]); end; memo1.Lines.Add(s2); s2:=''; end; //form1.Caption:=form1.Caption+intTostr(7); End; end; procedure Tform1.Showmas; var i,j :byte; s:string; begin memo1.Lines.Add(''); for j:=low(m) to high(m) do begin for i:=low(m) to high(m) do s:= s+intTostr(m[j,i]); memo1.Lines.Add(s); s:=''; end; end; procedure TForm1.Loadmas; var i,j,f:byte; begin f:=0; for I := low(m) to high(m) do for j := low(m) to high(m) do begin inc(f); m[i,j]:=StrToInt(s[f]) end; end; function TForm1.GetStringFromFile(s:string):string; var loadfromfile :Tstringlist; begin if s<>'' then begin loadfromfile:=TStringlist.Create; loadfromfile.LoadFromFile(s); result:= loadfromfile.text; loadfromfile.Free end else result:= ''; s:='' end; procedure TForm1.Button10Click(Sender: TObject); var i,j,f:byte; begin // memo1.Clear; f:= m[1,1]; Seven; //FF(1,1,f,7); //Showmas; count:=0; for I := low(m) to high(m) do for j := low(m) to high(m) do if m[i,j] = 7 then begin inc(count); m[i,j] := f End; //FF(1,1,7,f); // Showmas; Label1.Caption:=IntToStr(count); end; procedure TForm1.Button1Click(Sender: TObject); begin Form1.Caption:='Form '; memo1.Clear; s:=GetStringFromFile('Saved_String.txt'); loadmas; Showmas; end; end. |
Сообщ.
#5
,
|
|
|
Погодьте! У вас же в Паскале индексы с единицы, а проверяете за выход меньше нуля в FF! Надо проверять за выход единицы:
If ((i<1) Or (i>=14) Or (j<1) Or (j>=14)) Then Exit; |
Сообщ.
#6
,
|
|
|
Спасибо +1
If ((i<1) Or (i>14) Or (j<1) Or (j>14)) Then Exit; Иначе ряд не войдет в диапазон =) |