Advertisement
Janilabo

Untitled

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