var  a         :  array[1..100,1..100] of byte;

          Near     :  array[1..2] of record

                                                  x,y : byte; 

                                           end;

    Procedure Loang;

     Var i,j,z : byte;

     Begin

            Repeat  {Kiểm tra nếu phần tử cuối cùng a[n,m] khác 0 (gặp điểm dừng) thì sẽ kết thúc, ngược lại thì làm những công việc sau }

                  Flag := false; {Hiện tại, chưa tìm đc chỗ để loang}

                  For i := 1 to n do

                     For j := 1 to m do {Duyệt tất cả phần tử mảng}

                     Begin

                              If (a[i,j] = e) then  {Nếu phát hiện có dấu chân đc đánh dấu tại bước loang thứ e thì bắt đầu loang tiếp}

                              Begin

                                          {Tạo những phần tử xung quanh i,j. Ở đây tôi làm dưới và phải}

                                          Near[1].x := i+1;          Near[1].y := j;

                                          Near[2].x := i;             Near[2].y := j+1;

                                          For z := 1 to 2 do {Bắt đầu duyệt các phần tử xung quanh đó}

                                          Begin

                                                  If (a[Near[z].x,Near[z].y] = 0) then {Nếu kô gặp chướng ngại vật}  (Near là mảng hằng giống như trong bài toán mã đi tuần}

                                                  Begin

                                                           Flag := true; {Đã tìm được chỗ loang}

                                                           a[Near[z].x,Near[z].y] := e+1; {Đánh dấu chân đã loang tới đếm được ở bước thứ e + 1}

                                                  End;        

                                          End;

                              End;

                     End;

                  If  Flag then e := e+1;

            Until a[n,m] <> 0;

     End;

     BEGIN

            ReadInput;

            e := 1;

            Loang;

            Print;

            Readln;

     END.

Ma trận gốc:

0 0 1 0 1

0 0 0 1 1

0 0 0 0 1

0 0 0 0 0

Ma trận Loang:

1 2 1 0 1

2 3 4 1 1

3 4 5 6 1

4 5 6 7 8

Ma trận đã xóa Loang dư: 

1 0 1 0 1

2 0 0 1 1

3 0 0 0 1

4 5 6 7 8

Sau đây mình sẽ giới thiệu một cách cài đặt khác, sử dụng hàng đợi (queue) như sau:

Const

Hx:array[1..4] of shortint=(0,1,-1,0);

Hy:array[1..4] of shortint=(1,0,0,-1);

Front:=0;  Rear:=1;     {đánh dấu trong hàng đợi những phần tử cần quan tâm}

Repeat

    Inc(front);

    X:=queue[front].x;  Y:=queue[front].y;

    For  i:=1 to 4 do   {Xét các ô kề}

        If A[X+hx[i],Y+hy[i]]={đi được} then 

        Begin

            Inc(rear);   queue[rear].x:=X+hx[i];  queue[rear].y:=Y+hx[i];

            Pre[rear].x:=X;   Pre[rear].y:=Y;  {lưu đường đi}

        End;

Until Front>Rear;   {hết hàng đợi}