Advertisement
Janilabo

dilation

Nov 5th, 2013
62
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 2.57 KB | None | 0 0
  1. {$loadlib pumbaa.dll}
  2.  
  3. var
  4.   TPA: TPointArray;
  5.   i: Integer;
  6.  
  7. procedure TPADilation(var TPA: TPointArray; iterations: Integer);
  8. var
  9.   w, h, l, i, j, c, s, g, n, t: Integer;
  10.   m: T2DIntegerArray;
  11.   o, d: TIntegerArray;
  12.   se: TStructuringElement;
  13.   p: TPoint;
  14.   b: TBox;
  15. begin
  16.   if (iterations > 0) then
  17.   begin
  18.     l := Length(TPA);
  19.     if (l > 0) then
  20.     begin
  21.       b := pp_TPABounds(TPA);
  22.       pp_BoxResize(b, (iterations + 1));
  23.       WriteLn(ToStr(b));
  24.       pp_BoxDimensions(b, w, h);
  25.       m := pp_Create(0, w, h);
  26.       se := pp_SE_Cross(1, 1, -1, 1, 1);
  27.       g := 3;
  28.       c := 0;
  29.       for i := 0 to (l - 1) do
  30.         if not (m[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] = 1) then
  31.         begin
  32.           m[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] := 1;
  33.           TPA[c] := TPA[i];
  34.           c := (c + 1);
  35.         end;
  36.       l := (l - (c - 1));
  37.       s := (l - 1);
  38.       if (c > 0) then
  39.         SetLength(TPA, l);
  40.       d := pp_TIAByRange(0, (w * h));
  41.       o := pp_Clone(d);
  42.       t := 0;
  43.       repeat
  44.         n := 0;
  45.         case (t and 1) of
  46.           0:
  47.           for i := 0 to s do
  48.             for j := 0 to g do
  49.             begin
  50.               p.X := (TPA[o[i]].X + se[j].pixel.X);
  51.               p.Y := (TPA[o[i]].Y + se[j].pixel.Y);
  52.               if (m[(p.X - b.X1)][(p.Y - b.Y1)] = 0) then
  53.               begin
  54.                 SetLength(TPA, (l + 1));
  55.                 TPA[l] := p;
  56.                 m[(p.X - b.X1)][(p.Y - b.Y1)] := 1;
  57.                 d[n] := l;
  58.                 n := (n + 1);
  59.                 l := (l + 1);
  60.               end;
  61.             end;
  62.           1:
  63.           for i := 0 to s do
  64.             for j := 0 to g do
  65.             begin
  66.               p.X := (TPA[d[i]].X + se[j].pixel.X);
  67.               p.Y := (TPA[d[i]].Y + se[j].pixel.Y);
  68.               if (m[(p.X - b.X1)][(p.Y - b.Y1)] = 0) then
  69.               begin
  70.                 SetLength(TPA, (l + 1));
  71.                 TPA[l] := p;
  72.                 m[(p.X - b.X1)][(p.Y - b.Y1)] := 1;
  73.                 o[n] := l;
  74.                 n := (n + 1);
  75.                 l := (l + 1);
  76.               end;
  77.             end;
  78.         end;
  79.         s := (n - 1);
  80.         t := (t + 1);
  81.       until (t >= iterations);
  82.     end;
  83.   end;
  84. end;
  85.  
  86. procedure DebugBitmap(bmp: Integer);
  87. var
  88.   w, h: Integer;
  89. begin
  90.   GetBitmapSize(bmp, w, h);
  91.   DisplayDebugImgWindow(w, h);
  92.   DrawBitmapDebugImg(bmp);
  93. end;
  94.  
  95. var
  96.   b: Integer;
  97.  
  98. begin
  99.   b := CreateBitmap(500, 500);
  100.   ClearDebug;
  101.   TPA := [Point(250, 250)];
  102.   TPADilation(TPA, 100);
  103.   DrawTPABitmap(b, TPA, 255);
  104.   DebugBitmap(b);
  105. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement