option base 1
dim pole(10,10)
for i=1 to 10
for k=1 to 10
x=int(rnd*3)+1
pole(k,i)=x
next k
next i
private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)
'a() - само поле, значения 1..4
't() - маска заливки 1 - если клетка вошла в область, 0 - если (ещё) не вошла
'b() - массив для хранения текущего и будущего фронтов, ячейки b(0) и b(11) хранят количество клеток в фронте
Dim a(0 to 99) as byte,t(0 to 99) as byte, i as byte, j as byte, k as byte
Dim b(0 to 21) as byte, bi as byte, bc as byte, gc as byte, c as byte
For i=0 to 99
a(i)=CByte(rnd*3+1)
Next i
For i=0 to 99
c=a(i) ' цвет i-ой клетки
If c<4 then
off=0
offn=11
b(0)=1
b(1)=i
gc=1 'количество клеток в области
'вначале фронт состоит из одной клетки
Do
bc=0 'количество клеток в новом фронте
ZeroMemory t(0), 100
For j=1 to b(off)
t(b(off+j))=1
Next j
For j=1 to b(off)
k=b(off+j)
'проверка клетки сверху
If k>9 then
If a(k-10)=c then
If t=0 then
bc=bc+1
b(offn+bc)=k-10
end if
end if
end if
'проверка клетки снизу
If k<90 then
If a(k+10)=c then
If t=0 then
bc=bc+1
b(offn+bc)=k+10
end if
end if
end if
'проверка клетки слева
If (k mod 10)>0 then
If a(k-1)=c then
If t=0 then
bc=bc+1
b(offn+bc)=k-1
end if
end if
end if
'проверка клетки справа
If (k mod 10)<9 then
If a(k+1)=c then
If t=0 then
bc=bc+1
b(offn+bc)=k+1
end if
end if
end if
gc=gc+bc
'новый фронт заменяет старый
b(offn)=bc
off=11-off
offn=11-offn
Loop Until b(off)=0 'если в новом фронте нет клеток, то прекращаем работу
'если в области больше 2-х клеток, закрашиваем.
If gc>2 then
For j=0 to 99
If t(j) then a(j)=4
next j
end if
next i
Сейчас этот форум просматривают: Google-бот, SemrushBot и гости: 49